Index: palm/trunk/SOURCE/Makefile
===================================================================
--- palm/trunk/SOURCE/Makefile	(revision 2689)
+++ palm/trunk/SOURCE/Makefile	(revision 2696)
@@ -1,4 +1,4 @@
 #--------------------------------------------------------------------------------#
-# This file is part of PALM.
+# This file is part of the PALM model system.
 #
 # PALM is free software: you can redistribute it and/or modify it under the terms
@@ -25,4 +25,18 @@
 # -----------------
 # $Id$
+# Implementation of uv exposure model (FK)
+# Bugfix, removed loop dependcy for vertical_nesting_mod and 
+# turbulence_closure_mod, added depencies for vertical_nesting_mod (TG)
+# implemented turbulence_closure_mod (TG)
+# Additional dependencies for chemistry module (FK)
+# Additional dependencies for chemistry module (FK)
+# Implementation of chemistry module (FK)
+# For LSM, add dependency on calc_mean_profile (??)
+# poismg_noopt modularized and renamed into poismg_noopt_mod
+# add dependencies for netcdf_data_input_mod, calc_mean_profile, 
+# radiation_module_mod, land_surface_model_mod (MS)
+# 
+# 
+# 2608 2017-11-13 14:04:26Z schwenkel
 # Added diagnostic_quantities_mod 
 # 
@@ -31,10 +45,10 @@
 # 
 # 2599 2017-11-01 13:18:45Z hellstea
-# virtual_flight_mod.o, synthetic_turbulence_generator_mod.o and
-# wind_turbine_model_mod.o were added to read_var_list.o
+# virtual_flight_mod, synthetic_turbulence_generator_mod and
+# wind_turbine_model_mod were added to read_var_list
 # 
 # 2563 2017-10-19 15:36:10Z Giersch
-# wind_turbine_model_mod.o and synthetic_turbulence_generator_mod.o were added to
-# write_var_list.o and virtual_flight_mod.o was deleted from read_var_list.o  
+# wind_turbine_model_mod and synthetic_turbulence_generator_mod were added to
+# write_var_list and virtual_flight_mod was deleted from read_var_list  
 # 
 # 2544 2017-10-13 18:09:32Z maronga
@@ -381,5 +395,6 @@
 	buoyancy.f90 calc_liquid_water_content.f90 calc_mean_profile.f90 \
 	calc_radiation.f90 \
-	check_for_restart.f90 check_open.f90 check_parameters.f90 \
+	check_for_restart.f90 check_open.f90 check_parameters.f90 chem_modules.f90 \
+	chemistry_model_mod.f90 chem_gasphase_mod.f90 chem_photolysis_mod.f90 \
 	close_file.f90 compute_vpt.f90 coriolis.f90 cpulog_mod.f90 \
 	data_log.f90 data_output_dvrp.f90 \
@@ -388,6 +403,6 @@
 	data_output_tseries.f90 data_output_2d.f90 data_output_3d.f90 \
 	date_and_time_mod.f90  diagnostic_quantities_mod.f90 \
-	diffusion_e.f90 diffusion_s.f90 diffusion_u.f90 diffusion_v.f90 \
-	diffusion_w.f90 diffusivities.f90 disturb_field.f90 \
+	diffusion_s.f90 diffusion_u.f90 diffusion_v.f90 \
+	diffusion_w.f90 disturb_field.f90 \
 	disturb_heatflux.f90 eqn_state_seawater.f90 exchange_horiz.f90 \
 	exchange_horiz_2d.f90 fft_xy_mod.f90 flow_statistics.f90 \
@@ -407,10 +422,11 @@
 	lpm_set_attributes.f90 lpm_splitting.f90 \
 	lpm_write_exchange_statistics.f90 lpm_write_restart_file.f90 \
-        large_scale_forcing_nudging_mod.f90 message.f90 microphysics_mod.f90 \
-        modules.f90 mod_kinds.f90 mod_particle_attributes.f90 model_1d_mod.f90 netcdf_interface_mod.f90 \
+	large_scale_forcing_nudging_mod.f90 message.f90 microphysics_mod.f90 \
+	modules.f90 mod_kinds.f90 mod_particle_attributes.f90 model_1d_mod.f90 \
+	netcdf_interface_mod.f90 netcdf_data_input_mod.f90 \
 	outflow_turbulence.f90 package_parin.f90 palm.f90 parin.f90 plant_canopy_model_mod.f90 \
 	pmc_interface_mod.f90 pmc_child_mod.f90 pmc_general_mod.f90 pmc_handle_communicator_mod.f90 \
 	pmc_mpi_wrapper_mod.f90 pmc_parent_mod.f90 poisfft_mod.f90 poismg_mod.f90 \
-	poismg_noopt.f90 posix_calls_from_fortran.f90 pres.f90 print_1d.f90 production_e.f90 \
+	poismg_noopt_mod.f90 posix_calls_from_fortran.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 \
@@ -422,4 +438,5 @@
 	time_integration.f90 time_integration_spinup.f90 time_to_string.f90 timestep.f90 \
 	timestep_scheme_steering.f90 transpose.f90 tridia_solver_mod.f90 \
+	turbulence_closure_mod.f90 \
 	urban_surface_mod.f90 \
 	user_3d_data_averaging.f90 \
@@ -436,5 +453,6 @@
 	user_lpm_init.f90 user_lpm_set_attributes.f90 user_module.f90 \
 	user_parin.f90 user_read_restart_data.f90 \
-	user_spectra.f90 user_statistics.f90 vertical_nesting_mod.f90 virtual_flight_mod.f90 \
+	user_spectra.f90 user_statistics.f90 uv_exposure_model_mod.f90 \
+	vertical_nesting_mod.f90 virtual_flight_mod.f90 \
 	wind_turbine_model_mod.f90 write_3d_binary.f90 write_var_list.f90
 
@@ -452,4 +470,7 @@
 # The following line is needed for palm_simple_install, don't remove it!
 #to_be_replaced_by_include
+
+
+
 
 .SUFFIXES:
@@ -481,6 +502,7 @@
 advec_w_up.o: modules.o mod_kinds.o
 average_3d_data.o: modules.o cpulog_mod.o mod_kinds.o exchange_horiz_2d.o land_surface_model_mod.o \
-	radiation_model_mod.o urban_surface_mod.o
-boundary_conds.o: modules.o mod_kinds.o pmc_interface_mod.o surface_mod.o
+	radiation_model_mod.o turbulence_closure_mod.o urban_surface_mod.o chemistry_model_mod.o
+boundary_conds.o: modules.o mod_kinds.o pmc_interface_mod.o surface_mod.o \
+	turbulence_closure_mod.o chemistry_model_mod.o
 buoyancy.o: modules.o mod_kinds.o
 calc_mean_profile.o: modules.o mod_kinds.o
@@ -490,8 +512,13 @@
 check_open.o: modules.o mod_kinds.o mod_particle_attributes.o \
 	netcdf_interface_mod.o posix_calls_from_fortran.o
-check_parameters.o: modules.o mod_kinds.o land_surface_model_mod.o large_scale_forcing_nudging_mod.o \
+check_parameters.o: modules.o mod_kinds.o chemistry_model_mod.o netcdf_data_input_mod.o \
+	land_surface_model_mod.o large_scale_forcing_nudging_mod.o \
 	microphysics_mod.o model_1d_mod.o netcdf_interface_mod.o plant_canopy_model_mod.o pmc_interface_mod.o \
 	radiation_model_mod.o spectra_mod.o subsidence_mod.o synthetic_turbulence_generator_mod.o \
-	wind_turbine_model_mod.o urban_surface_mod.o vertical_nesting_mod.o
+	turbulence_closure_mod.o wind_turbine_model_mod.o urban_surface_mod.o uv_exposure_model_mod.o vertical_nesting_mod.o
+chemistry_model_mod.o: modules.o mod_kinds.o chem_gasphase_mod.o diffusion_s.o chem_modules.o netcdf_data_input_mod.o surface_mod.o  
+chem_gasphase_mod.o: modules.o mod_kinds.o
+chem_modules.o: modules.o mod_kinds.o chem_gasphase_mod.o  
+chem_photolysis_mod.o: modules.o mod_kinds.o chem_gasphase_mod.o chemistry_model_mod.o radiation_model_mod.o
 close_file.o: modules.o mod_kinds.o netcdf_interface_mod.o
 compute_vpt.o: modules.o mod_kinds.o
@@ -512,16 +539,13 @@
 data_output_2d.o: modules.o cpulog_mod.o mod_kinds.o mod_particle_attributes.o \
    netcdf_interface_mod.o land_surface_model_mod.o radiation_model_mod.o \
-   surface_mod.o urban_surface_mod.o
+   surface_mod.o urban_surface_mod.o uv_exposure_model_mod.o
 data_output_3d.o: modules.o cpulog_mod.o mod_kinds.o mod_particle_attributes.o \
-   netcdf_interface_mod.o land_surface_model_mod.o urban_surface_mod.o
+   chemistry_model_mod.o netcdf_interface_mod.o land_surface_model_mod.o turbulence_closure_mod.o urban_surface_mod.o
 date_and_time_mod.o: modules.o mod_kinds.o 
 diagnostic_quantities_mod.o: modules.o mod_kinds.o
-diffusion_e.o: modules.o mod_kinds.o microphysics_mod.o \
-   mod_particle_attributes.o surface_mod.o
 diffusion_s.o: modules.o mod_kinds.o surface_mod.o
 diffusion_u.o: modules.o mod_kinds.o surface_mod.o
 diffusion_v.o: modules.o mod_kinds.o surface_mod.o
 diffusion_w.o: modules.o mod_kinds.o surface_mod.o
-diffusivities.o: modules.o mod_kinds.o surface_mod.o vertical_nesting_mod.o
 disturb_field.o: modules.o cpulog_mod.o mod_kinds.o random_function_mod.o \
                  random_generator_parallel_mod.o
@@ -538,25 +562,28 @@
    pmc_interface_mod.o radiation_model_mod.o spectra_mod.o subsidence_mod.o surface_mod.o virtual_flight_mod.o
 inflow_turbulence.o: modules.o cpulog_mod.o mod_kinds.o
-init_3d_model.o: modules.o mod_kinds.o advec_ws.o cpulog_mod.o disturb_heatflux.o land_surface_model_mod.o \
-   large_scale_forcing_nudging_mod.o lpm_init.o model_1d_mod.o netcdf_interface_mod.o \
+init_3d_model.o: modules.o mod_kinds.o advec_ws.o cpulog_mod.o \
+   chemistry_model_mod.o disturb_heatflux.o land_surface_model_mod.o \
+   large_scale_forcing_nudging_mod.o lpm_init.o model_1d_mod.o netcdf_data_input_mod.o netcdf_interface_mod.o \
    plant_canopy_model_mod.o radiation_model_mod.o random_function_mod.o random_generator_parallel_mod.o \
-   microphysics_mod.o mod_particle_attributes.o surface_layer_fluxes_mod.o \
-   urban_surface_mod.o virtual_flight_mod.o surface_mod.o wind_turbine_model_mod.o 
+   microphysics_mod.o mod_particle_attributes.o surface_layer_fluxes_mod.o turbulence_closure_mod.o \
+   urban_surface_mod.o uv_exposure_model_mod.o virtual_flight_mod.o surface_mod.o wind_turbine_model_mod.o 
 init_advec.o: modules.o mod_kinds.o
 init_cloud_physics.o: modules.o mod_kinds.o
 init_coupling.o: modules.o mod_kinds.o vertical_nesting_mod.o
 init_dvrp.o: modules.o mod_kinds.o
-init_grid.o: modules.o mod_kinds.o advec_ws.o netcdf_interface_mod.o surface_mod.o vertical_nesting_mod.o
+init_grid.o: modules.o mod_kinds.o advec_ws.o netcdf_data_input_mod.o netcdf_interface_mod.o poismg_noopt_mod.o \
+             surface_mod.o vertical_nesting_mod.o
 init_masks.o: modules.o mod_kinds.o netcdf_interface_mod.o
 init_ocean.o: modules.o eqn_state_seawater.o mod_kinds.o
 init_pegrid.o: modules.o mod_kinds.o spectra_mod.o synthetic_turbulence_generator_mod.o \
-   vertical_nesting_mod.o
+               vertical_nesting_mod.o
 init_pt_anomaly.o: modules.o mod_kinds.o
 init_rankine.o: modules.o mod_kinds.o
 init_slope.o: modules.o mod_kinds.o
 interaction_droplets_ptq.o: modules.o mod_kinds.o
-land_surface_model_mod.o: modules.o mod_kinds.o radiation_model_mod.o surface_mod.o diagnostic_quantities_mod.o
-large_scale_forcing_nudging_mod.o: modules.o cpulog_mod.o mod_kinds.o surface_mod.o
-local_stop.o: modules.o mod_kinds.o pmc_interface_mod.o
+land_surface_model_mod.o: modules.o mod_kinds.o calc_mean_profile.o diagnostic_quantities_mod.o \
+                          netcdf_data_input_mod.o radiation_model_mod.o surface_mod.o
+large_scale_forcing_nudging_mod.o: modules.o cpulog_mod.o mod_kinds.o netcdf_data_input_mod.o surface_mod.o
+local_stop.o: modules.o mod_kinds.o pmc_interface_mod.o vertical_nesting_mod.o
 local_tremain.o: modules.o cpulog_mod.o mod_kinds.o
 local_tremain_ini.o: modules.o cpulog_mod.o mod_kinds.o
@@ -597,15 +624,18 @@
 mod_kinds.o: mod_kinds.f90
 mod_particle_attributes.o: mod_particle_attributes.f90 mod_kinds.o
+netcdf_data_input_mod.o: modules.o mod_kinds.o pmc_interface_mod.o
 netcdf_interface_mod.o: netcdf_interface_mod.f90 modules.o mod_kinds.o \
-   land_surface_model_mod.o radiation_model_mod.o spectra_mod.o urban_surface_mod.o
+   chemistry_model_mod.o land_surface_model_mod.o radiation_model_mod.o \
+   spectra_mod.o turbulence_closure_mod.o urban_surface_mod.o uv_exposure_model_mod.o
 outflow_turbulence.o: modules.o cpulog_mod.o mod_kinds.o
 package_parin.o: modules.o mod_kinds.o mod_particle_attributes.o
-palm.o: modules.o cpulog_mod.o land_surface_model_mod.o mod_kinds.o \
-	pmc_interface_mod.o surface_layer_fluxes_mod.o
+palm.o: modules.o mod_kinds.o cpulog_mod.o netcdf_data_input_mod.o land_surface_model_mod.o \
+   chemistry_model_mod.o chem_photolysis_mod.o pmc_interface_mod.o surface_layer_fluxes_mod.o
 parin.o: modules.o cpulog_mod.o date_and_time_mod.o land_surface_model_mod.o mod_kinds.o model_1d_mod.o netcdf_interface_mod.o \
-   plant_canopy_model_mod.o pmc_interface_mod.o progress_bar_mod.o spectra_mod.o \
+   chemistry_model_mod.o chem_modules.o plant_canopy_model_mod.o pmc_interface_mod.o \
+   progress_bar_mod.o spectra_mod.o \
    synthetic_turbulence_generator_mod.o radiation_model_mod.o microphysics_mod.o \
-   vertical_nesting_mod.o virtual_flight_mod.o wind_turbine_model_mod.o
-plant_canopy_model_mod.o: modules.o mod_kinds.o surface_mod.o
+   uv_exposure_model_mod.o virtual_flight_mod.o wind_turbine_model_mod.o
+plant_canopy_model_mod.o: modules.o mod_kinds.o netcdf_data_input_mod.o surface_mod.o
 pmc_interface_mod.o: modules.o mod_kinds.o pmc_child_mod.o pmc_general_mod.o \
 	pmc_handle_communicator_mod.o pmc_mpi_wrapper_mod.o pmc_parent_mod.o surface_mod.o
@@ -618,25 +648,28 @@
 poisfft_mod.o: modules.o cpulog_mod.o fft_xy_mod.o mod_kinds.o tridia_solver_mod.o
 poismg_mod.o: modules.o cpulog_mod.o mod_kinds.o
-poismg_noopt.o: modules.o cpulog_mod.o mod_kinds.o
+poismg_noopt_mod.o: modules.o cpulog_mod.o mod_kinds.o
 posix_calls_from_fortran.o: posix_calls_from_fortran.f90
-pres.o: modules.o cpulog_mod.o mod_kinds.o poisfft_mod.o poismg_mod.o pmc_interface_mod.o \
+pres.o: modules.o cpulog_mod.o mod_kinds.o poisfft_mod.o poismg_mod.o poismg_noopt_mod.o pmc_interface_mod.o \
         surface_mod.o
 print_1d.o: modules.o cpulog_mod.o mod_kinds.o
-production_e.o: modules.o mod_kinds.o surface_mod.o
 prognostic_equations.o: modules.o advec_s_pw.o advec_s_up.o advec_s_bc.o advec_u_pw.o \
 	advec_u_up.o advec_v_pw.o advec_v_up.o advec_w_pw.o advec_w_up.o \
 	advec_ws.o buoyancy.o calc_radiation.o coriolis.o \
-	cpulog_mod.o diffusion_e.o diffusion_s.o diffusion_u.o diffusion_v.o diffusion_w.o \
+	chemistry_model_mod.o chem_photolysis_mod.o chem_modules.o \
+	cpulog_mod.o diffusion_s.o diffusion_u.o diffusion_v.o diffusion_w.o \
 	eqn_state_seawater.o large_scale_forcing_nudging_mod.o modules.o cpulog_mod.o mod_kinds.o surface_mod.o \
         mod_kinds.o microphysics_mod.o \
-	plant_canopy_model_mod.o production_e.o radiation_model_mod.o \
-	subsidence_mod.o surface_mod.o user_actions.o wind_turbine_model_mod.o
+	plant_canopy_model_mod.o radiation_model_mod.o \
+	subsidence_mod.o surface_mod.o turbulence_closure_mod.o user_actions.o wind_turbine_model_mod.o
 progress_bar_mod.o: modules.o mod_kinds.o
-radiation_model_mod.o: modules.o mod_particle_attributes.o date_and_time_mod.o microphysics_mod.o surface_mod.o
+radiation_model_mod.o: modules.o mod_particle_attributes.o calc_mean_profile.o date_and_time_mod.o \
+                       netcdf_data_input_mod.o microphysics_mod.o \
+                       plant_canopy_model_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: modules.o mod_kinds.o
 read_3d_binary.o: modules.o cpulog_mod.o mod_kinds.o \
-   land_surface_model_mod.o radiation_model_mod.o random_function_mod.o random_generator_parallel_mod.o \
+   chemistry_model_mod.o land_surface_model_mod.o radiation_model_mod.o \
+   random_function_mod.o random_generator_parallel_mod.o \
    spectra_mod.o surface_mod.o urban_surface_mod.o
 read_var_list.o: modules.o mod_kinds.o model_1d_mod.o netcdf_interface_mod.o plant_canopy_model_mod.o \
@@ -649,21 +682,23 @@
 spectra_mod.o: spectra_mod.f90 modules.o mod_kinds.o cpulog_mod.o fft_xy_mod.o
 subsidence_mod.o: modules.o mod_kinds.o
-sum_up_3d_data.o: modules.o cpulog_mod.o mod_kinds.o land_surface_model_mod.o \
-                  radiation_model_mod.o surface_mod.o urban_surface_mod.o
+sum_up_3d_data.o: modules.o cpulog_mod.o mod_kinds.o \
+	chemistry_model_mod.o land_surface_model_mod.o \
+	radiation_model_mod.o surface_mod.o turbulence_closure_mod.o urban_surface_mod.o uv_exposure_model_mod.o
 surface_coupler.o: modules.o cpulog_mod.o mod_kinds.o surface_mod.o
-surface_layer_fluxes_mod.o: modules.o mod_kinds.o exchange_horiz_2d.o land_surface_model_mod.o \
-	urban_surface_mod.o surface_mod.o
-surface_mod.o: modules.o mod_kinds.o model_1d_mod.o 
+surface_layer_fluxes_mod.o: modules.o mod_kinds.o chem_modules.o exchange_horiz_2d.o \
+	land_surface_model_mod.o urban_surface_mod.o surface_mod.o
+surface_mod.o: modules.o mod_kinds.o model_1d_mod.o chem_modules.o
 swap_timelevel.o: modules.o cpulog_mod.o mod_kinds.o land_surface_model_mod.o \
-   pmc_interface_mod.o urban_surface_mod.o
-synthetic_turbulence_generator_mod.o: modules.o mod_kinds.o cpulog_mod.o
+   chemistry_model_mod.o pmc_interface_mod.o turbulence_closure_mod.o urban_surface_mod.o
+synthetic_turbulence_generator_mod.o: modules.o mod_kinds.o
 temperton_fft_mod.o: modules.o mod_kinds.o
 time_integration.o: modules.o advec_ws.o buoyancy.o calc_mean_profile.o \
+	chemistry_model_mod.o chem_modules.o \
 	cpulog_mod.o data_output_flight.o disturb_heatflux.o interaction_droplets_ptq.o land_surface_model_mod.o \
-	large_scale_forcing_nudging_mod.o mod_kinds.o pmc_interface_mod.o production_e.o \
+	large_scale_forcing_nudging_mod.o mod_kinds.o pmc_interface_mod.o \
 	prognostic_equations.o progress_bar_mod.o radiation_model_mod.o \
 	spectra_mod.o user_actions.o microphysics_mod.o synthetic_turbulence_generator_mod.o \
-        surface_layer_fluxes_mod.o surface_mod.o \
-	urban_surface_mod.o vertical_nesting_mod.o virtual_flight_mod.o wind_turbine_model_mod.o
+	surface_layer_fluxes_mod.o surface_mod.o turbulence_closure_mod.o\
+	urban_surface_mod.o uv_exposure_model_mod.o vertical_nesting_mod.o virtual_flight_mod.o wind_turbine_model_mod.o
 time_integration_spinup.o: cpulog_mod.o modules.o date_and_time_mod.o land_surface_model_mod.o mod_kinds.o radiation_model_mod.o surface_layer_fluxes_mod.o urban_surface_mod.o 
 time_to_string.o: mod_kinds.o
@@ -673,5 +708,9 @@
 transpose.o: modules.o cpulog_mod.o mod_kinds.o
 tridia_solver_mod.o: modules.o mod_kinds.o
-urban_surface_mod.o: modules.o mod_kinds.o date_and_time_mod.o radiation_model_mod.o plant_canopy_model_mod.o surface_mod.o
+turbulence_closure_mod.o: modules.o mod_kinds.o advec_s_pw.o advec_s_up.o advec_s_bc.o advec_ws.o \
+	 cpulog_mod.o microphysics_mod.o mod_particle_attributes.o plant_canopy_model_mod.o \
+	 surface_mod.o user_actions.o
+urban_surface_mod.o: modules.o mod_kinds.o date_and_time_mod.o netcdf_data_input_mod.o \
+                     radiation_model_mod.o plant_canopy_model_mod.o surface_mod.o
 user_3d_data_averaging.o: modules.o mod_kinds.o user_module.o
 user_actions.o: modules.o cpulog_mod.o mod_kinds.o user_module.o
@@ -706,5 +745,6 @@
 user_spectra.o: modules.o mod_kinds.o spectra_mod.o user_module.o
 user_statistics.o: modules.o mod_kinds.o netcdf_interface_mod.o user_module.o
-vertical_nesting_mod.o: modules.o mod_kinds.o surface_mod.o 
+uv_exposure_model_mod.o: modules.o mod_kinds.o date_and_time_mod.o radiation_model_mod.o
+vertical_nesting_mod.o: modules.o mod_kinds.o surface_mod.o turbulence_closure_mod.o
 virtual_flight_mod.o: modules.o cpulog_mod.o mod_kinds.o netcdf_interface_mod.o user_init_flight.o user_flight.o
 wind_turbine_model_mod.o: modules.o cpulog_mod.o mod_kinds.o
@@ -712,5 +752,6 @@
 	radiation_model_mod.o random_function_mod.o random_generator_parallel_mod.o \
 	spectra_mod.o surface_mod.o
-write_var_list.o: modules.o mod_kinds.o model_1d_mod.o netcdf_interface_mod.o plant_canopy_model_mod.o\
+write_var_list.o: modules.o mod_kinds.o chemistry_model_mod.o model_1d_mod.o \
+   netcdf_interface_mod.o plant_canopy_model_mod.o\
    spectra_mod.o microphysics_mod.o urban_surface_mod.o vertical_nesting_mod.o virtual_flight_mod.o\
    wind_turbine_model_mod.o synthetic_turbulence_generator_mod.o
Index: palm/trunk/SOURCE/advec_s_bc.f90
===================================================================
--- palm/trunk/SOURCE/advec_s_bc.f90	(revision 2689)
+++ palm/trunk/SOURCE/advec_s_bc.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file advec_s_bc.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/advec_s_pw.f90
===================================================================
--- palm/trunk/SOURCE/advec_s_pw.f90	(revision 2689)
+++ palm/trunk/SOURCE/advec_s_pw.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file advec_s_pw.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/advec_s_up.f90
===================================================================
--- palm/trunk/SOURCE/advec_s_up.f90	(revision 2689)
+++ palm/trunk/SOURCE/advec_s_up.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file advec_s_up.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/advec_u_pw.f90
===================================================================
--- palm/trunk/SOURCE/advec_u_pw.f90	(revision 2689)
+++ palm/trunk/SOURCE/advec_u_pw.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file advec_u_pw.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/advec_u_up.f90
===================================================================
--- palm/trunk/SOURCE/advec_u_up.f90	(revision 2689)
+++ palm/trunk/SOURCE/advec_u_up.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file advec_u_up.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/advec_v_pw.f90
===================================================================
--- palm/trunk/SOURCE/advec_v_pw.f90	(revision 2689)
+++ palm/trunk/SOURCE/advec_v_pw.f90	(revision 2696)
@@ -1,5 +1,6 @@
 !> @file advec_v_pw.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+!------------------------------------------------------------------------------!
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/advec_v_up.f90
===================================================================
--- palm/trunk/SOURCE/advec_v_up.f90	(revision 2689)
+++ palm/trunk/SOURCE/advec_v_up.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file advec_v_up.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/advec_w_pw.f90
===================================================================
--- palm/trunk/SOURCE/advec_w_pw.f90	(revision 2689)
+++ palm/trunk/SOURCE/advec_w_pw.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file advec_w_pw.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/advec_w_up.f90
===================================================================
--- palm/trunk/SOURCE/advec_w_up.f90	(revision 2689)
+++ palm/trunk/SOURCE/advec_w_up.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file advec_w_up.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/advec_ws.f90
===================================================================
--- palm/trunk/SOURCE/advec_ws.f90	(revision 2689)
+++ palm/trunk/SOURCE/advec_ws.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file advec_ws.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
@@ -25,4 +25,9 @@
 ! -----------------
 ! $Id$ 
+! Implement advection for TKE-dissipation in case of RANS-TKE-e closure (TG)
+! Allocate advc_flags_1/2 within ws_init_flags instead of init_grid
+! Change argument list for exchange_horiz_2d_int (MS)
+! 
+! 2329 2017-08-03 14:24:56Z knoop
 ! Bugfix concerning density in divergence correction close to buildings
 ! 
@@ -247,14 +252,15 @@
 
        USE arrays_3d,                                                          &
-           ONLY:  diss_l_e, diss_l_nc, diss_l_nr, diss_l_pt, diss_l_q,         &
-                  diss_l_qc, diss_l_qr, diss_l_s, diss_l_sa, diss_l_u,         &
-                  diss_l_v, diss_l_w, flux_l_e, flux_l_nc, flux_l_nr,          & 
-                  flux_l_pt, flux_l_q, flux_l_qc, flux_l_qr, flux_l_s,         &
-                  flux_l_sa, flux_l_u, flux_l_v, flux_l_w, diss_s_e,           &
-                  diss_s_nc,  diss_s_nr, diss_s_pt, diss_s_q, diss_s_qc,       &
-                  diss_s_qr, diss_s_s, diss_s_sa, diss_s_u, diss_s_v,          &
-                  diss_s_w, flux_s_e, flux_s_nc, flux_s_nr, flux_s_pt,         &
-                  flux_s_q, flux_s_qc, flux_s_qr, flux_s_s, flux_s_sa,         &
-                  flux_s_u, flux_s_v, flux_s_w
+           ONLY:  diss_l_diss, diss_l_e, diss_l_nc, diss_l_nr, diss_l_pt,      &
+                  diss_l_q, diss_l_qc, diss_l_qr, diss_l_s, diss_l_sa,         &
+                  diss_l_u, diss_l_v, diss_l_w, flux_l_diss, flux_l_e,         & 
+                  flux_l_nc, flux_l_nr, flux_l_pt, flux_l_q, flux_l_qc,        &
+                  flux_l_qr, flux_l_s, flux_l_sa, flux_l_u, flux_l_v,          &
+                  flux_l_w, diss_s_diss, diss_s_e, diss_s_nc,  diss_s_nr,      &
+                  diss_s_pt, diss_s_q, diss_s_qc, diss_s_qr, diss_s_s,         &
+                  diss_s_sa, diss_s_u, diss_s_v,  diss_s_w, flux_s_diss,       &
+                  flux_s_e, flux_s_nc, flux_s_nr, flux_s_pt, flux_s_q,         &
+                  flux_s_qc, flux_s_qr, flux_s_s, flux_s_sa, flux_s_u,         &
+                  flux_s_v, flux_s_w
 
        USE constants,                                                          &
@@ -265,5 +271,5 @@
            ONLY:  cloud_physics, humidity, loop_optimization,                  &
                   passive_scalar, microphysics_morrison, microphysics_seifert, &
-                  ocean, ws_scheme_mom, ws_scheme_sca
+                  ocean, rans_tke_e, ws_scheme_mom, ws_scheme_sca
 
        USE indices,                                                            &
@@ -378,4 +384,11 @@
                        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
@@ -437,11 +450,12 @@
 
        USE control_parameters,                                                 &
-           ONLY:  inflow_l, inflow_n, inflow_r, inflow_s, momentum_advec,      &
+           ONLY:  force_bound_l, force_bound_n, force_bound_r, force_bound_s,  &
+                  inflow_l, inflow_n, inflow_r, inflow_s, momentum_advec,      &
                   nest_bound_l, nest_bound_n, nest_bound_r, nest_bound_s,      &
                   outflow_l, outflow_n, outflow_r, outflow_s, scalar_advec
 
        USE indices,                                                            &
-           ONLY:  advc_flags_1, advc_flags_2, nbgp, nxl, nxlu, nxr, nyn, nys,  &
-                  nysv, nzb, nzt, wall_flags_0
+           ONLY:  advc_flags_1, advc_flags_2, nbgp, nxl, nxlg, nxlu, nxr, nxrg,&
+                  nyn, nyng, nys, nysg, nysv, nzb, nzt, wall_flags_0
 
        USE kinds
@@ -458,5 +472,8 @@
        LOGICAL      ::  flag_set !< steering variable for advection flags
    
-
+       ALLOCATE( advc_flags_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                  &
+                 advc_flags_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
+       advc_flags_1 = 0
+       advc_flags_2 = 0
        IF ( scalar_advec == 'ws-scheme' )  THEN
 !
@@ -474,7 +491,9 @@
                     .OR.  .NOT. BTEST(wall_flags_0(k,j,i+2),0)                 &   
                     .OR.  .NOT. BTEST(wall_flags_0(k,j,i-1),0) )               &
-                      .OR.  ( ( inflow_l .OR. outflow_l .OR. nest_bound_l )    &
+                      .OR.  ( ( inflow_l .OR. outflow_l .OR. nest_bound_l  .OR.&
+                                force_bound_l )                                &
                             .AND.  i == nxl   )                                &
-                      .OR.  ( ( inflow_r .OR. outflow_r .OR. nest_bound_r )    &
+                      .OR.  ( ( inflow_r .OR. outflow_r .OR. nest_bound_r  .OR.&
+                                force_bound_r )                                &
                             .AND.  i == nxr   ) )                              &
                    THEN
@@ -491,8 +510,10 @@
                             )                                                  &
                                                     .OR.                       &
-                            ( ( inflow_r .OR. outflow_r .OR. nest_bound_r )    &
+                            ( ( inflow_r .OR. outflow_r .OR. nest_bound_r  .OR.&
+                                force_bound_r )                                &
                               .AND. i == nxr-1 )    .OR.                       &
-                            ( ( inflow_l .OR. outflow_l .OR. nest_bound_l )    &
-                              .AND. i == nxlu  ) )                             &
+                            ( ( inflow_l .OR. outflow_l .OR. nest_bound_l  .OR.&
+                                force_bound_l )                                &
+                              .AND. i == nxlu  ) )                             & ! why not nxl+1
                    THEN
                       advc_flags_1(k,j,i) = IBSET( advc_flags_1(k,j,i), 1 )
@@ -511,7 +532,9 @@
                     .OR.  .NOT. BTEST(wall_flags_0(k,j+2,i),0)                 &   
                     .OR.  .NOT. BTEST(wall_flags_0(k,j-1,i),0))                &
-                      .OR.  ( ( inflow_s .OR. outflow_s .OR. nest_bound_s )    &
+                      .OR.  ( ( inflow_s .OR. outflow_s .OR. nest_bound_s  .OR.&
+                                force_bound_s )                                &
                             .AND.  j == nys   )                                &
-                      .OR.  ( ( inflow_n .OR. outflow_n .OR. nest_bound_n )    &
+                      .OR.  ( ( inflow_n .OR. outflow_n .OR. nest_bound_n  .OR.&
+                                force_bound_n )                                &
                             .AND.  j == nyn   ) )                              &
                    THEN
@@ -530,7 +553,9 @@
                             )                                                  &
                                                     .OR.                       &
-                            ( ( inflow_s .OR. outflow_s .OR. nest_bound_s )    &
-                              .AND. j == nysv  )    .OR.                       &
-                            ( ( inflow_n .OR. outflow_n .OR. nest_bound_n )    &
+                            ( ( inflow_s .OR. outflow_s .OR. nest_bound_s  .OR.&
+                                force_bound_s )                                &
+                              .AND. j == nysv  )    .OR.                       & ! why not nys+1
+                            ( ( inflow_n .OR. outflow_n .OR. nest_bound_n  .OR.&
+                                force_bound_n )                                &
                               .AND. j == nyn-1 ) )                             &          
                    THEN
@@ -620,7 +645,9 @@
 !--                WS1 (9), WS3 (10), WS5 (11)
                    IF ( .NOT. BTEST(wall_flags_0(k,j,i+1),1)  .OR.             &
-                            ( ( inflow_l .OR. outflow_l .OR. nest_bound_l )    &
+                            ( ( inflow_l .OR. outflow_l .OR. nest_bound_l  .OR.&
+                                force_bound_l )                                &
                               .AND. i <= nxlu  )    .OR.                       &
-                            ( ( inflow_r .OR. outflow_r .OR. nest_bound_r )    &
+                            ( ( inflow_r .OR. outflow_r .OR. nest_bound_r  .OR.&
+                                force_bound_r )                                &
                               .AND. i == nxr   ) )                             &
                    THEN
@@ -630,7 +657,9 @@
                               .NOT. BTEST(wall_flags_0(k,j,i-1),1) )           &
                                                         .OR.                   &
-                            ( ( inflow_r .OR. outflow_r .OR. nest_bound_r )    &
+                            ( ( inflow_r .OR. outflow_r .OR. nest_bound_r  .OR.&
+                                force_bound_r )                                &
                               .AND. i == nxr-1 )    .OR.                       &
-                            ( ( inflow_l .OR. outflow_l .OR. nest_bound_l )    &
+                            ( ( inflow_l .OR. outflow_l .OR. nest_bound_l  .OR.&
+                                force_bound_l )                                &
                               .AND. i == nxlu+1) )                             &
                    THEN
@@ -652,7 +681,9 @@
 !--                WS1 (12), WS3 (13), WS5 (14)
                    IF ( .NOT. BTEST(wall_flags_0(k,j+1,i),1)   .OR.            &
-                            ( ( inflow_s .OR. outflow_s .OR. nest_bound_s )    &
+                            ( ( inflow_s .OR. outflow_s .OR. nest_bound_s  .OR.&
+                                force_bound_s )                                &
                               .AND. j == nys   )    .OR.                       &
-                            ( ( inflow_n .OR. outflow_n .OR. nest_bound_n )    &
+                            ( ( inflow_n .OR. outflow_n .OR. nest_bound_n  .OR.&
+                                force_bound_n )                                &
                               .AND. j == nyn   ) )                             &
                    THEN
@@ -662,7 +693,9 @@
                               .NOT. BTEST(wall_flags_0(k,j-1,i),1) )           &
                                                         .OR.                   &
-                            ( ( inflow_s .OR. outflow_s .OR. nest_bound_s )    &
+                            ( ( inflow_s .OR. outflow_s .OR. nest_bound_s  .OR.&
+                                force_bound_s )                                &
                               .AND. j == nysv  )    .OR.                       &
-                            ( ( inflow_n .OR. outflow_n .OR. nest_bound_n )    &
+                            ( ( inflow_n .OR. outflow_n .OR. nest_bound_n  .OR.&
+                                force_bound_n )                                &
                               .AND. j == nyn-1 ) )                             &
                    THEN
@@ -746,7 +779,9 @@
 !--                WS1 (18), WS3 (19), WS5 (20)
                    IF ( .NOT. BTEST(wall_flags_0(k,j,i+1),2)  .OR.             &
-                            ( ( inflow_l .OR. outflow_l .OR. nest_bound_l )    &
+                            ( ( inflow_l .OR. outflow_l .OR. nest_bound_l  .OR.&
+                                force_bound_l )                                &
                               .AND. i == nxl   )    .OR.                       &
-                            ( ( inflow_r .OR. outflow_r .OR. nest_bound_r )    &
+                            ( ( inflow_r .OR. outflow_r .OR. nest_bound_r  .OR.&
+                                force_bound_r )                                &
                               .AND. i == nxr   ) )                             &
                   THEN
@@ -758,7 +793,9 @@
                               .NOT. BTEST(wall_flags_0(k,j,i-1),2)             &
                                                     .OR.                       &
-                            ( ( inflow_r .OR. outflow_r .OR. nest_bound_r )    &
+                            ( ( inflow_r .OR. outflow_r .OR. nest_bound_r  .OR.&
+                                force_bound_r )                                &
                               .AND. i == nxr-1 )    .OR.                       &
-                            ( ( inflow_l .OR. outflow_l .OR. nest_bound_l )    &
+                            ( ( inflow_l .OR. outflow_l .OR. nest_bound_l  .OR.&
+                                force_bound_l )                                &
                               .AND. i == nxlu  ) )                             &
                    THEN
@@ -780,7 +817,9 @@
 !--                WS1 (21), WS3 (22), WS5 (23)
                    IF ( .NOT. BTEST(wall_flags_0(k,j+1,i),2) .OR.              &
-                            ( ( inflow_s .OR. outflow_s .OR. nest_bound_s )    &
+                            ( ( inflow_s .OR. outflow_s .OR. nest_bound_s  .OR.&
+                                force_bound_s )                                &
                               .AND. j <= nysv  )    .OR.                       &
-                            ( ( inflow_n .OR. outflow_n .OR. nest_bound_n )    &
+                            ( ( inflow_n .OR. outflow_n .OR. nest_bound_n  .OR.&
+                                force_bound_n )                                &
                               .AND. j == nyn   ) )                             &
                    THEN
@@ -790,7 +829,9 @@
                               .NOT. BTEST(wall_flags_0(k,j-1,i),2) )           &
                                                         .OR.                   &
-                            ( ( inflow_s .OR. outflow_s .OR. nest_bound_s )    &
+                            ( ( inflow_s .OR. outflow_s .OR. nest_bound_s  .OR.&
+                                force_bound_s )                                &
                               .AND. j == nysv+1)    .OR.                       &
-                            ( ( inflow_n .OR. outflow_n .OR. nest_bound_n )    &
+                            ( ( inflow_n .OR. outflow_n .OR. nest_bound_n  .OR.&
+                                force_bound_n )                                &
                               .AND. j == nyn-1 ) )                             &
                    THEN
@@ -873,7 +914,9 @@
 !--                WS1 (27), WS3 (28), WS5 (29)
                    IF ( .NOT. BTEST(wall_flags_0(k,j,i+1),3) .OR.              &
-                            ( ( inflow_l .OR. outflow_l .OR. nest_bound_l )    &
+                            ( ( inflow_l .OR. outflow_l .OR. nest_bound_l  .OR.&
+                                force_bound_l )                                &
                               .AND. i == nxl   )    .OR.                       &
-                            ( ( inflow_r .OR. outflow_r .OR. nest_bound_r )    &
+                            ( ( inflow_r .OR. outflow_r .OR. nest_bound_r  .OR.&
+                                force_bound_r )                                &
                               .AND. i == nxr   ) )                             &
                    THEN
@@ -883,7 +926,9 @@
                               .NOT. BTEST(wall_flags_0(k,j,i-1),3) )           &
                                                         .OR.                   &
-                            ( ( inflow_r .OR. outflow_r .OR. nest_bound_r )    &
+                            ( ( inflow_r .OR. outflow_r .OR. nest_bound_r  .OR.&
+                                force_bound_r )                                &
                               .AND. i == nxr-1 )    .OR.                       &
-                            ( ( inflow_l .OR. outflow_l .OR. nest_bound_l )    &
+                            ( ( inflow_l .OR. outflow_l .OR. nest_bound_l  .OR.&
+                                force_bound_l )                                &
                               .AND. i == nxlu  ) )                             &
                    THEN
@@ -905,7 +950,9 @@
 !--                WS1 (30), WS3 (31), WS5 (32)
                    IF ( .NOT. BTEST(wall_flags_0(k,j+1,i),3) .OR.              &
-                            ( ( inflow_s .OR. outflow_s .OR. nest_bound_s )    &
+                            ( ( inflow_s .OR. outflow_s .OR. nest_bound_s  .OR.&
+                                force_bound_s )                                &
                               .AND. j == nys   )    .OR.                       &
-                            ( ( inflow_n .OR. outflow_n .OR. nest_bound_n )    &
+                            ( ( inflow_n .OR. outflow_n .OR. nest_bound_n  .OR.&
+                                force_bound_n )                                &
                               .AND. j == nyn   ) )                             &
                    THEN
@@ -915,7 +962,9 @@
                               .NOT. BTEST(wall_flags_0(k,j-1,i),3) )           &
                                                         .OR.                   &
-                            ( ( inflow_s .OR. outflow_s .OR. nest_bound_s )    &
+                            ( ( inflow_s .OR. outflow_s .OR. nest_bound_s  .OR.&
+                                force_bound_s )                                &
                               .AND. j == nysv  )    .OR.                       &
-                            ( ( inflow_n .OR. outflow_n .OR. nest_bound_n )    &
+                            ( ( inflow_n .OR. outflow_n .OR. nest_bound_n  .OR.&
+                                force_bound_n )                                &
                               .AND. j == nyn-1 ) )                             &
                    THEN
@@ -1003,25 +1052,29 @@
 !
 !--       Exchange ghost points for advection flags
-          CALL exchange_horiz_int( advc_flags_1, nbgp )
-          CALL exchange_horiz_int( advc_flags_2, nbgp )
+          CALL exchange_horiz_int( advc_flags_1, nys, nyn, nxl, nxr, nzt, nbgp )
+          CALL exchange_horiz_int( advc_flags_2, nys, nyn, nxl, nxr, nzt, nbgp )
 !
 !--       Set boundary flags at inflow and outflow boundary in case of 
 !--       non-cyclic boundary conditions.
-         IF ( inflow_l .OR. outflow_l .OR. nest_bound_l )  THEN
+          IF ( inflow_l      .OR.  outflow_l  .OR.                             &
+               nest_bound_l  .OR.  force_bound_l )  THEN
              advc_flags_1(:,:,nxl-1) = advc_flags_1(:,:,nxl)
              advc_flags_2(:,:,nxl-1) = advc_flags_2(:,:,nxl)
-         ENDIF
-
-         IF ( inflow_r .OR. outflow_r .OR. nest_bound_r )  THEN
+          ENDIF
+
+          IF ( inflow_r      .OR.  outflow_r  .OR.                             &
+               nest_bound_r  .OR.  force_bound_r )  THEN
             advc_flags_1(:,:,nxr+1) = advc_flags_1(:,:,nxr)
             advc_flags_2(:,:,nxr+1) = advc_flags_2(:,:,nxr)
           ENDIF
 
-          IF ( inflow_n .OR. outflow_n .OR. nest_bound_n )  THEN
+          IF ( inflow_n      .OR.  outflow_n  .OR.                             &
+               nest_bound_n  .OR.  force_bound_n )  THEN
              advc_flags_1(:,nyn+1,:) = advc_flags_1(:,nyn,:)
              advc_flags_2(:,nyn+1,:) = advc_flags_2(:,nyn,:)
           ENDIF
 
-          IF ( inflow_s .OR. outflow_s  .OR. nest_bound_s )  THEN
+          IF ( inflow_s      .OR.  outflow_s  .OR.                             &
+               nest_bound_s  .OR.  force_bound_s )  THEN
              advc_flags_1(:,nys-1,:) = advc_flags_1(:,nys,:)
              advc_flags_2(:,nys-1,:) = advc_flags_2(:,nys,:)
Index: palm/trunk/SOURCE/average_3d_data.f90
===================================================================
--- palm/trunk/SOURCE/average_3d_data.f90	(revision 2689)
+++ palm/trunk/SOURCE/average_3d_data.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file average_3d_data.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
@@ -25,4 +25,8 @@
 ! -----------------
 ! $Id$
+! Implement call for turbulence_closure_mod (TG)
+! Implementation of chemistry module (FK)
+! 
+! 2292 2017-06-20 09:51:42Z schwenkel
 ! Implementation of new microphysic scheme: cloud_scheme = 'morrison' 
 ! includes two more prognostic equations for cloud drop concentration (nc)  
@@ -112,7 +116,12 @@
     USE averaging
 
+#if defined( __chem )
+    USE chemistry_model_mod,                                                   &
+        ONLY:  chem_3d_data_averaging
+#endif
+
     USE control_parameters,                                                    &
-        ONLY:  average_count_3d, doav, doav_n, land_surface, urban_surface,    &
-               varnamelength
+        ONLY:  air_chemistry, average_count_3d, doav, doav_n, land_surface,    &
+               urban_surface, varnamelength
 
     USE cpulog,                                                                &
@@ -130,6 +139,11 @@
         ONLY:  radiation, radiation_3d_data_averaging
 
+    USE turbulence_closure_mod,                                                &
+        ONLY:  tcm_3d_data_averaging
+
     USE urban_surface_mod,                                                     &
         ONLY:  usm_average_3d_data
+
+
 
 
@@ -459,9 +473,12 @@
           CASE DEFAULT
 !
+!--          Turbulence closure module
+             CALL tcm_3d_data_averaging( 'average', doav(ii) )
+
+!
 !--          Land surface quantity
              IF ( land_surface )  THEN
                 CALL lsm_3d_data_averaging( 'average', doav(ii) )
              ENDIF
-
 !
 !--          Radiation quantity
@@ -469,5 +486,11 @@
                 CALL radiation_3d_data_averaging( 'average', doav(ii) )
              ENDIF
-
+!
+!--          Chemistry quantity
+#if defined( __chem )
+             IF ( air_chemistry )  THEN
+                CALL chem_3d_data_averaging( 'average', doav(ii) )
+             ENDIF
+#endif
 !
 !--          User-defined quantity
Index: palm/trunk/SOURCE/boundary_conds.f90
===================================================================
--- palm/trunk/SOURCE/boundary_conds.f90	(revision 2689)
+++ palm/trunk/SOURCE/boundary_conds.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file boundary_conds.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
@@ -25,4 +25,8 @@
 ! -----------------
 ! $Id$
+! Adjust boundary conditions for e and diss in case of TKE-e closure (TG)
+! Implementation of chemistry module (FK)
+! 
+! 2569 2017-10-20 11:54:42Z kanani
 ! Removed redundant code for ibc_s_b=1 and ibc_q_b=1
 ! 
@@ -166,12 +170,18 @@
     USE arrays_3d,                                                             &
         ONLY:  c_u, c_u_m, c_u_m_l, c_v, c_v_m, c_v_m_l, c_w, c_w_m, c_w_m_l,  &
-               dzu, e_p, nc_p, nr_p, pt, pt_p, q, q_p, qc_p, qr_p, s, s_p, sa, & 
-               sa_p, u, ug, u_init, u_m_l, u_m_n, u_m_r, u_m_s, u_p,           &
+               diss_p, dzu, e_p, nc_p, nr_p, pt, pt_p, q, q_p, qc_p, qr_p, s,  & 
+               s_p, sa, sa_p, u, ug, u_init, u_m_l, u_m_n, u_m_r, u_m_s, u_p,  &
                v, vg, v_init, v_m_l, v_m_n, v_m_r, v_m_s, v_p,                 &
                w, w_p, w_m_l, w_m_n, w_m_r, w_m_s, pt_init
-               
+
+#if defined( __chem )
+    USE chemistry_model_mod,                                                   &
+        ONLY:  chem_boundary_conds 
+#endif
+              
     USE control_parameters,                                                    &
-        ONLY:  bc_pt_t_val, bc_q_t_val, bc_s_t_val, constant_diffusion,        &
-               cloud_physics, coupling_mode, dt_3d, humidity,                  &
+        ONLY:  air_chemistry, bc_pt_t_val, bc_q_t_val, bc_s_t_val,             &
+               constant_diffusion, cloud_physics, coupling_mode, dt_3d,        &
+               force_bound_l, force_bound_s, forcing, humidity,                &
                ibc_pt_b, ibc_pt_t, ibc_q_b, ibc_q_t, ibc_s_b, ibc_s_t,         &
                ibc_sa_t, ibc_uv_b, ibc_uv_t, inflow_l, inflow_n, inflow_r,     &
@@ -179,5 +189,6 @@
                microphysics_morrison, microphysics_seifert, nest_domain,       &
                nest_bound_l, nest_bound_s, nudging, ocean, outflow_l,          &
-               outflow_n, outflow_r, outflow_s, passive_scalar, tsc, use_cmax
+               outflow_n, outflow_r, outflow_s, passive_scalar, rans_tke_e,    &
+               tsc, use_cmax
 
     USE grid_variables,                                                        &
@@ -309,21 +320,29 @@
     IF ( .NOT. constant_diffusion )  THEN
 
-       DO  l = 0, 1
-!
-!--       Set kb, for upward-facing surfaces value at topography top (k-1) is set,
-!--       for downward-facing surfaces at topography bottom (k+1). 
-          kb = MERGE( -1, 1, l == 0 )
-          !$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)
-             e_p(k+kb,j,i) = e_p(k,j,i)
-          ENDDO
-       ENDDO
+       IF ( .NOT. rans_tke_e )  THEN
+          DO  l = 0, 1
+!
+!--         Set kb, for upward-facing surfaces value at topography top (k-1) is set,
+!--         for downward-facing surfaces at topography bottom (k+1). 
+             kb = MERGE( -1, 1, l == 0 )
+             !$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)
+                e_p(k+kb,j,i) = e_p(k,j,i)
+             ENDDO
+          ENDDO
+       ENDIF
 
        IF ( .NOT. nest_domain )  THEN
           e_p(nzt+1,:,:) = e_p(nzt,:,:)
        ENDIF
+    ENDIF
+
+!
+!-- Boundary conditions for TKE dissipation rate
+    IF ( rans_tke_e .AND. .NOT. nest_domain )  THEN
+       diss_p(nzt+1,:,:) = diss_p(nzt,:,:)
     ENDIF
 
@@ -500,4 +519,9 @@
 
     ENDIF    
+!
+!-- Top/bottom boundary conditions for chemical species
+#if defined( __chem )
+    IF ( air_chemistry )  CALL chem_boundary_conds( 'set_bc_bottomtop' )
+#endif
 !
 !-- In case of inflow or nest boundary at the south boundary the boundary for v
@@ -523,9 +547,9 @@
 !-- 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.
-    IF ( nesting_mode /= 'vertical' )  THEN
-       IF ( nest_bound_s )  THEN
+    IF ( nesting_mode /= 'vertical'  .OR.  forcing )  THEN
+       IF ( nest_bound_s  .OR.  force_bound_s )  THEN
           v_p(:,nys,:) = v_p(:,nys-1,:)
        ENDIF
-       IF ( nest_bound_l )  THEN
+       IF ( nest_bound_l  .OR.  force_bound_l )  THEN
           u_p(:,:,nxl) = u_p(:,:,nxl-1)
        ENDIF
@@ -537,4 +561,5 @@
        pt_p(:,nys-1,:)     = pt_p(:,nys,:)
        IF ( .NOT. constant_diffusion )  e_p(:,nys-1,:) = e_p(:,nys,:)
+       IF ( rans_tke_e )  diss_p(:,nys-1,:) = diss_p(:,nys,:)
        IF ( humidity )  THEN
           q_p(:,nys-1,:) = q_p(:,nys,:)
@@ -551,5 +576,6 @@
     ELSEIF ( outflow_n )  THEN
        pt_p(:,nyn+1,:)     = pt_p(:,nyn,:)
-       IF ( .NOT. constant_diffusion     )  e_p(:,nyn+1,:) = e_p(:,nyn,:)
+       IF ( .NOT. constant_diffusion )  e_p(:,nyn+1,:) = e_p(:,nyn,:)
+       IF ( rans_tke_e )  diss_p(:,nyn+1,:) = diss_p(:,nyn,:)
        IF ( humidity )  THEN
           q_p(:,nyn+1,:) = q_p(:,nyn,:)
@@ -566,5 +592,6 @@
     ELSEIF ( outflow_l )  THEN
        pt_p(:,:,nxl-1)     = pt_p(:,:,nxl)
-       IF ( .NOT. constant_diffusion     )  e_p(:,:,nxl-1) = e_p(:,:,nxl)
+       IF ( .NOT. constant_diffusion )  e_p(:,:,nxl-1) = e_p(:,:,nxl)
+       IF ( rans_tke_e )  diss_p(:,:,nxl-1) = diss_p(:,:,nxl)
        IF ( humidity )  THEN
           q_p(:,:,nxl-1) = q_p(:,:,nxl)
@@ -581,5 +608,6 @@
     ELSEIF ( outflow_r )  THEN
        pt_p(:,:,nxr+1)     = pt_p(:,:,nxr)
-       IF ( .NOT. constant_diffusion     )  e_p(:,:,nxr+1) = e_p(:,:,nxr)
+       IF ( .NOT. constant_diffusion )  e_p(:,:,nxr+1) = e_p(:,:,nxr)
+       IF ( rans_tke_e )  diss_p(:,:,nxr+1) = diss_p(:,:,nxr)
        IF ( humidity )  THEN
           q_p(:,:,nxr+1) = q_p(:,:,nxr)
@@ -595,4 +623,11 @@
        IF ( passive_scalar )  s_p(:,:,nxr+1) = s_p(:,:,nxr)
     ENDIF
+
+!
+!-- Lateral boundary conditions for chemical species
+#if defined( __chem )
+    IF ( air_chemistry )  CALL chem_boundary_conds( 'set_bc_lateral' )    
+#endif
+
 
 !
Index: palm/trunk/SOURCE/buoyancy.f90
===================================================================
--- palm/trunk/SOURCE/buoyancy.f90	(revision 2689)
+++ palm/trunk/SOURCE/buoyancy.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file buoyancy.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/calc_liquid_water_content.f90
===================================================================
--- palm/trunk/SOURCE/calc_liquid_water_content.f90	(revision 2689)
+++ palm/trunk/SOURCE/calc_liquid_water_content.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file calc_liquid_water_content.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/calc_mean_profile.f90
===================================================================
--- palm/trunk/SOURCE/calc_mean_profile.f90	(revision 2689)
+++ palm/trunk/SOURCE/calc_mean_profile.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file calc_mean_profile.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
@@ -25,4 +25,8 @@
 ! -----------------
 ! $Id$
+! Enable usage also during initialization, required for initialization of 
+! radiation and land-surface model (MS)
+! 
+! 2233 2017-05-30 18:08:54Z suehring
 !
 ! 2232 2017-05-30 17:47:52Z suehring
@@ -109,7 +113,9 @@
 !--    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.
+!--    which are calling flow_statistics at different time intervals. At 
+!--    initialization, intermediate_timestep_count = 0 is considered as well.
+
        IF ( .NOT. flow_statistics_called  .AND.                                &
-            intermediate_timestep_count == 1 )  THEN
+            intermediate_timestep_count <= 1 )  THEN
 
 !
Index: palm/trunk/SOURCE/calc_radiation.f90
===================================================================
--- palm/trunk/SOURCE/calc_radiation.f90	(revision 2689)
+++ palm/trunk/SOURCE/calc_radiation.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file calc_radiation.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/check_for_restart.f90
===================================================================
--- palm/trunk/SOURCE/check_for_restart.f90	(revision 2689)
+++ palm/trunk/SOURCE/check_for_restart.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file check_for_restart.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/check_open.f90
===================================================================
--- palm/trunk/SOURCE/check_open.f90	(revision 2689)
+++ palm/trunk/SOURCE/check_open.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file check_open.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
@@ -12,5 +12,5 @@
 ! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
 !
-! You should have received a copy of the GNU fGeneral Public License along with
+! You should have received a copy of the GNU General Public License along with
 ! PALM. If not, see <http://www.gnu.org/licenses/>.
 !
Index: palm/trunk/SOURCE/check_parameters.f90
===================================================================
--- palm/trunk/SOURCE/check_parameters.f90	(revision 2689)
+++ palm/trunk/SOURCE/check_parameters.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file check_parameters.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
@@ -25,4 +25,10 @@
 ! -----------------
 ! $Id$
+! Implementation of uv exposure model (FK)
+! + new possible value for dissipation_1d
+! Added checks for turbulence_closure_mod (TG)
+! Implementation of chemistry module (FK)
+! 
+! 2689 2017-12-12 17:46:55Z Giersch
 ! Bugfix in if query
 ! 
@@ -552,4 +558,10 @@
 
     USE arrays_3d
+#if defined( __chem )
+    USE chemistry_model_mod,                                                   &
+        ONLY:  chem_boundary_conds, chem_check_data_output,                    &
+               chem_check_data_output_pr, chem_species                 
+    USE chem_modules
+#endif
     USE cloud_parameters
     USE constants
@@ -570,4 +582,8 @@
     USE model_1d_mod,                                                          &
         ONLY:  damp_level_1d, damp_level_ind_1d
+
+    USE netcdf_data_input_mod,                                                 &
+        ONLY:  init_model, input_pids_static, netcdf_data_input_check_dynamic, &
+               netcdf_data_input_check_static
 
     USE netcdf_interface,                                                      &
@@ -596,6 +612,10 @@
         ONLY:  stg_check_parameters
     USE transpose_indices
+    USE turbulence_closure_mod,                                                &
+        ONLY:  tcm_check_data_output, tcm_check_parameters
     USE urban_surface_mod,                                                     &
         ONLY:  usm_check_data_output, usm_check_parameters
+    USE uv_exposure_model_mod,                                                 &
+        ONLY:  uvem_check_data_output
     USE wind_turbine_model_mod,                                                &
         ONLY:  wtm_check_parameters
@@ -623,4 +643,5 @@
     INTEGER(iwp) ::  netcdf_data_format_save         !<
     INTEGER(iwp) ::  position                        !<
+    INTEGER(iwp) ::  lsp                             !< running index for chem spcs.
 
     LOGICAL     ::  found                            !<
@@ -633,5 +654,8 @@
 
     CALL location_message( 'checking parameters', .FALSE. )
-
+!
+!-- 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
@@ -673,4 +697,5 @@
 #if defined( __parallel )
 
+
        IF ( myid == 0 ) THEN
           CALL MPI_SEND( dt_coupling, 1, MPI_REAL, target_id, 11, comm_inter,  &
@@ -849,4 +874,5 @@
        CALL message( 'check_parameters', 'PA0001', 1, 2, 0, 6, 0 )
     ENDIF
+
 
 !
@@ -936,4 +962,8 @@
 
     ENDIF
+
+!
+!-- Check turbulence closure setup
+    CALL tcm_check_parameters
 
 !
@@ -1092,4 +1122,5 @@
        CALL message( 'check_parameters', 'PA0469', 1, 2, 0, 6, 0 )
     ENDIF
+
 !
 !-- Check whether there are any illegal values
@@ -1244,5 +1275,6 @@
 
              CASE ( 'set_constant_profiles', 'set_1d-model_profiles',          &
-                    'by_user', 'initialize_vortex', 'initialize_ptanom' )
+                    'by_user', 'initialize_vortex', 'initialize_ptanom',       &
+                    'inifor' )
                 action = action(position+1:)
 
@@ -1347,5 +1379,11 @@
        IF ( ocean          )  sa_init = sa_surface
        IF ( passive_scalar )  s_init  = s_surface
-
+#if defined(__chem )                              
+       IF ( air_chemistry )  THEN
+         DO lsp = 1, nvar
+            chem_species(lsp)%conc_pr_init = cs_surface(lsp)      
+         ENDDO
+       ENDIF
+#endif 
 !
 !--
@@ -1558,4 +1596,18 @@
        ENDIF
 !
+!--    Compute initial chemistry profile using the given chemical species gradients
+#if defined( __chem )
+       IF ( air_chemistry )  THEN                                                          
+         DO lsp = 1, nvar
+          CALL init_vertical_profiles( cs_vertical_gradient_level_ind(lsp,:),  &
+                                       cs_vertical_gradient_level(lsp,:),      &
+                                       cs_vertical_gradient(lsp,:),            &
+                                       chem_species(lsp)%conc_pr_init,         &
+                                       cs_surface(lsp), bc_cs_t_val(lsp) )
+         ENDDO
+       ENDIF
+#endif
+!
+!
 !--    If required, compute initial salinity profile using the given salinity
 !--    gradients
@@ -1610,5 +1662,11 @@
 
 !
-!-- Compute Coriolis parameter
+!-- Overwrite latitude if necessary and compute Coriolis parameter. 
+!-- To do - move initialization of f and fs to coriolis_mod.
+    IF ( input_pids_static )  THEN
+       latitude  = init_model%latitude
+       longitude = init_model%longitude
+    ENDIF
+
     f  = 2.0_wp * omega * SIN( latitude / 180.0_wp * pi )
     fs = 2.0_wp * omega * COS( latitude / 180.0_wp * pi )
@@ -1799,5 +1857,6 @@
        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' .OR. bc_p_t == 'nested'  .OR.                 &
+             bc_p_t == 'forcing'  )  THEN
        ibc_p_t = 1
     ELSE
@@ -1829,5 +1888,5 @@
     ELSEIF ( bc_pt_t == 'initial_gradient' )  THEN
        ibc_pt_t = 2
-    ELSEIF ( bc_pt_t == 'nested' )  THEN
+    ELSEIF ( bc_pt_t == 'nested'  .OR.  bc_pt_t == 'forcing' )  THEN
        ibc_pt_t = 3
     ELSE
@@ -2029,4 +2088,11 @@
        ENDIF
     ENDIF
+
+!
+!-- Boundary conditions for chemical species
+#if defined( __chem )
+    IF ( air_chemistry )  CALL chem_boundary_conds( 'init' )
+#endif
+
 !
 !-- Boundary conditions for horizontal components of wind speed
@@ -2068,5 +2134,5 @@
        ELSEIF ( bc_uv_t == 'neumann' )  THEN
           ibc_uv_t = 1
-       ELSEIF ( bc_uv_t == 'nested' )  THEN
+       ELSEIF ( bc_uv_t == 'nested'  .OR.  bc_uv_t == 'forcing' )  THEN
           ibc_uv_t = 3
        ELSE
@@ -2982,4 +3048,11 @@
              ENDIF
 
+#if defined( __chem )
+             IF ( unit == 'illegal' )  THEN                                        
+                CALL chem_check_data_output_pr( data_output_pr(i), i,          &
+                                                unit, dopr_unit(i) )
+             ENDIF 
+#endif
+
              IF ( unit == 'illegal' )  THEN
                 unit = ''
@@ -3261,9 +3334,22 @@
           CASE DEFAULT
 
-             CALL lsm_check_data_output ( var, unit, i, ilen, k )
+             CALL tcm_check_data_output ( var, unit, i, ilen, k )
+
+             IF ( unit == 'illegal' )  THEN
+                CALL lsm_check_data_output ( var, unit, i, ilen, k )
+             ENDIF
 
              IF ( unit == 'illegal' )  THEN
                 CALL radiation_check_data_output( var, unit, i, ilen, k )
              ENDIF
+
+!
+!--          Block of chemistry model outputs
+#if defined( __chem )
+             IF ( unit == 'illegal'  .AND.  air_chemistry                      &
+                                     .AND.  var(1:3) == 'kc_' )  THEN
+                CALL chem_check_data_output( var, unit, i, ilen, k )
+             ENDIF
+#endif
 
 !
@@ -3277,4 +3363,10 @@
              IF ( unit == 'illegal' .AND. plant_canopy .AND. var(1:4) == 'pcm_' ) THEN
                  CALL pcm_check_data_output( var, unit )
+             ENDIF
+
+!
+!--          Block of uv exposure model outputs
+             IF ( unit == 'illegal' .AND. uv_exposure .AND. var(1:5) == 'uvem_' )  THEN
+                CALL uvem_check_data_output( var, unit, i, ilen, k )
              ENDIF
 
@@ -3669,5 +3761,5 @@
           dist_nxl    = MAX( inflow_disturbance_begin, nxl )
           dist_nxr(1) = MIN( inflow_disturbance_end, nxr )
-       ELSEIF ( bc_lr == 'nested' )  THEN
+       ELSEIF ( bc_lr == 'nested'  .OR.  bc_lr == 'forcing' )  THEN
           dist_nxl = MAX( inflow_disturbance_begin, nxl )
        ENDIF
@@ -3678,5 +3770,5 @@
           dist_nys    = MAX( inflow_disturbance_begin, nys )
           dist_nyn(1) = MIN( inflow_disturbance_end, nyn )
-       ELSEIF ( bc_ns == 'nested' )  THEN
+       ELSEIF ( bc_ns == 'nested'  .OR.  bc_ns == 'forcing' )  THEN
           dist_nys = MAX( inflow_disturbance_begin, nys )
        ENDIF
@@ -3790,5 +3882,6 @@
     ENDIF
     IF ( TRIM( dissipation_1d ) /= 'as_in_3d_model'  .AND.                     &
-         TRIM( dissipation_1d ) /= 'detering' )  THEN
+         TRIM( dissipation_1d ) /= 'detering'  .AND.                           &
+         TRIM( dissipation_1d ) /= 'prognostic' )  THEN
        message_string = 'dissipation_1d = "' // TRIM( dissipation_1d ) //      &
                         '" is unknown'
@@ -4130,5 +4223,5 @@
        ELSEIF ( bc_t == 'initial_gradient' )  THEN
           ibc_t = 2
-       ELSEIF ( bc_t == 'nested' )  THEN
+       ELSEIF ( bc_t == 'nested'  .OR.  bc_t == 'forcing' )  THEN
           ibc_t = 3
        ELSE
Index: palm/trunk/SOURCE/chem_gasphase_mod.f90
===================================================================
--- palm/trunk/SOURCE/chem_gasphase_mod.f90	(revision 2696)
+++ palm/trunk/SOURCE/chem_gasphase_mod.f90	(revision 2696)
@@ -0,0 +1,2437 @@
+MODULE chem_gasphase_mod
+#if defined( __chem )
+!------------------------------------------------------------------------------!
+!
+! ******Module chem_gasphase_mod is automatically generated by kpp4palm ******
+!
+!           *********Please do NOT change this Code *********
+!
+!------------------------------------------------------------------------------!
+! 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-2017 Leibniz Universitaet Hannover
+!--------------------------------------------------------------------------------!
+!
+! Current revisions:
+! ------------------
+! 
+! 
+! Former revisions:
+! -----------------
+! $Id: module_header 2460 2017-09-13 14:47:48Z forkel $
+!
+! 
+! Variables for photolyis added
+!
+!
+!
+!
+!
+! Nov. 2016: Intial version (Klaus Ketelsen)
+!
+!------------------------------------------------------------------------------!
+!
+
+
+! 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 :: IERR_NAMES
+ 
+! PUBLIC :: SPC_NAMES,EQN_NAMES,EQN_TAGS,REQ_HET,REQ_AEROSOL,REQ_PHOTRAT &
+!         ,REQ_MCFCT,IP_MAX,jname
+
+  PUBLIC :: eqn_names, phot_names,spc_names
+  PUBLIC :: nmaxfixsteps
+  PUBLIC :: atol,rtol
+  PUBLIC :: nspec,nreact
+  PUBLIC :: temp
+  PUBLIC :: phot 
+  PUBLIC :: rconst
+  PUBLIC :: nvar
+  PUBLIC :: nphot
+ 
+  PUBLIC :: initialize,integrate,update_rconst
+  PUBLIC :: chem_gasphase_integrate
+  PUBLIC :: initialize_kpp_ctrl
+
+! END OF MODULE HEADER TEMPLATE
+                                                                 
+! Variables used for vector mode                                 
+                                                                 
+  LOGICAL, PARAMETER          :: l_vector = .FALSE.            
+  INTEGER, PARAMETER          :: i_lu_di = 0
+  INTEGER, PARAMETER          :: vl_dim = 1
+  INTEGER                     :: vl                              
+                                                                 
+  INTEGER                     :: vl_glo                          
+  INTEGER                     :: is,ie                           
+                                                                 
+  INTEGER, DIMENSION(vl_dim)  :: kacc,krej                      
+  INTEGER, DIMENSION(vl_dim)  :: ierrv                           
+  LOGICAL                     :: data_loaded = .false.             
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! 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                 : Fri Dec  8 11:54:15 2017
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20171117/GASPHASE_PREPROC/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+
+! NSPEC - Number of chemical species
+  INTEGER,PARAMETER :: nspec = 2 
+! NVAR - Number of Variable species
+  INTEGER,PARAMETER :: nvar = 2 
+! NVARACT - Number of Active species
+  INTEGER,PARAMETER :: nvaract = 2 
+! NFIX - Number of Fixed species
+  INTEGER,PARAMETER :: nfix = 1 
+! NREACT - Number of reactions
+  INTEGER,PARAMETER :: nreact = 2 
+! NVARST - Starting of variables in conc. vect.
+  INTEGER,PARAMETER :: nvarst = 1 
+! NFIXST - Starting of fixed in conc. vect.
+  INTEGER,PARAMETER :: nfixst = 3 
+! NONZERO - Number of nonzero entries in Jacobian
+  INTEGER,PARAMETER :: nonzero = 2 
+! LU_NONZERO - Number of nonzero entries in LU factoriz. of Jacobian
+  INTEGER,PARAMETER :: lu_nonzero = 2 
+! CNVAR - (NVAR+1) Number of elements in compressed row format
+  INTEGER,PARAMETER :: cnvar = 3 
+! CNEQN - (NREACT+1) Number stoicm elements in compressed col format
+  INTEGER,PARAMETER :: cneqn = 3 
+! NHESS - Length of Sparse Hessian
+  INTEGER,PARAMETER :: nhess = 1 
+! NLOOKAT - Number of species to look at
+  INTEGER,PARAMETER :: nlookat = 0 
+! NMONITOR - Number of species to monitor
+  INTEGER,PARAMETER :: nmonitor = 0 
+! 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_pm25 = 2 
+
+! 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 = 2 
+
+! NSTOICM - Length of Sparse Stoichiometric Matrix
+  INTEGER,PARAMETER :: nstoicm = 1 
+
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! 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                 : Fri Dec  8 11:54:15 2017
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20171117/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):: c(nspec)
+! VAR - Concentrations of variable species (global)
+  REAL(kind=dp):: var(nvar)
+! FIX - Concentrations of fixed species (global)
+  REAL(kind=dp):: fix(nfix)
+! VAR,FIX are chunks of array C
+      equivalence( c(1),var(1))
+! RCONST - Rate constants (global)
+  REAL(kind=dp):: rconst(nreact)
+! TIME - Current integration time
+  REAL(kind=dp):: time
+! SUN - Sunlight intensity between [0,1]
+  REAL(kind=dp):: sun
+! TEMP - Temperature
+  REAL(dp),dimension(:),allocatable             :: temp
+! RTOLS - (scalar) Relative tolerance
+  REAL(kind=dp):: rtols
+! TSTART - Integration start time
+  REAL(kind=dp):: tstart
+! TEND - Integration end time
+  REAL(kind=dp):: tend
+! DT - Integration step
+  REAL(kind=dp):: dt
+! 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
+! STEPMAX - Upper bound for integration step
+  REAL(kind=dp):: stepmax
+! CFACTOR - Conversion factor for concentration units
+  REAL(kind=dp):: cfactor
+! DDMTYPE - DDM sensitivity w.r.t.: 0=init.val.,1=params
+  INTEGER :: ddmtype
+
+! INLINED global variable declarations
+
+  !   declaration of global variable declarations for photolysis will come from 
+
+! 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                 : Fri Dec  8 11:54:15 2017
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20171117/GASPHASE_PREPROC/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+
+! Sparse Jacobian Data
+
+
+  INTEGER,PARAMETER,DIMENSION(2):: lu_irow =  (/ &
+       1, 2 /) 
+
+  INTEGER,PARAMETER,DIMENSION(2):: lu_icol =  (/ &
+       1, 2 /) 
+
+  INTEGER,PARAMETER,DIMENSION(3):: lu_crow =  (/ &
+       1, 2, 3 /) 
+
+  INTEGER,PARAMETER,DIMENSION(3):: lu_diag =  (/ &
+       1, 2, 3 /) 
+
+
+
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+! 
+! 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                 : Fri Dec  8 11:54:15 2017
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20171117/GASPHASE_PREPROC/tmp_kpp4palm
+! Equation file        : chem_gasphase_mod.kpp
+! Output root filename : chem_gasphase_mod
+! 
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+
+
+
+  CHARACTER(len=15),PARAMETER,DIMENSION(2):: spc_names =  (/ &
+     'PM10           ','PM25           ' /)
+
+  INTEGER,DIMENSION(1):: lookat
+  INTEGER,DIMENSION(1):: monitor
+  CHARACTER(len=15),DIMENSION(1):: smass
+  CHARACTER(len=100),PARAMETER,DIMENSION(2):: eqn_names =  (/ &
+     'PM10 --> PM10                                                                                       ',&
+     'PM25 --> PM25                                                                                       ' /)
+
+! 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                 : Fri Dec  8 11:54:15 2017
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20171117/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                 : Fri Dec  8 11:54:15 2017
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20171117/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                 : Fri Dec  8 11:54:15 2017
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20171117/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                 : Fri Dec  8 11:54:15 2017
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20171117/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                 : Fri Dec  8 11:54:15 2017
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20171117/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                 : Fri Dec  8 11:54:15 2017
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20171117/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                 : Fri Dec  8 11:54:15 2017
+! Working directory    : /home/forkel-r/palmstuff/work/chemistry20171117/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
+  !
+  INTEGER, DIMENSION(nkppctrl),PUBLIC     :: icntrl = 0
+  REAL(dp),DIMENSION(nkppctrl),PUBLIC     :: rcntrl = 0.0_dp
+  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            kppdecomp
+    MODULE PROCEDURE   kppdecomp
+  END INTERFACE        kppdecomp
+ 
+  INTERFACE            wlamch
+    MODULE PROCEDURE   wlamch
+  END INTERFACE        wlamch
+ 
+  INTERFACE            wlamch_add
+    MODULE PROCEDURE   wlamch_add
+  END INTERFACE        wlamch_add
+ 
+  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 not working  INTERFACE            wcopy
+!interface not working    MODULE PROCEDURE   wcopy
+!interface not working  END INTERFACE        wcopy
+ 
+  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            chem_gasphase_integrate
+    MODULE PROCEDURE   chem_gasphase_integrate
+  END INTERFACE        chem_gasphase_integrate
+ 
+  INTERFACE            fill_temp
+    MODULE PROCEDURE   fill_temp
+  END INTERFACE        fill_temp
+  PUBLIC               fill_temp
+ 
+ 
+ CONTAINS
+ 
+SUBROUTINE initialize()
+
+
+
+  INTEGER :: i
+  REAL(kind=dp):: x
+
+  cfactor = 1.000000e+00_dp
+
+  x = (0.)*cfactor
+  DO i = 1,nvar
+    var(i) = x
+  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
+
+   INTEGER,SAVE :: ntotal = 0
+
+   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)
+
+
+! Computation of equation rates
+
+! Aggregate function
+  vdot(1) = 0
+  vdot(2) = 0
+      
+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(2) = x(2)/ jvs(2)
+  x(1) = x(1)/ jvs(1)
+      
+END SUBROUTINE kppsolve
+ 
+SUBROUTINE kppdecomp( jvs,ier)
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+!        Sparse LU factorization
+! ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+
+      INTEGER  :: ier
+      REAL(kind=dp):: jvs(lu_nonzero),w(nvar),a
+      INTEGER  :: k,kk,j,jj
+
+      a = 0. ! mz_rs_20050606
+      ier = 0
+      DO k=1,nvar
+        ! mz_rs_20050606: don't check if real value == 0
+        ! IF(jvs( lu_diag(k)).eq. 0.)THEN
+        IF(abs(jvs(lu_diag(k)))< tiny(a))THEN
+            ier = k
+            RETURN
+        ENDIF
+        DO kk = lu_crow(k),lu_crow(k+ 1)- 1
+              w( lu_icol(kk)) = jvs(kk)
+        ENDDO
+        DO kk = lu_crow(k),lu_diag(k)- 1
+            j = lu_icol(kk)
+            a = - w(j)/ jvs( lu_diag(j))
+            w(j) = - a
+            DO jj = lu_diag(j)+ 1,lu_crow(j+ 1)- 1
+               w( lu_icol(jj)) = w( lu_icol(jj))+ a*jvs(jj)
+            ENDDO
+         ENDDO
+         DO kk = lu_crow(k),lu_crow(k+ 1)- 1
+            jvs(kk) = w( lu_icol(kk))
+         ENDDO
+      ENDDO
+      
+END SUBROUTINE kppdecomp
+ 
+      REAL(kind=dp)FUNCTION wlamch( c)
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
+!     returns epsilon machine
+!     after LAPACK
+!     replace this by the function from the optimized LAPACK implementation:
+!          CALL SLAMCH('E') or CALL DLAMCH('E')
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
+!      USE chem_gasphase_mod_Precision
+
+      CHARACTER ::  c
+      INTEGER    :: i
+      REAL(kind=dp),SAVE  ::  eps
+      REAL(kind=dp) ::  suma
+      REAL(kind=dp),PARAMETER  ::  one=1.0_dp, half=0.5_dp
+      LOGICAL,SAVE   ::  first=.true.
+      
+      IF (first)THEN
+        first = .false.
+        eps = half**(16)
+        DO i = 17,80
+          eps = eps*half
+          CALL wlamch_add(one,eps,suma)
+          IF (suma.le.one)goto 10
+        ENDDO
+        PRINT*,'ERROR IN WLAMCH. EPS < ',Eps
+        RETURN
+10      eps = eps*2
+        i = i- 1      
+      ENDIF
+
+      wlamch = eps
+
+      END FUNCTION wlamch
+ 
+      SUBROUTINE wlamch_add( a,b,suma)
+!      USE chem_gasphase_mod_Precision
+      
+      REAL(kind=dp)a,b,suma
+      suma = a + b
+
+      END SUBROUTINE wlamch_add
+ 
+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(2)
+
+! B(1) = dA(1)/dV(1)
+  b(1) = rct(1)
+! B(2) = dA(2)/dV(2)
+  b(2) = rct(2)
+
+! Construct the Jacobian terms from B's
+! JVS(1) = Jac_FULL(1,1)
+  jvs(1) = 0
+! JVS(2) = Jac_FULL(2,2)
+  jvs(2) = 0
+      
+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         :: j,k
+
+  k = is
+
+! Begin INLINED RCONST
+
+
+! End INLINED RCONST
+
+  rconst(1) = (1.0_dp)
+  rconst(2) = (1.0_dp)
+      
+END SUBROUTINE update_rconst
+ 
+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,iou,modstr)
+
+
+  ! i/o
+  INTEGER,         INTENT(out):: status
+  INTEGER,         INTENT(in) :: iou     ! LOGICAL i/o unit
+  CHARACTER(len=*),INTENT(in) :: modstr  ! read <modstr>.nml
+
+  ! 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)
+
+
+END SUBROUTINE error_output
+ 
+      SUBROUTINE wcopy(n,x,incx,y,incy)
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
+!     copies a vector,x,to a vector,y:  y <- x
+!     only for incX=incY=1
+!     after BLAS
+!     replace this by the function from the optimized BLAS implementation:
+!         CALL  SCOPY(N,X,1,Y,1)   or   CALL  DCOPY(N,X,1,Y,1)
+!- - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - 
+!     USE chem_gasphase_mod_Precision
+      
+      INTEGER  :: i,incx,incy,m,mp1,n
+      REAL(kind=dp):: x(n),y(n)
+
+      IF (n.le.0)RETURN
+
+      m = mod(n,8)
+      IF( m .ne. 0)THEN
+        DO i = 1,m
+          y(i) = x(i)
+        ENDDO
+        IF( n .lt. 8)RETURN
+      ENDIF    
+      mp1 = m+ 1
+      DO i = mp1,n,8
+        y(i) = x(i)
+        y(i + 1) = x(i + 1)
+        y(i + 2) = x(i + 2)
+        y(i + 3) = x(i + 3)
+        y(i + 4) = x(i + 4)
+        y(i + 5) = x(i + 5)
+        y(i + 6) = x(i + 6)
+        y(i + 7) = x(i + 7)
+      ENDDO
+
+      END SUBROUTINE wcopy
+ 
+      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
+
+      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
+
+      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 = WLAMCH('E')
+
+!~~~>  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)
+
+#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 chem_gasphase_integrate (time_step_len,conc,tempk,photo,ierrf,xnacc,xnrej,istatus,l_debug,pe) 
+                                                                    
+  IMPLICIT NONE                                                     
+                                                                    
+  REAL(dp), INTENT(IN)                    :: time_step_len           
+  REAL(dp), DIMENSION(:,:), INTENT(INOUT) :: conc                    
+  REAL(dp), DIMENSION(:,:), INTENT(INOUT) :: photo                   
+  REAL(dp), DIMENSION(:), INTENT(IN)      :: tempk                   
+  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                                 :: k   ! loop variable     
+  REAL(dp)                                :: dt                      
+  INTEGER, DIMENSION(20)                  :: istatus_u               
+  INTEGER                                 :: ierr_u                  
+                                                                    
+                                                                    
+  if (present (istatus)) istatus = 0                              
+                                                                    
+  DO k=1,vl_glo,vl_dim                                              
+    is = k                                                          
+    ie = min(k+vl_dim-1,vl_glo)                                     
+    vl = ie-is+1                                                    
+                                                                    
+    c(:) = conc(is,:)                                             
+                                                                    
+    temp = tempk(is)                                              
+                                                                    
+    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                                           
+                                                                    
+  if (ALLOCATED(temp))   DEALLOCATE(temp)   
+                                                                    
+  data_loaded = .false.                                             
+                                                                    
+  RETURN                                                            
+END SUBROUTINE chem_gasphase_integrate                                        
+ 
+  SUBROUTINE fill_temp(status,array) 
+ 
+    INTEGER, INTENT(OUT)               :: status 
+    REAL(dp), INTENT(IN), DIMENSION(:) :: array 
+ 
+    status = 0
+    IF (.not. ALLOCATED(temp)) & 
+       ALLOCATE(temp(size(array))) 
+ 
+    IF (data_loaded .AND. (vl_glo /= size(array,1))) THEN 
+       status = 1 
+       RETURN 
+    END IF 
+ 
+    vl_glo = size(array,1) 
+    temp = array 
+    data_loaded = .TRUE. 
+ 
+    RETURN
+ 
+  END   SUBROUTINE fill_temp
+#endif
+END MODULE chem_gasphase_mod
+ 
Index: palm/trunk/SOURCE/chem_modules.f90
===================================================================
--- palm/trunk/SOURCE/chem_modules.f90	(revision 2696)
+++ palm/trunk/SOURCE/chem_modules.f90	(revision 2696)
@@ -0,0 +1,132 @@
+!> @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 1997-2017 Leibniz Universitaet Hannover
+! Copyright 2017-2017 Karlsruhe Institute of Technology
+! Copyright 2017-2017 Freie Universitaet Berlin
+!------------------------------------------------------------------------------!
+!
+! Current revisions:
+! -----------------
+! 
+! 
+! Former revisions:
+! -----------------
+! $Id$
+! Initial revision
+!
+! 
+!
+!
+! Authors:
+! --------
+! @author Farah Kanani-Suehring
+! @author Basit Khan
+!
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Definition of global palm-4u chemistry variables
+!> (Module written to define global palm-4u chemistry variables. basit 16Nov2017)
+!------------------------------------------------------------------------------!
+!
+ MODULE chem_modules
+#if defined( __chem )  
+    USE kinds 
+    USE chem_gasphase_mod,                                                     &   
+        ONLY: nspec, nvar, spc_names
+
+
+    IMPLICIT NONE
+
+    PUBLIC nspec
+    PUBLIC nvar
+    PUBLIC spc_names
+
+    LOGICAL ::  constant_top_csflux(99)            = .TRUE.                       !< chem spcs at the top  orig .TRUE.
+    LOGICAL ::  constant_csflux(99)                = .TRUE.                       !< chem spcs at namelist parameter   orig TRUE
+
+
+    INTEGER(iwp) :: cs_vertical_gradient_level_ind(99,10) = -9999                 !< grid index values of cs_vertical_gradient_level_ind(s)
+    REAL(wp),     DIMENSION(:),   ALLOCATABLE :: bc_cs_t_val
+    INTEGER(iwp)                              :: ibc_cs_b                         !< integer flag for bc_cs_b
+    INTEGER(iwp)                              :: ibc_cs_t                         !< integer flag for bc_cs_t
+
+    REAL(wp),      DIMENSION(:),  ALLOCATABLE ::  css                             !< scaling parameter for chem spcs
+
+!-- Namelist parameters for creating initial chemistry profiles
+    CHARACTER (LEN=20)               :: bc_cs_b    = 'dirichlet'                  !< namelist parameter
+    CHARACTER (LEN=20)               :: bc_cs_t    = 'initial_gradient'           !< namelist parameter
+    REAL(wp) :: wall_csflux (99,0:5)               = 0.0_wp                       !< namelist parameter
+    REAL(wp) :: cs_vertical_gradient (99,10)       = 0.0_wp                       !< namelist parameter
+    REAL(wp) :: cs_vertical_gradient_level (99,10) = -999999.9_wp                 !< namelist parameter
+    REAL(wp) :: top_csflux ( 99 )                  = 0.0_wp                       !< namelist parameter 
+    REAL(wp) :: cs_surface_initial_change(99)      = 0.0_wp                       !< namelist parameter
+    REAL(wp) :: surface_csflux(99 )                = 0.0_wp                       !< namelist parameter: fluxes where 'surface_csflux_name' is in the namelist
+!   RFo: I do not know whether it makes sense to have 'constant_csflux=.TRUE. for only these species where 
+!        no flux is given in the namelist. Let's choos surface_csflux=0.0 (and thus 'constant_csflux'=.TRUE.) as default
+!       To obtain  constant_csflux=.FALSE., set surface_csflux = 9999999.9 in the namelist
+!   @todo: need to think a bit more about constant_csflux for chemistry. 
+
+    LOGICAL :: call_chem_at_all_substeps           = .FALSE.                      !< namelist parameter 
+    LOGICAL :: chem_debug0                         = .FALSE.                      !< namelist parameter flag for minimum print output
+    LOGICAL :: chem_debug1                         = .FALSE.                      !< namelist parameter flag for print output
+    LOGICAL :: chem_debug2                         = .FALSE.                      !< namelist parameter flag for further print output
+    LOGICAL :: chem_gasphase_on                    = .TRUE.                       !< namelist parameter 
+
+    CHARACTER (LEN=11), DIMENSION(99)         :: cs_name = 'novalue'              !< Namelist parameter: chem spcs names 
+    CHARACTER (LEN=11), DIMENSION(99)         :: cs_profile_name = 'novalue'      !< Namelist parameter: Names of the
+    CHARACTER (LEN=11), DIMENSION(99)         :: surface_csflux_name = 'novalue'  !< Namelist parameter: chem species surface fluxes names
+                                                                                  !< active chem spcs, default is 'novalue')  ????
+    REAL(wp), DIMENSION(99)                   :: cs_surface = 0.0_wp              !< Namelist parameter: Surface conc of chem spcs'
+    REAL(wp), DIMENSION(99,100)               :: cs_heights = 9999999.9_wp        !< Namelist parameter: Height lvls(m) for cs_profiles
+    REAL(wp), DIMENSION(99,100)               :: cs_profile = 9999999.9_wp        !< Namelist parameter: Chem conc for each spcs defined
+
+#if defined( __nopointer )
+    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET   :: cs                       !< chem spcs
+    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET   :: cs_p                     !< prognostic value of chem spc
+    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET   :: tcs_m                    !< weighted tendency of s for previous sub-timestep (Runge-Kutta)
+
+#else                                                               
+! use pointers cs, cs_p and tcs_m to point arrays cs_1, cs_2, and cs_3
+    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:
+
+#endif                                                                            
+                                                                                  !< by cs_name for each height lvls defined by cs_heights
+!
+!-- Namelist parameters for chem_emissions
+    INTEGER(iwp) ::  main_street_id = 0
+    INTEGER(iwp) ::  max_street_id = 0
+    INTEGER(iwp) ::  side_street_id = 0
+!
+!-- Constant emission factors
+    REAL(wp) ::  emiss_factor_main = 0.0_wp
+    REAL(wp) ::  emiss_factor_side = 0.0_wp
+    
+!-- Emission factors with daily cycle
+!     REAL(wp), DIMENSION(1:24) ::  emiss_factor_main = 0.0_wp
+!     REAL(wp), DIMENSION(1:24) ::  emiss_factor_side = 0.0_wp
+
+    SAVE
+#endif
+ END MODULE chem_modules
+
Index: palm/trunk/SOURCE/chem_photolysis_mod.f90
===================================================================
--- palm/trunk/SOURCE/chem_photolysis_mod.f90	(revision 2696)
+++ palm/trunk/SOURCE/chem_photolysis_mod.f90	(revision 2696)
@@ -0,0 +1,332 @@
+!> @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 1997-2017 Leibniz Universitaet Hannover
+! Copyright 2017-2017 Karlsruhe Institute of Technology
+!------------------------------------------------------------------------------!
+!
+! Current revisions:
+! -----------------
+! 
+! 
+! Former revisions:
+! -----------------
+! $Id$
+! Initial revision
+!
+! 
+!
+!
+! Authors:
+! --------
+! @author Renate Forkel
+!
+!
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> photolysis models and interfaces (Adapted from photolysis_model_mod.f90)
+!> @todo Alles!
+!------------------------------------------------------------------------------!
+ MODULE chem_photolysis_mod
+#if defined( __chem )
+    USE arrays_3d,                                                             &
+        ONLY:  dzw, hyp, pt, q, ql, zu, zw
+
+    USE constants,                                                             &
+        ONLY:  pi
+
+    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 radiation_model_mod,                                                   &
+        ONLY:  calc_zenith, zenith
+               !day, day_init, lat, lambda, lon,                   &
+               !time_utc, time_utc_init,    !FKa: This is now handled by date_and_time_mod
+
+    USE control_parameters,                                                    &
+        ONLY:  initializing_actions           
+!       ONLY:  cloud_droplets, cloud_physics, g, initializing_actions,         &
+!              large_scale_forcing, lsf_surf, phi, pt_surface, rho_surface,    &
+!              surface_pressure, time_since_reference_point
+
+    USE chem_gasphase_mod,                                                     &
+        ONLY: nphot, phot_names, phot 
+
+    USE chemistry_model_mod,                                                   &
+        ONLY: phot_frequen, photolysis_scheme
+
+    USE chem_modules,                                                          &
+        ONLY: chem_debug2
+
+!   REAL(wp), DIMENSION(0:0) ::  zenith,         & !< cosine of solar zenith angle
+!                                sun_dir_lat,    & !< solar directional vector in latitudes
+!                                sun_dir_lon       !< solar directional vector in longitudes
+    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 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
+     INTEGER,PARAMETER :: nsimple = 15               !< available predefined photolysis prequencies for simpel 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    ' /)
+
+!-- Parameters for simeple photolysis frequencies from MCM (http://mcm.leeds.ac.uk/MCM)
+!-- Saunders et al., 2003, Atmos. Chem. Phys., 3, 161-180
+     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) :: time_photolysis = 0.0_wp,         & !< time since last call of photolysis code
+                dt_photolysis = 0.0_wp,           & !< hotolysis model timestep
+                skip_time_do_photolysis = 0.0_wp    !< Radiation model is not called before this time
+
+    REAL(wp)     :: cosz = 0.7_wp                   !< cosine of Zenith angle (45 deg, if not specified otherwise)
+
+!
+!-- Variables and parameters used in Fast-J only
+! ....
+
+!   INTERFACE photolysis_check_parameters
+!      MODULE PROCEDURE photolysis_check_parameters
+!   END INTERFACE photolysis_check_parameters
+  
+    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
+
+!   INTERFACE photolysis_header
+!      MODULE PROCEDURE photolysis_header
+!   END INTERFACE photolysis_header 
+! 
+    INTERFACE photolysis_init
+       MODULE PROCEDURE photolysis_init
+    END INTERFACE photolysis_init
+
+!   INTERFACE photolysis_parin
+!      MODULE PROCEDURE photolysis_parin
+!   END INTERFACE photolysis_parin
+    
+!   INTERFACE photolysis_read_restart_data
+!      MODULE PROCEDURE photolysis_read_restart_data
+!   END INTERFACE photolysis_read_restart_data
+
+!   INTERFACE photolysis_last_actions
+!      MODULE PROCEDURE photolysis_last_actions
+!   END INTERFACE photolysis_last_actions
+
+    SAVE
+
+    PRIVATE
+
+!
+!-- Public functions / NEEDS SORTING
+!   PUBLIC photolysis_init
+!          photolysis_check_parameters, photolysis_control,                      &
+!          photolysis_header, photolysis_init, photolysis_parin !,                 &
+!          photolysis_define_netcdf_grid, photolysis_last_actions,               &
+!          photolysis_read_restart_data, photolysis_data_output_mask
+
+   PUBLIC  photolysis_control, photolysis_init
+
+   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:
+! ------------
+!> Initialization of the photolysis model
+!------------------------------------------------------------------------------!
+    SUBROUTINE photolysis_init    !### not yes used. Call should be placed near call of chem_init
+    
+       IMPLICIT NONE
+
+!-- Just in case we need anything
+
+       RETURN
+
+    END SUBROUTINE photolysis_init
+
+
+!------------------------------------------------------------------------------!
+! 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) :: i, j, k   !< loop indices
+       INTEGER(iwp) :: iphot,iav !< loop indix for photolysis reaction
+!      REAL(wp)     :: exn,   &  !< Exner functions at surface
+!                      pt1       !< potential temperature at first grid level
+
+       DO iphot = 1,nphot
+          DO iav = 1,nconst
+             IF ( TRIM( names_c(iav) ) == TRIM( phot_names(iphot) ) ) then
+!--    Prescribe fixed photolysis frequencies  [1/s]
+!             IF(myid == 0 .AND. chem_debug2 )  WRITE(06,*) iphot, iav,phot_names(iphot),names_c(iav)
+
+                      phot_frequen(iphot)%freq(nzb+1:nzt,:,:) =    &
+                            phot0(iav) * cosz
+
+!              IF(myid == 0 .AND. chem_debug2 )  WRITE(06,*) phot_frequen(iphot)%freq(1,5,5)
+            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
+!------------------------------------------------------------------------------!
+    SUBROUTINE photolysis_simple
+
+       IMPLICIT NONE
+
+!      INTEGER(iwp) :: i, j, k   !< loop indices
+       INTEGER(iwp) :: iphot,iav !< loop indix for photolysis reaction
+!      REAL(wp)     :: exn,   &  !< Exner functions at surface
+!                      pt1       !< potential temperature at first grid level
+       REAL(wp)     :: coszi     !< 1./cosine of zenith angle
+
+    DO iphot = 1,nphot
+       phot_frequen(iphot)%freq = 0.0_wp
+    ENDDO
+
+    CALL calc_zenith
+
+    IF ( zenith(0) > 0.0_wp ) THEN
+       coszi = 1. / zenith(0)
+
+       DO iphot = 1,nphot
+          DO iav = 1,nsimple
+             IF ( TRIM( names_s(iav) ) == TRIM( phot_names(iphot) ) ) then
+!              if(myid == 0 .AND. chem_debug2 )  WRITE(06,*) 'simple', iphot, iav,phot_names(iphot),names_s(iav)
+
+                      phot_frequen(iphot)%freq(nzb+1:nzt,:,:) =    &
+                            par_l(iav) * zenith(0)**par_m(iav) *  EXP( -par_n(iav) * coszi ) 
+
+!              if(myid == 0 .AND. chem_debug2 )  WRITE(06,*) 'simple', phot_frequen(iphot)%freq(1,5,5)
+            ENDIF
+          ENDDO
+       ENDDO
+    ENDIF
+
+    END SUBROUTINE photolysis_simple
+#endif
+ END MODULE chem_photolysis_mod
Index: palm/trunk/SOURCE/chemistry_model_mod.f90
===================================================================
--- palm/trunk/SOURCE/chemistry_model_mod.f90	(revision 2696)
+++ palm/trunk/SOURCE/chemistry_model_mod.f90	(revision 2696)
@@ -0,0 +1,1800 @@
+!> @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 1997-2017 Leibniz Universitaet Hannover
+! Copyright 2017-2017 Karlsruhe Institute of Technology
+! Copyright 2017-2017 Freie Universitaet Berlin
+!------------------------------------------------------------------------------!
+!
+! Current revisions:
+! -----------------
+! 
+! 
+! Former revisions:
+! -----------------
+! $Id$
+! Initial revision
+!
+! 
+!
+!
+! Authors:
+! --------
+! @author Renate Forkel
+! @author Farah Kanani-Suehring
+! @author Klaus Ketelsen
+! @author Basit Khan
+!
+!
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Chemistry model for PALM-4U
+!> @todo Update/clean-up todo list! (FK)
+!> @todo Chemistry for prognostic_equations_vector! (FK)
+!> @todo Set proper fill values (/= 0) for chem output arrays! (FK)
+!> @todo Add routine chem_check_parameters, add checks for inconsistent or
+!>       unallowed parameter settings (e.g. "only cache optimized version
+!>       available"). CALL of chem_check_parameters from check_parameters. (FK)
+!> @todo Make routine chem_header available, CALL from header.f90
+!>       (see e.g. how it is done in routine lsm_header in 
+!>        land_surface_model_mod.f90). chem_header should include all setup
+!>        info about chemistry parameter settings. (FK)
+!> @todo Implement turbulent inflow of chem spcs in inflow_turbulence.
+!> @todo Separate boundary conditions for each chem spcs to be implemented
+!> @todo Currently only total concentration are calculated. Resolved, parameterized
+!>       and chemistry fluxes although partially and some completely coded but
+!>       are not operational/activated in this version. bK.
+!> @todo slight differences in passive scalar and chem spcs when chem reactions
+!>       turned off. Need to be fixed. bK
+!> @todo introduce nesting for chem spcs. bK
+!> @todo subroutine set_const_initial_values to be taken out from chemistry_model_mod !bK.
+!> @todo chemistry error messages
+!> @todo Format this module according to PALM coding standard (see e.g. module
+!>       template under http://palm.muk.uni-hannover.de/mosaik/downloads/8 or
+!>       D3_coding_standard.pdf under https://palm.muk.uni-hannover.de/trac/downloads/16)
+! 
+!------------------------------------------------------------------------------!
+
+MODULE chemistry_model_mod
+#if defined( __chem )
+   USE kinds,              ONLY: wp, iwp
+   USE indices,            ONLY: nz, nzb,nzt,nysg,nyng,nxlg,nxrg,nys,nyn
+   USE pegrid,             ONLY: myid, threads_per_task
+   USE control_parameters, ONLY: dt_3d, ws_scheme_sca, initializing_actions, message_string, &
+                                 omega, tsc, intermediate_timestep_count,      &
+                                 intermediate_timestep_count_max,              &
+                                 timestep_scheme, use_prescribed_profile_data  
+   USE arrays_3d,          ONLY: hyp, pt, rdf_sc, tend, zu                     
+   USE chem_gasphase_mod,  ONLY: nspec, spc_names, nkppctrl, nmaxfixsteps,     &
+                                 t_steps, fill_temp, chem_gasphase_integrate,  &
+                                 nvar, atol, rtol, nphot, phot_names
+   USE cpulog,             ONLY: cpu_log, log_point
+
+   USE chem_modules
+ 
+
+   IMPLICIT   NONE
+   PRIVATE
+   SAVE
+
+!- Define chemical variables
+
+   TYPE   species_def
+      CHARACTER(LEN=8)                                   :: name
+      CHARACTER(LEN=16)                                  :: unit
+      REAL(kind=wp),POINTER,DIMENSION(:,:,:)             :: conc
+      REAL(kind=wp),POINTER,DIMENSION(:,:,:)             :: conc_av
+      REAL(kind=wp),POINTER,DIMENSION(:,:,:)             :: conc_p
+      REAL(kind=wp),POINTER,DIMENSION(:,:,:)             :: tconc_m
+      REAL(kind=wp),ALLOCATABLE,DIMENSION(:,:)           :: cssws_av           
+      REAL(kind=wp),ALLOCATABLE,DIMENSION(:,:)           :: flux_s_cs
+      REAL(kind=wp),ALLOCATABLE,DIMENSION(:,:)           :: diss_s_cs
+      REAL(kind=wp),ALLOCATABLE,DIMENSION(:,:,:)         :: flux_l_cs
+      REAL(kind=wp),ALLOCATABLE,DIMENSION(:,:,:)         :: diss_l_cs
+      REAL(kind=wp),ALLOCATABLE,DIMENSION(:)             :: conc_pr_init
+   END TYPE species_def
+
+
+   TYPE   photols_def                                                            
+      CHARACTER(LEN=8)                                   :: name
+      CHARACTER(LEN=16)                                  :: unit
+      REAL(kind=wp),POINTER,DIMENSION(:,:,:)             :: freq
+   END TYPE photols_def
+
+
+   PUBLIC  species_def
+   PUBLIC  photols_def
+
+
+   TYPE(species_def),ALLOCATABLE,DIMENSION(:),TARGET, PUBLIC     :: chem_species
+   TYPE(photols_def),ALLOCATABLE,DIMENSION(:),TARGET, PUBLIC     :: phot_frequen  
+
+   REAL(kind=wp),ALLOCATABLE,DIMENSION(:,:,:,:),TARGET   :: spec_conc_1
+   REAL(kind=wp),ALLOCATABLE,DIMENSION(:,:,:,:),TARGET   :: spec_conc_2
+   REAL(kind=wp),ALLOCATABLE,DIMENSION(:,:,:,:),TARGET   :: spec_conc_3
+   REAL(kind=wp),ALLOCATABLE,DIMENSION(:,:,:,:),TARGET   :: spec_conc_av       
+   REAL(kind=wp),ALLOCATABLE,DIMENSION(:,:,:,:),TARGET   :: freq_1
+
+   INTEGER,DIMENSION(nkppctrl)                           :: icntrl                            ! Fine tuning kpp
+   REAL(kind=wp),DIMENSION(nkppctrl)                     :: rcntrl                            ! Fine tuning kpp
+
+   CHARACTER(10), PUBLIC :: 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
+
+   PUBLIC nspec
+   PUBLIC nvar       
+   PUBLIC spc_names  
+
+!- Interface section
+  INTERFACE chem_boundary_conds
+      MODULE PROCEDURE chem_boundary_conds
+  END INTERFACE chem_boundary_conds
+
+   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_parin
+      MODULE PROCEDURE chem_parin
+   END INTERFACE chem_parin
+
+   INTERFACE chem_integrate
+      MODULE PROCEDURE chem_integrate_ij
+   END INTERFACE chem_integrate
+
+   INTERFACE chem_swap_timelevel
+      MODULE PROCEDURE chem_swap_timelevel
+   END INTERFACE chem_swap_timelevel
+
+   INTERFACE chem_define_netcdf_grid
+      MODULE PROCEDURE chem_define_netcdf_grid
+   END INTERFACE chem_define_netcdf_grid
+
+   INTERFACE chem_data_output_3d
+      MODULE PROCEDURE chem_data_output_3d
+   END INTERFACE chem_data_output_3d
+
+   INTERFACE chem_check_data_output
+      MODULE PROCEDURE chem_check_data_output
+   END INTERFACE chem_check_data_output
+
+   INTERFACE chem_check_data_output_pr
+      MODULE PROCEDURE chem_check_data_output_pr
+   END INTERFACE chem_check_data_output_pr
+
+   INTERFACE chem_3d_data_averaging
+      MODULE PROCEDURE chem_3d_data_averaging 
+   END INTERFACE chem_3d_data_averaging
+
+   INTERFACE chem_last_actions
+      MODULE PROCEDURE chem_last_actions 
+   END INTERFACE chem_last_actions
+
+   INTERFACE chem_read_restart_data
+      MODULE PROCEDURE chem_read_restart_data
+   END INTERFACE chem_read_restart_data
+
+   INTERFACE chem_tendency
+      MODULE PROCEDURE chem_tendency
+   END INTERFACE chem_tendency
+
+   INTERFACE chem_header
+      MODULE PROCEDURE chem_header
+   END INTERFACE chem_header
+
+   INTERFACE chem_emissions
+      MODULE PROCEDURE chem_emissions
+   END INTERFACE chem_emissions
+
+!    INTERFACE chem_write_var_list
+!       MODULE PROCEDURE chem_write_var_list
+!    END INTERFACE chem_write_var_list
+! 
+!    INTERFACE chem_read_var_list
+!       MODULE PROCEDURE chem_read_var_list
+!    END INTERFACE chem_read_var_list
+! 
+!    INTERFACE chem_skip_var_list
+!       MODULE PROCEDURE chem_skip_var_list
+!    END INTERFACE chem_skip_var_list
+
+
+   PUBLIC chem_boundary_conds, chem_check_data_output,                         &
+          chem_check_data_output_pr, chem_data_output_3d,                      &
+          chem_define_netcdf_grid, chem_header, chem_init,                     &
+          chem_init_profiles, chem_integrate, chem_parin,                      &
+          chem_swap_timelevel, chem_last_actions, chem_read_restart_data,      &
+          chem_tendency, chem_3d_data_averaging, chem_emissions!, chem_write_var_list,          &
+          !chem_read_var_list, chem_skip_var_list
+
+
+ CONTAINS
+
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+!> Subroutine to initialize and set all boundary conditions for chemical species
+!------------------------------------------------------------------------------!
+
+ SUBROUTINE chem_boundary_conds( mode )                                           
+                                                                                  
+    USE control_parameters,                                                    &  
+        ONLY: air_chemistry, outflow_l, outflow_n, outflow_r, outflow_s                 
+    USE indices,                                                               &  
+        ONLY: nxl, nxr,  nxlg, nxrg, nyng, nysg, nzt                              
+                                                                                  
+!    USE prognostic_equations_mod,                                             &
+
+    USE arrays_3d,                                                             &     
+        ONLY: dzu                                                
+    USE surface_mod,                                                           &
+        ONLY: bc_h                                                           
+
+    CHARACTER (len=*), INTENT(IN) :: mode
+    INTEGER(iwp) ::  i                                                            !< grid index x direction.
+    INTEGER(iwp) ::  j                                                            !< grid index y direction.
+    INTEGER(iwp) ::  k                                                            !< grid index z direction.
+    INTEGER(iwp) ::  kb                                                           !< variable to set respective boundary value, depends on facing. 
+    INTEGER(iwp) ::  l                                                            !< running index boundary type, for up- and downward-facing walls.
+    INTEGER(iwp) ::  m                                                            !< running index surface elements.
+    INTEGER(iwp) ::  lsp                                                          !< running index for chem spcs.
+    INTEGER(iwp) ::  lph                                                          !< running index for photolysis frequencies
+
+
+    SELECT CASE ( TRIM( mode ) )        
+       CASE ( 'init' )     
+          DO lsp = 1, nspec            
+            IF ( surface_csflux(lsp) == 9999999.9_wp )  THEN
+                 constant_csflux(lsp) = .FALSE.            
+            ENDIF
+          ENDDO
+
+          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 ) // '"'  ! bK commented
+             CALL message( 'chem_boundary_conds', 'CHEM001', 1, 2, 0, 6, 0 )     !< chemistry_model_mod should have special error numbers --> "CHEM###",
+          ENDIF                                                                  
+!
+!--       Set Integer flags and check for possible erroneous settings for top
+!--       boundary condition. bK added *_cs_* here.
+          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( 'check_parameters', 'CHEM002', 1, 2, 0, 6, 0 )
+          ENDIF
+
+      
+       CASE ( 'set_bc_bottomtop' )                   
+!--      Bottom boundary condtions for chemical species      
+          DO lsp = 1, nspec                                                      
+             IF ( ibc_cs_b == 0 ) THEN                   
+                DO l = 0, 1 
+!--             Set index kb: For upward-facing surfaces (l=0), kb=-1, i.e.
+!--             the chem_species(nsp)%conc_p value at the topography top (k-1)
+!--             is set; for downward-facing surfaces (l=1), kb=1, i.e. the 
+!--             value at the topography bottom (k+1) is set. 
+
+                   kb = MERGE( -1, 1, l == 0 )
+                   !$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+kb,j,i) = chem_species(lsp)%conc(k+kb,j,i) 
+                   ENDDO                                        
+                ENDDO                                       
+          
+             ELSEIF ( ibc_cs_b == 1 ) THEN
+         ! in boundary_conds there is som extra loop over m here for passive tracer
+                DO l = 0, 1
+                   kb = MERGE( -1, 1, l == 0 )
+                   !$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+kb,j,i) = chem_species(lsp)%conc_p(k,j,i)
+
+!< @todo: chem_species(nsp)%conc_p(k+kb,j,i) = chem_species(nsp)%conc(k+kb,j,i),    &
+!<  pls loop over nsp=1, NSPEC.
+!< @todo: We should also think about the possibility to have &
+!< individual boundary conditions for each species? This means, bc_cs_b,       &
+!< bc_cs_t, ibc_cs_b, ibc_cs_t would need to be added to TYPE chem_species(nsp)%,   &
+!< and the loop over nsp would have to be put outside of this IF-clause.
+!< i think its better we keep the same bonundary cond i.e. dirichlet or neumann
+!< for all chem spcs. ... !bK
+
+                   ENDDO
+                ENDDO
+             ENDIF
+          ENDDO    ! end lsp loop  
+
+!--    Top boundary conditions for chemical species - Should this not be done for all species?
+          IF ( ibc_cs_t == 0 )  THEN                    
+             DO lsp = 1, nspec
+                chem_species(lsp)%conc_p(nzt+1,:,:) = chem_species(lsp)%conc(nzt+1,:,:)        
+             ENDDO
+          ELSEIF ( ibc_cs_t == 1 )  THEN
+             DO lsp = 1, nspec
+                chem_species(lsp)%conc_p(nzt+1,:,:) = chem_species(lsp)%conc_p(nzt,:,:)
+             ENDDO
+          ELSEIF ( ibc_cs_t == 2 )  THEN
+             DO lsp = 1, nspec
+                chem_species(lsp)%conc_p(nzt+1,:,:) = chem_species(lsp)%conc_p(nzt,:,:) + bc_cs_t_val(lsp) * dzu(nzt+1)
+             ENDDO
+                                    !@todo: bc_cs_t_val needs to be calculated,    
+                                    !see bc_pt_t_val = ( pt_init(nzt+1) - pt_init(nzt) ) / dzu(nzt+1) 
+                                    !(in time_integration). pt_init would be the counterpart to
+                                    !chem_species(i)%conc_pr_init (see kchem_driver_FKa1408.f90 of my 
+                                    !"Hints: prescribing initial concentration.
+          ENDIF
+!
+       CASE ( 'set_bc_lateral' )                       ! bK commented it
+!--          Lateral boundary conditions for chem species at inflow boundary
+!--          are automatically set when chem_species concentration is
+!--          initialized. The initially set value at the inflow boundary is not
+!--          touched during time integration, hence, this boundary value remains
+!--          at a constant value, which is the concentration that flows into the
+!--          domain.                                                           
+!--          Lateral boundary conditions for chem species at outflow boundary 
+
+          IF ( outflow_s )  THEN
+             DO lsp = 1, nspec
+                chem_species(lsp)%conc_p(:,nys-1,:) = chem_species(lsp)%conc_p(:,nys,:)
+             ENDDO
+          ELSEIF ( outflow_n )  THEN
+             DO lsp = 1, nspec
+                chem_species(lsp)%conc_p(:,nyn+1,:) = chem_species(lsp)%conc_p(:,nyn,:)
+             ENDDO
+          ELSEIF ( outflow_l )  THEN
+             DO lsp = 1, nspec
+                chem_species(lsp)%conc_p(:,:,nxl-1) = chem_species(lsp)%conc_p(:,:,nxl)
+             ENDDO
+          ELSEIF ( outflow_r )  THEN
+             DO lsp = 1, nspec
+                chem_species(lsp)%conc_p(:,:,nxr+1) = chem_species(lsp)%conc_p(:,:,nxr)
+             ENDDO
+          ENDIF
+         
+    END SELECT
+
+ END SUBROUTINE chem_boundary_conds
+!
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+!> Subroutine defining initial vertical profiles of chemical species (given by
+!> namelist parameters chem_profiles and chem_heights)  --> which should work
+!> analogue to parameters u_profile, v_profile and uv_heights)
+!------------------------------------------------------------------------------!
+ SUBROUTINE chem_init_profiles              !< SUBROUTINE is called from chem_init in case of 
+                                            !< TRIM( initializing_actions ) /= 'read_restart_data'
+                                            !< We still need to see what has to be done in case of restart run
+    USE chem_modules
+
+    IMPLICIT NONE
+
+!-- Local variables
+    INTEGER ::  lsp        !< running index for number of species in derived data type species_def
+    INTEGER ::  lsp_pr     !< running index for number of species in cs_names, cs_profiles etc
+    INTEGER ::  lpr_lev    !< running index for profile level for each chem spcs. 
+    INTEGER ::  npr_lev    !< the next available profile lev
+
+!-----------------
+!-- To prescribe/initialize a vertically constant  'cs_profile', another parameter
+!-- "cs_surface" is introduced. 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_pr = 1
+       DO  WHILE ( TRIM( cs_name( lsp_pr ) ) /= '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_pr) ) )  THEN   !
+!                IF ( cs_profile(1,1) == 9999999.9_wp ) THEN
+!--               Set a vertically constant profile based on the surface conc (cs_surface(lsp_pr)) of each species
+                  DO lpr_lev = 0, nzt+1
+                     chem_species(lsp)%conc_pr_init(lpr_lev) = cs_surface(lsp_pr)
+                  ENDDO
+
+!                ELSE
+!                   IF ( cs_heights(lsp,1) /= 0.0_wp )  THEN
+!                      message_string = 'cs_heights(1,1) must be 0.0'
+!                      CALL message( 'chem_check_parameters', 'CHEM0004', 1, 2, 0, 6, 0 )
+!                   ENDIF
+!  
+!                   IF ( omega /= 0.0_wp )  THEN
+!                      message_string = 'Coriolis force must be switched off (by setting omega=0.0)' //  &
+!                                       ' when prescribing the forcing by u_profile and v_profile'
+!                      CALL message( 'check_parameters', 'PA0347', 1, 2, 0, 6, 0 )
+!                   ENDIF
+!  
+!                   use_prescribed_profile_data = .TRUE.
+! 
+!                   npr_lev = 1
+! !                  chem_sddpecies(lsp)%conc_pr_init(0) = 0.0_wp
+!                   DO  lpr_lev = 1, nz+1
+!                      IF ( npr_lev < 100 )  THEN
+!                         DO  WHILE ( cs_heights(lsp, npr_lev+1) <= zu(lpr_lev) )
+!                            npr_lev = npr_lev + 1
+!                            IF ( npr_lev == 100 )  EXIT
+!                         ENDDO
+!                      ENDIF
+!  
+!                      IF ( npr_lev < 100  .AND.  cs_heights(lsp, npr_lev + 1) /= 9999999.9_wp )  THEN
+!                         chem_species(lsp)%conc_pr_init(lpr_lev) = cs_profile(lsp, npr_lev) +         &
+!                                                 ( zu(lpr_lev) - cs_heights(lsp, npr_lev) ) /         &
+!                                                 ( cs_heights(lsp, npr_lev + 1) - cs_heights(lsp, npr_lev ) ) * &
+!                                                 ( cs_profile(lsp, npr_lev + 1) - cs_profile(lsp, npr_lev ) )
+!                      ELSE
+!                         chem_species(lsp)%conc_pr_init(lpr_lev) = cs_profile(lsp, npr_lev)
+!                      ENDIF
+!                   ENDDO
+!                ENDIF
+!-- If a profile is prescribed explicity using cs_profiles and cs_heights, we then have to fill the 
+!-- chem_species(lsp)%conc_pr_init for the specific "lsp" based on the cs_profiles(lsp_pr,:) 
+!-- and cs_heights(lsp_pr,:). 
+             ENDIF
+          ENDDO
+          lsp_pr = lsp_pr + 1
+       ENDDO
+!     ELSE
+!       IF (chem_debug1 ) print*,'code to be added for initializing_actions == read_restart_data'   !bK
+!     ENDIF
+
+!-- Now, go back to chem_init and use the contents of chem_species(lsp)%conc_pr_init to
+!-- initialize the 3D conc arrays, as it is currently taken care of in chem_set_constant_values.
+!-- After initializing the 3D arrays, these can be used to set the boundary conditions in the
+!-- subroutine kchem_boundary_conds, which should be called from boundary_conds.f90.
+
+
+ END SUBROUTINE chem_init_profiles
+!
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+!> Subroutine initializating chemistry_model_mod
+!------------------------------------------------------------------------------!
+   SUBROUTINE chem_init
+
+
+      USE control_parameters,                                                  &
+         ONLY: message_string, io_blocks, io_group, turbulent_inflow
+       
+      USE arrays_3d,                                                           &
+          ONLY: mean_inflow_profiles
+
+      USE pegrid
+
+    IMPLICIT   none
+!-- local variables
+    INTEGER                 :: i,j               !< running index for for horiz numerical grid points
+    INTEGER                 :: lsp               !< running index for chem spcs
+    INTEGER                 :: lpr_lev           !< running index for chem spcs profile level
+!
+!-- NOPOINTER version not implemented yet
+! #if defined( __nopointer )
+!     message_string = 'The chemistry module only runs with POINTER version'
+!     CALL message( 'chemistry_model_mod', 'CM0001', 1, 2, 0, 6, 0 )      
+! #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( spec_conc_av(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
+    spec_conc_av(:,:,:,:) = 0.0_wp
+
+
+    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)
+       chem_species(lsp)%conc_av(nzb:nzt+1,nysg:nyng,nxlg:nxrg)       => spec_conc_av(:,:,:,lsp)     
+
+       ALLOCATE (chem_species(lsp)%cssws_av(nysg:nyng,nxlg:nxrg))                   
+       chem_species(lsp)%cssws_av    = 0.0_wp
+!
+!--    (todo (FK): This needs to be revised. This block must go somewhere else)                                         
+!      IF ( ws_scheme_sca )  THEN                                                
+          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                                     
+!      ENDIF         
+!
+!--   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
+
+!
+!-- Set initial concentration of profiles prescribed by parameters cs_profile
+!-- and cs_heights in the namelist &chemistry_par
+!-- (todo (FK): chem_init_profiles not ready yet, has some bugs)
+!     CALL chem_init_profiles
+!
+!-- 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 computes.
+       IF ( INDEX( initializing_actions, 'set_1d-model_profiles' ) /= 0 )  THEN
+!            CALL location_message( 'initializing with 1D model profiles', .FALSE. )
+!
+!          CALL init_1d_model    ...... decide to call or not later     !bK
+
+!--        Transfer initial profiles to the arrays of the 3D model
+          DO lsp = 1, nspec
+             DO  i = nxlg, nxrg
+                DO  j = nysg, nyng
+                   DO lpr_lev = 1, nz + 1
+                      chem_species(lsp)%conc(lpr_lev,j,i) = chem_species(lsp)%conc_pr_init(lpr_lev)
+                   ENDDO
+                ENDDO
+             ENDDO   
+          ENDDO
+       
+       ELSEIF ( INDEX(initializing_actions, 'set_constant_profiles') /= 0 )    &
+       THEN
+!           CALL location_message( 'initializing with constant profiles', .FALSE. )
+
+
+
+!--       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!).
+
+          DO lsp = 1, nspec 
+             DO  i = nxlg, nxrg
+                DO  j = nysg, nyng
+                   chem_species(lsp)%conc(:,j,i) = chem_species(lsp)%conc_pr_init    !ITS THERE bK
+                ENDDO
+             ENDDO
+          ENDDO
+
+!        ELSEIF ( INDEX(initializing_actions, 'by_user') /= 0 )                  &
+!        THEN
+!           CALL location_message( 'initializing by user', .FALSE. )
+!
+!--       Initialization will completely be done by the user
+!--       (FK: This should be called only once, in init_3d_model, i.e. remove it here)
+!           CALL user_init_3d_model
+!           CALL location_message( 'finished', .TRUE. )
+
+       ENDIF
+
+!-- Store initial chem spcs profile
+!         DO lsp = 1, nvar
+!          hom_cs(:,1,115,:) = SPREAD(  chem_species(lsp)%conc(:,nys,nxl), 2, statistic_regions+1 )
+!         ENDDO
+!
+!-- If required, change the surface chem spcs at the start of the 3D run
+       IF ( cs_surface_initial_change(1) /= 0.0_wp ) THEN            
+          DO lsp = 1, nspec 
+             chem_species(lsp)%conc(nzb,:,:) = chem_species(lsp)%conc(nzb,:,:) +  &
+                                               cs_surface_initial_change(lsp)
+          ENDDO
+       ENDIF 
+!
+!-- Initiale old and new time levels. 
+       DO lsp = 1, nvar
+          chem_species(lsp)%tconc_m = 0.0_wp                      
+          chem_species(lsp)%conc_p  = chem_species(lsp)%conc     
+       ENDDO
+!        CALL location_message( 'finished', .TRUE. )
+
+!
+!-- (todo (FK): Restarts not available yet. It is not correct to call 
+!--             read_3d_binary here)
+    ELSEIF ( TRIM( initializing_actions ) == 'read_restart_data'  .OR.         &
+             TRIM( initializing_actions ) == 'cyclic_fill' )                   &
+    THEN
+
+       message_string = 'so far, restarts are not possible with chemistry'
+       CALL message( 'chem_init', 'CM0002', 1, 2, 0, 6, 0 )
+!        CALL location_message( 'initializing in case of restart / cyclic_fill', &
+!                               .FALSE. )
+! !
+! !--    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
+!           DO  i = 0, io_blocks-1
+!              IF ( i == io_group )  THEN
+!                 CALL read_parts_of_var_list
+!                 CALL close_file( 13 )
+!              ENDIF
+! #if defined( __parallel )
+!              CALL MPI_BARRIER( comm2d, ierr )
+! #endif
+!           ENDDO
+!        ENDIF
+! !
+! !--    Read binary data from restart file
+!        DO  i = 0, io_blocks-1
+!           IF ( i == io_group )  THEN
+!              CALL read_3d_binary
+!           ENDIF
+! #if defined( __parallel )
+!           CALL MPI_BARRIER( comm2d, ierr )
+! #endif
+!        ENDDO
+! !
+! !--    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,8) )
+! !         mean_inflow_profiles(:,8) = hom_sum(:,115,0)   !cs           
+! 
+! !         IF ( inflow_l) THEN
+! !            DO  j = nysg, nyng
+! !               DO  k = nzb, nzt+1
+! !                     DO lsp = 1, nvar 
+! !                       chem_species(lsp)%conc(k,j,nxlg:-1)  = mean_inflow_profiles(k,8)  ???
+! !                     ENDDO
+! !               ENDDO
+! !            ENDDO
+! !         ENDIF
+!        ENDIF
+! 
+! !--    Inside buildings set velocities and TKE back to zero         
+! !       IF ( TRIM( initializing_actions ) == 'cyclic_fill' .AND.                &
+! !            topography /= 'flat' )  THEN
+! !           ......
+! !       ENDIF
+! ! 
+! !--    Initialize new time levels (only done in order to set boundary values
+! !--    including ghost points)
+!        DO lsp = 1, nvar
+!           chem_species(lsp)%conc_p  = chem_species(lsp)%conc
+!        ENDDO
+! !
+! !--    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. 
+! 
+!        DO lsp = 1, nvar
+!           chem_species(lsp)%tconc_m  = 0.0_wp
+!        ENDDO
+
+    ELSE
+!
+!--    Actually this part of the programm should not be reached
+       message_string = 'unknown initializing problem'
+       CALL message( 'chem_init', 'CM0003', 1, 2, 0, 6, 0 )
+    ENDIF
+
+
+
+!--- new code add above this line
+    DO lsp = 1, nphot
+       phot_frequen(lsp)%name = phot_names(lsp)
+!        IF( myid == 0 )  THEN
+!           WRITE(6,'(a,i4,3x,a)')  'Photolysis: ',lsp,trim(phot_names(lsp))
+!        ENDIF 
+         phot_frequen(lsp)%freq(nzb:nzt+1,nysg:nyng,nxlg:nxrg)    => freq_1(:,:,:,lsp)
+    ENDDO
+
+!--   Set initial values
+!    Not required any more, this can now be done with the namelist  by setting cs_surface 
+!    and cs_name without specifying cs_profile (Nevertheless, we still want to keep it for a while) 
+!   IF (  TRIM( initializing_actions ) /= 'read_restart_data' )  THEN             
+!         CALL set_const_initial_values
+!   ENDIF
+
+    RETURN
+
+    CONTAINS
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+!> Subroutine setting constant initial values of chemical species
+!------------------------------------------------------------------------------!
+     SUBROUTINE set_const_initial_values
+!    Not required any more, this can now be done with the namelist  by setting cs_surface 
+!    and cs_name without specifying cs_profile (Nevertheless, we still want to keep it for a while) 
+         IMPLICIT   none
+
+!--      local variables
+         INTEGER                  :: lsp
+
+         IF(myid == 0)  THEN
+            write(6,'(/,a,/)')  ' chemics >>>> Set constant Initial Values: '
+         ENDIF
+
+!        Default values are taken from smog.def from supplied kpp example
+         DO lsp = 1, nspec
+            IF(trim(chem_species(lsp)%name) == 'NO')           THEN
+!              chem_species(lsp)%conc = 8.725*1.0E+08
+!              chem_species(lsp)%conc = 0.05_wp                          !added by bK
+               chem_species(lsp)%conc = 0.01_wp                          !added by RFo
+            ELSEIF (trim(chem_species(lsp)%name) == 'NO2')     THEN
+!              chem_species(lsp)%conc = 2.240*1.0E+08             
+!              chem_species(lsp)%conc = 0.01_wp                          !added by bK
+               chem_species(lsp)%conc = 0.05_wp                          !added by RFo
+            ELSEIF( trim( chem_species(lsp)%name ) == 'O3' )   THEN
+               chem_species(lsp)%conc = 0.05_wp                          !added by bK
+            ELSEIF(trim(chem_species(lsp)%name) == 'H2O')      THEN
+!              chem_species(lsp)%conc = 5.326*1.0E+11
+               chem_species(lsp)%conc = 1.30*1.0E+4_wp                   !added by bK
+            ELSEIF(trim(chem_species(lsp)%name) == 'O2')       THEN
+               chem_species(lsp)%conc = 2.0*1.0E+5_wp                    !added by bK
+            ELSEIF(trim(chem_species(lsp)%name) == 'RH')       THEN
+               chem_species(lsp)%conc = 0.001_wp                         !added by RFo
+            ELSEIF(trim(chem_species(lsp)%name) == 'CO')       THEN
+               chem_species(lsp)%conc = 0.5_wp                           !added by RFo
+            ELSEIF(trim(chem_species(lsp)%name) == 'RCHO')     THEN
+!              chem_species(lsp)%conc = 2.0_wp                           !added by bK
+               chem_species(lsp)%conc = 0.01_wp                          !added by RFo
+!           ELSEIF(trim(chem_species(lsp)%name) == 'OH')       THEN
+!              chem_species(lsp)%conc = 1.0*1.0E-07_wp                   !added by bK
+!           ELSEIF(trim(chem_species(lsp)%name) == 'HO2')      THEN
+!              chem_species(lsp)%conc = 1*1.0E-7_wp                      !added by bK
+!           ELSEIF(trim(chem_species(lsp)%name) == 'RCOO2')    THEN      ! corrected RFo
+!              chem_species(lsp)%conc = 1.0*1.0E-7_wp                    !added by bK
+!           ELSEIF(trim(chem_species(lsp)%name) == 'RCOO2NO2') THEN
+!              chem_species(lsp)%conc = 1.0*1.0E-7_wp                    !added by bK
+            ELSE
+!              H2O = 2.0e+04;
+               chem_species(lsp)%conc(nzb:nzt+1,nysg:nyng,nxlg:nxrg) = 0.0_wp
+            ENDIF
+
+            IF(myid == 0)  THEN
+               WRITE(6,'(a,3x,a,3x,a,e12.4)')  '   Species:     ',chem_species(lsp)%name(1:7),' Initial Value = ',chem_species(lsp)%conc(nzb,nysg,nxlg)
+            ENDIF
+         ENDDO
+
+!   #if defined( __nopointer )
+!   !kk      Hier mit message abbrechen
+!            if(myid == 0)  then
+!               write(6,*)  '   KPP does only run with POINTER Version'
+!            end if
+!            stop 'error'
+!   #endif
+
+         RETURN
+      END SUBROUTINE set_const_initial_values
+
+
+   END SUBROUTINE chem_init
+!
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+!> Subroutine defining parin for &chemistry_par for chemistry model
+!------------------------------------------------------------------------------!
+   SUBROUTINE chem_parin
+   
+      USE control_parameters,                                                  &
+          ONLY: air_chemistry
+          
+      USE chem_modules
+      
+      USE kinds
+
+      IMPLICIT   none
+
+      CHARACTER (LEN=80) ::  line   !< dummy string that contains the current line of the parameter file
+      
+      REAL(wp), DIMENSION(nmaxfixsteps) ::   my_steps   !< List of fixed timesteps   my_step(1) = 0.0 automatic stepping
+
+      NAMELIST /chemistry_par/   bc_cs_b,                                &
+                                 bc_cs_t,                                &
+                                 call_chem_at_all_substeps,              &
+                                 chem_debug0,                            &
+                                 chem_debug1,                            &
+                                 chem_debug2,                            &
+                                 chem_gasphase_on,                       &
+                                 cs_heights,                             &
+                                 cs_name,                                &
+                                 cs_profile,                             &
+                                 cs_profile_name,                        & 
+                                 cs_surface,                             &
+                                 emiss_factor_main,                      &
+                                 emiss_factor_side,                      &                      
+                                 icntrl,                                 &
+                                 main_street_id,                         &
+                                 max_street_id,                          &
+                                 my_steps,                               &
+                                 rcntrl,                                 &
+                                 side_street_id,                         &
+                                 photolysis_scheme,                      &
+                                 wall_csflux,                            &
+                                 cs_vertical_gradient,                   &
+                                 top_csflux,                             & 
+                                 surface_csflux,                         &
+                                 surface_csflux_name,                    &
+                                 cs_surface_initial_change,              &
+                                 cs_vertical_gradient_level
+                             
+!-- analogue 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_par 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   
+!--   (todo: initialize these parameters in declaration part, do this for
+!--          all chemistry_par namelist parameters)
+      icntrl    = 0
+      rcntrl    = 0.0_wp
+      my_steps  = 0.0_wp
+      icntrl(2) = 1                                  
+      photolysis_scheme = 'simple'
+      atol = 1.0_wp
+      rtol = 0.01_wp
+!
+!--   Try to find chemistry package
+      REWIND ( 11 )
+      line = ' '
+      DO   WHILE ( INDEX( line, '&chemistry_par' ) == 0 )
+         READ ( 11, '(A)', END=10 )  line
+      ENDDO
+      BACKSPACE ( 11 )
+!
+!--   Read chemistry namelist
+      READ ( 11, chemistry_par )                          
+!
+!--   Enable chemistry model
+      air_chemistry = .TRUE.                    
+
+!
+!--   FK: Not in use/needed (yet), since chemistry_par namelist is always read in
+!       IF ( TRIM( initializing_actions ) == 'read_restart_data' ) THEN
+!          CALL chem_read_var_list
+!       ENDIF
+      
+ 10   CONTINUE
+
+      t_steps = my_steps          !(todo: Why not directly make t_steps a
+                                  !       namelist parameter?)
+
+   END SUBROUTINE chem_parin
+
+ !
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+!> Subroutine to integrate chemical species in the given chemical mechanism
+!------------------------------------------------------------------------------!
+
+   SUBROUTINE chem_integrate_ij (i, j)
+
+      USE cpulog,                                                              &
+           ONLY: cpu_log, log_point
+      USE statistics,                                                          &   ! ## RFo
+           ONLY:  weight_pres
+       USE control_parameters,                                                 &   ! ## RFo 
+           ONLY:  dt_3d, intermediate_timestep_count
+
+      IMPLICIT   none
+      INTEGER,INTENT(IN)       :: i,j
+
+!--   local variables
+      INTEGER(iwp) ::  lsp                                                          !< running index for chem spcs.
+      INTEGER(iwp) ::  lph                                                          !< running index for photolysis frequencies
+      INTEGER                  :: k,m,istatf                                        
+      INTEGER,dimension(20)    :: istatus
+      REAL(kind=wp),dimension(nzb+1:nzt,nspec)                :: tmp_conc           
+      REAL(kind=wp),dimension(nzb+1:nzt)                      :: tmp_temp
+      REAL(kind=wp),dimension(nzb+1:nzt,nphot)                :: tmp_phot
+      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(wp)                         ::  conv                                !< conversion factor
+     REAL(wp), PARAMETER              ::  ppm2fr  = 1.0e-6_wp                 !< Conversion factor ppm to fraction
+     REAL(wp), PARAMETER              ::  pref_i  = 1._wp / 100000.0_wp       !< inverse reference pressure (1/Pa)
+     REAL(wp), PARAMETER              ::  t_std   = 273.15_wp                 !< standard pressure (Pa)
+     REAL(wp), PARAMETER              ::  p_std   = 101325.0_wp               !< standard pressure (Pa)
+     REAL(wp), PARAMETER              ::  r_cp    = 0.286_wp                  !< R / cp (exponent for potential temperature)
+     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)
+
+
+      REAL(kind=wp)  :: dt_chem                                             
+
+       CALL cpu_log( log_point(80), '[chem_integrate_ij]', 'start' )
+!<     Set chem_gasphase_on to .FALSE. if you want to skip computation of gas phase chemistry
+    IF (chem_gasphase_on) THEN
+
+       tmp_temp(:) = pt(:,j,i) * ( hyp(nzb+1:nzt) / 100000.0_wp )**0.286_wp
+! 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
+
+       CALL fill_temp (istatf, tmp_temp)                                      !< Load constant temperature into kpp context
+!      CALL fill_temp (istatf, pt(nzb+1:nzt,j,i))                             !< Load temperature into kpp context
+
+       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
+
+       IF(myid == 0 .AND. chem_debug0 ) THEN
+          IF (i == 10 .and. j == 10) WRITE(0,*) 'begin chemics step ',dt_3d
+       ENDIF
+
+!--    Compute length of time step     # RFo
+       IF ( call_chem_at_all_substeps )  THEN
+          dt_chem = dt_3d * weight_pres(intermediate_timestep_count)
+       ELSE
+          dt_chem = dt_3d
+       ENDIF
+
+       CALL cpu_log( log_point(81), '{chem_gasphase_integrate}', 'start' )
+
+
+       CALL chem_gasphase_integrate (dt_chem, tmp_conc, tmp_temp, tmp_phot, istatus=istatus)
+
+
+       CALL cpu_log( log_point(81), '{chem_gasphase_integrate}', 'stop' )
+
+       DO lsp = 1,nspec
+          chem_species(lsp)%conc (nzb+1:nzt,j,i) = tmp_conc(:,lsp) * tmp_fact_i(:)  ! RFo
+       ENDDO
+
+!      IF (myid == 0 .AND. chem_debug2 ) THEN 
+!         IF (i == 10 .and. j == 10)   WRITE(6,'(a,8i7)') ' KPP Status ',istatus(1:8)
+!         write(6,'(a,8i7)') ' KPP Status ',istatus(1:8)
+!      ENDIF
+
+    ENDIF
+       CALL cpu_log( log_point(80), '[chem_integrate_ij]', 'stop' )
+
+       RETURN
+   END SUBROUTINE chem_integrate_ij
+!
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+!> Subroutine for swapping of timelevels for chemical species
+!> called out from subroutine swap_timelevel
+!------------------------------------------------------------------------------!
+
+   SUBROUTINE chem_swap_timelevel (level)
+      IMPLICIT   none
+
+      INTEGER,INTENT(IN)                  :: level
+
+!--   local variables
+
+      INTEGER               :: lsp
+
+!        print*,' *** entering chem_swap_timelevel ***) '
+      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)
+         end do
+      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)
+         end do
+      end if
+
+      RETURN
+   END SUBROUTINE chem_swap_timelevel
+
+!------------------------------------------------------------------------------!
+!
+! 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 )
+
+      IMPLICIT NONE
+
+      CHARACTER (LEN=*), INTENT(IN)  ::  var         !<
+      LOGICAL, INTENT(OUT)           ::  found       !<
+      CHARACTER (LEN=*), INTENT(OUT) ::  grid_x      !<
+      CHARACTER (LEN=*), INTENT(OUT) ::  grid_y      !<
+      CHARACTER (LEN=*), INTENT(OUT) ::  grid_z      !<
+
+      found  = .TRUE.
+
+      if(var(1:3) == 'kc_')   then                    !< always the same grid for chemistry variables
+            grid_x = 'x'
+            grid_y = 'y'
+            grid_z = 'zu'                             !< kk Use same z axis as u variables. Has to be checked if OK
+      else
+            found  = .FALSE.
+            grid_x = 'none'
+            grid_y = 'none'
+            grid_z = 'none'
+      end if
+
+!     write(6,*) 'chem_define_netcdf_grid ',TRIM(var),' ',trim(grid_x),' ',found
+
+   END SUBROUTINE chem_define_netcdf_grid
+!
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+!> Subroutine for checking data output for chemical species
+!------------------------------------------------------------------------------!
+
+   SUBROUTINE chem_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, lsp
+      INTEGER(iwp) :: ilen
+      INTEGER(iwp) :: k
+
+      CHARACTER(len=16)    ::  spec_name
+
+      unit = 'illegal'
+
+      spec_name = TRIM(var(4:))             !< var 1:3 is 'kc_'.
+
+       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 micrograms per m**3 for PM10 and PM25 (PM2.5)
+         IF (spec_name(1:2) == 'PM')   THEN  
+            unit = 'ug m-3'
+         ENDIF
+       ENDDO
+
+       DO lsp=1,nphot                                                     
+         IF (TRIM(spec_name) == TRIM(phot_frequen(lsp)%name))   THEN
+            unit = 'sec-1'
+         ENDIF
+       ENDDO
+
+
+       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,                                                             &
+        ONLY: zu
+
+    USE control_parameters,                                                    &
+        ONLY: data_output_pr, message_string, air_chemistry
+
+    USE indices
+
+    USE profil_parameter
+
+    USE statistics
+
+
+    IMPLICIT NONE
+
+    CHARACTER (LEN=*) ::  unit     !< 
+    CHARACTER (LEN=*) ::  variable !< 
+    CHARACTER (LEN=*) ::  dopr_unit
+    CHARACTER(len=16) ::  spec_name
+ 
+    INTEGER(iwp) ::  var_count, lsp  !<
+    
+
+    spec_name = TRIM(variable(4:))    
+!             write(9,*) 'fm #32 .. air_chemistry ', air_chemistry
+
+          IF (  .NOT.  air_chemistry )  THEN
+                 message_string = 'data_output_pr = ' //                        &
+                 TRIM( data_output_pr(var_count) ) // ' is not imp' // &
+                          'lemented for air_chemistry = .FALSE.'
+!                CALL message( 'check_parameters', 'PA0185', 1, 2, 0, 6, 0 )
+          ELSE
+             DO lsp = 1, nspec
+                IF (TRIM( spec_name ) == TRIM( chem_species(lsp)%name ) ) THEN 
+                    dopr_index(var_count) = 900 
+                    dopr_unit  = 'ppm'
+                    hom(:,2,900,:) = SPREAD( zu, 2, statistic_regions+1 )
+                ENDIF
+             ENDDO
+          ENDIF
+
+   END SUBROUTINE chem_check_data_output_pr
+!
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+!> Subroutine defining 3D output variables for chemical species
+!------------------------------------------------------------------------------!
+
+
+   SUBROUTINE chem_data_output_3d( av, variable, found, local_pf )
+
+
+      USE indices
+
+      USE kinds
+
+
+      IMPLICIT NONE
+
+      CHARACTER (LEN=*) ::  variable !<
+      LOGICAL      ::  found !<
+      INTEGER(iwp) ::  av    !<
+      REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb:nzt+1) ::  local_pf !<
+
+      !-- local variables
+
+      INTEGER              ::  i, j, k, lsp
+      CHARACTER(len=16)    ::  spec_name
+
+
+      found = .FALSE.
+
+      spec_name = TRIM(variable(4:))
+!av == 0
+
+       DO lsp=1,nspec
+          IF (TRIM(spec_name) == TRIM(chem_species(lsp)%name))   THEN
+             IF(myid == 0 .AND. chem_debug0 )  WRITE(6,*) 'Output of species ',TRIM(variable),' ',TRIM(chem_species(lsp)%name)       
+             
+             IF (av == 0) THEN
+                DO  i = nxl, nxr
+                   DO  j = nys, nyn
+                      DO  k = nzb, nzt+1
+                          local_pf(i,j,k) = chem_species(lsp)%conc(k,j,i)
+                      ENDDO
+                   ENDDO
+                ENDDO
+           
+             ELSE
+                DO  i = nxl, nxr
+                   DO  j = nys, nyn
+                      DO  k = nzb, nzt+1
+                          local_pf(i,j,k) = chem_species(lsp)%conc_av(k,j,i)
+                      ENDDO
+                   ENDDO
+                ENDDO
+             ENDIF
+
+            found = .TRUE.
+          ENDIF
+       ENDDO
+
+       RETURN
+   END SUBROUTINE chem_data_output_3d
+!
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+!> Subroutine for averaging 3D data of chemical species
+!------------------------------------------------------------------------------!
+
+    SUBROUTINE chem_3d_data_averaging ( mode, variable )
+
+    USE control_parameters
+
+    USE indices
+
+    USE kinds
+
+    USE surface_mod,                                                         &
+        ONLY: surf_def_h, surf_lsm_h, surf_usm_h   
+  
+    IMPLICIT NONE
+ 
+    CHARACTER (LEN=*) ::  mode    !< 
+    CHARACTER (LEN=*) :: variable !< 
+ 
+
+    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 type
+    INTEGER(iwp) :: lsp                 !< running index for chem spcs
+    INTEGER(iwp) :: lsp_2               !< it looks like redundent .. will be delted ..bK
+  
+    IF ( mode == 'allocate' )  THEN
+       DO lsp = 1, nspec
+          IF (TRIM(variable(4:)) == TRIM(chem_species(lsp)%name)) THEN
+!                   lsp_2 = lsp 
+             chem_species(lsp)%conc_av = 0.0_wp
+             
+          ENDIF
+       ENDDO
+
+    ELSEIF ( mode == 'sum' )  THEN
+   
+       DO lsp = 1, nspec
+          IF (TRIM(variable(4:)) == TRIM(chem_species(lsp)%name)) THEN
+!                   lsp_2 = lsp 
+             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  m = 1, surf_def_h(0)%ns
+                 i = surf_def_h(0)%i(m)
+                 j = surf_def_h(0)%j(m)
+                 chem_species(lsp)%cssws_av(j,i) = chem_species(lsp)%cssws_av(j,i) + surf_def_h(0)%cssws(lsp,m)
+             ENDDO 
+             DO  m = 1, surf_lsm_h%ns
+                 i = surf_lsm_h%i(m)
+                 j = surf_lsm_h%j(m)
+                 chem_species(lsp)%cssws_av(j,i) = chem_species(lsp)%cssws_av(j,i) + surf_lsm_h%cssws(lsp,m)
+             ENDDO
+             DO  m = 1, surf_usm_h%ns
+                 i = surf_usm_h%i(m)
+                 j = surf_usm_h%j(m)
+                 chem_species(lsp)%cssws_av(j,i) = chem_species(lsp)%cssws_av(j,i) + surf_usm_h%cssws(lsp,m)
+             ENDDO
+
+          ENDIF
+       ENDDO
+ 
+    ELSEIF ( mode == 'average' )  THEN
+       DO lsp = 1, nspec
+          IF (TRIM(variable(4:)) == TRIM(chem_species(lsp)%name)) THEN
+!                   lsp_2 = lsp 
+             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, nbgp )                 
+          ENDIF
+       ENDDO
+       
+    ENDIF     
+
+    END SUBROUTINE chem_3d_data_averaging
+
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+!> Subroutine to write restart data for chemistry model
+!------------------------------------------------------------------------------!
+ SUBROUTINE chem_last_actions
+ 
+
+    USE control_parameters
+    
+    USE kinds
+
+    IMPLICIT NONE 
+
+    INTEGER(iwp) :: lsp !< 
+    CHARACTER(LEN=20) ::  cspcs_name
+    CHARACTER(LEN=20) ::  cspcs_name_av
+!      REAL(kind=wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg)   :: chems_conc
+  
+    IF ( write_binary )  THEN
+       DO  lsp = 1, nspec
+          cspcs_name    = '                    '
+          cspcs_name_av = '                    '
+          cspcs_name    = TRIM(chem_species(lsp)%name)
+          cspcs_name_av = TRIM(chem_species(lsp)%name)//'_av'
+
+          WRITE(14) cspcs_name   ; WRITE(14) chem_species(lsp)%conc
+          WRITE(14) cspcs_name_av; WRITE(14) chem_species(lsp)%conc_av
+       ENDDO
+   
+       WRITE ( 14 )       '*** end chem ***    '
+
+    ENDIF
+
+ END SUBROUTINE chem_last_actions
+
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+!> Subroutine to read restart data of chemical species
+!------------------------------------------------------------------------------!
+
+ SUBROUTINE chem_read_restart_data( i, nxlfa, nxl_on_file, nxrfa, nxr_on_file, &
+                                    nynfa, nyn_on_file, nysfa, nys_on_file,    &
+                                    offset_xa, offset_ya, overlap_count, tmp_2d, tmp_3d)    
+                                     
+    USE control_parameters
+            
+    USE indices
+    
+    USE kinds
+    
+    USE pegrid
+
+    IMPLICIT NONE 
+
+    CHARACTER (LEN=20) :: field_char !<   
+    CHARACTER (LEN=20) :: spc_name_av !<   
+       
+    INTEGER(iwp) ::  i, lsp          !< 
+    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(iwp) ::  overlap_count   !<   
+
+    INTEGER(iwp), DIMENSION(numprocs_previous_run,1000) ::  nxlfa       !< 
+    INTEGER(iwp), DIMENSION(numprocs_previous_run,1000) ::  nxrfa       !< 
+    INTEGER(iwp), DIMENSION(numprocs_previous_run,1000) ::  nynfa       !< 
+    INTEGER(iwp), DIMENSION(numprocs_previous_run,1000) ::  nysfa       !< 
+    INTEGER(iwp), DIMENSION(numprocs_previous_run,1000) ::  offset_xa   !<   
+    INTEGER(iwp), DIMENSION(numprocs_previous_run,1000) ::  offset_ya   !<   
+!!
+    REAL(wp), DIMENSION(nys_on_file-nbgp:nyn_on_file+nbgp,                    &   !< 2D array to temp store data 
+                        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       !< 3D array to temp store data
+
+
+    IF ( initializing_actions == 'read_restart_data' )  THEN
+       READ ( 13 )  field_char
+
+       DO WHILE ( TRIM( field_char ) /= '*** end chem ***')
+          DO k = 1, overlap_count
+             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)
+
+             DO  lsp = 1, nspec
+                spc_name_av  =  TRIM(chem_species(lsp)%name)//'_av'
+                IF (TRIM( field_char ) == TRIM(chem_species(lsp)%name) )  THEN
+                   IF ( k == 1 )  READ ( 13 )  tmp_3d                             !< read data into tmp_3d
+                   chem_species(lsp)%conc = tmp_3d                                !< fill ..%conc in the restart run
+                ELSEIF (TRIM( field_char ) == spc_name_av ) THEN
+                   IF( k == 1 ) READ ( 13 ) tmp_3d
+                   chem_species(lsp)%conc_av = tmp_3d
+                ENDIF
+
+             ENDDO
+
+          ENDDO
+
+          READ ( 13 )  field_char
+
+       ENDDO
+
+!        IF (TRIM( field_char ) == TRIM('surface_csflux') )      THEN
+!           READ ( 13 ) surface_csflux
+!        ENDIF
+
+    ENDIF
+
+ END SUBROUTINE chem_read_restart_data
+!
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+!> Subroutine calculating tendencies for chemical species
+!------------------------------------------------------------------------------!
+
+ SUBROUTINE chem_tendency ( cs_scalar_p, cs_scalar, tcs_scalar_m, pr_init_cs, i, j, i_omp_start, tn, ilsp, flux_s_cs, diss_s_cs, flux_l_cs, diss_l_cs )
+    USE pegrid         
+    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 diffusion_s_mod, ONLY:  diffusion_s
+    USE indices,         ONLY:  wall_flags_0
+    USE surface_mod,                                                                            &
+                         ONLY :  surf_def_h, surf_def_v, surf_lsm_h, surf_lsm_v, surf_usm_h,    &
+                                 surf_usm_v
+!> Only one chem_spcs recieved prog_eqns at time.
+!> cem_tendency is called in prog_eqns over loop => nvar
+
+    IMPLICIT NONE
+
+    REAL(wp), DIMENSION(:,:,:), POINTER                         :: cs_scalar_p, cs_scalar, tcs_scalar_m
+
+    INTEGER(iwp),INTENT(IN) :: i, j, i_omp_start, tn, ilsp
+    REAL(wp), DIMENSION(nzb+1:nzt,0:threads_per_task-1)         :: flux_s_cs   !<
+    REAL(wp), DIMENSION(nzb+1:nzt,0:threads_per_task-1)         :: diss_s_cs   !<
+    REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) :: flux_l_cs   !<
+    REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn,0:threads_per_task-1) :: diss_l_cs   !<
+    REAL(wp), DIMENSION(0:nz+1)                                 :: pr_init_cs  !<
+
+!-- local variables
+
+    INTEGER :: k
+    !
+    !--    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
+          CALL advec_s_ws( i, j, cs_scalar, 'kc', flux_s_cs, diss_s_cs,                &
+             flux_l_cs, diss_l_cs, i_omp_start, tn )
+       ELSE
+          CALL advec_s_pw( i, j, cs_scalar )
+       ENDIF
+    ELSE
+         CALL advec_s_up( i, j, cs_scalar )
+    ENDIF
+
+!
+
+!-- Diffusion terms ( ie hinteren 3 sind 0 )
+
+      CALL diffusion_s( i, j, cs_scalar,                                                 &
+                        surf_def_h(0)%cssws(ilsp,:), surf_def_h(1)%cssws(ilsp,:),        &
+                        surf_def_h(2)%cssws(ilsp,:),                                     &
+                        surf_lsm_h%cssws(ilsp,:), surf_usm_h%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
+       cs_scalar_p(k,j,i) = cs_scalar(k,j,i) + ( dt_3d  *                       &
+                                               ( tsc(2) * tend(k,j,i) +         &
+                                                 tsc(3) * tcs_scalar_m(k,j,i) ) & 
+                                               - tsc(5) * rdf_sc(k)             &
+                                                        * ( cs_scalar(k,j,i) - pr_init_cs(k) )    &   
+                                               )                                                  &
+                                                        * MERGE( 1.0_wp, 0.0_wp,                  &      
+                                                                BTEST( wall_flags_0(k,j,i), 0 )   &             
+                                                                 )       
+
+       IF ( cs_scalar_p(k,j,i) < 0.0_wp )  cs_scalar_p(k,j,i) = 0.1_wp * cs_scalar(k,j,i)    !FKS6
+    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
+             tcs_scalar_m(k,j,i) = tend(k,j,i)
+          ENDDO
+       ELSEIF ( intermediate_timestep_count < &
+          intermediate_timestep_count_max )  THEN
+          DO  k = nzb+1, nzt
+             tcs_scalar_m(k,j,i) = -9.5625_wp * tend(k,j,i) + &
+                5.3125_wp * tcs_scalar_m(k,j,i)
+          ENDDO
+       ENDIF
+    ENDIF
+!
+ END SUBROUTINE chem_tendency
+
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+!> Subroutine defining header output for chemistry model
+!------------------------------------------------------------------------------!
+ SUBROUTINE chem_header ( io )
+       
+    IMPLICIT NONE 
+ 
+       INTEGER(iwp), INTENT(IN) ::  io            !< Unit of the output file
+
+!      print*,'the header subroutine is still not operational'     
+!!
+!!--    Write chemistry 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 ) 
+!       ENDIF 
+!
+!       IF ( albedo_type == 0 )  THEN 
+!          WRITE( io, 7 ) albedo
+!       ELSE
+!          WRITE( io, 8 ) TRIM( albedo_type_name(albedo_type) )
+!       ENDIF
+!       IF ( constant_albedo )  THEN 
+!          WRITE( io, 9 )
+!       ENDIF
+!     
+!       IF ( radiation .AND. radiation_scheme /= 'constant' )  THEN 
+!          WRITE ( io, 1 )  lambda
+!          WRITE ( io, 2 )  day_init, time_utc_init
+!       ENDIF
+!
+!       WRITE( io, 12 ) dt_radiation
+! 
+! 1 FORMAT ('    Geograph. longitude            :   lambda = ',F4.1,' degr')
+! 2 FORMAT ('    Day of the year at model start :   day_init = ',I3   &
+!            /'    UTC time at model start        :   time_utc_init = ',F7.1' s')
+! 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')
+!
+!
+ END SUBROUTINE chem_header
+
+!------------------------------------------------------------------------------
+! Description:
+! ------------
+!> Subroutine reading restart data for chemistry model input parameters
+!  (FK: To make restarts work, I had to comment this routine. We actually
+!       don't need it, since the namelist parameters are always read in,
+!       also in case of a restart run)
+!------------------------------------------------------------------------------
+!  SUBROUTINE chem_read_var_list
+! 
+! !   USE kinds
+! !   USE chem_modules
+! 
+!     
+!     IMPLICIT NONE
+!     
+!     CHARACTER (LEN=30) ::  variable_chr !< dummy variable to read string
+!     
+!     
+!     READ ( 13 )  variable_chr
+!     DO  WHILE ( TRIM( variable_chr ) /= '*** end chemistry ***' )
+! 
+!        SELECT CASE ( TRIM( variable_chr ) )
+!        
+!           CASE ( 'bc_cs_b' )
+!              READ ( 13 )  bc_cs_b
+!    
+!        
+!        END SELECT
+!        
+!        READ ( 13 )  variable_chr
+!        
+!     ENDDO
+!     
+!  END SUBROUTINE chem_read_var_list
+
+!------------------------------------------------------------------------------
+! Description:
+! ------------
+!> Skipping the chemistry-module parameters from restart-file (binary format).
+!  (FK: To make restarts work, I had to comment this routine. We actually
+!       don't need it, since the namelist parameters are always read in,
+!       also in case of a restart run)
+!------------------------------------------------------------------------------
+!  SUBROUTINE chem_skip_var_list 
+!       
+!     IMPLICIT NONE
+!           
+!     CHARACTER (LEN=1)  ::  cdum
+!     CHARACTER (LEN=30) ::  variable_chr
+!           
+!     READ ( 13 )  variable_chr
+! 
+!     DO  WHILE ( TRIM( variable_chr ) /= '*** end chemistry ***' )
+! 
+!        READ ( 13 )  cdum
+!        READ ( 13 )  variable_chr
+! 
+!     ENDDO   
+!           
+!  END SUBROUTINE chem_skip_var_list
+
+
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+!> Subroutine writing restart data for chemistry model input parameters
+!  (FK: To make restarts work, I had to comment this routine. We actually
+!       don't need it, since the namelist parameters are always read in,
+!       also in case of a restart run)
+!------------------------------------------------------------------------------!
+!  SUBROUTINE chem_write_var_list
+! 
+!     USE chem_modules
+!     
+!     USE kinds
+! 
+! 
+!     IMPLICIT NONE
+! 
+!     INTEGER(iwp) ::  lsp  !< running index for chem spcs
+! 
+! !
+! !-- Writing out input parameters that are not part of chemistry_par namelist
+! !-- (namelist parameters are anyway read in again in case of restart)
+!     DO lsp = 1, nvar
+!        WRITE ( 14 )  'conc_pr_init_'//chem_species(lsp)%name 
+!        WRITE ( 14 )  chem_species(lsp)%conc_pr_init
+!     ENDDO
+! 
+!     WRITE ( 14 )     '*** end chemistry ***         '
+! 
+!  END SUBROUTINE chem_write_var_list
+
+
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+!> Subroutine for emission
+!------------------------------------------------------------------------------!
+ SUBROUTINE chem_emissions
+
+    USE chem_modules
+    
+    USE netcdf_data_input_mod,                                                 &
+        ONLY:  street_type_f
+    
+    USE surface_mod,                                                           &
+        ONLY:  surf_lsm_h
+
+
+    IMPLICIT NONE
+
+    INTEGER(iwp) ::  i    !< running index for grid in x-direction
+    INTEGER(iwp) ::  j    !< running index for grid in y-direction
+    INTEGER(iwp) ::  m    !< running index for horizontal surfaces
+    INTEGER(iwp) ::  lsp  !< running index for chem spcs
+
+!
+!-- Comment??? (todo)
+    IF ( street_type_f%from_file )  THEN
+!
+!--    Streets are lsm surfaces, hence, no usm surface treatment required
+       DO  m = 1, surf_lsm_h%ns
+          i = surf_lsm_h%i(m)
+          j = surf_lsm_h%j(m)
+          
+          IF ( street_type_f%var(j,i) >= main_street_id  .AND.                 &
+               street_type_f%var(j,i) < max_street_id )  THEN
+             DO  lsp = 1, nvar
+                surf_lsm_h%cssws(lsp,m) = emiss_factor_main * surface_csflux(lsp)
+             ENDDO
+          ELSEIF ( street_type_f%var(j,i) >= side_street_id  .AND.             &
+                   street_type_f%var(j,i) < main_street_id )  THEN
+             DO  lsp = 1, nvar
+                surf_lsm_h%cssws(lsp,m) = emiss_factor_side * surface_csflux(lsp)
+             ENDDO
+          ELSE
+             surf_lsm_h%cssws(:,m) = 0.0_wp
+          ENDIF
+       ENDDO
+       
+    ENDIF
+
+ END SUBROUTINE chem_emissions
+
+
+#endif
+ END MODULE chemistry_model_mod
+
Index: palm/trunk/SOURCE/close_file.f90
===================================================================
--- palm/trunk/SOURCE/close_file.f90	(revision 2689)
+++ palm/trunk/SOURCE/close_file.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file close_file.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/compute_vpt.f90
===================================================================
--- palm/trunk/SOURCE/compute_vpt.f90	(revision 2689)
+++ palm/trunk/SOURCE/compute_vpt.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file compute_vpt.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/coriolis.f90
===================================================================
--- palm/trunk/SOURCE/coriolis.f90	(revision 2689)
+++ palm/trunk/SOURCE/coriolis.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file coriolis.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
@@ -25,4 +25,7 @@
 ! -----------------
 ! $Id$
+! Forcing implemented, preliminary (MS)
+! 
+! 2233 2017-05-30 18:08:54Z suehring
 !
 ! 2232 2017-05-30 17:47:52Z suehring
@@ -102,5 +105,5 @@
            
        USE control_parameters,                                                 &
-           ONLY:  f, fs, message_string
+           ONLY:  f, forcing, fs, message_string
            
        USE indices,                                                            &
@@ -117,4 +120,7 @@
 
        REAL(wp)     ::  flag       !< flag to mask topography
+       REAL(wp)     ::  flag_force !< flag to mask large-scale pressure gradient in case larger-scale forcing is applied
+
+       flag_force = MERGE( 0.0_wp, 1.0_wp, forcing )
 !
 !--    Compute Coriolis terms for the three velocity components
@@ -128,5 +134,5 @@
                    DO  k = nzb+1, nzt
 !
-!--                    Predetermine flag to mask topography
+!--                   Predetermine flag to mask topography
                       flag = MERGE( 1.0_wp, 0.0_wp,                            &
                                     BTEST( wall_flags_0(k,j,i), 1 ) )
@@ -134,9 +140,10 @@
                       tend(k,j,i) = tend(k,j,i) + f  *    ( 0.25_wp *          &
                                    ( v(k,j,i-1) + v(k,j,i) + v(k,j+1,i-1) +    &
-                                     v(k,j+1,i) ) - vg(k)   ) * flag           &
+                                     v(k,j+1,i) ) - vg(k) * flag_force         &
+                                                          ) * flag           &
                                                 - fs *    ( 0.25_wp *          &
                                    ( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) +  &
                                      w(k,j,i)   )                              &
-                                                          )   * flag
+                                                          ) * flag
                    ENDDO
                 ENDDO
@@ -149,9 +156,13 @@
                 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_0(k,j,i), 2 ) )
+
                       tend(k,j,i) = tend(k,j,i) - f *     ( 0.25_wp *          &
                                    ( u(k,j-1,i) + u(k,j,i) + u(k,j-1,i+1) +    &
-                                     u(k,j,i+1) ) - ug(k) ) *                  &
-                                      MERGE( 1.0_wp, 0.0_wp,                   &
-                                             BTEST( wall_flags_0(k,j,i), 2 ) )
+                                     u(k,j,i+1) ) - ug(k) * flag_force         &
+                                                          ) * flag
                    ENDDO
                 ENDDO
@@ -164,9 +175,12 @@
                 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_0(k,j,i), 3 ) )
+
                       tend(k,j,i) = tend(k,j,i) + fs * 0.25_wp *               &
                                    ( u(k,j,i) + u(k+1,j,i) + u(k,j,i+1) +      &
-                                     u(k+1,j,i+1) ) *                          &
-                                      MERGE( 1.0_wp, 0.0_wp,                   &
-                                             BTEST( wall_flags_0(k,j,i), 3 ) )
+                                     u(k+1,j,i+1) ) * flag
                    ENDDO
                 ENDDO
@@ -194,5 +208,5 @@
            
        USE control_parameters,                                                 &
-           ONLY:  f, fs, message_string
+           ONLY:  f, forcing, fs, message_string
            
        USE indices,                                                            &
@@ -209,5 +223,7 @@
 
        REAL(wp)     ::  flag       !< flag to mask topography
-
+       REAL(wp)     ::  flag_force !< flag to mask large-scale pressure gradient in case larger-scale forcing is applied
+
+       flag_force = MERGE( 0.0_wp, 1.0_wp, forcing )
 !
 !--    Compute Coriolis terms for the three velocity components
@@ -224,8 +240,9 @@
                 tend(k,j,i) = tend(k,j,i) + f  *     ( 0.25_wp *               &
                                 ( v(k,j,i-1) + v(k,j,i) + v(k,j+1,i-1) +       &
-                                  v(k,j+1,i) ) - vg(k) ) * flag                &
-                                          - fs *    ( 0.25_wp *                &
+                                  v(k,j+1,i) ) - vg(k) * flag_force            &
+                                                     ) * flag                  &
+                                          - fs *     ( 0.25_wp *               &
                                 ( w(k-1,j,i-1) + w(k-1,j,i) + w(k,j,i-1) +     &
-                                  w(k,j,i)   )      ) * flag
+                                  w(k,j,i)   )       ) * flag
              ENDDO
 
@@ -234,9 +251,12 @@
           CASE ( 2 )
              DO  k = nzb+1, nzt
+!
+!--             Predetermine flag to mask topography
+                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 2 ) )
+
                 tend(k,j,i) = tend(k,j,i) - f *        ( 0.25_wp *             &
                                 ( u(k,j-1,i) + u(k,j,i) + u(k,j-1,i+1) +       &
-                                  u(k,j,i+1) ) - ug(k) ) *                     &
-                                      MERGE( 1.0_wp, 0.0_wp,                   &
-                                             BTEST( wall_flags_0(k,j,i), 2 ) )
+                                  u(k,j,i+1) ) - ug(k)   * flag_force          &
+                                                       ) * flag
              ENDDO
 
@@ -245,9 +265,11 @@
           CASE ( 3 )
              DO  k = nzb+1, nzt
+!
+!--             Predetermine flag to mask topography
+                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 3 ) )
+
                 tend(k,j,i) = tend(k,j,i) + fs * 0.25_wp *                     &
                                 ( u(k,j,i) + u(k+1,j,i) + u(k,j,i+1) +         &
-                                  u(k+1,j,i+1) ) *                             &
-                                      MERGE( 1.0_wp, 0.0_wp,                   &
-                                             BTEST( wall_flags_0(k,j,i), 3 ) )
+                                  u(k+1,j,i+1) ) * flag
              ENDDO
 
Index: palm/trunk/SOURCE/cpulog_mod.f90
===================================================================
--- palm/trunk/SOURCE/cpulog_mod.f90	(revision 2689)
+++ palm/trunk/SOURCE/cpulog_mod.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file cpulog_mod.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/data_log.f90
===================================================================
--- palm/trunk/SOURCE/data_log.f90	(revision 2689)
+++ palm/trunk/SOURCE/data_log.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file data_log.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/data_output_2d.f90
===================================================================
--- palm/trunk/SOURCE/data_output_2d.f90	(revision 2689)
+++ palm/trunk/SOURCE/data_output_2d.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file data_output_2d.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
@@ -25,4 +25,10 @@
 ! -----------------
 ! $Id$
+! Implementation of uv exposure model (FK)
+! Implementation of turbulence_closure_mod (TG)
+! Set fill values at topography grid points or e.g. non-natural-type surface
+! in case of LSM output (MS)
+! 
+! 2512 2017-10-04 08:26:59Z raasch
 ! upper bounds of cross section output changed from nx+1,ny+1 to nx,ny
 ! no output of ghost layer data
@@ -196,5 +202,5 @@
                ntdim_2d_xy, ntdim_2d_xz, ntdim_2d_yz,                          &
                psolver, section, simulated_time, simulated_time_chr,           &
-               time_since_reference_point
+               time_since_reference_point, uv_exposure
         
     USE cpulog,                                                                &
@@ -205,5 +211,5 @@
         
     USE indices,                                                               &
-        ONLY:  nbgp, nx, nxl, nxr, ny, nyn, nys, nz, nzb, nzt
+        ONLY:  nbgp, nx, nxl, nxr, ny, nyn, nys, nz, nzb, nzt, wall_flags_0
                
     USE kinds
@@ -217,7 +223,7 @@
 
     USE netcdf_interface,                                                      &
-        ONLY:  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
+        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,                                                   &
@@ -232,4 +238,11 @@
     USE surface_mod,                                                           &
         ONLY:  surf_def_h, surf_lsm_h, surf_usm_h
+
+    USE turbulence_closure_mod,                                                &
+        ONLY:  tcm_data_output_2d
+
+    USE uv_exposure_model_mod,                                                 &
+        ONLY:  uvem_data_output_2d
+
 
     IMPLICIT NONE
@@ -244,4 +257,5 @@
     INTEGER(iwp) ::  ngp       !< 
     INTEGER(iwp) ::  file_id   !< 
+    INTEGER(iwp) ::  flag_nr   !< number of masking flag
     INTEGER(iwp) ::  i         !< 
     INTEGER(iwp) ::  if        !< 
@@ -457,8 +471,14 @@
           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,if) ) )
-
              CASE ( 'e_xy', 'e_xz', 'e_yz' )
                 IF ( av == 0 )  THEN
@@ -928,4 +948,5 @@
 
              CASE ( 'u_xy', 'u_xz', 'u_yz' )
+                flag_nr = 1
                 IF ( av == 0 )  THEN
                    to_be_resorted => u
@@ -970,4 +991,5 @@
 
              CASE ( 'v_xy', 'v_xz', 'v_yz' )
+                flag_nr = 2
                 IF ( av == 0 )  THEN
                    to_be_resorted => v
@@ -992,4 +1014,5 @@
 
              CASE ( 'w_xy', 'w_xz', 'w_yz' )
+                flag_nr = 3
                 IF ( av == 0 )  THEN
                    to_be_resorted => w
@@ -1093,8 +1116,22 @@
 
 !
+!--             Turbulence closure variables
+                IF ( .NOT. found )  THEN
+                   CALL tcm_data_output_2d( av, do2d(av,if), found, grid, mode,&
+                                             local_pf, two_d, nzb_do, nzt_do )
+                ENDIF
+
+!
 !--             Radiation quantity
                 IF ( .NOT. found  .AND.  radiation )  THEN
                    CALL radiation_data_output_2d( av, do2d(av,if), found, grid,&
                                                   mode, local_pf, two_d  )
+                ENDIF
+
+!
+!--             UV exposure model quantity
+                IF ( uv_exposure )  THEN
+                   CALL uvem_data_output_2d( av, do2d(av,if), found, grid, mode,&
+                                             local_pf, two_d, nzb_do, nzt_do )
                 ENDIF
 
@@ -1127,10 +1164,14 @@
 
 !
-!--       Resort the array to be output, if not done above
+!--       Resort the array to be output, if not done above. Flag topography 
+!--       grid points with fill values, using the corresponding maksing flag.
           IF ( .NOT. resorted )  THEN
              DO  i = nxl, nxr
                 DO  j = nys, nyn
                    DO  k = nzb_do, nzt_do
-                      local_pf(i,j,k) = to_be_resorted(k,j,i)
+                      local_pf(i,j,k) = MERGE( to_be_resorted(k,j,i),          &
+                                               REAL( fill_value, KIND = wp ),  &
+                                               BTEST( wall_flags_0(k,j,i),     &
+                                                      flag_nr ) ) 
                    ENDDO
                 ENDDO
Index: palm/trunk/SOURCE/data_output_3d.f90
===================================================================
--- palm/trunk/SOURCE/data_output_3d.f90	(revision 2689)
+++ palm/trunk/SOURCE/data_output_3d.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file data_output_3d.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
@@ -25,4 +25,10 @@
 ! -----------------
 ! $Id$
+! Implementation of turbulence_closure_mod (TG)
+! Implementation of chemistry module (FK)
+! Set fill values at topography grid points or e.g. non-natural-type surface
+! in case of LSM output (MS)
+! 
+! 2512 2017-10-04 08:26:59Z raasch
 ! upper bounds of 3d output changed from nx+1,ny+1 to nx,ny
 ! no output of ghost layer data
@@ -169,10 +175,16 @@
     USE averaging
         
+#if defined( __chem )
+    USE chemistry_model_mod,                                                   &
+        ONLY:  chem_data_output_3d
+#endif        
+
     USE cloud_parameters,                                                      &
         ONLY:  l_d_cp, pt_d_t
         
     USE control_parameters,                                                    &
-        ONLY:  cloud_physics, do3d, do3d_no, do3d_time_count, io_blocks,       &
-               io_group, land_surface, message_string, ntdim_3d, nz_do3d,      &
+        ONLY:  air_chemistry, cloud_physics, do3d, do3d_no, do3d_time_count,   &
+               io_blocks, io_group, land_surface, message_string,              &
+               ntdim_3d, nz_do3d,                                              &
                psolver, simulated_time, time_since_reference_point,            &
                urban_surface, varnamelength
@@ -182,5 +194,5 @@
         
     USE indices,                                                               &
-        ONLY:  nbgp, nx, nxl, nxr, ny, nyn, nys, nzb
+        ONLY:  nbgp, nx, nxl, nxr, ny, nyn, nys, nzb, wall_flags_0
         
     USE kinds
@@ -194,5 +206,5 @@
 
     USE netcdf_interface,                                                      &
-        ONLY:  id_set_3d, id_var_do3d, id_var_time_3d, nc_stat,                &
+        ONLY:  fill_value, id_set_3d, id_var_do3d, id_var_time_3d, nc_stat,    &
                netcdf_data_format, netcdf_handle_error
         
@@ -207,8 +219,11 @@
         
     USE radiation_model_mod,                                                   &
-        ONLY:  radiation, radiation_data_output_3d
+        ONLY:  nzub, nzut, radiation, radiation_data_output_3d
+
+    USE turbulence_closure_mod,                                                &
+        ONLY:  tcm_data_output_3d
 
     USE urban_surface_mod,                                                     &
-        ONLY:  nzub, nzut, usm_data_output_3d
+        ONLY:  usm_data_output_3d
 
 
@@ -216,4 +231,5 @@
 
     INTEGER(iwp) ::  av        !< 
+    INTEGER(iwp) ::  flag_nr   !< number of masking flag
     INTEGER(iwp) ::  i         !< 
     INTEGER(iwp) ::  if        !< 
@@ -315,4 +331,10 @@
 !--    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 = fill_value
+!
+!--    Set masking flag for topography for not resorted arrays
+       flag_nr = 0
 
        SELECT CASE ( trimvar )
@@ -569,4 +591,5 @@
 
           CASE ( 'u' )
+             flag_nr = 1
              IF ( av == 0 )  THEN
                 to_be_resorted => u
@@ -576,4 +599,5 @@
 
           CASE ( 'v' )
+             flag_nr = 2
              IF ( av == 0 )  THEN
                 to_be_resorted => v
@@ -590,4 +614,5 @@
 
           CASE ( 'w' )
+             flag_nr = 3
              IF ( av == 0 )  THEN
                 to_be_resorted => w
@@ -613,4 +638,5 @@
                 DEALLOCATE ( local_pf )
                 ALLOCATE( local_pf(nxl:nxr,nys:nyn,nzb_do:nzt_do) )
+                local_pf = fill_value
 
                 CALL lsm_data_output_3d( av, do3d(av,if), found, local_pf )
@@ -629,4 +655,9 @@
              ENDIF
 
+             IF ( .NOT. found )  THEN
+                CALL tcm_data_output_3d( av, do3d(av,if), found, local_pf )
+                resorted = .TRUE.
+             ENDIF
+
 !
 !--          Radiation quantity
@@ -638,8 +669,18 @@
 
 !
+!--          Chemistry model output
+#if defined( __chem )
+             IF ( .NOT. found  .AND.  air_chemistry )  THEN
+                CALL chem_data_output_3d( av, do3d(av,if), found,              &
+                                          local_pf )
+                resorted = .TRUE.
+             ENDIF
+#endif
+
+!
 !--          Plant canopy model output
              IF ( .NOT. found  .AND.  plant_canopy )  THEN
-                CALL pcm_data_output_3d( av, do3d(av,if), found,         &
-                                               local_pf )
+                CALL pcm_data_output_3d( av, do3d(av,if), found, local_pf,     &
+                                         fill_value )
                 resorted = .TRUE.
              ENDIF
@@ -667,5 +708,8 @@
              DO  j = nys, nyn
                 DO  k = nzb_do, nzt_do
-                   local_pf(i,j,k) = to_be_resorted(k,j,i)
+                   local_pf(i,j,k) = MERGE(                                    &
+                                      to_be_resorted(k,j,i),                   &
+                                      REAL( fill_value, KIND = wp ),           &
+                                      BTEST( wall_flags_0(k,j,i), flag_nr ) )
                 ENDDO
              ENDDO
Index: palm/trunk/SOURCE/data_output_dvrp.f90
===================================================================
--- palm/trunk/SOURCE/data_output_dvrp.f90	(revision 2689)
+++ palm/trunk/SOURCE/data_output_dvrp.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file data_output_dvrp.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/data_output_flight.f90
===================================================================
--- palm/trunk/SOURCE/data_output_flight.f90	(revision 2689)
+++ palm/trunk/SOURCE/data_output_flight.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file data_output_flight.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/data_output_mask.f90
===================================================================
--- palm/trunk/SOURCE/data_output_mask.f90	(revision 2689)
+++ palm/trunk/SOURCE/data_output_mask.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file data_output_mask.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
@@ -25,4 +25,7 @@
 ! -----------------
 ! $Id$
+! 
+! 
+! 2292 2017-06-20 09:51:42Z schwenkel
 ! Implementation of new microphysic scheme: cloud_scheme = 'morrison' 
 ! includes two more prognostic equations for cloud drop concentration (nc)  
Index: palm/trunk/SOURCE/data_output_profiles.f90
===================================================================
--- palm/trunk/SOURCE/data_output_profiles.f90	(revision 2689)
+++ palm/trunk/SOURCE/data_output_profiles.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file data_output_profiles.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/data_output_ptseries.f90
===================================================================
--- palm/trunk/SOURCE/data_output_ptseries.f90	(revision 2689)
+++ palm/trunk/SOURCE/data_output_ptseries.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file data_output_ptseries.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/data_output_spectra.f90
===================================================================
--- palm/trunk/SOURCE/data_output_spectra.f90	(revision 2689)
+++ palm/trunk/SOURCE/data_output_spectra.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file data_output_spectra.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/data_output_tseries.f90
===================================================================
--- palm/trunk/SOURCE/data_output_tseries.f90	(revision 2689)
+++ palm/trunk/SOURCE/data_output_tseries.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file data_output_tseries.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/date_and_time_mod.f90
===================================================================
--- palm/trunk/SOURCE/date_and_time_mod.f90	(revision 2689)
+++ palm/trunk/SOURCE/date_and_time_mod.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file date_and_time_mod.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/diagnostic_quantities_mod.f90
===================================================================
--- palm/trunk/SOURCE/diagnostic_quantities_mod.f90	(revision 2689)
+++ palm/trunk/SOURCE/diagnostic_quantities_mod.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file diagnostic_quantities_mod.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/diffusion_e.f90
===================================================================
--- palm/trunk/SOURCE/diffusion_e.f90	(revision 2689)
+++ 	(revision )
@@ -1,506 +1,0 @@
-!> @file diffusion_e.f90
-!------------------------------------------------------------------------------!
-! This file is part of PALM.
-!
-! PALM is free software: you can redistribute it and/or modify it under the
-! terms of the GNU General Public License as published by the Free Software
-! Foundation, either version 3 of the License, or (at your option) any later
-! version.
-!
-! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
-! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License along with
-! PALM. If not, see <http://www.gnu.org/licenses/>.
-!
-! Copyright 1997-2017 Leibniz Universitaet Hannover
-!------------------------------------------------------------------------------!
-!
-! Current revisions:
-! -----------------
-! 
-! 
-! Former revisions:
-! -----------------
-! $Id$
-!
-! 2232 2017-05-30 17:47:52Z suehring
-! Adjustments to new topography and surface concept
-! 
-! 2118 2017-01-17 16:38:49Z raasch
-! OpenACC version of subroutine removed
-! 
-! 2037 2016-10-26 11:15:40Z knoop
-! Anelastic approximation implemented
-! 
-! 2000 2016-08-20 18:09:15Z knoop
-! Forced header and separation lines into 80 columns
-! 
-! 1873 2016-04-18 14:50:06Z maronga
-! Module renamed (removed _mod)
-! 
-! 1850 2016-04-08 13:29:27Z maronga
-! Module renamed
-! Adapted for modularization of microphysics
-! 
-! 1831 2016-04-07 13:15:51Z hoffmann 
-! turbulence renamed collision_turbulence
-!
-! 1682 2015-10-07 23:56:08Z knoop
-! Code annotations made doxygen readable 
-! 
-! 1374 2014-04-25 12:55:07Z raasch
-! missing variables added to ONLY list
-! rif removed from acc-present-list
-! 
-! 1340 2014-03-25 19:45:13Z kanani
-! REAL constants defined as wp-kind
-!
-! 1320 2014-03-20 08:40:49Z raasch
-! ONLY-attribute added to USE-statements,
-! kind-parameters added to all INTEGER and REAL declaration statements,
-! kinds are defined in new module kinds,
-! revision history before 2012 removed,
-! comment fields (!:) to be used for variable explanations added to
-! all variable declaration statements
-!
-! 1257 2013-11-08 15:18:40Z raasch
-! openacc loop and loop vector clauses removed
-!
-! 1179 2013-06-14 05:57:58Z raasch
-! use_reference renamed use_single_reference_value
-!
-! 1171 2013-05-30 11:27:45Z raasch
-! use_reference-case activated in accelerator version
-!
-! 1128 2013-04-12 06:19:32Z raasch
-! loop index bounds in accelerator version replaced by i_left, i_right, j_south,
-! j_north
-!
-! 1065 2012-11-22 17:42:36Z hoffmann
-! Enabled the claculation of diss in case of turbulence = .TRUE. (parameterized 
-! effects of turbulence on autoconversion and accretion in two-moments cloud 
-! physics scheme). 
-!
-! 1036 2012-10-22 13:43:42Z raasch
-! code put under GPL (PALM 3.9)
-!
-! 1015 2012-09-27 09:23:24Z raasch
-! accelerator version (*_acc) added,
-! adjustment of mixing length to the Prandtl mixing length at first grid point
-! above ground removed
-!
-! 1010 2012-09-20 07:59:54Z raasch
-! cpp switch __nopointer added for pointer free version
-!
-! 1001 2012-09-13 14:08:46Z raasch
-! most arrays comunicated by module instead of parameter list
-!
-! 825 2012-02-19 03:03:44Z raasch
-! wang_collision_kernel renamed wang_kernel
-!
-! Revision 1.1  1997/09/19 07:40:24  raasch
-! Initial revision
-!
-!
-! Description:
-! ------------
-!> Diffusion- and dissipation terms for the TKE
-!------------------------------------------------------------------------------!
- MODULE diffusion_e_mod
- 
-
-    PRIVATE
-    PUBLIC diffusion_e
-    
-
-    INTERFACE diffusion_e
-       MODULE PROCEDURE diffusion_e
-       MODULE PROCEDURE diffusion_e_ij
-    END INTERFACE diffusion_e
- 
- CONTAINS
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points
-!------------------------------------------------------------------------------!
-    SUBROUTINE diffusion_e( var, var_reference )
-
-       USE arrays_3d,                                                          &
-           ONLY:  dd2zu, ddzu, ddzw, diss, e, km, l_grid, l_wall, tend, zu, zw,&
-                  drho_air, rho_air_zw
-           
-       USE control_parameters,                                                 &
-           ONLY:  atmos_ocean_sign, g, use_single_reference_value, &
-                  wall_adjustment, wall_adjustment_factor
-
-       USE grid_variables,                                                     &
-           ONLY:  ddx2, ddy2
-           
-       USE indices,                                                            &
-           ONLY:  nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzb_max,    &
-                  nzt, wall_flags_0
-           
-       USE kinds
-
-       USE microphysics_mod,                                                   &
-           ONLY:  collision_turbulence
-
-       USE particle_attributes,                                                &
-           ONLY:  use_sgs_for_particles, wang_kernel
-
-       USE surface_mod,                                                        &
-          ONLY :  bc_h
-
-       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)     ::  dvar_dz        !< 
-       REAL(wp)     ::  flag           !< flag to mask topography
-       REAL(wp)     ::  l_stable       !< 
-       REAL(wp)     ::  var_reference  !< 
-
-#if defined( __nopointer )
-       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  var  !< 
-#else
-       REAL(wp), DIMENSION(:,:,:), POINTER ::  var  !< 
-#endif
-       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  dissipation  !<
-       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  l            !<
-       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  ll           !< 
- 
-
-!
-!--    This if clause must be outside the k-loop because otherwise
-!--    runtime errors occur with -C hopt on NEC
-       IF ( use_single_reference_value )  THEN
-
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                DO  k = nzb+1, nzt
-!
-!--                Calculate the mixing length (for dissipation)
-                   dvar_dz = atmos_ocean_sign * &
-                             ( var(k+1,j,i) - var(k-1,j,i) ) * dd2zu(k)
-                   IF ( dvar_dz > 0.0_wp ) THEN
-                      l_stable = 0.76_wp * SQRT( e(k,j,i) ) / &
-                                    SQRT( g / var_reference * dvar_dz ) + 1E-5_wp
-                   ELSE
-                      l_stable = l_grid(k)
-                   ENDIF
-!
-!--                Adjustment of the mixing length
-                   IF ( wall_adjustment )  THEN
-                      l(k,j)  = MIN( wall_adjustment_factor * l_wall(k,j,i),   &
-                                     l_grid(k), l_stable )
-                      ll(k,j) = MIN( wall_adjustment_factor * l_wall(k,j,i),   &
-                                     l_grid(k) )
-                   ELSE
-                      l(k,j)  = MIN( l_grid(k), l_stable )
-                      ll(k,j) = l_grid(k)
-                   ENDIF
-
-                ENDDO
-             ENDDO
-
-!
-!--          Calculate the tendency terms
-             DO  j = nys, nyn
-                DO  k = nzb+1, nzt
-!
-!--                Predetermine flag to mask topography
-                   flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
-
-                   dissipation(k,j) = ( 0.19_wp + 0.74_wp * l(k,j) / ll(k,j) ) * &
-                                       e(k,j,i) * SQRT( e(k,j,i) ) / l(k,j)
-
-                   tend(k,j,i) = tend(k,j,i)                                   &
-                                        + (                                    &
-                          ( km(k,j,i)+km(k,j,i+1) ) * ( e(k,j,i+1)-e(k,j,i) )  &
-                        - ( km(k,j,i)+km(k,j,i-1) ) * ( e(k,j,i)-e(k,j,i-1) )  &
-                                          ) * ddx2  * flag                     &
-                                        + (                                    &
-                          ( 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  * flag                     &
-                                        + (                                    &
-               ( 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) * flag     &
-                             - dissipation(k,j) * flag
-
-                ENDDO
-             ENDDO
-
-!
-!--          Store dissipation if needed for calculating the sgs particle
-!--          velocities
-             IF ( use_sgs_for_particles  .OR.  wang_kernel  .OR.               &
-                  collision_turbulence )  THEN
-                DO  j = nys, nyn
-                   DO  k = nzb+1, nzt
-                      diss(k,j,i) = dissipation(k,j) *                         &
-                                        MERGE( 1.0_wp, 0.0_wp,                 &
-                                               BTEST( wall_flags_0(k,j,i), 0 ) )
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          ENDDO
-
-       ELSE
-
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                DO  k = nzb+1, nzt
-!
-!--                Calculate the mixing length (for dissipation)
-                   dvar_dz = atmos_ocean_sign * &
-                             ( var(k+1,j,i) - var(k-1,j,i) ) * dd2zu(k)
-                   IF ( dvar_dz > 0.0_wp ) THEN
-                      l_stable = 0.76_wp * SQRT( e(k,j,i) ) / &
-                                           SQRT( g / var(k,j,i) * dvar_dz ) + 1E-5_wp
-                   ELSE
-                      l_stable = l_grid(k)
-                   ENDIF
-!
-!--                Adjustment of the mixing length
-                   IF ( wall_adjustment )  THEN
-                      l(k,j)  = MIN( wall_adjustment_factor * l_wall(k,j,i),   &
-                                     l_grid(k), l_stable )
-                      ll(k,j) = MIN( wall_adjustment_factor * l_wall(k,j,i),   &
-                                     l_grid(k) )
-                   ELSE
-                      l(k,j)  = MIN( l_grid(k), l_stable )
-                      ll(k,j) = l_grid(k)
-                   ENDIF
-
-                ENDDO
-             ENDDO
-
-!
-!--          Calculate the tendency terms
-             DO  j = nys, nyn
-                DO  k = nzb+1, nzt
-!
-!--                Predetermine flag to mask topography
-                   flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
-
-                   dissipation(k,j) = ( 0.19_wp + 0.74_wp * l(k,j) / ll(k,j) )   *&
-                                             e(k,j,i) * SQRT( e(k,j,i) ) / l(k,j)
-
-                   tend(k,j,i) = tend(k,j,i)                                   &
-                                        + (                                    &
-                          ( km(k,j,i)+km(k,j,i+1) ) * ( e(k,j,i+1)-e(k,j,i) )  &
-                        - ( km(k,j,i)+km(k,j,i-1) ) * ( e(k,j,i)-e(k,j,i-1) )  &
-                                          ) * ddx2  * flag                     &
-                                        + (                                    &
-                          ( 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  * flag                     &
-                                        + (                                    &
-               ( 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) * flag     &
-                             - dissipation(k,j) * flag
-
-                ENDDO
-             ENDDO
-
-!
-!--          Store dissipation if needed for calculating the sgs particle
-!--          velocities
-             IF ( use_sgs_for_particles  .OR.  wang_kernel  .OR.               &
-                  collision_turbulence )  THEN
-                DO  j = nys, nyn
-                   DO  k = nzb+1, nzt
-                      diss(k,j,i) = dissipation(k,j) *                         &
-                                        MERGE( 1.0_wp, 0.0_wp,                 &
-                                               BTEST( wall_flags_0(k,j,i), 0 ) )
-                   ENDDO
-                ENDDO
-             ENDIF
-
-          ENDDO
-
-       ENDIF
-
-!
-!--    Neumann boundary condition for dissipation diss(nzb,:,:) = diss(nzb+1,:,:)
-       IF ( 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:
-! ------------
-!> Call for grid point i,j
-!------------------------------------------------------------------------------!
-    SUBROUTINE diffusion_e_ij( i, j, var, var_reference )
-
-       USE arrays_3d,                                                          &
-           ONLY:  dd2zu, ddzu, ddzw, diss, e, km, l_grid, l_wall, tend, zu, zw,&
-                  drho_air, rho_air_zw
-          
-       USE control_parameters,                                                 &
-           ONLY:  atmos_ocean_sign, g, use_single_reference_value,             &
-                  wall_adjustment, wall_adjustment_factor
-
-       USE grid_variables,                                                     &
-           ONLY:  ddx2, ddy2
-           
-       USE indices,                                                            &
-           ONLY:  nxlg, nxrg, nyng, nysg, nzb, nzb_max, nzt, wall_flags_0
-           
-       USE kinds
-
-       USE microphysics_mod,                                                   &
-           ONLY:  collision_turbulence
-
-       USE particle_attributes,                                                &
-           ONLY:  use_sgs_for_particles, wang_kernel
-
-       USE surface_mod,                                                        &
-          ONLY :  bc_h
-
-       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)     ::  dvar_dz        !< 
-       REAL(wp)     ::  flag           !< flag to mask topography
-       REAL(wp)     ::  l_stable       !<
-       REAL(wp)     ::  var_reference  !<
-
-#if defined( __nopointer )
-       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  var  !<
-#else
-       REAL(wp), DIMENSION(:,:,:), POINTER ::  var     !<
-#endif
-       REAL(wp), DIMENSION(nzb+1:nzt) ::  dissipation  !<
-       REAL(wp), DIMENSION(nzb+1:nzt) ::  l            !<
-       REAL(wp), DIMENSION(nzb+1:nzt) ::  ll           !<
-
-!
-!--    Calculate the mixing length (for dissipation)
-       DO  k = nzb+1, nzt
-!
-!--       Predetermine flag to mask topography
-          flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
-
-          dvar_dz = atmos_ocean_sign * &
-                    ( var(k+1,j,i) - var(k-1,j,i) ) * dd2zu(k)
-          IF ( dvar_dz > 0.0_wp ) THEN
-             IF ( use_single_reference_value )  THEN
-                l_stable = 0.76_wp * SQRT( e(k,j,i) ) / &
-                                     SQRT( g / var_reference * dvar_dz ) + 1E-5_wp
-             ELSE
-                l_stable = 0.76_wp * SQRT( e(k,j,i) ) / &
-                                     SQRT( g / var(k,j,i) * dvar_dz ) + 1E-5_wp
-             ENDIF
-          ELSE
-             l_stable = l_grid(k)
-          ENDIF
-!
-!--       Adjustment of the mixing length
-          IF ( wall_adjustment )  THEN
-             l(k)  = MIN( wall_adjustment_factor * l_wall(k,j,i),              &
-                          l_grid(k), l_stable )
-             ll(k) = MIN( wall_adjustment_factor * l_wall(k,j,i), l_grid(k) )
-          ELSE
-             l(k)  = MIN( l_grid(k), l_stable )
-             ll(k) = l_grid(k)
-          ENDIF
-!
-!--       Calculate the tendency term
-          dissipation(k) = ( 0.19_wp + 0.74_wp * l(k) / ll(k) ) * e(k,j,i) *   &
-                                 SQRT( e(k,j,i) ) / l(k)
-
-          tend(k,j,i) = tend(k,j,i)                                            &
-                                       + (                                     &
-                         ( km(k,j,i)+km(k,j,i+1) ) * ( e(k,j,i+1)-e(k,j,i) )   &
-                       - ( km(k,j,i)+km(k,j,i-1) ) * ( e(k,j,i)-e(k,j,i-1) )   &
-                                         ) * ddx2  * flag                      &
-                                       + (                                     &
-                         ( 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  * flag                      &
-                                       + (                                     &
-              ( 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) * flag      &
-                                       - dissipation(k) * flag
-
-       ENDDO
-
-!
-!--    Store dissipation if needed for calculating the sgs particle velocities
-       IF ( use_sgs_for_particles  .OR.  wang_kernel  .OR.                     &
-            collision_turbulence )  THEN
-          DO  k = nzb+1, nzt
-             diss(k,j,i) = dissipation(k) *                                    &
-                                        MERGE( 1.0_wp, 0.0_wp,                 &
-                                               BTEST( wall_flags_0(k,j,i), 0 ) )
-          ENDDO
-!
-!--       Neumann boundary condition for dissipation diss(nzb,:,:) = diss(nzb+1,:,:)
-!--       For each surface type determine start and end index (in case of elevated
-!--       toopography several up/downward facing surfaces may exist.
-          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
-
- END MODULE diffusion_e_mod
Index: palm/trunk/SOURCE/diffusion_s.f90
===================================================================
--- palm/trunk/SOURCE/diffusion_s.f90	(revision 2689)
+++ palm/trunk/SOURCE/diffusion_s.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file diffusion_s.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/diffusion_u.f90
===================================================================
--- palm/trunk/SOURCE/diffusion_u.f90	(revision 2689)
+++ palm/trunk/SOURCE/diffusion_u.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file diffusion_u.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/diffusion_v.f90
===================================================================
--- palm/trunk/SOURCE/diffusion_v.f90	(revision 2689)
+++ palm/trunk/SOURCE/diffusion_v.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file diffusion_v.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/diffusion_w.f90
===================================================================
--- palm/trunk/SOURCE/diffusion_w.f90	(revision 2689)
+++ palm/trunk/SOURCE/diffusion_w.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file diffusion_w.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/diffusivities.f90
===================================================================
--- palm/trunk/SOURCE/diffusivities.f90	(revision 2689)
+++ 	(revision )
@@ -1,278 +1,0 @@
-!> @file diffusivities.f90
-!------------------------------------------------------------------------------!
-! This file is part of PALM.
-!
-! PALM is free software: you can redistribute it and/or modify it under the
-! terms of the GNU General Public License as published by the Free Software
-! Foundation, either version 3 of the License, or (at your option) any later
-! version.
-!
-! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
-! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License along with
-! PALM. If not, see <http://www.gnu.org/licenses/>.
-!
-! Copyright 1997-2017 Leibniz Universitaet Hannover
-!------------------------------------------------------------------------------!
-!
-! Current revisions:
-! -----------------
-! 
-! 
-! Former revisions:
-! -----------------
-! $Id$
-! Vertical grid nesting implemented (SadiqHuq)
-! 
-! 2233 2017-05-30 18:08:54Z suehring
-!
-! 2232 2017-05-30 17:47:52Z suehring
-! Adjustments to new topography and surface concept
-! 
-! 2118 2017-01-17 16:38:49Z raasch
-! OpenACC directives removed
-! 
-! 2031 2016-10-21 15:11:58Z knoop
-! renamed variable rho to rho_ocean
-! 
-! 2000 2016-08-20 18:09:15Z knoop
-! Forced header and separation lines into 80 columns
-!
-! 1711 2015-11-05 07:38:04Z raasch
-! bugfix: loop moved into IF block to avoid usage of l without being defined
-!
-! 1682 2015-10-07 23:56:08Z knoop
-! Code annotations made doxygen readable 
-! 
-! 1374 2014-04-25 12:55:07Z raasch
-! rif removed from acc-present-list
-! 
-! 1353 2014-04-08 15:21:23Z heinze
-! REAL constants provided with KIND-attribute 
-! 
-! 1340 2014-03-25 19:45:13Z kanani
-! REAL constants defined as wp-kind
-!
-! 1322 2014-03-20 16:38:49Z raasch
-! REAL constants defined as wp-kind
-!
-! 1320 2014-03-20 08:40:49Z raasch
-! ONLY-attribute added to USE-statements,
-! kind-parameters added to all INTEGER and REAL declaration statements, 
-! kinds are defined in new module kinds, 
-! revision history before 2012 removed,
-! comment fields (!:) to be used for variable explanations added to
-! all variable declaration statements 
-!
-! 1179 2013-06-14 05:57:58Z raasch
-! use_reference renamed use_single_reference_value
-!
-! 1036 2012-10-22 13:43:42Z raasch
-! code put under GPL (PALM 3.9)
-!
-! 1015 2012-09-27 09:23:24Z raasch
-! OpenACC statements added + code changes required for GPU optimization,
-! adjustment of mixing length to the Prandtl mixing length at first grid point
-! above ground removed
-!
-! 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
-!------------------------------------------------------------------------------!
- SUBROUTINE diffusivities( var, var_reference )
- 
-
-    USE arrays_3d,                                                             &
-        ONLY:  dd2zu, e, kh, km, l_grid, l_wall
-        
-    USE control_parameters,                                                    &
-        ONLY:  atmos_ocean_sign, e_min, g, outflow_l, outflow_n, outflow_r,    &
-               outflow_s, use_single_reference_value, wall_adjustment,         &
-               wall_adjustment_factor
-                
-    USE indices,                                                               &
-        ONLY:  nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt,           &
-               wall_flags_0
-    USE kinds
-    
-    USE pegrid
-    
-    USE statistics,                                                            &
-        ONLY :  rmask, statistic_regions, sums_l_l
-
-    USE surface_mod,                                                           &
-        ONLY :  bc_h
-
-    USE vertical_nesting_mod,                                                  &
-        ONLY:  vnest_boundary_conds_khkm, vnest_init
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  i                   !<
-    INTEGER(iwp) ::  j                   !<
-    INTEGER(iwp) ::  k                   !<
-    INTEGER(iwp) ::  m                   !<
-    INTEGER(iwp) ::  omp_get_thread_num  !<
-    INTEGER(iwp) ::  sr                  !<
-    INTEGER(iwp) ::  tn                  !<
-
-    REAL(wp)     ::  dvar_dz             !<
-    REAL(wp)     ::  flag                !<
-    REAL(wp)     ::  l                   !<
-    REAL(wp)     ::  ll                  !<
-    REAL(wp)     ::  l_stable            !<
-    REAL(wp)     ::  sqrt_e              !<
-    REAL(wp)     ::  var_reference       !<
-
-    REAL(wp)     ::  var(nzb:nzt+1,nysg:nyng,nxlg:nxrg)  !<
-
-
-!
-!-- Default thread number in case of one thread
-    tn = 0
-
-!
-!-- Initialization for calculation of the mixing length profile
-    sums_l_l = 0.0_wp
-
-!
-!-- Compute the turbulent diffusion coefficient for momentum
-    !$OMP PARALLEL PRIVATE (dvar_dz,i,j,k,l,ll,l_stable,sqrt_e,sr,tn,flag)
-!$  tn = omp_get_thread_num()
-
-!
-!-- Introduce an optional minimum tke
-    IF ( e_min > 0.0_wp )  THEN
-       !$OMP DO
-       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_0(k,j,i), 0 ) )
-             ENDDO
-          ENDDO
-       ENDDO
-    ENDIF
-
-    !$OMP DO
-    DO  i = nxlg, nxrg
-       DO  j = nysg, nyng
-          DO  k = nzb+1, nzt
-
-             flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
-
-             sqrt_e = SQRT( e(k,j,i) )
-!
-!--          Determine the mixing length
-             dvar_dz = atmos_ocean_sign * &  ! inverse effect of pt/rho_ocean gradient
-                       ( var(k+1,j,i) - var(k-1,j,i) ) * dd2zu(k)
-             IF ( dvar_dz > 0.0_wp ) THEN
-                IF ( use_single_reference_value )  THEN
-                   l_stable = 0.76_wp * sqrt_e /                               &
-                                 SQRT( g / var_reference * dvar_dz ) + 1E-5_wp
-                ELSE
-                   l_stable = 0.76_wp * sqrt_e /                               &
-                                 SQRT( g / var(k,j,i) * dvar_dz ) + 1E-5_wp
-                ENDIF
-             ELSE
-                l_stable = l_grid(k)
-             ENDIF
-!
-!--          Adjustment of the mixing length
-             IF ( wall_adjustment )  THEN
-                l  = MIN( wall_adjustment_factor * l_wall(k,j,i), l_grid(k),   &
-                          l_stable )
-                ll = MIN( wall_adjustment_factor * l_wall(k,j,i), l_grid(k) )
-             ELSE
-                l  = MIN( l_grid(k), l_stable )
-                ll = l_grid(k)
-             ENDIF
-!
-!--          Compute diffusion coefficients for momentum and heat
-             km(k,j,i) = 0.1_wp * l * sqrt_e                      * flag
-             kh(k,j,i) = ( 1.0_wp + 2.0_wp * l / ll ) * km(k,j,i) * flag
-     
-
-!
-!--          Summation for averaged profile (cf. flow_statistics)
-             DO  sr = 0, statistic_regions
-                sums_l_l(k,sr,tn) = sums_l_l(k,sr,tn) + l * rmask(j,i,sr)      &
-                                                          * flag
-             ENDDO
-
-          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 upward- and 
-!-- downward facing walls. To set wall-boundary values, the surface data type 
-!-- is applied.
-!-- Horizontal boundary conditions at vertical walls are not set because
-!-- so far vertical surfaces require usage of a Prandtl-layer where the boundary
-!-- values of the diffusivities are not needed.
-!-- Upward-facing
-    !$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)
-       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 )
-    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
-!
-!-- Model top
-    !$OMP PARALLEL DO
-    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 ( 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
-!
-!-- Vertical nesting: set fine grid eddy viscosity top boundary condition
-    IF ( vnest_init )  CALL vnest_boundary_conds_khkm
-
- END SUBROUTINE diffusivities
Index: palm/trunk/SOURCE/disturb_field.f90
===================================================================
--- palm/trunk/SOURCE/disturb_field.f90	(revision 2689)
+++ palm/trunk/SOURCE/disturb_field.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file disturb_field.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/disturb_heatflux.f90
===================================================================
--- palm/trunk/SOURCE/disturb_heatflux.f90	(revision 2689)
+++ palm/trunk/SOURCE/disturb_heatflux.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file disturb_heatflux.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/eqn_state_seawater.f90
===================================================================
--- palm/trunk/SOURCE/eqn_state_seawater.f90	(revision 2689)
+++ palm/trunk/SOURCE/eqn_state_seawater.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file eqn_state_seawater.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/exchange_horiz.f90
===================================================================
--- palm/trunk/SOURCE/exchange_horiz.f90	(revision 2689)
+++ palm/trunk/SOURCE/exchange_horiz.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file exchange_horiz.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
@@ -25,4 +25,7 @@
 ! -----------------
 ! $Id$
+! 3D-Integer exchange on multigrid level (MS)
+! 
+! 2298 2017-06-29 09:28:18Z raasch
 ! sendrecv_in_background related parts removed
 ! 
@@ -266,8 +269,8 @@
 !> @todo Missing subroutine description.
 !------------------------------------------------------------------------------!
- SUBROUTINE exchange_horiz_int( ar, nbgp_local)
+ SUBROUTINE exchange_horiz_int( ar, nys_l, nyn_l, nxl_l, nxr_l, nzt_l, nbgp_local)
 
     USE control_parameters,                                                    &
-        ONLY:  bc_lr, bc_lr_cyc, bc_ns, bc_ns_cyc
+        ONLY:  bc_lr, bc_lr_cyc, bc_ns, bc_ns_cyc, grid_level
                        
     USE indices,                                                               &
@@ -280,9 +283,13 @@
     IMPLICIT NONE
 
-
+    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) ::  nbgp_local  !< number of ghost points
     
-    INTEGER(iwp), DIMENSION(nzb:nzt+1,nys-nbgp_local:nyn+nbgp_local,           &
-                        nxl-nbgp_local:nxr+nbgp_local) ::  ar  !< treated array
+    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
 
 
@@ -293,19 +300,21 @@
 !--    within the PE memory
        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)
+          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-nbgp_local,nxl),   1, type_yz_int, pleft,  0,            &
-           ar(nzb,nys-nbgp_local,nxr+1), 1, type_yz_int, pright, 0,            &
+       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-nbgp_local,nxr+1-nbgp_local), 1, type_yz_int, pright, 1, &
-           ar(nzb,nys-nbgp_local,nxl-nbgp_local),   1, type_yz_int, pleft,  1, &
+       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
@@ -317,6 +326,6 @@
 !--    within the PE memory
        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,:)
+          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
 
@@ -325,14 +334,14 @@
 !
 !--    Send front boundary, receive rear one (synchronous)
-       CALL MPI_SENDRECV(                                                      &
-           ar(nzb,nys,nxl-nbgp_local),   1, type_xz_int, psouth, 0,            &
-           ar(nzb,nyn+1,nxl-nbgp_local), 1, type_xz_int, pnorth, 0,            &
+       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-nbgp_local+1,nxl-nbgp_local), 1,          &
-                          type_xz_int, pnorth, 1,                              &
-                          ar(nzb,nys-nbgp_local,nxl-nbgp_local),   1,          &
-                          type_xz_int, psouth, 1,                              &
+       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 )
 
@@ -342,11 +351,11 @@
 
     IF ( bc_lr == 'cyclic' )  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)
+       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 == 'cyclic' )  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,:)
+       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
 
Index: palm/trunk/SOURCE/exchange_horiz_2d.f90
===================================================================
--- palm/trunk/SOURCE/exchange_horiz_2d.f90	(revision 2689)
+++ palm/trunk/SOURCE/exchange_horiz_2d.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file exchange_horiz_2d.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
@@ -25,4 +25,7 @@
 ! -----------------
 ! $Id$
+! Forcing implemented (MS)
+! 
+! 2101 2017-01-05 16:42:31Z suehring
 !
 ! 2000 2016-08-20 18:09:15Z knoop
@@ -77,5 +80,7 @@
 
     USE control_parameters,                                                    &
-        ONLY :  bc_lr_cyc, bc_ns_cyc, inflow_l, inflow_n, inflow_r, inflow_s,  &
+        ONLY :  bc_lr_cyc, bc_ns_cyc, force_bound_l, force_bound_n,            &
+                force_bound_r, force_bound_s,                                  &
+                inflow_l, inflow_n, inflow_r, inflow_s,                        &
                 nest_bound_l, nest_bound_n, nest_bound_r, nest_bound_s,        &
                 outflow_l, outflow_n, outflow_r, outflow_s
@@ -175,20 +180,24 @@
 !-- Neumann-conditions at inflow/outflow/nested boundaries
     IF ( nesting_mode /= 'vertical' )  THEN
-       IF ( inflow_l .OR. outflow_l .OR. nest_bound_l )  THEN
+       IF ( inflow_l .OR. outflow_l .OR. nest_bound_l  .OR.  force_bound_l )   &
+       THEN
           DO  i = nbgp, 1, -1
              ar(:,nxl-i) = ar(:,nxl)
           ENDDO
        ENDIF
-       IF ( inflow_r .OR. outflow_r .OR. nest_bound_r )  THEN
+       IF ( inflow_r .OR. outflow_r .OR. nest_bound_r  .OR.  force_bound_r )   &
+       THEN
           DO  i = 1, nbgp
              ar(:,nxr+i) = ar(:,nxr)
           ENDDO
        ENDIF
-       IF ( inflow_s .OR. outflow_s .OR. nest_bound_s )  THEN
+       IF ( inflow_s .OR. outflow_s .OR. nest_bound_s  .OR.  force_bound_s )   &
+       THEN
           DO  i = nbgp, 1, -1
              ar(nys-i,:) = ar(nys,:)
           ENDDO
        ENDIF
-       IF ( inflow_n .OR. outflow_n .OR. nest_bound_n )  THEN
+       IF ( inflow_n .OR. outflow_n .OR. nest_bound_n  .OR.  force_bound_n )   &
+       THEN
           DO  i = 1, nbgp
              ar(nyn+i,:) = ar(nyn,:)
@@ -214,5 +223,6 @@
 
     USE control_parameters,                                                    &
-        ONLY:  bc_lr_cyc, bc_ns_cyc, grid_level, nest_bound_l, nest_bound_n,   &
+        ONLY:  bc_lr_cyc, bc_ns_cyc, grid_level, force_bound_l, force_bound_n, &
+               force_bound_r, force_bound_s, nest_bound_l, nest_bound_n,       &
                nest_bound_r, nest_bound_s
         
@@ -312,20 +322,20 @@
 !
 !-- Neumann-conditions at inflow/outflow/nested boundaries
-    IF ( nest_bound_l )  THEN
+    IF ( nest_bound_l  .OR.  force_bound_l )  THEN
        DO  i = nbgp_local, 1, -1
          ar(:,nxl_l-i) = ar(:,nxl_l)
        ENDDO
     ENDIF
-    IF ( nest_bound_r )  THEN
+    IF ( nest_bound_r  .OR.  force_bound_r )  THEN
        DO  i = 1, nbgp_local
           ar(:,nxr_l+i) = ar(:,nxr_l)
        ENDDO
     ENDIF
-    IF ( nest_bound_s )  THEN
+    IF ( nest_bound_s  .OR.  force_bound_s )  THEN
        DO  i = nbgp_local, 1, -1
          ar(nys_l-i,:) = ar(nys_l,:)
        ENDDO
     ENDIF
-    IF ( nest_bound_n )  THEN
+    IF ( nest_bound_n  .OR.  force_bound_n )  THEN
        DO  i = 1, nbgp_local
          ar(nyn_l+i,:) = ar(nyn_l,:)
Index: palm/trunk/SOURCE/fft_xy_mod.f90
===================================================================
--- palm/trunk/SOURCE/fft_xy_mod.f90	(revision 2689)
+++ palm/trunk/SOURCE/fft_xy_mod.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file fft_xy_mod.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/flow_statistics.f90
===================================================================
--- palm/trunk/SOURCE/flow_statistics.f90	(revision 2689)
+++ palm/trunk/SOURCE/flow_statistics.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file flow_statistics.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
@@ -25,4 +25,8 @@
 ! -----------------
 ! $Id$
+! Bugfix in evaluation of surface quantities in case different surface types
+! are used (MS)
+! 
+! 2674 2017-12-07 11:49:21Z suehring
 ! Bugfix in output conversion of resolved-scale momentum fluxes in case of 
 ! PW advections scheme.
@@ -288,5 +292,5 @@
 
     USE radiation_model_mod,                                                   &
-        ONLY:  radiation, radiation_scheme, rad_net,                           &
+        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
@@ -698,5 +702,6 @@
 !
 !--          2D-arrays (being collected in the last column of sums_l)
-             IF ( surf_def_h(0)%ns >= 1 )  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,pr_palm,tn)   = sums_l(nzb,pr_palm,tn) +               &
@@ -717,5 +722,5 @@
                 ENDIF
              ENDIF
-             IF ( surf_lsm_h%ns >= 1 )  THEN
+             IF ( surf_lsm_h%end_index(j,i) >= surf_lsm_h%start_index(j,i) )  THEN
                 m = surf_lsm_h%start_index(j,i)
                 sums_l(nzb,pr_palm,tn)   = sums_l(nzb,pr_palm,tn) +               &
@@ -736,6 +741,6 @@
                 ENDIF
              ENDIF
-             IF ( surf_usm_h%ns >= 1 )  THEN
-                m = surf_lsm_h%start_index(j,i)
+             IF ( surf_usm_h%end_index(j,i) >= surf_usm_h%start_index(j,i) )  THEN
+                m = surf_usm_h%start_index(j,i)
                 sums_l(nzb,pr_palm,tn)   = sums_l(nzb,pr_palm,tn) +               &
                                         surf_usm_h%us(m)   * rmask(j,i,sr)
@@ -925,5 +930,6 @@
                    ki = MERGE( -1, 0, l == 0 )
                    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)
+                      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)
 
@@ -978,5 +984,6 @@
                    ENDIF
                 ENDDO
-                IF ( surf_lsm_h%ns >= 1 )  THEN
+                IF ( surf_lsm_h%end_index(j,i) >=                              &
+                     surf_lsm_h%start_index(j,i) )  THEN
                    m = surf_lsm_h%start_index(j,i)
                    sums_l(nzb,12,tn) = sums_l(nzb,12,tn) + &
@@ -1028,5 +1035,6 @@
 
                 ENDIF
-                IF ( surf_usm_h%ns >= 1 )  THEN
+                IF ( surf_usm_h%end_index(j,i) >=                              &
+                     surf_usm_h%start_index(j,i) )  THEN
                    m = surf_usm_h%start_index(j,i)
                    sums_l(nzb,12,tn) = sums_l(nzb,12,tn) + &
@@ -1082,17 +1090,20 @@
 
              IF ( .NOT. neutral )  THEN
-                IF ( surf_def_h(0)%ns >= 1 )  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) +                      &
+                   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%ns >= 1 )  THEN
+                IF ( surf_lsm_h%end_index(j,i) >=                              &
+                     surf_lsm_h%start_index(j,i) )  THEN
                    m = surf_lsm_h%start_index(j,i)
-                   sums_l(nzb,112,tn) = sums_l(nzb,112,tn) +                      &
+                   sums_l(nzb,112,tn) = sums_l(nzb,112,tn) +                   &
                                         surf_lsm_h%ol(m)  * rmask(j,i,sr) ! L
                 ENDIF
-                IF ( surf_usm_h%ns >= 1 )  THEN
+                IF ( surf_usm_h%end_index(j,i) >=                              &
+                     surf_usm_h%start_index(j,i) )  THEN
                    m = surf_usm_h%start_index(j,i)
-                   sums_l(nzb,112,tn) = sums_l(nzb,112,tn) +                      &
+                   sums_l(nzb,112,tn) = sums_l(nzb,112,tn) +                   &
                                         surf_usm_h%ol(m)  * rmask(j,i,sr) ! L
                 ENDIF
@@ -1100,16 +1111,87 @@
 
              IF ( radiation )  THEN
-                sums_l(nzb,99,tn)  = sums_l(nzb,99,tn)  + rad_net(j,i)
-                sums_l(nzb,100,tn)  = sums_l(nzb,100,tn)  + rad_lw_in(nzb,j,i)
-                sums_l(nzb,101,tn)  = sums_l(nzb,101,tn)  + rad_lw_out(nzb,j,i)
-                sums_l(nzb,102,tn)  = sums_l(nzb,102,tn)  + rad_sw_in(nzb,j,i)
-                sums_l(nzb,103,tn)  = sums_l(nzb,103,tn)  + rad_sw_out(nzb,j,i)
+                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%end_index(j,i) >=                              &
+                     surf_lsm_h%start_index(j,i) )  THEN
+                   m = surf_lsm_h%start_index(j,i)
+                   sums_l(nzb,99,tn)  = sums_l(nzb,99,tn)  +                   &
+                                        surf_lsm_h%rad_net(m) * rmask(j,i,sr)
+                   sums_l(nzb,100,tn) = sums_l(nzb,100,tn)  +                  &
+                                        surf_lsm_h%rad_lw_in(m) * rmask(j,i,sr)
+                   sums_l(nzb,101,tn) = sums_l(nzb,101,tn)  +                  &
+                                        surf_lsm_h%rad_lw_out(m) * rmask(j,i,sr)
+                   sums_l(nzb,102,tn) = sums_l(nzb,102,tn)  +                  &
+                                        surf_lsm_h%rad_sw_in(m) * rmask(j,i,sr)
+                   sums_l(nzb,103,tn) = sums_l(nzb,103,tn)  +                  &
+                                        surf_lsm_h%rad_sw_out(m) * rmask(j,i,sr)
+                ENDIF
+                IF ( surf_usm_h%end_index(j,i) >=                              &
+                     surf_usm_h%start_index(j,i) )  THEN
+                   m = surf_usm_h%start_index(j,i)
+                   sums_l(nzb,99,tn)  = sums_l(nzb,99,tn)  +                   &
+                                        surf_usm_h%rad_net(m) * rmask(j,i,sr)
+                   sums_l(nzb,100,tn) = sums_l(nzb,100,tn)  +                  &
+                                        surf_usm_h%rad_lw_in(m) * rmask(j,i,sr)
+                   sums_l(nzb,101,tn) = sums_l(nzb,101,tn)  +                  &
+                                        surf_usm_h%rad_lw_out(m) * rmask(j,i,sr)
+                   sums_l(nzb,102,tn) = sums_l(nzb,102,tn)  +                  &
+                                        surf_usm_h%rad_sw_in(m) * rmask(j,i,sr)
+                   sums_l(nzb,103,tn) = sums_l(nzb,103,tn)  +                  &
+                                        surf_usm_h%rad_sw_out(m) * rmask(j,i,sr)
+                ENDIF
 
 #if defined ( __rrtmg )
                 IF ( radiation_scheme == 'rrtmg' )  THEN
-                   sums_l(nzb,108,tn)  = sums_l(nzb,108,tn)  + rrtm_aldif(0,j,i)
-                   sums_l(nzb,109,tn)  = sums_l(nzb,109,tn)  + rrtm_aldir(0,j,i)
-                   sums_l(nzb,110,tn)  = sums_l(nzb,110,tn)  + rrtm_asdif(0,j,i)
-                   sums_l(nzb,111,tn)  = sums_l(nzb,111,tn)  + rrtm_asdir(0,j,i)
+
+                   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) * rmask(j,i,sr)
+                      sums_l(nzb,109,tn) = sums_l(nzb,109,tn)  +               &
+                                           surf_def_h(0)%rrtm_aldir(m) * rmask(j,i,sr)
+                      sums_l(nzb,110,tn) = sums_l(nzb,110,tn)  +               &
+                                           surf_def_h(0)%rrtm_asdif(m) * rmask(j,i,sr)
+                      sums_l(nzb,111,tn) = sums_l(nzb,111,tn)  +               &
+                                           surf_def_h(0)%rrtm_asdir(m) * rmask(j,i,sr)
+                   ENDIF
+                   IF ( surf_lsm_h%end_index(j,i) >=                           &
+                        surf_lsm_h%start_index(j,i) )  THEN
+                      m = surf_lsm_h%start_index(j,i)
+                      sums_l(nzb,108,tn)  = sums_l(nzb,108,tn)  +              &
+                                           surf_lsm_h%rrtm_aldif(m) * rmask(j,i,sr)
+                      sums_l(nzb,109,tn) = sums_l(nzb,109,tn)  +               &
+                                           surf_lsm_h%rrtm_aldir(m) * rmask(j,i,sr)
+                      sums_l(nzb,110,tn) = sums_l(nzb,110,tn)  +               &
+                                           surf_lsm_h%rrtm_asdif(m) * rmask(j,i,sr)
+                      sums_l(nzb,111,tn) = sums_l(nzb,111,tn)  +               &
+                                           surf_lsm_h%rrtm_asdir(m) * rmask(j,i,sr)
+                   ENDIF
+                   IF ( surf_usm_h%end_index(j,i) >=                           &
+                        surf_usm_h%start_index(j,i) )  THEN
+                      m = surf_usm_h%start_index(j,i)
+                      sums_l(nzb,108,tn)  = sums_l(nzb,108,tn)  +              &
+                                           surf_usm_h%rrtm_aldif(m) * rmask(j,i,sr)
+                      sums_l(nzb,109,tn) = sums_l(nzb,109,tn)  +               &
+                                           surf_usm_h%rrtm_aldir(m) * rmask(j,i,sr)
+                      sums_l(nzb,110,tn) = sums_l(nzb,110,tn)  +               &
+                                           surf_usm_h%rrtm_asdif(m) * rmask(j,i,sr)
+                      sums_l(nzb,111,tn) = sums_l(nzb,111,tn)  +               &
+                                           surf_usm_h%rrtm_asdir(m) * rmask(j,i,sr)
+                   ENDIF
+
                 ENDIF
 #endif
Index: palm/trunk/SOURCE/global_min_max.f90
===================================================================
--- palm/trunk/SOURCE/global_min_max.f90	(revision 2689)
+++ palm/trunk/SOURCE/global_min_max.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file global_min_max.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/header.f90
===================================================================
--- palm/trunk/SOURCE/header.f90	(revision 2689)
+++ palm/trunk/SOURCE/header.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file header.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
@@ -25,4 +25,8 @@
 ! -----------------
 ! $Id$
+! Print information about turbulence closure (TG)
+! Print information about inifor initialization (MS)
+! 
+! 2575 2017-10-24 09:57:58Z maronga
 ! Added output for complex terrain simulations
 ! 
@@ -512,4 +516,6 @@
     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'
@@ -602,4 +608,9 @@
 !-- 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
@@ -1962,4 +1973,5 @@
 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')
Index: palm/trunk/SOURCE/inflow_turbulence.f90
===================================================================
--- palm/trunk/SOURCE/inflow_turbulence.f90	(revision 2689)
+++ palm/trunk/SOURCE/inflow_turbulence.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file inflow_turbulence.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/init_3d_model.f90
===================================================================
--- palm/trunk/SOURCE/init_3d_model.f90	(revision 2689)
+++ palm/trunk/SOURCE/init_3d_model.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file init_3d_model.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
@@ -25,4 +25,12 @@
 ! -----------------
 ! $Id$
+! Implementation of uv exposure model (FK)
+! Moved initialisation of diss, e, kh, km to turbulence_closure_mod (TG)
+! Added chemical emissions (FK)
+! Initialize masking arrays and number-of-grid-points arrays before initialize
+! LSM, USM and radiation module 
+! Initialization with inifor (MS)
+! 
+! 2618 2017-11-16 15:37:30Z suehring
 ! Reorder calls of init_surfaces.
 ! 
@@ -378,4 +386,9 @@
 
     USE arrays_3d
+
+#if defined( __chem )
+    USE chemistry_model_mod,                                                   &
+        ONLY:  chem_emissions
+#endif
 
     USE cloud_parameters,                                                      &
@@ -404,5 +417,5 @@
   
     USE lsf_nudging_mod,                                                       &
-        ONLY:  lsf_init, ls_forcing_surf, nudge_init 
+        ONLY:  lsf_init, ls_forcing_surf, nudge_init
 
     USE microphysics_mod,                                                      &
@@ -415,4 +428,7 @@
     USE netcdf_interface,                                                      &
         ONLY:  dots_max, dots_num
+
+    USE netcdf_data_input_mod,                                                  &
+        ONLY:  init_3d, netcdf_data_input_interpolate, netcdf_data_input_init_3d
     
     USE particle_attributes,                                                   &
@@ -425,5 +441,9 @@
 
     USE radiation_model_mod,                                                   &
-        ONLY:  radiation_init, radiation, radiation_scheme
+        ONLY:  radiation_init, radiation, radiation_control, radiation_scheme, &
+               read_svf_on_init,                                               &
+               write_svf_on_init, radiation_calc_svf, radiation_write_svf,     &
+               radiation_interaction, radiation_interactions,                  &
+               radiation_interaction_init, radiation_read_svf
     
     USE random_function_mod 
@@ -450,6 +470,12 @@
     USE transpose_indices
 
+    USE turbulence_closure_mod,                                                &
+        ONLY:  tcm_init_arrays, tcm_init
+
     USE urban_surface_mod,                                                     &
-        ONLY:  usm_init_urban_surface
+        ONLY:  usm_init_urban_surface, usm_allocate_surface
+
+    USE uv_exposure_model_mod,                                                 &
+        ONLY:  uvem_init, uvem_init_arrays
 
     USE wind_turbine_model_mod,                                                &
@@ -522,13 +548,9 @@
 
     ALLOCATE( d(nzb+1:nzt,nys:nyn,nxl:nxr),                                    &
-              kh(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                               &
-              km(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                               &
               p(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                &
               tend(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
 
 #if defined( __nopointer )
-    ALLOCATE( e(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                &
-              e_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                              &
-              pt(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                               &
+    ALLOCATE( pt(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                               &
               pt_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                             &
               u(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                &
@@ -538,5 +560,4 @@
               w(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                                &
               w_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                              &
-              te_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                             &
               tpt_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                            &
               tu_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                             &
@@ -544,8 +565,5 @@
               tw_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
 #else
-    ALLOCATE( e_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                              &
-              e_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                              &
-              e_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                              &
-              pt_1(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),                              &
@@ -771,5 +789,5 @@
                             + 2.0_wp * ( rho_air(nzt+1) - rho_air_zw(nzt)  )
     ENDIF
-
+!
 !-- compute the inverse density array in order to avoid expencive divisions
     drho_air    = 1.0_wp / rho_air
@@ -878,12 +896,4 @@
 
 !
-!-- 3D-array for storing the dissipation, needed for calculating the sgs
-!-- particle velocities
-    IF ( use_sgs_for_particles  .OR.  wang_kernel  .OR.  collision_turbulence )&
-    THEN
-       ALLOCATE( diss(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-    ENDIF
-
-!
 !-- 1D-array for large scale subsidence velocity
     IF ( .NOT. ALLOCATED( w_subs ) )  THEN
@@ -932,5 +942,4 @@
 !
 !-- Initial assignment of the pointers
-    e  => e_1;   e_p  => e_2;   te_m  => e_3
     IF ( .NOT. neutral )  THEN
        pt => pt_1;  pt_p => pt_2;  tpt_m => pt_3
@@ -976,5 +985,8 @@
 #endif
 !
-!-- Initialize wall arrays
+!-- Initialize arrays for turbulence closure
+    CALL tcm_init_arrays
+!
+!-- Initialize surface arrays
     CALL init_surface_arrays
 !
@@ -997,13 +1009,12 @@
 
 !
-!-- Initialize nudging if required
-    IF ( nudging )  THEN
-       CALL nudge_init
-    ENDIF
-
-!
-!-- Initialize reading of large scale forcing from external file - if required
-    IF ( large_scale_forcing )  THEN
-       CALL lsf_init
+!-- Read uv exposure input data
+    IF ( uv_exposure )  THEN
+       CALL uvem_init
+    ENDIF
+!
+!-- Allocate uv exposure arrays
+    IF ( uv_exposure )  THEN
+       CALL uvem_init_arrays
     ENDIF
 
@@ -1032,4 +1043,6 @@
     sums_wsts_bc_l     = 0.0_wp
 
+
+
 !
 !-- Initialize model variables
@@ -1037,7 +1050,117 @@
          TRIM( initializing_actions ) /= 'cyclic_fill' )  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
+!--    Initialization with provided input data derived from larger-scale model
+       IF ( INDEX( initializing_actions, 'inifor' ) /= 0 )  THEN
+          CALL location_message( 'initializing with INIFOR', .FALSE. )
+!
+!--       Read initial 1D profiles from NetCDF file if available. 
+!--       At the moment, only u, v, w, pt and q are provided. 
+          CALL netcdf_data_input_init_3d
+!
+!--       Please note, at the moment INIFOR assumes only an equidistant vertical
+!--       grid. In case of vertical grid stretching, input of inital data 
+!--       need to be inter- and/or extrapolated. 
+!--       Therefore, check if zu grid on file is identical to numeric zw grid. 
+!--       Please note  
+          IF ( ANY( zu(1:nzt+1) /= init_3d%zu_atmos(1:init_3d%nzu) ) )  THEN
+
+             CALL netcdf_data_input_interpolate( init_3d%u_init(nzb+1:nzt+1),  &
+                                                 zu(nzb+1:nzt+1),              &
+                                                 init_3d%zu_atmos )
+             CALL netcdf_data_input_interpolate( init_3d%v_init(nzb+1:nzt+1),  &
+                                                 zu(nzb+1:nzt+1),              &
+                                                 init_3d%zu_atmos )
+!              CALL netcdf_data_input_interpolate( init_3d%w_init(nzb+1:nzt),    &
+!                                                  zw(nzb+1:nzt),                &
+!                                                  init_3d%zw_atmos )
+             IF ( .NOT. neutral )                                              &
+                CALL netcdf_data_input_interpolate(                            &
+                                             init_3d%pt_init(nzb+1:nzt+1),     &
+                                             zu(nzb+1:nzt+1),                  &
+                                             init_3d%zu_atmos )
+             IF ( humidity )                                                   &
+                CALL netcdf_data_input_interpolate(                            &
+                                             init_3d%q_init(nzb+1:nzt+1),      &
+                                             zu(nzb+1:nzt+1),                  &
+                                             init_3d%zu_atmos )
+          ENDIF
+
+          u_init = init_3d%u_init
+          v_init = init_3d%v_init    
+          IF( .NOT. neutral )  pt_init = init_3d%pt_init
+          IF( humidity      )  q_init  = init_3d%q_init
+
+!
+!--       Please note, Inifor provides data from nzb+1 to nzt+1. 
+!--       Initialize pt and q with Neumann condition at nzb.
+          IF( .NOT. neutral )  pt_init(nzb) = pt_init(nzb+1)
+          IF( humidity      )  q_init(nzb)  = q_init(nzb+1)
+          DO  i = nxlg, nxrg
+             DO  j = nysg, nyng
+                u(:,j,i) = u_init(:)
+                v(:,j,i) = v_init(:)
+                IF( .NOT. neutral )  pt(:,j,i) = pt_init(:)
+                IF( humidity      )  q(:,j,i)  = q_init(:)
+             ENDDO
+          ENDDO
+!
+!--       MS: What about the geostrophic wind profiles? Actually these
+!--           are not identical to the initial wind profiles in this case. 
+!--           This need to be further revised.
+!           ug(:) = u_init(:)
+!           vg(:) = v_init(:)
+!
+!--       Set inital w to 0
+          w = 0.0_wp
+!
+!--       Initialize the remaining quantities
+          IF ( humidity )  THEN
+             IF ( cloud_physics  .AND.  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 ( cloud_physics  .AND.  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
+
+          ENDIF
+
+          IF ( passive_scalar )  THEN
+             DO  i = nxlg, nxrg
+                DO  j = nysg, nyng
+                   s(:,j,i) = s_init
+                ENDDO
+             ENDDO
+          ENDIF
+
+          IF ( ocean )  THEN
+             DO  i = nxlg, nxrg
+                DO  j = nysg, nyng
+                   sa(:,j,i) = sa_init
+                ENDDO
+             ENDDO
+          ENDIF
+
+!
+!--       Set velocity components at non-atmospheric / oceanic grid points to 
+!--       zero. 
+          u = MERGE( u, 0.0_wp, BTEST( wall_flags_0, 1 ) )
+          v = MERGE( v, 0.0_wp, BTEST( wall_flags_0, 2 ) )
+          w = MERGE( w, 0.0_wp, BTEST( wall_flags_0, 3 ) )
+
+          CALL location_message( 'finished', .TRUE. )
+!
+!--    Initialization via computed 1D-model profiles
+       ELSEIF ( INDEX( initializing_actions, 'set_1d-model_profiles' ) /= 0 )  THEN
 
           CALL location_message( 'initializing with 1D model profiles', .FALSE. )
@@ -1050,7 +1173,4 @@
           DO  i = nxlg, nxrg
              DO  j = nysg, nyng
-                e(:,j,i)  = e1d
-                kh(:,j,i) = kh1d
-                km(:,j,i) = km1d
                 pt(:,j,i) = pt_init
                 u(:,j,i)  = u1d
@@ -1090,50 +1210,38 @@
              ENDDO   
           ENDIF
-
+!
+!--          Store initial profiles for output purposes etc.
           IF ( .NOT. constant_diffusion )  THEN
-             DO  i = nxlg, nxrg
-                DO  j = nysg, nyng
-                   e(:,j,i)  = e1d
+             hom(:,1,25,:) = SPREAD( l1d, 2, statistic_regions+1 )
+          ENDIF
+!
+!--       Set velocities back to zero
+          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_0(k,j,i), 1 ) )
+                   v(k,j,i) = MERGE( v(k,j,i), 0.0_wp,                      &
+                                     BTEST( wall_flags_0(k,j,i), 2 ) )
                 ENDDO
              ENDDO
-!
-!--          Store initial profiles for output purposes etc.
-             hom(:,1,25,:) = SPREAD( l1d, 2, statistic_regions+1 )
-
-          ELSE
-             e    = 0.0_wp  ! must be set, because used in
-          ENDIF
-!
-!--       Inside buildings set velocities back to zero
-          IF ( topography /= 'flat' )  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_0(k,j,i), 1 ) )
-                      v(k,j,i) = MERGE( v(k,j,i), 0.0_wp,                      &
-                                        BTEST( wall_flags_0(k,j,i), 2 ) )
-                   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 == 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)
                 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 == 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)
-                   ENDDO
-                ENDDO
-
-             ENDIF
 
           ENDIF
@@ -1225,29 +1333,4 @@
              ENDDO
           ENDIF
-          
-          IF ( constant_diffusion )  THEN
-             km   = km_constant
-             kh   = km / prandtl_number
-             e    = 0.0_wp
-          ELSEIF ( e_init > 0.0_wp )  THEN
-             DO  k = nzb+1, nzt
-                km(k,:,:) = 0.1_wp * l_grid(k) * SQRT( e_init )
-             ENDDO
-             km(nzb,:,:)   = km(nzb+1,:,:)
-             km(nzt+1,:,:) = km(nzt,:,:)
-             kh   = km / prandtl_number
-             e    = e_init
-          ELSE
-             IF ( .NOT. ocean )  THEN
-                kh   = 0.01_wp   ! there must exist an initial diffusion, because 
-                km   = 0.01_wp   ! otherwise no 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
 !
 !--       Compute initial temperature field and other constants used in case
@@ -1300,5 +1383,8 @@
 
 !
-!--    Store initial profiles for output purposes etc.
+!--    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.   
        hom(:,1,5,:) = SPREAD( u(:,nys,nxl), 2, statistic_regions+1 )
        hom(:,1,6,:) = SPREAD( v(:,nys,nxl), 2, statistic_regions+1 )
@@ -1308,10 +1394,9 @@
        ENDIF
        hom(:,1,7,:)  = SPREAD( pt(:,nys,nxl), 2, statistic_regions+1 )
-       hom(:,1,23,:) = SPREAD( km(:,nys,nxl), 2, statistic_regions+1 )
-       hom(:,1,24,:) = SPREAD( kh(:,nys,nxl), 2, statistic_regions+1 )
-
+
+
+!
+!--    Store initial salinity profile
        IF ( ocean )  THEN
-!
-!--       Store initial salinity profile
           hom(:,1,26,:)  = SPREAD( sa(:,nys,nxl), 2, statistic_regions+1 )
        ENDIF
@@ -1323,8 +1408,8 @@
           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 specific humidity and potential
+!--       temperature
           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 )
@@ -1332,7 +1417,7 @@
        ENDIF
 
+!
+!--    Store initial scalar profile
        IF ( passive_scalar )  THEN
-!
-!--       Store initial scalar profile
           hom(:,1,121,:) = SPREAD(  s(:,nys,nxl), 2, statistic_regions+1 )
        ENDIF
@@ -1413,6 +1498,6 @@
 !
 !--    Initialize old and new time levels.
-       te_m = 0.0_wp; tpt_m = 0.0_wp; tu_m = 0.0_wp; tv_m = 0.0_wp; tw_m = 0.0_wp
-       e_p = e; pt_p = pt; u_p = u; v_p = v; w_p = w
+       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
@@ -1506,9 +1591,6 @@
                 w(nz_w_shift:nzt+1,j,i)  = w(0:nzt+1-nz_w_shift,j,i)
 
-                e(nz_s_shift:nzt+1,j,i)  =  e(0:nzt+1-nz_s_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)
-                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
@@ -1534,5 +1616,4 @@
           ENDIF
           mean_inflow_profiles(:,4) = hom_sum(:,4,0)       ! pt
-          mean_inflow_profiles(:,5) = hom_sum(:,8,0)       ! e
           IF ( humidity )                                                      &
              mean_inflow_profiles(:,6) = hom_sum(:,41,0)   ! q
@@ -1578,5 +1659,4 @@
 
              mean_inflow_profiles(nz_s_shift:nzt+1,4) = hom_sum(0:nzt+1-nz_s_shift,4,0)  ! pt
-             mean_inflow_profiles(nz_s_shift:nzt+1,5) = hom_sum(0:nzt+1-nz_s_shift,8,0)  ! e
 
           ENDIF
@@ -1606,5 +1686,4 @@
                    w(k,j,nxlg:-1)  = 0.0_wp
                    pt(k,j,nxlg:-1) = mean_inflow_profiles(k,4)
-                   e(k,j,nxlg:-1)  = mean_inflow_profiles(k,5)
                    IF ( humidity )                                             &
                       q(k,j,nxlg:-1)  = mean_inflow_profiles(k,6)
@@ -1663,10 +1742,10 @@
 
 !
-!--    Inside buildings set velocities and TKE back to zero
+!--    Inside buildings set velocities back to zero
        IF ( TRIM( initializing_actions ) == 'cyclic_fill' .AND.                &
             topography /= 'flat' )  THEN
 !
-!--       Inside buildings set velocities and TKE back to zero.
-!--       Other scalars (pt, q, s, km, kh, p, sa, ...) are ignored at present,
+!--       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
@@ -1679,6 +1758,4 @@
                    w(k,j,i)     = MERGE( w(k,j,i), 0.0_wp,                     &
                                          BTEST( wall_flags_0(k,j,i), 3 ) )
-                   e(k,j,i)     = MERGE( e(k,j,i), 0.0_wp,                     &
-                                         BTEST( wall_flags_0(k,j,i), 0 ) )
                    tu_m(k,j,i)  = MERGE( tu_m(k,j,i), 0.0_wp,                  &
                                          BTEST( wall_flags_0(k,j,i), 1 ) )
@@ -1687,6 +1764,4 @@
                    tw_m(k,j,i)  = MERGE( tw_m(k,j,i), 0.0_wp,                  &
                                          BTEST( wall_flags_0(k,j,i), 3 ) )
-                   te_m(k,j,i)  = MERGE( te_m(k,j,i), 0.0_wp,                  &
-                                         BTEST( wall_flags_0(k,j,i), 0 ) )
                    tpt_m(k,j,i) = MERGE( tpt_m(k,j,i), 0.0_wp,                 &
                                          BTEST( wall_flags_0(k,j,i), 0 ) )
@@ -1705,5 +1780,5 @@
 !--    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
+       pt_p = pt; u_p = u; v_p = v; w_p = w
        IF ( humidity )  THEN
           q_p = q
@@ -1724,5 +1799,5 @@
 !--    have to be predefined here because they are used (but multiplied with 0)
 !--    there before they are set. 
-       te_m = 0.0_wp; tpt_m = 0.0_wp; tu_m = 0.0_wp; tv_m = 0.0_wp; tw_m = 0.0_wp
+       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
@@ -1751,4 +1826,8 @@
        CALL message( 'init_3d_model', 'PA0193', 1, 2, 0, 6, 0 )
     ENDIF
+
+!
+!-- Initialize TKE, Kh and Km
+    CALL tcm_init
 
 
@@ -1958,275 +2037,6 @@
 
 !
-!-- 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
-!
-!-- 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
-
-       CALL location_message( 'creating initial disturbances', .FALSE. )
-       CALL disturb_field( 'u', tend, u )
-       CALL disturb_field( 'v', tend, v )
-       CALL location_message( 'finished', .TRUE. )
-
-       CALL location_message( 'calling pressure solver', .FALSE. )
-       n_sor = nsor_ini
-       CALL pres
-       n_sor = nsor
-       CALL location_message( 'finished', .TRUE. )
-
-    ENDIF
-
-!
-!-- If required, initialize quantities needed for the plant canopy model
-    IF ( plant_canopy )  THEN
-       CALL location_message( 'initializing plant canopy model', .FALSE. )    
-       CALL pcm_init
-       CALL location_message( 'finished', .TRUE. )
-    ENDIF
-
-!
-!-- If required, initialize dvrp-software
-    IF ( dt_dvrp /= 9999999.9_wp )  CALL init_dvrp
-
-    IF ( ocean )  THEN
-!
-!--    Initialize quantities needed for the ocean model
-       CALL init_ocean
-
-    ELSE
-!
-!--    Initialize quantities for handling cloud physics
-!--    This routine must be called before lpm_init, because
-!--    otherwise, array pt_d_t, needed in data_output_dvrp (called by
-!--    lpm_init) is not defined.
-       CALL init_cloud_physics
-!
-!--    Initialize bulk cloud microphysics
-       CALL microphysics_init
-    ENDIF
-
-!
-!-- If required, initialize particles
-    IF ( particle_advection )  CALL lpm_init
-
-!
-!-- If required, initialize quantities needed for the LSM
-    IF ( land_surface )  THEN
-       CALL location_message( 'initializing land surface model', .FALSE. )
-       CALL lsm_init
-       CALL location_message( 'finished', .TRUE. )
-    ENDIF
-
-!
-!-- Initialize surface layer (done after LSM as roughness length are required
-!-- for initialization
-    IF ( constant_flux_layer )  THEN
-       CALL location_message( 'initializing surface layer', .FALSE. )
-       CALL init_surface_layer_fluxes
-       CALL location_message( 'finished', .TRUE. )
-    ENDIF
-
-!
-!-- If required, initialize radiation model
-    IF ( radiation )  THEN
-       CALL location_message( 'initializing radiation model', .FALSE. )
-       CALL radiation_init
-       CALL location_message( 'finished', .TRUE. )
-    ENDIF
-
-    
-!
-!-- 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
-    
-!
-!-- If required, initialize urban surface model
-    IF ( urban_surface )  THEN
-       CALL location_message( 'initializing urban surface model', .FALSE. )
-       CALL usm_init_urban_surface
-       CALL location_message( 'finished', .TRUE. )
-    ENDIF
-
-!
-!-- If required, initialize quantities needed for the wind turbine model
-    IF ( wind_turbine )  THEN
-       CALL location_message( 'initializing wind turbine model', .FALSE. )
-       CALL wtm_init
-       CALL location_message( 'finished', .TRUE. )
-    ENDIF
-
-
-!
-!-- Initialize the ws-scheme.    
-    IF ( ws_scheme_sca .OR. ws_scheme_mom )  CALL ws_init        
-
-!
-!-- 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 )  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
-          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
-
-!
-!-- 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
-
-!
-!-- User-defined initializing actions. Check afterwards, if maximum number
-!-- of allowed timeseries is exceeded
-    CALL user_init
-
-    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 modules.f90.'
-       CALL message( 'init_3d_model', 'PA0194', 1, 2, 0, 6, 0 )    
-    ENDIF
-
-!
-!-- 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
-!-- and the mean surface level height for each statistic region
+!-- Before initializing further modules, compute total sum of active mask 
+!-- grid points and the mean surface level height for each statistic region.
 !-- ngp_2dh: number of grid points of a horizontal cross section through the
 !--          total domain
@@ -2245,4 +2055,11 @@
     mean_surface_level_height   = 0.0_wp
     mean_surface_level_height_l = 0.0_wp
+!
+!-- 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
 
 !
@@ -2347,4 +2164,331 @@
                 ngp_3d_inner_l, ngp_3d_inner_tmp )
 
+!
+!-- Initialize nudging if required
+    IF ( nudging )  THEN
+       CALL nudge_init
+    ENDIF
+
+!
+!-- Initialize reading of large scale forcing from external file - if required
+    IF ( large_scale_forcing  .OR.  forcing )  THEN
+       CALL lsf_init
+    ENDIF
+!
+!-- 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
+!
+!-- 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
+
+       CALL location_message( 'creating initial disturbances', .FALSE. )
+       CALL disturb_field( 'u', tend, u )
+       CALL disturb_field( 'v', tend, v )
+       CALL location_message( 'finished', .TRUE. )
+
+       CALL location_message( 'calling pressure solver', .FALSE. )
+       n_sor = nsor_ini
+       CALL pres
+       n_sor = nsor
+       CALL location_message( 'finished', .TRUE. )
+
+    ENDIF
+
+!
+!-- If required, initialize quantities needed for the plant canopy model
+    IF ( plant_canopy )  THEN
+       CALL location_message( 'initializing plant canopy model', .FALSE. )    
+       CALL pcm_init
+       CALL location_message( 'finished', .TRUE. )
+    ENDIF
+
+!
+!-- If required, initialize dvrp-software
+    IF ( dt_dvrp /= 9999999.9_wp )  CALL init_dvrp
+
+    IF ( ocean )  THEN
+!
+!--    Initialize quantities needed for the ocean model
+       CALL init_ocean
+
+    ELSE
+!
+!--    Initialize quantities for handling cloud physics
+!--    This routine must be called before lpm_init, because
+!--    otherwise, array pt_d_t, needed in data_output_dvrp (called by
+!--    lpm_init) is not defined.
+       CALL init_cloud_physics
+!
+!--    Initialize bulk cloud microphysics
+       CALL microphysics_init
+    ENDIF
+
+!
+!-- If required, initialize particles
+    IF ( particle_advection )  CALL lpm_init
+
+!
+!-- If required, initialize quantities needed for the LSM
+    IF ( land_surface )  THEN
+       CALL location_message( 'initializing land surface model', .FALSE. )
+       CALL lsm_init
+       CALL location_message( 'finished', .TRUE. )
+    ENDIF
+
+!
+!-- If required, allocate USM and LSM surfaces
+    IF ( urban_surface )  THEN
+       CALL location_message( 'initializing and allocating urban surfaces', .FALSE. )
+       CALL usm_allocate_surface
+       CALL location_message( 'finished', .TRUE. )
+    ENDIF
+!
+!-- If required, initialize urban surface model
+    IF ( urban_surface )  THEN
+       CALL location_message( 'initializing urban surface model', .FALSE. )
+       CALL usm_init_urban_surface
+       CALL location_message( 'finished', .TRUE. )
+    ENDIF
+
+!
+!-- Initialize surface layer (done after LSM as roughness length are required
+!-- for initialization
+    IF ( constant_flux_layer )  THEN
+       CALL location_message( 'initializing surface layer', .FALSE. )
+       CALL init_surface_layer_fluxes
+       CALL location_message( 'finished', .TRUE. )
+    ENDIF
+
+!
+!-- If required, set chemical emissions
+!-- (todo(FK): This should later on be CALLed time-dependently in init_3d_model)
+#if defined( __chem )
+    IF ( air_chemistry ) THEN
+       CALL chem_emissions
+    ENDIF
+#endif
+
+!
+!-- Initialize radiation processes
+    IF ( radiation )  THEN
+!
+!--    If required, initialize radiation interactions between surfaces 
+!--    via sky-view factors. This must be done befoe radiation is initialized.
+       IF ( radiation_interactions )  CALL radiation_interaction_init
+
+!
+!--    Initialize radiation model
+       CALL location_message( 'initializing radiation model', .FALSE. )
+       CALL radiation_init
+       CALL location_message( 'finished', .TRUE. )
+
+!
+!--    If required, read or calculate and write out the SVF 
+       IF ( radiation_interactions  .AND.  read_svf_on_init )  THEN
+!
+!--       Read sky-view factors and further required data from file
+          CALL location_message( '    Start reading SVF from file', .FALSE. )
+          CALL radiation_read_svf()
+          CALL location_message( '    Reading SVF from file has finished', .TRUE. )
+
+       ELSEIF ( radiation_interactions )  THEN
+!
+!--       calculate SFV and CSF
+          CALL location_message( '    Start calculation of SVF', .FALSE. )
+          CALL radiation_calc_svf()
+          CALL location_message( '    Calculation of SVF has finished', .TRUE. )
+       ENDIF
+
+       IF ( radiation_interactions  .AND.  write_svf_on_init )  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_control 
+       IF ( radiation_interactions )  THEN
+          CALL radiation_interaction
+       ENDIF
+    ENDIF
+    
+!
+!-- 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
+    
+
+
+!
+!-- If required, initialize quantities needed for the wind turbine model
+    IF ( wind_turbine )  THEN
+       CALL location_message( 'initializing wind turbine model', .FALSE. )
+       CALL wtm_init
+       CALL location_message( 'finished', .TRUE. )
+    ENDIF
+
+
+!
+!-- Initialize the ws-scheme.    
+    IF ( ws_scheme_sca .OR. ws_scheme_mom )  CALL ws_init        
+
+!
+!-- 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 )  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
+          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
+
+!
+!-- User-defined initializing actions. Check afterwards, if maximum number
+!-- of allowed timeseries is exceeded
+    CALL user_init
+
+    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 modules.f90.'
+       CALL message( 'init_3d_model', 'PA0194', 1, 2, 0, 6, 0 )    
+    ENDIF
+
+!
+!-- Input binary data file is not needed anymore. This line must be placed
+!-- after call of user_init!
+    CALL close_file( 13 )
+
     CALL location_message( 'leaving init_3d_model', .TRUE. )
 
Index: palm/trunk/SOURCE/init_advec.f90
===================================================================
--- palm/trunk/SOURCE/init_advec.f90	(revision 2689)
+++ palm/trunk/SOURCE/init_advec.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file init_advec.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/init_cloud_physics.f90
===================================================================
--- palm/trunk/SOURCE/init_cloud_physics.f90	(revision 2689)
+++ palm/trunk/SOURCE/init_cloud_physics.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file init_cloud_physics.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/init_coupling.f90
===================================================================
--- palm/trunk/SOURCE/init_coupling.f90	(revision 2689)
+++ palm/trunk/SOURCE/init_coupling.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file init_coupling.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/init_dvrp.f90
===================================================================
--- palm/trunk/SOURCE/init_dvrp.f90	(revision 2689)
+++ palm/trunk/SOURCE/init_dvrp.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file init_dvrp.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/init_grid.f90
===================================================================
--- palm/trunk/SOURCE/init_grid.f90	(revision 2689)
+++ palm/trunk/SOURCE/init_grid.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file init_grid.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
@@ -25,4 +25,13 @@
 ! -----------------
 ! $Id$
+! Revised topography input
+! Set nzb_max not for the entire nest domain, only for boundary PEs
+! Re-organize routine, split-up into several subroutines
+! Modularize poismg_noopt
+! Remove setting bit 26, 27, 28 in wall_flags_0, indicating former '_outer'
+! arrays (not required any more).  
+! Bugfix in generic tunnel setup (MS)
+! 
+! 2550 2017-10-16 17:12:01Z boeske
 ! Set lateral boundary conditions for topography on all three ghost layers
 ! 
@@ -239,9 +248,11 @@
 !
 ! Description:
-! ------------
+! -----------------------------------------------------------------------------!
 !> Creating grid depending constants
-!> To Do: Setting topo flags only based on topo_3d array - flags for former
-!> nzb_outer arrays are still not set properly. 
-!> To Do: Rearrange topo flag list
+!> @todo: Move initialization mixing length
+!> @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
@@ -251,6 +262,5 @@
 
     USE arrays_3d,                                                             &
-        ONLY:  dd2zu, ddzu, ddzu_pres, ddzw, dzu, dzu_mg, dzw, dzw_mg, f1_mg,  &
-               f2_mg, f3_mg, l_grid, l_wall, zu, zw
+        ONLY:  dd2zu, ddzu, ddzu_pres, ddzw, dzu, dzw, zu, zw
         
     USE control_parameters,                                                    &
@@ -259,9 +269,9 @@
                canyon_height, canyon_wall_left, canyon_wall_south,             &
                canyon_width_x, canyon_width_y, constant_flux_layer,            &
-               coupling_char, coupling_mode,                                   &
                dp_level_ind_b, dz, dz_max, dz_stretch_factor,                  &
-               dz_stretch_level, dz_stretch_level_index, grid_level, ibc_uv_b, &
-               io_blocks, io_group, inflow_l, inflow_n, inflow_r, inflow_s,    &
-               lod, masking_method, maximum_grid_level, message_string,        &
+               dz_stretch_level, dz_stretch_level_index, grid_level,           &
+               force_bound_l, force_bound_r, force_bound_n, force_bound_s,     &
+               ibc_uv_b, inflow_l, inflow_n, inflow_r, inflow_s,               &
+               masking_method, maximum_grid_level, message_string,             &
                momentum_advec, nest_domain, nest_bound_l, nest_bound_n,        &
                nest_bound_r, nest_bound_s, ocean, outflow_l, outflow_n,        &
@@ -275,21 +285,15 @@
         
     USE indices,                                                               &
-        ONLY:  advc_flags_1, advc_flags_2, flags, nbgp, nx, nxl, nxlg, nxl_mg, &
-               nxr, nxrg, nxr_mg, ny, nyn, nyng, nyn_mg, nys, nys_mg, nysg, nz,&
+        ONLY:  nbgp, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, nz,   &
                nzb, nzb_diff, nzb_diff_s_inner, nzb_diff_s_outer,              &
                nzb_max, nzb_s_inner, nzb_s_outer, nzb_u_inner,                 &
                nzb_u_outer, nzb_v_inner, nzb_v_outer, nzb_w_inner,             &
-               nzb_w_outer, nzt, nzt_mg, wall_flags_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
+               nzb_w_outer, nzt
     
     USE kinds
-#if defined ( __netcdf )
-    USE netcdf_interface,                                                      &
-        ONLY:  netcdf_close_file, netcdf_open_read_file, netcdf_get_attribute, &
-               netcdf_get_variable
-#endif
+
     USE pegrid
+
+    USE poismg_noopt_mod
 
     USE surface_mod,                                                           &
@@ -298,4 +302,1174 @@
     USE vertical_nesting_mod,                                                  &
         ONLY:  vnested, vnest_init_grid
+
+    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) ::  l             !< loop variable 
+    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 ::  nzb_local      !< index for topography top at cell-center
+    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  nzb_tmp        !< dummy to calculate topography indices on u- and v-grid
+
+    INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE ::  topo !< input array for 3D topography and dummy array for setting "outer"-flags
+
+    REAL(wp) ::  dz_stretched  !< stretched vertical grid spacing
+
+
+!
+!-- Calculation of horizontal array bounds including ghost layers
+    nxlg = nxl - nbgp
+    nxrg = nxr + nbgp
+    nysg = nys - nbgp
+    nyng = nyn + nbgp
+
+!
+!-- Allocate grid arrays
+    ALLOCATE( ddzu(1:nzt+1), ddzw(1:nzt+1), dd2zu(1:nzt), dzu(1:nzt+1),        &
+              dzw(1:nzt+1), zu(nzb:nzt+1), zw(nzb:nzt+1) )
+
+!
+!-- Compute height of u-levels from constant grid length and dz stretch factors
+    IF ( dz == -1.0_wp )  THEN
+       message_string = 'missing dz'
+       CALL message( 'init_grid', 'PA0200', 1, 2, 0, 6, 0 ) 
+    ELSEIF ( dz <= 0.0_wp )  THEN
+       WRITE( message_string, * ) 'dz=',dz,' <= 0.0'
+       CALL message( 'init_grid', 'PA0201', 1, 2, 0, 6, 0 )
+    ENDIF
+
+!
+!-- Define the vertical grid levels
+    IF ( .NOT. ocean )  THEN
+!
+!--    Grid for atmosphere with surface at z=0 (k=0, w-grid).
+!--    The second u-level (k=1) corresponds to the top of the 
+!--    Prandtl-layer.
+
+       IF ( ibc_uv_b == 0 .OR. ibc_uv_b == 2 ) THEN
+          zu(0) = 0.0_wp
+      !    zu(0) = - dz * 0.5_wp
+       ELSE
+          zu(0) = - dz * 0.5_wp
+       ENDIF
+       zu(1) =   dz * 0.5_wp
+
+       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
+          zu(k) = zu(k-1) + dz_stretched
+       ENDDO
+
+!
+!--    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). 
+!--    The top w-level is extrapolated linearly.
+       zw(0) = 0.0_wp
+       DO  k = 1, nzt
+          zw(k) = ( zu(k) + zu(k+1) ) * 0.5_wp
+       ENDDO
+       zw(nzt+1) = zw(nzt) + 2.0_wp * ( zu(nzt+1) - zw(nzt) )
+
+    ELSE
+!
+!--    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 Prandtl-layer.
+       zu(nzt+1) =   dz * 0.5_wp
+       zu(nzt)   = - dz * 0.5_wp
+
+       dz_stretch_level_index = 0
+       dz_stretched = dz
+       DO  k = nzt-1, 0, -1
+!
+!--       The default value of dz_stretch_level is positive, thus the first 
+!--       condition is always true. Hence, the second condition is necessary.
+          IF ( dz_stretch_level >= zu(k+1)  .AND.  dz_stretch_level <= 0.0  &
+               .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 == 0 ) dz_stretch_level_index = k+1
+          ENDIF
+          zu(k) = zu(k+1) - dz_stretched
+       ENDDO
+
+!
+!--    Compute the w-levels. They are always staggered half-way between the 
+!--    corresponding u-levels, except in case of dirichlet bc 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 tp nzt+1.
+       zw(nzt+1) = dz
+       zw(nzt)   = 0.0_wp
+       DO  k = 0, nzt
+          zw(k) = ( zu(k) + zu(k+1) ) * 0.5_wp
+       ENDDO
+
+!
+!--    In case of dirichlet bc for u and v the first u- and w-level are defined
+!--    at same height.
+       IF ( ibc_uv_b == 0 ) THEN
+          zu(0) = zw(0)
+       ENDIF
+
+    ENDIF
+
+!
+!-- Compute grid lengths.
+    DO  k = 1, nzt+1
+       dzu(k)  = zu(k) - zu(k-1)
+       ddzu(k) = 1.0_wp / dzu(k)
+       dzw(k)  = zw(k) - zw(k-1)
+       ddzw(k) = 1.0_wp / 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
+    ENDIF
+
+!
+!-- Compute the reciprocal values of the horizontal grid lengths.
+    ddx = 1.0_wp / dx
+    ddy = 1.0_wp / 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 from topography from file.  
+    CALL init_topo( topo )
+!
+!-- Set flags to mask topography on the grid. 
+    CALL set_topo_flags( topo )    
+!
+!-- Calculate wall flag arrays for the multigrid method.
+!-- Please note, wall flags are only applied in the non-optimized version.
+    IF ( psolver == 'multigrid_noopt' )  CALL poismg_noopt_init 
+
+!
+!-- Init flags for ws-scheme to degrade order of the numerics near walls, i.e. 
+!-- to decrease the numerical stencil appropriately.
+    IF ( momentum_advec == 'ws-scheme'  .OR.  scalar_advec == 'ws-scheme' )    &
+       CALL ws_init_flags
+
+!
+!-- Calculated grid-dependent as well as near-wall mixing length 
+    CALL init_mixing_length
+
+!
+!-- 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. 
+!-- In case of non-cyclic lateral boundaries, the order of the advection
+!-- scheme has to be reduced up to nzt (required at the lateral boundaries).
+    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 + 1, nzb_max, 1, MPI_INTEGER,                    & !is +1 really necessary here?
+                        MPI_MAX, comm2d, ierr )
+#else
+    nzb_max = k_top + 1
+#endif
+    IF ( inflow_l  .OR.  outflow_l  .OR.  force_bound_l  .OR.  nest_bound_l  .OR.&
+         inflow_r  .OR.  outflow_r  .OR.  force_bound_r  .OR.  nest_bound_r  .OR.&
+         inflow_n  .OR.  outflow_n  .OR.  force_bound_n  .OR.  nest_bound_n  .OR.&
+         inflow_s  .OR.  outflow_s  .OR.  force_bound_s  .OR.  nest_bound_s )    &
+         nzb_max = nzt
+!   
+!-- Finally, if topography extents up to the model top, limit nzb_max to nzt.
+    nzb_max = MIN( nzb_max, nzt ) 
+
+!
+!-- Initialize boundary conditions via surface type
+    CALL init_bc
+
+!
+!-- Allocate and set topography height arrays required for data output
+    IF ( TRIM( topography ) /= 'flat' )  THEN
+!
+!--    Allocate and set the arrays containing the topography height
+       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) )
+       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_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( get_topography_top_index( j, i, 's' ) )
+!
+!--          Topography height on w grid. Therefore, determine index of 
+!--          upward-facing surface element on w grid.
+             zw_w_inner(i,j) = zw( get_topography_top_index( j, i, 's' ) )
+          ENDDO
+       ENDDO
+    ENDIF
+
+!
+!-- In the following, calculate 2D index arrays. Note, these will be removed
+!-- soon. 
+!-- Allocate outer and inner index arrays for topography and set
+!-- defaults.                    
+    ALLOCATE( nzb_s_inner(nysg:nyng,nxlg:nxrg),                                &
+              nzb_s_outer(nysg:nyng,nxlg:nxrg),                                &
+              nzb_u_inner(nysg:nyng,nxlg:nxrg),                                &
+              nzb_u_outer(nysg:nyng,nxlg:nxrg),                                &
+              nzb_v_inner(nysg:nyng,nxlg:nxrg),                                &
+              nzb_v_outer(nysg:nyng,nxlg:nxrg),                                &
+              nzb_w_inner(nysg:nyng,nxlg:nxrg),                                &
+              nzb_w_outer(nysg:nyng,nxlg:nxrg),                                &
+              nzb_diff_s_inner(nysg:nyng,nxlg:nxrg),                           &
+              nzb_diff_s_outer(nysg:nyng,nxlg:nxrg),                           &
+              nzb_local(nysg:nyng,nxlg:nxrg),                                  &
+              nzb_tmp(nysg:nyng,nxlg:nxrg) )
+!
+!-- Initialize 2D-index arrays. Note, these will be removed soon! 
+    nzb_local(nys:nyn,nxl:nxr) = get_topography_top_index( 's' )
+    CALL exchange_horiz_2d_int( nzb_local, nys, nyn, nxl, nxr, nbgp )
+
+    IF ( TRIM( topography ) /= 'flat' )  THEN
+#if defined( __parallel )
+       CALL MPI_ALLREDUCE( MAXVAL( get_topography_top_index( 's' ) ),          &
+                           nzb_local_max, 1, MPI_INTEGER, MPI_MAX, comm2d, ierr )
+       CALL MPI_ALLREDUCE( MINVAL( get_topography_top_index( 's' ) ),          &
+                           nzb_local_min, 1, MPI_INTEGER, MPI_MIN, comm2d, ierr )                   
+#else
+       nzb_local_max = MAXVAL( get_topography_top_index( 's' ) )
+       nzb_local_min = MINVAL( get_topography_top_index( 's' ) )
+#endif
+!
+!--    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
+
+    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 (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
+       nzb_diff = nzb + 2
+    ELSE
+       nzb_diff = nzb + 1
+    ENDIF
+
+    nzb_diff_s_inner = nzb_diff;  nzb_diff_s_outer = nzb_diff
+!
+!-- Set Neumann conditions for topography. Will be removed soon.
+    IF ( .NOT. bc_ns_cyc )  THEN
+       IF ( nys == 0  )  THEN
+          nzb_local(-1,:)   = nzb_local(0,:)
+       ELSEIF ( nyn == ny )  THEN
+          nzb_local(ny+1,:) = nzb_local(ny,:)
+       ENDIF
+    ENDIF
+
+    IF ( .NOT. bc_lr_cyc )  THEN
+       IF ( nxl == 0  )  THEN
+          nzb_local(:,-1)   = nzb_local(:,0)
+          nzb_local(:,-2)   = nzb_local(:,0)
+          nzb_local(:,-3)   = nzb_local(:,0)
+       ELSEIF ( nxr == nx )  THEN
+          nzb_local(:,nx+1) = nzb_local(:,nx)
+          nzb_local(:,nx+2) = nzb_local(:,nx)          
+          nzb_local(:,nx+3) = nzb_local(:,nx)          
+       ENDIF          
+    ENDIF
+!
+!-- Initialization of 2D index arrays, will be removed soon!
+!-- Initialize nzb_s_inner and nzb_w_inner
+    nzb_s_inner = nzb_local
+    nzb_w_inner = nzb_local
+
+!
+!-- 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
+
+!
+!-- nzb_s_outer: 
+!-- extend nzb_local east-/westwards first, then north-/southwards
+    nzb_tmp = nzb_local
+    DO  j = nys, nyn
+       DO  i = nxl, nxr
+          nzb_tmp(j,i) = MAX( nzb_local(j,i-1), nzb_local(j,i),             &
+                              nzb_local(j,i+1) )
+       ENDDO
+    ENDDO
+       
+    CALL exchange_horiz_2d_int( nzb_tmp, nys, nyn, nxl, nxr, nbgp )
+     
+    DO  i = nxl, nxr
+       DO  j = nys, nyn
+          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 ( nyn == 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 = nys, nyn
+       DO  i = nxl, nxr
+          nzb_tmp(j,i) = MAX( nzb_local(j,i-1), nzb_local(j,i) )
+       ENDDO
+    ENDDO
+       
+    CALL exchange_horiz_2d_int( nzb_tmp, nys, nyn, nxl, nxr, nbgp )
+       
+    nzb_u_inner = nzb_tmp
+!
+!-- 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 ( nyn == 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 = nxl, nxr
+       DO  j = nys, nyn
+          nzb_tmp(j,i) = MAX( nzb_local(j-1,i), nzb_local(j,i) )
+       ENDDO
+    ENDDO
+       
+    CALL exchange_horiz_2d_int( nzb_tmp, nys, nyn, nxl, nxr, nbgp )      
+    nzb_v_inner = nzb_tmp
+
+!
+!-- 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, nys, nyn, nxl, nxr, nbgp )
+    CALL exchange_horiz_2d_int( nzb_u_outer, nys, nyn, nxl, nxr, nbgp )
+    CALL exchange_horiz_2d_int( nzb_v_inner, nys, nyn, nxl, nxr, nbgp )
+    CALL exchange_horiz_2d_int( nzb_v_outer, nys, nyn, nxl, nxr, nbgp )
+    CALL exchange_horiz_2d_int( nzb_w_outer, nys, nyn, nxl, nxr, nbgp )
+    CALL exchange_horiz_2d_int( nzb_s_outer, nys, nyn, nxl, nxr, nbgp )
+
+!
+!-- 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 ( constant_flux_layer  .OR.  use_surface_fluxes )  THEN
+       nzb_diff_s_inner   = nzb_s_inner + 2
+       nzb_diff_s_outer   = nzb_s_outer + 2
+    ELSE
+       nzb_diff_s_inner   = nzb_s_inner + 1
+       nzb_diff_s_outer   = nzb_s_outer + 1
+    ENDIF
+!
+!-- Vertical nesting: communicate vertical grid level arrays between fine and
+!-- coarse grid
+    IF ( vnested )  CALL vnest_init_grid
+
+ END SUBROUTINE init_grid
+
+! Description:
+! -----------------------------------------------------------------------------!
+!> Set temporary topography flags and reference buildings on top of underlying
+!> orography. 
+!------------------------------------------------------------------------------!
+ SUBROUTINE process_topography( topo_3d )
+
+    USE arrays_3d,                                                             &
+        ONLY:  zw
+
+    USE control_parameters,                                                    &
+        ONLY:  bc_lr_cyc, bc_ns_cyc, land_surface, ocean, urban_surface
+
+    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, input_pids_static,                  &
+               terrain_height_f
+
+    USE kinds
+
+    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 with respect to numeric grid
+    INTEGER(iwp) ::  k2        !< running index along z-direction with respect to netcdf grid
+    INTEGER(iwp) ::  k_surf    !< orography top index, used to map 3D buildings onto terrain
+    INTEGER(iwp) ::  nr        !< index variable indication maximum terrain height for respective building ID
+    INTEGER(iwp) ::  num_build !< counter for number of buildings
+
+    INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  displace_dum        !< displacements of start addresses, used for MPI_ALLGATHERV
+    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), 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
+
+!
+!-- 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 )
+!
+!-- 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 
+       num_buildings_l = 0
+       num_buildings   = 0
+!
+!--    Allocate at least one element for building ids, 
+       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) .EQ.  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) .EQ. 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
+
+!
+!--    Finally, determine maximumum terrain height occupied by the 
+!--    respective building. First, on each PE locally. 
+       ALLOCATE( oro_max_l(1:SIZE(build_ids_final)) )
+       ALLOCATE( oro_max(1:SIZE(build_ids_final))   )
+       oro_max_l = 0.0_wp
+
+       DO  nr = 1, SIZE(build_ids_final)
+          oro_max_l(nr) = MAXVAL(                                              &
+                           MERGE( terrain_height_f%var, 0.0_wp,                &
+                                  building_id_f%var(nys:nyn,nxl:nxr) .EQ.      &
+                                  build_ids_final(nr) ) )
+       ENDDO
+   
+#if defined( __parallel )    
+       IF ( SIZE(build_ids_final) >= 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
+!
+!--    Map orography as well as buildings on grid. 
+!--    In case of ocean simulations, add an offset.  
+       ocean_offset = MERGE( zw(0), 0.0_wp, ocean )
+       DO  i = nxl, nxr
+          DO  j = nys, nyn
+             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, de-flag the grid point and give it 
+!--             urban type instead. 
+                IF ( zw(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 ) 
+                ENDIF
+!
+!--             Set building grid points. Here, only consider 2D buildings. 
+!--             3D buildings require separate treatment. 
+                IF ( buildings_f%lod == 1 )  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 )
+        
+                      IF ( zw(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 )
+!
+!--                      De-flag grid point of type natural. See comment above.
+                         topo_3d(k,j,i) = IBCLR( topo_3d(k,j,i), 1 ) 
+                      ENDIF
+                   ENDIF
+                ENDIF
+             ENDDO
+!
+!--          Map 3D buildings onto terrain height.  
+             IF ( buildings_f%lod == 2 )  THEN
+                IF ( building_id_f%var(j,i) /= building_id_f%fill )  THEN
+!
+!--                Determine topo index occupied by terrain
+                   k_surf = MAXLOC( MERGE( 1, 0,                               &
+                                           .NOT. BTEST( topo_3d(:,j,i), 0 ) ), &
+                                    DIM = 1 ) - 1
+                   k2 = nzb+1
+                   DO k = k_surf + 1, nzt + 1
+                      IF ( k2 <= buildings_f%nz )  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
+                   ENDDO
+                ENDIF
+             ENDIF
+          ENDDO
+       ENDDO
+!
+!--    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 )
+       topo_3d          = IBSET( topo_3d, 0 )
+       topo_3d(nzb,:,:) = IBCLR( topo_3d(nzb,:,:), 0 )
+       DO  i = nxl, nxr
+          DO  j = nys, nyn
+             DO  k = nzb, nzt
+                IF ( zw(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) = IBSET( topo_3d(k,j,i), 2 ) !indicates terrain
+                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 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) ::  it         !< counter for number of iterations
+    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
+!
+!-- 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
+    it = 0
+    DO WHILE ( num_hole > 0 )       
+
+       num_hole = 0    
+       CALL exchange_horiz_int( topo_3d, nys, nyn, nxl, nxr, nzt, 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
+
+       it = it + 1
+       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 3) 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), 3 )
+!
+!--                   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    
+
+!
+!--    Create an informative message if any holes were filled.
+       IF ( num_hole > 0 )  THEN
+          WRITE( message_string, * ) num_hole, 'hole(s) resolved by only '//   &
+                                     'one grid point were filled at ', it,     &
+                                     'th iteration '
+          CALL message( 'init_grid', 'PA0430', 0, 0, 0, 6, 0 )
+       ENDIF
+
+
+    ENDDO
+
+    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
+
+ END SUBROUTINE filter_topography
+
+! Description:
+! -----------------------------------------------------------------------------!
+!> Pre-computation of grid-dependent and near-wall mixing length.
+!> @todo: move subroutine to turbulence module developed by M1 (Tobi).
+!------------------------------------------------------------------------------!
+ SUBROUTINE init_mixing_length
+
+    USE arrays_3d,                                                             &
+        ONLY:  dzw, l_grid, l_wall, zu, zw
+
+    USE control_parameters,                                                    &
+        ONLY:  message_string, wall_adjustment_factor
+
+    USE grid_variables,                                                        &
+        ONLY:  dx, dy
+
+    USE indices,                                                               &
+        ONLY:  nbgp, nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt,     &
+               wall_flags_0
+    
+    USE kinds
+
+    IMPLICIT NONE
+
+    INTEGER(iwp) ::  i             !< index variable along x
+    INTEGER(iwp) ::  j             !< index variable along y
+    INTEGER(iwp) ::  k             !< index variable along z
+
+    ALLOCATE( l_grid(1:nzt) )
+    ALLOCATE( l_wall(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
+!
+!-- Compute the grid-dependent mixing length.
+    DO  k = 1, nzt
+       l_grid(k)  = ( dx * dy * dzw(k) )**0.33333333333333_wp
+    ENDDO
+!
+!-- Initialize near-wall mixing length l_wall only in the vertical direction
+!-- for the moment, multiplication with wall_adjustment_factor further below
+    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)
+
+    DO  k = 1, nzt
+       IF ( l_grid(k) > 1.5_wp * dx * wall_adjustment_factor .OR.  &
+            l_grid(k) > 1.5_wp * dy * wall_adjustment_factor )  THEN
+          WRITE( message_string, * ) 'grid anisotropy exceeds ', &
+                                     'threshold given by only local', &
+                                     ' &horizontal reduction of near_wall ', &
+                                     'mixing length l_wall', &
+                                     ' &starting from height level k = ', k, '.'
+          CALL message( 'init_grid', 'PA0202', 0, 1, 0, 6, 0 )
+          EXIT
+       ENDIF
+    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.
+!-- Is this correct in 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_0(k,j,i), 0 ) )  THEN
+!
+!--             Check for neighbouring grid-points.
+!--             Vertical distance, down
+                IF ( .NOT. BTEST( wall_flags_0(k-1,j,i), 0 ) )                 &
+                   l_wall(k,j,i) = MIN( l_grid(k), zu(k) - zw(k-1) )
+!
+!--             Vertical distance, up
+                IF ( .NOT. BTEST( wall_flags_0(k+1,j,i), 0 ) )                 &
+                   l_wall(k,j,i) = MIN( l_grid(k), zw(k) - zu(k) )
+!
+!--             y-distance
+                IF ( .NOT. BTEST( wall_flags_0(k,j-1,i), 0 )  .OR.             &
+                     .NOT. BTEST( wall_flags_0(k,j+1,i), 0 ) )                 &
+                   l_wall(k,j,i) = MIN( l_wall(k,j,i), l_grid(k), 0.5_wp * dy )
+!
+!--             x-distance
+                IF ( .NOT. BTEST( wall_flags_0(k,j,i-1), 0 )  .OR.             &
+                     .NOT. BTEST( wall_flags_0(k,j,i+1), 0 ) )                 &
+                   l_wall(k,j,i) = MIN( l_wall(k,j,i), l_grid(k), 0.5_wp * dx )
+!
+!--              yz-distance (vertical edges, down)
+                 IF ( .NOT. BTEST( wall_flags_0(k-1,j-1,i), 0 )  .OR.          &
+                      .NOT. BTEST( wall_flags_0(k-1,j+1,i), 0 )  )             &
+                   l_wall(k,j,i) = MIN( l_wall(k,j,i), l_grid(k),              &
+                                        SQRT( 0.25_wp * dy**2 +                &
+                                       ( zu(k) - zw(k-1) )**2 ) )
+!
+!--              yz-distance (vertical edges, up)
+                 IF ( .NOT. BTEST( wall_flags_0(k+1,j-1,i), 0 )  .OR.          &
+                      .NOT. BTEST( wall_flags_0(k+1,j+1,i), 0 )  )             &
+                   l_wall(k,j,i) = MIN( l_wall(k,j,i), l_grid(k),              &
+                                        SQRT( 0.25_wp * dy**2 +                &
+                                       ( zw(k) - zu(k) )**2 ) )
+!   
+!--              xz-distance (vertical edges, down)
+                 IF ( .NOT. BTEST( wall_flags_0(k-1,j,i-1), 0 )  .OR.          &
+                      .NOT. BTEST( wall_flags_0(k-1,j,i+1), 0 )  )             &
+                   l_wall(k,j,i) = MIN( l_wall(k,j,i), l_grid(k),              &
+                                        SQRT( 0.25_wp * dx**2 +                &
+                                       ( zu(k) - zw(k-1) )**2 ) )
+!
+!--              xz-distance (vertical edges, up)
+                 IF ( .NOT. BTEST( wall_flags_0(k+1,j,i-1), 0 )  .OR.          &
+                      .NOT. BTEST( wall_flags_0(k+1,j,i+1), 0 )  )             &
+                  l_wall(k,j,i) = MIN( l_wall(k,j,i), l_grid(k),              &
+                                        SQRT( 0.25_wp * dx**2 +                &
+                                       ( zw(k) - zu(k) )**2 ) )
+!
+!--             xy-distance (horizontal edges)
+                IF ( .NOT. BTEST( wall_flags_0(k,j-1,i-1), 0 )  .OR.           &
+                     .NOT. BTEST( wall_flags_0(k,j+1,i-1), 0 )  .OR.           &
+                     .NOT. BTEST( wall_flags_0(k,j-1,i+1), 0 )  .OR.           &
+                     .NOT. BTEST( wall_flags_0(k,j+1,i+1), 0 ) )               &
+                   l_wall(k,j,i) = MIN( l_wall(k,j,i), l_grid(k),              &
+                                        SQRT( 0.25_wp * ( dx**2 + dy**2 ) ) )
+!
+!--             xyz distance (vertical and horizontal edges, down)
+                IF ( .NOT. BTEST( wall_flags_0(k-1,j-1,i-1), 0 )  .OR.         &
+                     .NOT. BTEST( wall_flags_0(k-1,j+1,i-1), 0 )  .OR.         &
+                     .NOT. BTEST( wall_flags_0(k-1,j-1,i+1), 0 )  .OR.         &
+                     .NOT. BTEST( wall_flags_0(k-1,j+1,i+1), 0 ) )             &
+                   l_wall(k,j,i) = MIN( l_wall(k,j,i), l_grid(k),              &
+                                        SQRT( 0.25_wp * ( dx**2 + dy**2 )      &
+                                              +  ( zu(k) - zw(k-1) )**2  ) )
+!
+!--             xyz distance (vertical and horizontal edges, up)
+                IF ( .NOT. BTEST( wall_flags_0(k+1,j-1,i-1), 0 )  .OR.         &
+                     .NOT. BTEST( wall_flags_0(k+1,j+1,i-1), 0 )  .OR.         &
+                     .NOT. BTEST( wall_flags_0(k+1,j-1,i+1), 0 )  .OR.         &
+                     .NOT. BTEST( wall_flags_0(k+1,j+1,i+1), 0 ) )             &
+                   l_wall(k,j,i) = MIN( l_wall(k,j,i), l_grid(k),              &
+                                        SQRT( 0.25_wp * ( dx**2 + dy**2 )      &
+                                              +  ( zw(k) - zu(k) )**2  ) )
+                  
+             ENDIF
+          ENDDO
+       ENDDO
+    ENDDO
+!
+!-- Set lateral boundary conditions for l_wall
+    CALL exchange_horiz( l_wall, nbgp )     
+
+ END SUBROUTINE init_mixing_length
+
+! 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, ocean, topography, topography_grid_convention,  &
+               tunnel_height, tunnel_length, tunnel_width_x, tunnel_width_y,   &
+               tunnel_wall_depth
+         
+    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 pegrid
+
+    USE surface_mod,                                                           &
+        ONLY:  get_topography_top_index
 
     IMPLICIT NONE
@@ -316,22 +1490,7 @@
     INTEGER(iwp) ::  cys           !< index for south canyon wall
     INTEGER(iwp) ::  i             !< index variable along x
-    INTEGER(iwp) ::  id_topo       !< NetCDF id of topograhy input file
-    INTEGER(iwp) ::  ii            !< loop variable for reading topography file
-    INTEGER(iwp) ::  inc           !< incremental parameter for coarsening grid level
+    INTEGER(iwp) ::  it            !< Number of iterations required to fill all problematic holes
     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) ::  l             !< loop variable 
-    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) ::  nzb_local_max !< vertical grid index of maximum topography height
-    INTEGER(iwp) ::  nzb_local_min !< vertical grid index of minimum topography height
-    INTEGER(iwp) ::  nzt_l         !< index of top PE boundary for multigrid level
-    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) ::  skip_n_rows   !< counting variable to skip rows while reading topography file    
     INTEGER(iwp) ::  hv_in         !< heavyside function to model inner tunnel surface 
     INTEGER(iwp) ::  hv_out        !< heavyside function to model outer tunnel surface 
@@ -346,226 +1505,9 @@
     INTEGER(iwp) ::  td            !< tunnel wall depth
     INTEGER(iwp) ::  th            !< height of outer tunnel wall
-                                      
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  nzb_local      !< index for topography top at cell-center
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  nzb_tmp        !< dummy to calculate topography indices on u- and v-grid
-
-    INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE ::  topo_3d !< input array for 3D topography and dummy array for setting "outer"-flags
-
-    LOGICAL  ::  netcdf_extend = .FALSE. !< Flag indicating wether netcdf topography input file or not
-
-    REAL(wp) ::  dum           !< dummy variable to skip columns while reading topography file    
-    REAL(wp) ::  dz_stretched  !< stretched vertical grid spacing
-
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  oro_height    !< input variable for terrain height
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  topo_height   !< input variable for topography height
-
-    INTEGER( KIND=1 ), DIMENSION(:,:,:), ALLOCATABLE ::  topo_3d_read !< input variable for 3D topography
-
-!
-!-- Calculation of horizontal array bounds including ghost layers
-    nxlg = nxl - nbgp
-    nxrg = nxr + nbgp
-    nysg = nys - nbgp
-    nyng = nyn + nbgp
-
-!
-!-- Allocate grid arrays
-    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(nzb:nzt+1), zw(nzb:nzt+1) )
-
-!
-!-- Compute height of u-levels from constant grid length and dz stretch factors
-    IF ( dz == -1.0_wp )  THEN
-       message_string = 'missing dz'
-       CALL message( 'init_grid', 'PA0200', 1, 2, 0, 6, 0 ) 
-    ELSEIF ( dz <= 0.0_wp )  THEN
-       WRITE( message_string, * ) 'dz=',dz,' <= 0.0'
-       CALL message( 'init_grid', 'PA0201', 1, 2, 0, 6, 0 )
-    ENDIF
-
-!
-!-- Define the vertical grid levels
-    IF ( .NOT. ocean )  THEN
-!
-!--    Grid for atmosphere with surface at z=0 (k=0, w-grid).
-!--    The second u-level (k=1) corresponds to the top of the 
-!--    Prandtl-layer.
-
-       IF ( ibc_uv_b == 0 .OR. ibc_uv_b == 2 ) THEN
-          zu(0) = 0.0_wp
-      !    zu(0) = - dz * 0.5_wp
-       ELSE
-          zu(0) = - dz * 0.5_wp
-       ENDIF
-       zu(1) =   dz * 0.5_wp
-
-       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
-          zu(k) = zu(k-1) + dz_stretched
-       ENDDO
-
-!
-!--    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). 
-!--    The top w-level is extrapolated linearly.
-       zw(0) = 0.0_wp
-       DO  k = 1, nzt
-          zw(k) = ( zu(k) + zu(k+1) ) * 0.5_wp
-       ENDDO
-       zw(nzt+1) = zw(nzt) + 2.0_wp * ( zu(nzt+1) - zw(nzt) )
-
-    ELSE
-!
-!--    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 Prandtl-layer.
-       zu(nzt+1) =   dz * 0.5_wp
-       zu(nzt)   = - dz * 0.5_wp
-
-       dz_stretch_level_index = 0
-       dz_stretched = dz
-       DO  k = nzt-1, 0, -1
-!
-!--       The default value of dz_stretch_level is positive, thus the first 
-!--       condition is always true. Hence, the second condition is necessary.
-          IF ( dz_stretch_level >= zu(k+1)  .AND.  dz_stretch_level <= 0.0  &
-               .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 == 0 ) dz_stretch_level_index = k+1
-          ENDIF
-          zu(k) = zu(k+1) - dz_stretched
-       ENDDO
-
-!
-!--    Compute the w-levels. They are always staggered half-way between the 
-!--    corresponding u-levels, except in case of dirichlet bc 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 tp nzt+1.
-       zw(nzt+1) = dz
-       zw(nzt)   = 0.0_wp
-       DO  k = 0, nzt
-          zw(k) = ( zu(k) + zu(k+1) ) * 0.5_wp
-       ENDDO
-
-!
-!--    In case of dirichlet bc for u and v the first u- and w-level are defined
-!--    at same height.
-       IF ( ibc_uv_b == 0 ) THEN
-          zu(0) = zw(0)
-       ENDIF
-
-    ENDIF
-
-!
-!-- Compute grid lengths.
-    DO  k = 1, nzt+1
-       dzu(k)  = zu(k) - zu(k-1)
-       ddzu(k) = 1.0_wp / dzu(k)
-       dzw(k)  = zw(k) - zw(k-1)
-       ddzw(k) = 1.0_wp / 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
-    ENDIF
-
-!
-!-- Compute the reciprocal values of the horizontal grid lengths.
-    ddx = 1.0_wp / dx
-    ddy = 1.0_wp / dy
-    dx2 = dx * dx
-    dy2 = dy * dy
-    ddx2 = 1.0_wp / dx2
-    ddy2 = 1.0_wp / dy2
-
-!
-!-- Compute the grid-dependent mixing length.
-    DO  k = 1, nzt
-       l_grid(k)  = ( dx * dy * dzw(k) )**0.33333333333333_wp
-    ENDDO
-
-!
-!-- Allocate outer and inner index arrays for topography and set
-!-- defaults.                    
-    ALLOCATE( nzb_s_inner(nysg:nyng,nxlg:nxrg),                             &
-              nzb_s_outer(nysg:nyng,nxlg:nxrg),                             &
-              nzb_u_inner(nysg:nyng,nxlg:nxrg),                             &
-              nzb_u_outer(nysg:nyng,nxlg:nxrg),                             &
-              nzb_v_inner(nysg:nyng,nxlg:nxrg),                             &
-              nzb_v_outer(nysg:nyng,nxlg:nxrg),                             &
-              nzb_w_inner(nysg:nyng,nxlg:nxrg),                             &
-              nzb_w_outer(nysg:nyng,nxlg:nxrg),                             &
-              nzb_diff_s_inner(nysg:nyng,nxlg:nxrg),                        &
-              nzb_diff_s_outer(nysg:nyng,nxlg:nxrg),                        &
-              nzb_local(nysg:nyng,nxlg:nxrg),                               &
-              nzb_tmp(nysg:nyng,nxlg:nxrg),                                 &
-              wall_flags_0(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-
-    ALLOCATE( topo_3d(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-    topo_3d    = 0
-
-    ALLOCATE( l_wall(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-
-    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 (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
-       nzb_diff = nzb + 2
-    ELSE
-       nzb_diff = nzb + 1
-    ENDIF
-
-    nzb_diff_s_inner = nzb_diff;  nzb_diff_s_outer = nzb_diff
-
-!
-!-- 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)
-
-    DO  k = 1, nzt
-       IF ( l_grid(k) > 1.5_wp * dx * wall_adjustment_factor .OR.  &
-            l_grid(k) > 1.5_wp * dy * wall_adjustment_factor )  THEN
-          WRITE( message_string, * ) 'grid anisotropy exceeds ', &
-                                     'threshold given by only local', &
-                                     ' &horizontal reduction of near_wall ', &
-                                     'mixing length l_wall', &
-                                     ' &starting from height level k = ', k, '.'
-          CALL message( 'init_grid', 'PA0202', 0, 1, 0, 6, 0 )
-          EXIT
-       ENDIF
-    ENDDO
+
+    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
+
+
 !
 !-- Set outer and inner index arrays for non-flat topography.
@@ -578,13 +1520,7 @@
 
        CASE ( 'flat' )
-!
-!--       nzb_local is required for the multigrid solver
-          nzb_local = 0
-!
+!   
 !--       Initialilize 3D topography array, used later for initializing flags
-          topo_3d(nzb+1:nzt+1,:,:) = IBSET( topo_3d(nzb+1:nzt+1,:,:), 0 ) 
-!
-!--       level of detail is required for output routines
-          lod       = 1
+          topo(nzb+1:nzt+1,:,:) = IBSET( topo(nzb+1:nzt+1,:,:), 0 ) 
 
        CASE ( 'single_building' )
@@ -597,5 +1533,4 @@
           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 - blx ) / 2 * dx
@@ -605,5 +1540,5 @@
 
           IF ( building_wall_south == 9999999.9_wp )  THEN
-             building_wall_south = ( ny + 1 - bly ) / 2 * dy
+              building_wall_south = ( ny + 1 - bly ) / 2 * dy
           ENDIF
           bys = NINT( building_wall_south / dy )
@@ -612,5 +1547,5 @@
 !
 !--       Building size has to meet some requirements
-          IF ( ( bxl < 1 ) .OR. ( bxr > nx-1 ) .OR. ( bxr < bxl+3 ) .OR.  &
+          IF ( ( bxl < 1 ) .OR. ( bxr > nx-1 ) .OR. ( bxr < bxl+3 ) .OR.       &
                ( bys < 1 ) .OR. ( byn > ny-1 ) .OR. ( byn < bys+3 ) )  THEN
              WRITE( message_string, * ) 'inconsistent building parameters:',   &
@@ -620,26 +1555,22 @@
           ENDIF
 
+          ALLOCATE( nzb_local(nysg:nyng,nxlg:nxrg) )
 !
 !--       Define the building. 
-          nzb_local = 0
           IF ( bxl <= nxr  .AND.  bxr >= nxl  .AND.                            &
-               bys <= nyn  .AND.  byn >= nys )                                 &        
+               bys <= nyn  .AND.  byn >= nys )                                 & 
              nzb_local(MAX(nys,bys):MIN(nyn,byn),MAX(nxl,bxl):MIN(nxr,bxr)) = bh
-
-          CALL exchange_horiz_2d_int( nzb_local, nys, nyn, nxl, nxr, nbgp )
-!
-!--       Set bit array to mask topography
-          DO  i = nxlg, nxrg
-             DO  j = nysg, nyng
-
-                topo_3d(nzb_local(j,i)+1:nzt+1,j,i) =                          &
-                                 IBSET( topo_3d(nzb_local(j,i)+1:nzt+1,j,i), 0 ) 
+!
+!--       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
-!
-!--       level of detail is required for output routines. Here, 2D topography. 
-          lod = 1
-
-          CALL exchange_horiz_int( topo_3d, nbgp )
+        
+          DEALLOCATE( nzb_local )
+
+          CALL exchange_horiz_int( topo, nys, nyn, nxl, nxr, nzt, nbgp )
 
        CASE ( 'single_street_canyon' )
@@ -656,5 +1587,4 @@
              cxl = NINT( canyon_wall_left / dx )
              cxr = cxl + cwx
-
           ELSEIF ( canyon_width_y /= 9999999.9_wp )  THEN
 !
@@ -666,5 +1596,5 @@
              cys = NINT( canyon_wall_south / dy )
              cyn = cys + cwy
-
+      
           ELSE
              
@@ -677,5 +1607,4 @@
           IF ( ABS( zw(ch)   - canyon_height ) == &
                ABS( zw(ch+1) - canyon_height )    )  ch = ch + 1
-
           dp_level_ind_b = ch
 !
@@ -683,5 +1612,5 @@
           IF ( canyon_width_x /= 9999999.9_wp )  THEN
              IF ( ( cxl < 1 ) .OR. ( cxr > nx-1 ) .OR. ( cwx < 3 ) .OR.        &
-               ( ch < 3 ) )  THEN
+                  ( ch < 3 ) )  THEN
                 WRITE( message_string, * ) 'inconsistent canyon parameters:',  &
                                            '&cxl=', cxl, 'cxr=', cxr,          &
@@ -692,5 +1621,5 @@
           ELSEIF ( canyon_width_y /= 9999999.9_wp )  THEN
              IF ( ( cys < 1 ) .OR. ( cyn > ny-1 ) .OR. ( cwy < 3 ) .OR.        &
-               ( ch < 3 ) )  THEN
+                  ( ch < 3 ) )  THEN
                 WRITE( message_string, * ) 'inconsistent canyon parameters:',  &
                                            '&cys=', cys, 'cyn=', cyn,          &
@@ -708,4 +1637,5 @@
           ENDIF
 
+          ALLOCATE( nzb_local(nysg:nyng,nxlg:nxrg) )
           nzb_local = ch
           IF ( canyon_width_x /= 9999999.9_wp )  THEN
@@ -716,19 +1646,15 @@
                 nzb_local(MAX(nys,cys+1):MIN(nyn,cyn-1),:) = 0
           ENDIF
-
-          CALL exchange_horiz_2d_int( nzb_local, nys, nyn, nxl, nxr, nbgp )
-!
-!--       Set bit array to mask topography
-          DO  i = nxlg, nxrg
-             DO  j = nysg, nyng
-                topo_3d(nzb_local(j,i)+1:nzt+1,j,i) =                          &
-                                 IBSET( topo_3d(nzb_local(j,i)+1:nzt+1,j,i), 0 ) 
+!
+!--       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
-!
-!--       level of detail is required for output routines. Here, 2D topography. 
-          lod = 1
-
-          CALL exchange_horiz_int( topo_3d, nbgp )
+          DEALLOCATE( nzb_local )
+
+          CALL exchange_horiz_int( topo, nys, nyn, nxl, nxr, nzt, nbgp )
 
        CASE ( 'tunnel' )
@@ -743,5 +1669,5 @@
 !
 !--       Tunnel-wall depth
-          IF ( tunnel_wall_depth == 9999999.9_wp )  THEN
+          IF ( tunnel_wall_depth == 9999999.9_wp )  THEN  
              td = MAX ( dx, dy, dz )
           ELSE
@@ -775,5 +1701,5 @@
                                       ( tunnel_width_x * 0.5_wp - td ) )
              txe_in  = INT( ( nx + 1 ) * 0.5_wp * dx +                         &
-                                      ( tunnel_width_x * 0.5_wp - td ) )
+                                   ( tunnel_width_x * 0.5_wp - td ) )
 
              tys_out = INT( ( ny + 1 ) * 0.5_wp * dy - tunnel_length * 0.5_wp )
@@ -782,11 +1708,13 @@
              tye_in  = tye_out
           ENDIF
-          IF ( tunnel_width_x /= 9999999.9_wp  .AND.                           &
-               tunnel_width_x - 2.0_wp * tunnel_wall_depth <= 2.0_wp * dx )  THEN
+          IF ( tunnel_width_x /= 9999999.9_wp  .AND.                           &   
+               tunnel_width_x - 2.0_wp * td <= 2.0_wp * dx )                   &
+          THEN
              message_string = 'Tunnel width 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 * tunnel_wall_depth <= 2.0_wp * dy )  THEN
+               tunnel_width_y - 2.0_wp * td <= 2.0_wp * dy )                   &
+          THEN
              message_string = 'Tunnel width too small'
              CALL message( 'init_grid', 'PA0455', 1, 2, 0, 6, 0 )
@@ -808,10 +1736,10 @@
              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 ) )
+                                        ( 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_3d = 0
+          topo = 0
           DO  i = nxl, nxr
              DO  j = nys, nyn
@@ -825,5 +1753,5 @@
                             ( ( 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 *                                &
@@ -837,5 +1765,5 @@
 !--             Set flags at x-y-positions without any tunnel surface
                 IF ( hv_out - hv_in == 0.0_wp )  THEN
-                   topo_3d(nzb+1:nzt+1,j,i) = IBSET( topo_3d(nzb+1:nzt+1,j,i), 0 )
+                   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
@@ -846,7 +1774,7 @@
                       IF ( hv_out - hv_in == th )  THEN
                          IF ( zw(k) <= hv_out )  THEN
-                            topo_3d(k,j,i) = IBCLR( topo_3d(k,j,i), 0 )
+                            topo(k,j,i) = IBCLR( topo(k,j,i), 0 )
                          ELSE
-                            topo_3d(k,j,i) = IBSET( topo_3d(k,j,i), 0 )
+                            topo(k,j,i) = IBSET( topo(k,j,i), 0 )
                          ENDIF
                       ENDIF
@@ -855,9 +1783,9 @@
                       IF ( hv_out - hv_in == td )  THEN
                          IF ( zw(k) <= hv_in )  THEN 
-                            topo_3d(k,j,i) = IBSET( topo_3d(k,j,i), 0 )
+                            topo(k,j,i) = IBSET( topo(k,j,i), 0 )
                          ELSEIF ( zw(k) > hv_in  .AND.  zw(k) <= hv_out )  THEN 
-                            topo_3d(k,j,i) = IBCLR( topo_3d(k,j,i), 0 )
+                            topo(k,j,i) = IBCLR( topo(k,j,i), 0 )
                          ELSEIF ( zw(k) > hv_out )  THEN 
-                            topo_3d(k,j,i) = IBSET( topo_3d(k,j,i), 0 )
+                            topo(k,j,i) = IBSET( topo(k,j,i), 0 )
                          ENDIF
                       ENDIF
@@ -867,189 +1795,34 @@
           ENDDO
 
-          nzb_local = 0
-!
-!--       level of detail is required for output routines. Here, 3D topography. 
-          lod = 2
-
-          CALL exchange_horiz_int( topo_3d, nbgp )
+          CALL exchange_horiz_int( topo, nys, nyn, nxl, nxr, nzt, nbgp )
 
        CASE ( 'read_from_file' )
-
-          ALLOCATE ( oro_height(nys:nyn,nxl:nxr)  )
-          ALLOCATE ( topo_height(nys:nyn,nxl:nxr) )
-          oro_height  = 0.0_wp
-          topo_height = 0.0_wp
-
-          DO  ii = 0, io_blocks-1
-             IF ( ii == io_group )  THEN
-
-!
-!--             Arbitrary irregular topography data in PALM format (exactly
-!--             matching the grid size and total domain size). 
-!--             First, check if NetCDF file for topography exist or not.
-!--             This case, read topography from NetCDF, else read it from 
-!--             ASCII file.
-#if defined ( __netcdf )
-                INQUIRE( FILE='TOPOGRAPHY_DATA_NC'//TRIM( coupling_char ),     &
-                         EXIST=netcdf_extend )
-!
-!--             NetCDF branch    
-                IF ( netcdf_extend )  THEN
-!
-!--                Open file in read-only mode
-                   CALL netcdf_open_read_file( 'TOPOGRAPHY_DATA_NC',           &
-                                               id_topo, 20 )  !Error number still need to be set properly 
-
-!
-!--                Read terrain height. Reading is done PE-wise, i.e. each
-!--                processor reads its own domain. Reading is realized
-!--                via looping over x-dimension, i.e. calling 
-!--                netcdf_get_variable reads topography along y for given x. 
-!--                Orography is 2D. 
-                   DO  i = nxl, nxr
-                      CALL netcdf_get_variable( id_topo, 'orography_0',        &
-                                                i, oro_height(:,i), 20 )  !Error number still need to be set properly 
-                   ENDDO
-!
-!--                Read attribute lod (level of detail), required for variable 
-!--                buildings_0 
-                   CALL netcdf_get_attribute( id_topo, "lod", lod, .FALSE.,    &
-                                              20, 'buildings_0' ) !Error number still need to be set properly 
-!
-!--                Read building height
-!--                2D for lod = 1, 3D for lod = 2
-                   IF ( lod == 1 )  THEN
-                      DO  i = nxl, nxr
-                         CALL netcdf_get_variable( id_topo, 'buildings_0',     &
-                                                   i, topo_height(:,i), 20 )  !Error number still need to be set properly 
-                      ENDDO
-
-                   ELSEIF ( lod == 2 )  THEN
-!
-!--                   Allocate 1-byte integer dummy array to read 3D topography
-                      ALLOCATE( topo_3d_read(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-!
-!--                   Read data PE-wise. Read yz-slices.
-                      DO  i = nxl, nxr
-                         DO  j = nys, nyn
-                            CALL netcdf_get_variable( id_topo, 'buildings_0',  &
-                                                      i, j, topo_3d_read(:,j,i), 20 )  !Error number still need to be set properly 
-                         ENDDO
-                      ENDDO
-                   ELSE 
-                      message_string = 'NetCDF attribute lod ' //              &
-                                       '(level of detail) is not set properly.'
-                      CALL message( 'init_grid', 'PA0457', 1, 2, 0, 6, 0 )
-                   ENDIF
-!
-!--                On file, 3D topography grid points is classified with 1, 
-!--                atmosphere is classified with 0, contrary to the internal 
-!--                treatment. Hence, conversion is required. Moreover, set 
-!--                topography array to zero at lowest grid level. 
-                   topo_3d = MERGE( 0, 1, topo_3d_read == 1 )
-                   topo_3d(nzb,:,:) = 0 
-!
-!--                Deallocate dummy array
-                   DEALLOCATE( topo_3d_read )
-!
-!--                Close topography input file
-                   CALL netcdf_close_file( id_topo, 20 )
-#endif
-
-!
-!--             ASCII branch. Please note, reading of 3D topography is not
-!--             supported in ASCII format. Further, no distinction is made 
-!--             between orography and buildings
-                ELSE
-
-                   OPEN( 90, FILE='TOPOGRAPHY_DATA'//TRIM( coupling_char ),    &
-                         STATUS='OLD', FORM='FORMATTED', ERR=10 )
-!
-!--                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
-                   DO  j = nyn, nys, -1
-                      READ( 90, *, ERR=11, END=11 )                            &
-                                              ( dum, i = 0, nxl-1 ),           &
-                                              ( topo_height(j,i), i = nxl, nxr )
-                   ENDDO
-
-                   GOTO 12
-          
- 10                message_string = 'file TOPOGRAPHY'//TRIM( coupling_char )// &
-                                    ' does not exist'
-                   CALL message( 'init_grid', 'PA0208', 1, 2, 0, 6, 0 )
-
- 11                message_string = 'errors in file TOPOGRAPHY_DATA'//         &
-                                    TRIM( coupling_char )
-                   CALL message( 'init_grid', 'PA0209', 1, 2, 0, 6, 0 )
-
- 12                CLOSE( 90 )
-
-                ENDIF
-
-             ENDIF
-#if defined( __parallel )
-             CALL MPI_BARRIER( comm2d, ierr )
-#endif
-          ENDDO
-
-!
-!--       Calculate the index height of the topography
-          nzb_local = 0
-          DO  i = nxl, nxr
-             DO  j = nys, nyn
-                IF ( .NOT. ocean )  THEN
-                   nzb_local(j,i) = MINLOC( ABS( zw - topo_height(j,i)         &
-                                                    - oro_height(j,i) ), 1 ) - 1
-                   IF ( ABS( zw(nzb_local(j,i)  ) - topo_height(j,i)           &
-                                                  - oro_height(j,i)  ) ==      &
-                        ABS( zw(nzb_local(j,i)+1) - topo_height(j,i)           &
-                                                  - oro_height(j,i)  )    )    &
-                      nzb_local(j,i) = nzb_local(j,i) + 1
-                ELSE
-                   nzb_local(j,i) = MINLOC( ABS( zw - zw(0)                    &
-                                                    - topo_height(j,i)         &
-                                                    - oro_height(j,i) ), 1 ) - 1
-                   IF ( ABS( zw(nzb_local(j,i)  ) - zw(0)                      &
-                                                  - topo_height(j,i)           &
-                                                  - oro_height(j,i)  )  ==     &
-                        ABS( zw(nzb_local(j,i)+1) - zw(0)                      &
-                                                  - topo_height(j,i)           &
-                                                  - oro_height(j,i)  )    )    &
-                      nzb_local(j,i) = nzb_local(j,i) + 1
-                ENDIF
-
-             ENDDO
-          ENDDO
-
-          DEALLOCATE ( oro_height  )
-          DEALLOCATE ( topo_height )
-!
-!--       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.
-!--       For now, check only for holes and fill them to the lowest height level
-!--       of the directly adjoining grid points along x- and y- direction. 
-!--       Before checking for holes, set lateral boundary conditions for 
-!--       topography. After hole-filling, boundary conditions must be set again!
-          CALL exchange_horiz_2d_int( nzb_local, nys, nyn, nxl, nxr, nbgp )
-          
+!
+!--       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
-                nzb_local(-1,:)   = nzb_local(0,:)
-                nzb_local(-2,:)   = nzb_local(0,:)
-                nzb_local(-3,:)   = nzb_local(0,:)
-             ELSEIF ( nyn == ny )  THEN
-                nzb_local(ny+1,:) = nzb_local(ny,:)
-                nzb_local(ny+2,:) = nzb_local(ny,:)
-                nzb_local(ny+3,:) = nzb_local(ny,:)
+                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
@@ -1057,118 +1830,30 @@
           IF ( .NOT. bc_lr_cyc )  THEN
              IF ( nxl == 0  )  THEN
-                nzb_local(:,-1)   = nzb_local(:,0)
-                nzb_local(:,-2)   = nzb_local(:,0)
-                nzb_local(:,-3)   = nzb_local(:,0)
-             ELSEIF ( nxr == nx )  THEN
-                nzb_local(:,nx+1) = nzb_local(:,nx)
-                nzb_local(:,nx+2) = nzb_local(:,nx)          
-                nzb_local(:,nx+3) = nzb_local(:,nx)          
-             ENDIF          
+                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
 
-          num_hole_l = 0
-          DO i = nxl, nxr
-             DO j = nys, nyn
-
-                num_wall = 0
-
-                IF ( nzb_local(j-1,i) > nzb_local(j,i) )                       &
-                   num_wall = num_wall + 1
-                IF ( nzb_local(j+1,i) > nzb_local(j,i) )                       &
-                   num_wall = num_wall + 1
-                IF ( nzb_local(j,i-1) > nzb_local(j,i) )                       &
-                   num_wall = num_wall + 1
-                IF ( nzb_local(j,i+1) > nzb_local(j,i) )                       &
-                   num_wall = num_wall + 1
-
-                IF ( num_wall == 4 )  THEN
-                   nzb_local(j,i) = MIN( nzb_local(j-1,i), nzb_local(j+1,i),   &
-                                         nzb_local(j,i-1), nzb_local(j,i+1) )
-                   num_hole_l     = num_hole_l + 1
-                ENDIF
-             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    
-!
-!--       Create an informative message if any hole was removed.
-          IF ( num_hole > 0 )  THEN
-             WRITE( message_string, * ) num_hole, 'hole(s) resolved by only '//&
-                                                  'one grid point were filled'
-             CALL message( 'init_grid', 'PA0430', 0, 0, 0, 6, 0 )
-          ENDIF
-
-!
-!--       Set bit array to mask topography. Only required for lod = 1
-          IF ( lod == 1 )  THEN
-             DO  i = nxlg, nxrg
-                DO  j = nysg, nyng
-                   topo_3d(nzb_local(j,i)+1:nzt+1,j,i) =                          &
-                                 IBSET( topo_3d(nzb_local(j,i)+1:nzt+1,j,i), 0 ) 
-                ENDDO
-             ENDDO
-          ENDIF
-!
-!--       Exchange ghost-points, as well as add cyclic or Neumann boundary 
-!--       conditions.
-          CALL exchange_horiz_int( topo_3d, nbgp )
-          CALL exchange_horiz_2d_int( nzb_local, nys, nyn, nxl, nxr, 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,:)
-
-             IF ( nys == 0  )  nzb_local(-1,:)   = nzb_local(0,:)
-             IF ( nyn == ny )  nzb_local(ny+1,:) = nzb_local(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)     
-
-             IF ( nxl == 0  )  nzb_local(:,-1)   = nzb_local(:,0)
-             IF ( nxr == nx )  nzb_local(:,nx+1) = nzb_local(:,nx)          
-          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_3d )
+          CALL user_init_grid( topo )
+          CALL filter_topography( topo )
 
     END SELECT
 !
 !-- Consistency checks and index array initialization are only required for
-!-- non-flat topography, also the initialization of topography height arrays
-!-- zu_s_inner and zw_w_inner
+!-- non-flat topography.
     IF ( TRIM( topography ) /= 'flat' )  THEN
-#if defined( __parallel )
-       CALL MPI_ALLREDUCE( MAXVAL( nzb_local ), nzb_local_max, 1, MPI_INTEGER, &
-                           MPI_MAX, comm2d, ierr )
-       CALL MPI_ALLREDUCE( MINVAL( nzb_local ), nzb_local_min, 1, MPI_INTEGER, &
-                           MPI_MIN, comm2d, ierr )                           
-#else
-       nzb_local_max = MAXVAL( nzb_local )
-       nzb_local_min = MINVAL( nzb_local )
-#endif
-
-!
-!--    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
 !
 !--    In case of non-flat topography, check whether the convention how to 
@@ -1184,9 +1869,9 @@
 !--          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'', ',                      &
-                  '''single_street_canyon'' & or ''read_from_file''.',         &
-                  ' & Choose ''cell_edge'' or ''cell_center''.'
+               'The value for "topography_grid_convention" ',                  &
+               'is not set. Its default value is & only valid for ',           &
+               '"topography" = ''single_building'', ',                         &
+               '''single_street_canyon'' & or ''read_from_file''.',            &
+               ' & Choose ''cell_edge'' or ''cell_center''.'
              CALL message( 'init_grid', 'PA0239', 1, 2, 0, 6, 0 )
           ELSE
@@ -1204,44 +1889,9 @@
                 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''.'
+            '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
 
-!
-!--    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 ) /= 'single_building' .AND.                   &
-               TRIM( topography ) /= 'single_street_canyon' .AND.              &
-               TRIM( topography ) /= 'read_from_file' )  THEN
-!--          The default value is not applicable here, because it is only valid
-!--          for the two standard cases 'single_building' 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'', ',                      &
-                  '''single_street_canyon'' & 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' )  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
@@ -1259,269 +1909,80 @@
           DO  j = nys+1, nyn+1
              DO  i = nxl-1, nxr
-                nzb_local(j,i) = MIN( nzb_local(j,i), nzb_local(j,i+1) )
-             ENDDO
-          ENDDO
-!
-!--       Exchange ghost points
-          CALL exchange_horiz_2d_int( nzb_local, nys, nyn, nxl, nxr, nbgp )
-
-          DO  i = nxl, nxr+1
-             DO  j = nys-1, nyn
-                nzb_local(j,i) = MIN( nzb_local(j,i), nzb_local(j+1,i) )
-             ENDDO
-          ENDDO  
-!
-!--       Exchange ghost points          
-          CALL exchange_horiz_2d_int( nzb_local, nys, nyn, nxl, nxr, nbgp )
-!
-!--       Apply cell-edge convention also for 3D topo array. The former setting
-!--       of nzb_local will be removed later. 
-          DO  j = nys+1, nyn+1
-             DO  i = nxl-1, nxr
                 DO  k = nzb, nzt+1
-                   IF ( BTEST( topo_3d(k,j,i), 0 )  .OR.                       &
-                        BTEST( topo_3d(k,j,i+1), 0 ) )                         &
-                      topo_3d(k,j,i) = IBSET( topo_3d(k,j,i), 0 )
+                   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_3d, nbgp )   
+          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_3d(k,j,i), 0 )  .OR.                       &
-                        BTEST( topo_3d(k,j+1,i), 0 ) )                         &
-                      topo_3d(k,j,i) = IBSET( topo_3d(k,j,i), 0 )
+                   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_3d, nbgp )
+          CALL exchange_horiz_int( topo, nys, nyn, nxl, nxr, nzt, nbgp )
    
        ENDIF
-      
-!
-!--    Initialize index arrays nzb_s_inner and nzb_w_inner
-
-       nzb_s_inner = nzb_local
-       nzb_w_inner = nzb_local
-
-!
-!--    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 = nys, nyn
-          DO  i = nxl, nxr
-             nzb_tmp(j,i) = MAX( nzb_local(j,i-1), nzb_local(j,i),             &
-                                 nzb_local(j,i+1) )
-          ENDDO
-       ENDDO
-       
-       CALL exchange_horiz_2d_int( nzb_tmp, nys, nyn, nxl, nxr, nbgp )
-       
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             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 ( nyn == 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 = nys, nyn
-          DO  i = nxl, nxr
-             nzb_tmp(j,i) = MAX( nzb_local(j,i-1), nzb_local(j,i) )
-          ENDDO
-       ENDDO
-       
-       CALL exchange_horiz_2d_int( nzb_tmp, nys, nyn, nxl, nxr, nbgp )
-       
-       nzb_u_inner = nzb_tmp
-!
-!--    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 ( nyn == 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 = nxl, nxr
-          DO  j = nys, nyn
-             nzb_tmp(j,i) = MAX( nzb_local(j-1,i), nzb_local(j,i) )
-          ENDDO
-       ENDDO
-       
-       CALL exchange_horiz_2d_int( nzb_tmp, nys, nyn, nxl, nxr, nbgp )      
-       nzb_v_inner = nzb_tmp
-
-!
-!--    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, nys, nyn, nxl, nxr, nbgp )
-       CALL exchange_horiz_2d_int( nzb_u_outer, nys, nyn, nxl, nxr, nbgp )
-       CALL exchange_horiz_2d_int( nzb_v_inner, nys, nyn, nxl, nxr, nbgp )
-       CALL exchange_horiz_2d_int( nzb_v_outer, nys, nyn, nxl, nxr, nbgp )
-       CALL exchange_horiz_2d_int( nzb_w_outer, nys, nyn, nxl, nxr, nbgp )
-       CALL exchange_horiz_2d_int( nzb_s_outer, nys, nyn, nxl, nxr, nbgp )
-
     ENDIF
-!
-!-- Deallocate temporary array, as it might be reused for different
-!-- grid-levels further below.
-    DEALLOCATE( nzb_tmp )
-
-!
-!-- Determine the maximum level of topography. It is used for
-!-- steering the degradation of order of the applied advection scheme.
-!-- In case of non-cyclic lateral boundaries, the order of the advection
-!-- scheme has to be reduced up to nzt (required at the lateral boundaries).
-    k_top = 0
+
+
+ END SUBROUTINE init_topo
+
+ SUBROUTINE set_topo_flags(topo)
+
+    USE control_parameters,                                                    &
+        ONLY:  bc_lr_cyc, bc_ns_cyc, constant_flux_layer, land_surface,        &
+               use_surface_fluxes, use_top_fluxes, urban_surface
+
+    USE indices,                                                               &
+        ONLY:  nbgp, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, nz,   &
+               nzb, nzt, wall_flags_0
+
+    USE kinds
+
+    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), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  topo !< input array for 3D topography and dummy array for setting "outer"-flags
+
+    ALLOCATE( wall_flags_0(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
+    wall_flags_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
-             k_top = MAX( k_top, MERGE( k, 0,                                  &
-                                        .NOT. BTEST( topo_3d(k,j,i), 0 ) ) )
+          DO  k = nzb, nzt+1
+!
+!--          scalar grid
+             IF ( BTEST( topo(k,j,i), 0 ) )                                 &
+                wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 0 )
+!
+!--          u grid
+             IF ( BTEST( topo(k,j,i),   0 )  .AND.                          &
+                  BTEST( topo(k,j,i-1), 0 ) )                               &
+                wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 1 )
+!
+!--          v grid
+             IF ( BTEST( topo(k,j,i),   0 )  .AND.                          &
+                  BTEST( topo(k,j-1,i), 0 ) )                               &
+                 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 2 )
+
           ENDDO
-       ENDDO
-    ENDDO
-#if defined( __parallel )
-    CALL MPI_ALLREDUCE( k_top + 1, nzb_max, 1, MPI_INTEGER,                    & !is +1 really necessary here?
-                        MPI_MAX, comm2d, ierr )
-#else
-    nzb_max = k_top + 1
-#endif
-    IF ( inflow_l .OR. outflow_l .OR. inflow_r .OR. outflow_r .OR.             &
-         inflow_n .OR. outflow_n .OR. inflow_s .OR. outflow_s .OR.             &
-         nest_domain )                                                         &
-    THEN
-       nzb_max = nzt
-    ENDIF
-!
-!-- Finally, if topography extents up to the model top, limit nzb_max to nzt.
-    nzb_max = MIN( nzb_max, nzt ) 
-
-!
-!-- 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 ( constant_flux_layer  .OR.  use_surface_fluxes )  THEN
-       nzb_diff_s_inner   = nzb_s_inner + 2
-       nzb_diff_s_outer   = nzb_s_outer + 2
-    ELSE
-       nzb_diff_s_inner   = nzb_s_inner + 1
-       nzb_diff_s_outer   = nzb_s_outer + 1
-    ENDIF
-
-!
-!-- Set-up topography flags. First, set flags only for s, u, v and w-grid.
-!-- Further special flags will be set in following loops. 
-    wall_flags_0 = 0
-    DO  j = nys, nyn
-       DO  i = nxl, nxr
-          DO  k = nzb, nzt+1
-!
-!--          scalar grid
-             IF ( BTEST( topo_3d(k,j,i), 0 ) )                                 &
-                wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 0 )
-!
-!--          v grid
-             IF ( BTEST( topo_3d(k,j,i),   0 )  .AND.                          &
-                  BTEST( topo_3d(k,j-1,i), 0 ) )                               &
-                wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 2 )
-!
-!--     To do: set outer arrays on basis of topo_3d array, adjust for downward-facing walls
-!--          s grid outer array
-             IF ( k >= nzb_s_outer(j,i) )                                      &
-                wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 24 )
-!
-!--          s grid outer array
-             IF ( k >= nzb_u_outer(j,i) )                                      &
-                wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 26 )
-!
-!--          s grid outer array
-             IF ( k >= nzb_v_outer(j,i) )                                      &
-                wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 27 )
-!
-!--          w grid outer array
-             IF ( k >= nzb_w_outer(j,i) )                                      &
-                wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 28 )
-          ENDDO
 
           DO k = nzb, nzt
 !
 !--          w grid
-             IF ( BTEST( topo_3d(k,j,i),   0 )  .AND.                          &
-                  BTEST( topo_3d(k+1,j,i), 0 ) )                               &
+             IF ( BTEST( topo(k,j,i),   0 )  .AND.                          &
+                  BTEST( topo(k+1,j,i), 0 ) )                               &
                 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 3 )
           ENDDO
@@ -1530,13 +1991,20 @@
        ENDDO
     ENDDO
-!
-!-- u grid. Note, reverse 
-!-- memory access is required for setting flag on u-grid
-    DO  j = nys, nyn
-       DO  i = nxl, nxr
+
+    CALL exchange_horiz_int ( wall_flags_0, nys, nyn, nxl, nxr, nzt, nbgp )
+!
+!-- Set outer array for scalars to mask near-surface grid points in 
+!-- production_e
+    DO i = nxl, nxr
+       DO j = nys, nyn
           DO k = nzb, nzt+1
-             IF ( BTEST( topo_3d(k,j,i),   0 )  .AND.                          &
-                  BTEST( topo_3d(k,j,i-1), 0 ) )                               &
-                wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 1 )
+             IF ( BTEST( wall_flags_0(k,j-1,i), 0 )  .AND.                       &
+                  BTEST( wall_flags_0(k,j+1,i), 0 )  .AND.                       &
+                  BTEST( wall_flags_0(k,j,i-1), 0 )  .AND.                       &
+                  BTEST( wall_flags_0(k,j-1,i-1), 0 )  .AND.                       &
+                  BTEST( wall_flags_0(k,j+1,i-1), 0 )  .AND.                       &
+                  BTEST( wall_flags_0(k,j-1,i+1), 0 )  .AND.                       &
+                  BTEST( wall_flags_0(k,j+1,i+1), 0 ) )                            &
+                wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 24 )
           ENDDO
        ENDDO
@@ -1576,4 +2044,5 @@
              wall_flags_0(nzt+1,j,i) = IBCLR( wall_flags_0(nzt+1,j,i), 9 )
 
+
           DO k = nzb+1, nzt
 !
@@ -1634,5 +2103,5 @@
              IF ( BTEST( wall_flags_0(k-1,j,i), 0 )  .AND.                     &
             .NOT. BTEST( wall_flags_0(k,j,i), 0   ) )                          & 
-                wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 13 ) 
+                 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 13 ) 
 !
 !--          Downward facing wall on u grid
@@ -1665,10 +2134,10 @@
                 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 14 )
 
-!
+!   
 !--          Upward facing wall on v grid
              IF ( .NOT. BTEST( wall_flags_0(k,j,i),   2 )  .AND.               &
                         BTEST( wall_flags_0(k+1,j,i), 2 ) )                    & 
                 wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 16 )
-
+   
 !
 !--          Upward facing wall on w grid
@@ -1681,5 +2150,5 @@
                   BTEST( wall_flags_0(k,j,i), 12 ) .OR.                        &
                   BTEST( wall_flags_0(k,j,i), 13 ) )                           &
-                wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 22 )
+                   wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 22 )
 !
 !--          Special flag on scalar grid, nzb_diff_s_inner - 1, required for 
@@ -1688,10 +2157,10 @@
                 IF ( BTEST( wall_flags_0(k,j,i),   0 )  .AND.                  &
                      BTEST( wall_flags_0(k+1,j,i), 0 ) )                       &
-                   wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 23 )
+                  wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 23 )
              ELSE
                 IF ( BTEST( wall_flags_0(k,j,i), 22 ) )                        &
                    wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 23 )
              ENDIF
-
+   
 
           ENDDO
@@ -1701,334 +2170,65 @@
     ENDDO
 !
+!-- Finally, set identification flags indicating natural terrain or buildings.
+!-- Natural terrain grid points.
+    IF ( land_surface )  THEN
+       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_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 5 )
+             ENDDO
+          ENDDO
+       ENDDO
+    ENDIF
+!
+!-- Building grid points.
+    IF ( urban_surface )  THEN
+       DO i = nxl, nxr
+          DO j = nys, nyn
+             DO k = nzb, nzt+1
+                IF ( BTEST( topo(k,j,i), 2 ) )                                 &
+                   wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 6 )
+             ENDDO
+          ENDDO
+       ENDDO
+    ENDIF
+
+!
 !-- Exchange ghost points for wall flags
-    CALL exchange_horiz_int( wall_flags_0, nbgp )
+    CALL exchange_horiz_int( wall_flags_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  )  wall_flags_0(:,-1,:)   = wall_flags_0(:,0,:)
-       IF ( nyn == ny )  wall_flags_0(:,ny+1,:) = wall_flags_0(:,ny,:)
+       IF ( nys == 0  )  THEN
+          DO  i = 1, nbgp     
+             wall_flags_0(:,nys-i,:)   = wall_flags_0(:,nys,:)
+          ENDDO
+       ENDIF
+       IF ( nyn == ny )  THEN
+          DO  i = 1, nbgp  
+             wall_flags_0(:,nyn+i,:) = wall_flags_0(:,nyn,:)
+          ENDDO
+       ENDIF
     ENDIF
     IF ( .NOT. bc_lr_cyc )  THEN
-       IF ( nxl == 0  )  wall_flags_0(:,:,-1)   = wall_flags_0(:,:,0)
-       IF ( nxr == nx )  wall_flags_0(:,:,nx+1) = wall_flags_0(:,:,nx)           
+       IF ( nxl == 0  )  THEN
+          DO  i = 1, nbgp   
+             wall_flags_0(:,:,nxl-i)   = wall_flags_0(:,:,nxl)
+          ENDDO
+       ENDIF
+       IF ( nxr == nx )  THEN 
+          DO  i = 1, nbgp   
+             wall_flags_0(:,:,nxr+i) = wall_flags_0(:,:,nxr)     
+          ENDDO
+       ENDIF      
     ENDIF
 
-!
-!-- Initialize boundary conditions via surface type
-    CALL init_bc
-!
-!-- Allocate and set topography height arrays required for data output
-    IF ( TRIM( topography ) /= 'flat' )  THEN
-!
-!--    Allocate and set the arrays containing the topography height
-
-       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) )
-       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_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( get_topography_top_index( j, i, 's' ) )
-!
-!--          Topography height on w grid. Therefore, determine index of 
-!--          upward-facing surface element on w grid.
-             zw_w_inner(i,j) = zw( get_topography_top_index( j, i, 's' ) )
-          ENDDO
-       ENDDO
-
-    ENDIF
-
-!
-!-- Calculate wall flag arrays for the multigrid method.
-!-- Please note, wall flags are only applied in the not cache-optimized 
-!-- version.
-    IF ( psolver == 'multigrid_noopt' )  THEN
-
-!
-!--    Gridpoint 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 ghoist points are required, in order to
-!--          calculate flags() on the interior ghost point. 
-             ALLOCATE( nzb_tmp(nys_l-2:nyn_l+2,nxl_l-2:nxr_l+2) )
-             nzb_tmp = 0
-             
-             DO  i = nxl_l, nxr_l
-                DO  j = nys_l, nyn_l
-                   nzb_tmp(j,i) = nzb_local(j*inc,i*inc)
-                ENDDO
-             ENDDO
-!
-!--          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. The alternative would be to 
-!--          exchange 3D-INTEGER array flags on the respective multigrid level.
-             CALL exchange_horiz_2d_int( nzb_tmp, nys_l, nyn_l, nxl_l, nxr_l, 2 )
-!
-!--          Set non-cyclic boundary conditions on respective multigrid level
-             IF ( .NOT. bc_ns_cyc )  THEN
-                IF ( inflow_s .OR. outflow_s .OR. nest_bound_s  )  THEN
-                   nzb_tmp(-2,:) = nzb_tmp(0,:)
-                   nzb_tmp(-1,:) = nzb_tmp(0,:)
-                ENDIF
-                IF ( inflow_n .OR. outflow_n .OR. nest_bound_n )  THEN
-                   nzb_tmp(nyn_l+2,:) = nzb_tmp(nyn_l,:)
-                   nzb_tmp(nyn_l+1,:) = nzb_tmp(nyn_l,:)
-                ENDIF
-             ENDIF
-             IF ( .NOT. bc_lr_cyc )  THEN
-                IF ( inflow_l .OR. outflow_l .OR. nest_bound_l  )  THEN
-                   nzb_tmp(:,-2) = nzb_tmp(:,0)
-                   nzb_tmp(:,-1) = nzb_tmp(:,0)
-                ENDIF
-                IF ( inflow_r .OR. outflow_r .OR. nest_bound_r )  THEN
-                   nzb_tmp(:,nxr_l+1) = nzb_tmp(:,nxr_l)    
-                   nzb_tmp(:,nxr_l+2) = nzb_tmp(:,nxr_l)      
-                ENDIF        
-             ENDIF
-                       
-             DO  i = nxl_l-1, nxr_l+1
-                DO  j = nys_l-1, nyn_l+1
-                   DO  k = nzb, nzt_l+1     
-!
-!--                   Inside/outside building (inside building does not need
-!--                   further tests for walls)
-                      IF ( k*inc <= nzb_tmp(j,i) )  THEN
-
-                         flags(k,j,i) = IBSET( flags(k,j,i), 6 )
-
-                      ELSE
-!
-!--                      Bottom wall
-                         IF ( (k-1)*inc <= nzb_tmp(j,i) )  THEN
-                            flags(k,j,i) = IBSET( flags(k,j,i), 0 )
-                         ENDIF
-!
-!--                      South wall
-                         IF ( k*inc <= nzb_tmp(j-1,i) )  THEN
-                            flags(k,j,i) = IBSET( flags(k,j,i), 2 )
-                         ENDIF
-!
-!--                      North wall
-                         IF ( k*inc <= nzb_tmp(j+1,i) )  THEN
-                            flags(k,j,i) = IBSET( flags(k,j,i), 3 )
-                         ENDIF
-!
-!--                      Left wall
-                         IF ( k*inc <= nzb_tmp(j,i-1) )  THEN
-                            flags(k,j,i) = IBSET( flags(k,j,i), 4 )
-                         ENDIF
-!
-!--                      Right wall
-                         IF ( k*inc <= nzb_tmp(j,i+1) )  THEN
-                            flags(k,j,i) = IBSET( flags(k,j,i), 5 )
-                         ENDIF
-
-                      ENDIF
-                            
-                   ENDDO
-                ENDDO
-             ENDDO
-
-             DEALLOCATE( nzb_tmp )
-
-          ENDIF
-
-          inc = inc * 2
-
-       ENDDO
-!
-!--    Reset grid_level to "normal" grid
-       grid_level = 0
-       
-    ENDIF
-!
-!-- Allocate flags needed for masking walls. Even though these flags are only
-!-- required in the ws-scheme, the arrays need to be allocated here as they are 
-!-- used in OpenACC directives. 
-    ALLOCATE( advc_flags_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                     &
-              advc_flags_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
-    advc_flags_1 = 0
-    advc_flags_2 = 0
-!
-!-- Init flags for ws-scheme to degrade order of the numerics near walls, i.e. 
-!-- to decrease the numerical stencil appropriately.
-    IF ( momentum_advec == 'ws-scheme'  .OR.  scalar_advec == 'ws-scheme'      &
-       )  THEN
-       CALL ws_init_flags
-    ENDIF
-
-!
-!-- 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
-    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_0(k,j,i), 0 ) )  THEN
-!
-!--             Check for neighbouring grid-points.
-!--             Vertical distance, down
-                IF ( .NOT. BTEST( wall_flags_0(k-1,j,i), 0 ) )                 &
-                   l_wall(k,j,i) = MIN( l_grid(k), zu(k) - zw(k-1) )
-!
-!--             Vertical distance, up
-                IF ( .NOT. BTEST( wall_flags_0(k+1,j,i), 0 ) )                 &
-                   l_wall(k,j,i) = MIN( l_grid(k), zw(k) - zu(k) )
-!
-!--             y-distance
-                IF ( .NOT. BTEST( wall_flags_0(k,j-1,i), 0 )  .OR.             &
-                     .NOT. BTEST( wall_flags_0(k,j+1,i), 0 ) )                 &
-                   l_wall(k,j,i) = MIN( l_wall(k,j,i), l_grid(k), 0.5_wp * dy )
-!
-!--             x-distance
-                IF ( .NOT. BTEST( wall_flags_0(k,j,i-1), 0 )  .OR.             &
-                     .NOT. BTEST( wall_flags_0(k,j,i+1), 0 ) )                 &
-                   l_wall(k,j,i) = MIN( l_wall(k,j,i), l_grid(k), 0.5_wp * dx )
-!
-!--              yz-distance (vertical edges, down)
-                 IF ( .NOT. BTEST( wall_flags_0(k-1,j-1,i), 0 )  .OR.          &
-                      .NOT. BTEST( wall_flags_0(k-1,j+1,i), 0 )  )             &
-                   l_wall(k,j,i) = MIN( l_wall(k,j,i), l_grid(k),              &
-                                        SQRT( 0.25_wp * dy**2 +                &
-                                       ( zu(k) - zw(k-1) )**2 ) )
-!
-!--              yz-distance (vertical edges, up)
-                 IF ( .NOT. BTEST( wall_flags_0(k+1,j-1,i), 0 )  .OR.          &
-                      .NOT. BTEST( wall_flags_0(k+1,j+1,i), 0 )  )             &
-                   l_wall(k,j,i) = MIN( l_wall(k,j,i), l_grid(k),              &
-                                        SQRT( 0.25_wp * dy**2 +                &
-                                       ( zw(k) - zu(k) )**2 ) )
-!
-!--              xz-distance (vertical edges, down)
-                 IF ( .NOT. BTEST( wall_flags_0(k-1,j,i-1), 0 )  .OR.          &
-                      .NOT. BTEST( wall_flags_0(k-1,j,i+1), 0 )  )             &
-                   l_wall(k,j,i) = MIN( l_wall(k,j,i), l_grid(k),              &
-                                        SQRT( 0.25_wp * dx**2 +                &
-                                       ( zu(k) - zw(k-1) )**2 ) )
-!
-!--              xz-distance (vertical edges, up)
-                 IF ( .NOT. BTEST( wall_flags_0(k+1,j,i-1), 0 )  .OR.          &
-                      .NOT. BTEST( wall_flags_0(k+1,j,i+1), 0 )  )             &
-                   l_wall(k,j,i) = MIN( l_wall(k,j,i), l_grid(k),              &
-                                        SQRT( 0.25_wp * dx**2 +                &
-                                       ( zw(k) - zu(k) )**2 ) )
-!
-!--             xy-distance (horizontal edges)
-                IF ( .NOT. BTEST( wall_flags_0(k,j-1,i-1), 0 )  .OR.           &
-                     .NOT. BTEST( wall_flags_0(k,j+1,i-1), 0 )  .OR.           &
-                     .NOT. BTEST( wall_flags_0(k,j-1,i+1), 0 )  .OR.           &
-                     .NOT. BTEST( wall_flags_0(k,j+1,i+1), 0 ) )               &
-                   l_wall(k,j,i) = MIN( l_wall(k,j,i), l_grid(k),              &
-                                        SQRT( 0.25_wp * ( dx**2 + dy**2 ) ) )
-!
-!--             xyz distance (vertical and horizontal edges, down)
-                IF ( .NOT. BTEST( wall_flags_0(k-1,j-1,i-1), 0 )  .OR.         &
-                     .NOT. BTEST( wall_flags_0(k-1,j+1,i-1), 0 )  .OR.         &
-                     .NOT. BTEST( wall_flags_0(k-1,j-1,i+1), 0 )  .OR.         &
-                     .NOT. BTEST( wall_flags_0(k-1,j+1,i+1), 0 ) )             &
-                   l_wall(k,j,i) = MIN( l_wall(k,j,i), l_grid(k),              &
-                                        SQRT( 0.25_wp * ( dx**2 + dy**2 )      &
-                                              +  ( zu(k) - zw(k-1) )**2  ) )
-!
-!--             xyz distance (vertical and horizontal edges, up)
-                IF ( .NOT. BTEST( wall_flags_0(k+1,j-1,i-1), 0 )  .OR.         &
-                     .NOT. BTEST( wall_flags_0(k+1,j+1,i-1), 0 )  .OR.         &
-                     .NOT. BTEST( wall_flags_0(k+1,j-1,i+1), 0 )  .OR.         &
-                     .NOT. BTEST( wall_flags_0(k+1,j+1,i+1), 0 ) )             &
-                   l_wall(k,j,i) = MIN( l_wall(k,j,i), l_grid(k),              &
-                                        SQRT( 0.25_wp * ( dx**2 + dy**2 )      &
-                                              +  ( zw(k) - zu(k) )**2  ) )
-                  
-             ENDIF
-          ENDDO
-       ENDDO
-    ENDDO
-!
-!-- Set lateral boundary conditions for l_wall
-    CALL exchange_horiz( l_wall, nbgp )     
-
-!
-!-- Vertical nesting: communicate vertical grid level arrays between fine and
-!-- coarse grid
-    IF ( vnested )  CALL vnest_init_grid
-
- END SUBROUTINE init_grid
+
+ END SUBROUTINE set_topo_flags
+
+
+
Index: palm/trunk/SOURCE/init_masks.f90
===================================================================
--- palm/trunk/SOURCE/init_masks.f90	(revision 2689)
+++ palm/trunk/SOURCE/init_masks.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file init_masks.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/init_ocean.f90
===================================================================
--- palm/trunk/SOURCE/init_ocean.f90	(revision 2689)
+++ palm/trunk/SOURCE/init_ocean.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file init_ocean.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/init_pegrid.f90
===================================================================
--- palm/trunk/SOURCE/init_pegrid.f90	(revision 2689)
+++ palm/trunk/SOURCE/init_pegrid.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file init_pegrid.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
@@ -25,4 +25,8 @@
 ! -----------------
 ! $Id$
+! 3D-Integer exchange on multigrid level (MS)
+! Forcing implemented (MS)
+! 
+! 2600 2017-11-01 14:11:20Z raasch
 ! calculation of block-I/O quantitites removed (is now done in parin)
 ! 
@@ -204,4 +208,6 @@
 !> 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
@@ -210,5 +216,6 @@
     USE control_parameters,                                                    &
         ONLY:  bc_lr, bc_ns, coupling_mode, coupling_mode_remote,              &
-               coupling_topology, gathered_size, grid_level,                   &
+               coupling_topology, force_bound_l, force_bound_n, force_bound_r, &
+               force_bound_s, gathered_size, grid_level,                       &
                grid_level_count, inflow_l, inflow_n, inflow_r, inflow_s,       &
                maximum_grid_level, message_string,                             &
@@ -352,5 +359,4 @@
     CALL MPI_CART_SHIFT( comm2d, 0, 1, pleft, pright, ierr )
     CALL MPI_CART_SHIFT( comm2d, 1, 1, psouth, pnorth, ierr )
-
 !
 !-- In case of cyclic boundary conditions, a y-shift at the boundaries in
@@ -405,5 +411,4 @@
        ENDIF
     ENDIF
-
 !
 !-- Vertical nesting: store four lists that identify partner ranks to exchange 
@@ -700,5 +705,4 @@
 #endif
 
-
 ! 
 !-- Determine the number of ghost point layers
@@ -823,5 +827,4 @@
 !-- Create custom MPI vector datatypes for contiguous data transfer
     IF ( vnested )  CALL vnest_init_pegrid_domain
-
 
 #else
@@ -1096,6 +1099,12 @@
 !-- 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_yz(0:maximum_grid_level),     &
-               type_xz(0:maximum_grid_level), type_yz(0:maximum_grid_level) )
+    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) )
 
     nxl_l = nxl; nxr_l = nxr; nys_l = nys; nyn_l = nyn; nzb_l = nzb; nzt_l = nzt
@@ -1125,4 +1134,16 @@
 
 !
+!-- 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
@@ -1131,15 +1152,33 @@
        DO  i = maximum_grid_level, 1 , -1
 !
-!--       For 3D-exchange
+!--       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)
 
-          CALL MPI_TYPE_VECTOR( nxr_l-nxl_l+3, nzt_l-nzb_l+2, ngp_yz(i), &
+          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 )
 
 
@@ -1155,6 +1194,4 @@
           CALL MPI_TYPE_COMMIT( type_y_int(i), ierr )
 
-
-
           nxl_l = nxl_l / 2
           nxr_l = nxr_l / 2
@@ -1166,15 +1203,4 @@
 
     ENDIF
-!
-!-- Define data types for exchange of 3D Integer arrays.
-    ngp_yz_int = (nzt - nzb + 2) * (nyn - nys + 1 + 2 * nbgp)
-
-    CALL MPI_TYPE_VECTOR( nxr-nxl+1+2*nbgp, nbgp*(nzt-nzb+2), ngp_yz_int, &
-                          MPI_INTEGER, type_xz_int, ierr )
-    CALL MPI_TYPE_COMMIT( type_xz_int, ierr )
-
-    CALL MPI_TYPE_VECTOR( nbgp, ngp_yz_int, ngp_yz_int, MPI_INTEGER, type_yz_int, &
-                          ierr )
-    CALL MPI_TYPE_COMMIT( type_yz_int, ierr )
 
 #endif
@@ -1190,4 +1216,6 @@
        ELSEIF ( bc_lr == 'nested' )  THEN
           nest_bound_l = .TRUE.
+       ELSEIF ( bc_lr == 'forcing' )  THEN
+          force_bound_l = .TRUE.
        ENDIF
     ENDIF
@@ -1200,4 +1228,6 @@
        ELSEIF ( bc_lr == 'nested' )  THEN
           nest_bound_r = .TRUE.
+       ELSEIF ( bc_lr == 'forcing' )  THEN
+          force_bound_r = .TRUE.
        ENDIF
     ENDIF
@@ -1210,4 +1240,6 @@
        ELSEIF ( bc_ns == 'nested' )  THEN
           nest_bound_s = .TRUE.
+       ELSEIF ( bc_ns == 'forcing' )  THEN
+          force_bound_s = .TRUE.
        ENDIF
     ENDIF
@@ -1220,4 +1252,6 @@
        ELSEIF ( bc_ns == 'nested' )  THEN
           nest_bound_n = .TRUE.
+       ELSEIF ( bc_ns == 'forcing' )  THEN
+          force_bound_n = .TRUE.
        ENDIF
     ENDIF
@@ -1295,10 +1329,10 @@
 !-- At the inflow or outflow, u or v, respectively, have to be calculated for
 !-- one more grid point.
-    IF ( inflow_l .OR. outflow_l .OR. nest_bound_l )  THEN
+    IF ( inflow_l .OR. outflow_l .OR. nest_bound_l .OR. force_bound_l )  THEN
        nxlu = nxl + 1
     ELSE
        nxlu = nxl
     ENDIF
-    IF ( inflow_s .OR. outflow_s .OR. nest_bound_s )  THEN
+    IF ( inflow_s .OR. outflow_s .OR. nest_bound_s .OR. force_bound_s )  THEN
        nysv = nys + 1
     ELSE
Index: palm/trunk/SOURCE/init_pt_anomaly.f90
===================================================================
--- palm/trunk/SOURCE/init_pt_anomaly.f90	(revision 2689)
+++ palm/trunk/SOURCE/init_pt_anomaly.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file init_pt_anomaly.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/init_rankine.f90
===================================================================
--- palm/trunk/SOURCE/init_rankine.f90	(revision 2689)
+++ palm/trunk/SOURCE/init_rankine.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file init_rankine.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/init_slope.f90
===================================================================
--- palm/trunk/SOURCE/init_slope.f90	(revision 2689)
+++ palm/trunk/SOURCE/init_slope.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file init_slope.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/interaction_droplets_ptq.f90
===================================================================
--- palm/trunk/SOURCE/interaction_droplets_ptq.f90	(revision 2689)
+++ palm/trunk/SOURCE/interaction_droplets_ptq.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file interaction_droplets_ptq.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/land_surface_model_mod.f90
===================================================================
--- palm/trunk/SOURCE/land_surface_model_mod.f90	(revision 2689)
+++ palm/trunk/SOURCE/land_surface_model_mod.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file land_surface_model_mod.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
@@ -25,4 +25,24 @@
 ! -----------------
 ! $Id$
+! Bugfix: missing USE statement for calc_mean_profile
+! do not write surface temperatures onto pt array as this might cause 
+! problems with nesting (MS)
+! Revised calculation of pt1 and qv1 (now done in surface_layer_fluxes). Bugfix
+! in calculation of surface density (cannot be done via an surface non-air 
+! temperature) (BM)
+! Bugfix: g_d was NaN for non-vegetaed surface types (BM)
+! Bugfix initialization of c_veg and lai
+! Revise data output to enable _FillValues
+! Bugfix in calcultion of r_a and rad_net_l (MS)
+! Bugfix: rad_net is not updated in case of radiation_interaction and must thu
+! be calculated again from the radiative fluxes
+! Temporary fix for cases where no soil model is used on some PEs (BM)
+! Revised input and initialization of soil and surface paramters
+! pavement_depth is variable for each surface element
+! radiation quantities belong to surface type now
+! surface fractions initialized
+! Rename lsm_last_actions into lsm_write_restart_data (MS)
+! 
+! 2608 2017-11-13 14:04:26Z schwenkel
 ! Calculation of magnus equation in external module (diagnostic_quantities_mod).
 ! Adjust calculation of vapor pressure and saturation mixing ratio that it is
@@ -265,5 +285,4 @@
 !> DALES and UCLA-LES models.
 !>
-!> @todo Restart data for vertical natural land-surfaces
 !> @todo Extensive verification energy-balance solver for vertical surfaces, 
 !>       e.g. parametrization of r_a
@@ -282,4 +301,7 @@
 !> @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?
 !------------------------------------------------------------------------------!
  MODULE land_surface_model_mod
@@ -287,4 +309,7 @@
     USE arrays_3d,                                                             &
         ONLY:  hyp, pt, prr, q, q_p, ql, vpt, u, v, w
+
+    USE calc_mean_profile_mod,                                                 &
+        ONLY:  calc_mean_profile
 
     USE cloud_parameters,                                                      &
@@ -301,5 +326,13 @@
 
     USE indices,                                                               &
-        ONLY:  nbgp, nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb 
+        ONLY:  nbgp, nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb
+
+    USE netcdf_data_input_mod,                                                 &
+        ONLY :  building_type_f, init_3d, input_pids_static,                   &
+                netcdf_data_input_interpolate,                                 &
+                pavement_pars_f, pavement_subsurface_pars_f, pavement_type_f,  &
+                root_area_density_lsm_f, soil_pars_f, soil_type_f,             &
+                surface_fraction_f, vegetation_pars_f, vegetation_type_f,      &
+                water_pars_f, water_type_f
 
     USE kinds
@@ -308,7 +341,6 @@
 
     USE radiation_model_mod,                                                   &
-        ONLY:  albedo, albedo_type, emissivity, force_radiation_call, rad_net, &
-               rad_sw_in, rad_lw_out, rad_lw_out_change_0, radiation_scheme,   &
-               unscheduled_radiation_calls
+        ONLY:  albedo, albedo_type, emissivity, force_radiation_call,          &
+               radiation_scheme, unscheduled_radiation_calls
         
     USE statistics,                                                            &
@@ -316,11 +348,11 @@
 
     USE surface_mod,                                                           &
-        ONLY :  surf_lsm_h, surf_lsm_v, surf_type
+        ONLY :  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
+       REAL(wp), DIMENSION(:),   ALLOCATABLE ::  var_1d !< 1D prognostic variable
+       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  var_2d !< 2D prognostic variable
     END TYPE surf_type_lsm
 
@@ -355,5 +387,5 @@
 !
 !-- LSM variables
-    CHARACTER(10) :: surface_type = 'vegetation'  !< general classification. Allowed are:
+    CHARACTER(10) :: surface_type = 'netcdf'      !< general classification. Allowed are:
                                                   !< 'vegetation', 'pavement', ('building'), 
                                                   !< 'water', and 'netcdf'
@@ -447,4 +479,5 @@
                                      m_soil_v,       & !< Soil moisture (m3/m3), vertical surface elements
                                      m_soil_v_p        !< Prog. soil moisture (m3/m3), vertical surface elements
+
 #else
     TYPE(surf_type_lsm), POINTER ::  t_soil_h,    & !< Soil temperature (K), horizontal surface elements
@@ -474,6 +507,6 @@
     TYPE(surf_type_lsm), TARGET   ::  t_surface_h,    & !< surface temperature (K), horizontal surface elements 
                                       t_surface_h_p,  & !< progn. surface temperature (K), horizontal surface elements 
-                                      m_liq_h,     & !< liquid water reservoir (m), horizontal surface elements 
-                                      m_liq_h_p      !< progn. liquid water reservoir (m), horizontal surface elements 
+                                      m_liq_h,        & !< liquid water reservoir (m), horizontal surface elements 
+                                      m_liq_h_p         !< progn. liquid water reservoir (m), horizontal surface elements 
 
     TYPE(surf_type_lsm), DIMENSION(0:3), TARGET   ::  &
@@ -533,14 +566,14 @@
 !-- 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
-              ghf_av,       & !< average of ghf
-              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_a_av,       & !< average of r_a
-              r_s_av          !< average of r_s
+              c_liq_av,         & !< average of c_liq
+              c_soil_av,        & !< average of c_soil
+              c_veg_av,         & !< average of c_veg
+              ghf_av,           & !< average of ghf
+              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_a_av,           & !< average of r_a
+              r_s_av              !< average of r_s
                    
 
@@ -548,23 +581,23 @@
 !-- 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
+                                   '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
                                                                  /)
 
@@ -572,11 +605,11 @@
 !-- 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
+                                   'user defined',                  & ! 0 
+                                   'coarse      ',                  & ! 1
+                                   'medium      ',                  & ! 2
+                                   'medium-fine ',                  & ! 3
+                                   'fine        ',                  & ! 4
+                                   'very fine   ',                  & ! 5
+                                   'organic     '                   & ! 6
                                                                  /)
 
@@ -600,24 +633,51 @@
                                    '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
+                                   'user defined',                   & ! 0 
+                                   'lake        ',                   & ! 1
+                                   'river       ',                   & ! 2
+                                   'ocean       ',                   & ! 3
+                                   'pond        ',                   & ! 4
+                                   'fountain    '                    & ! 5
                                                                   /)                                                                  
-                                                                 
-                                                                 !
+!
+!-- IDs for vegetation, pavement and water surfaces
+    INTEGER(iwp) ::  ind_veg = 0    !< index for vegetation surfaces, used to assess surface-fraction, albedo, etc.      
+    INTEGER(iwp) ::  ind_pav = 1    !< index for pavement surfaces, used to assess surface-fraction, albedo, etc.        
+    INTEGER(iwp) ::  ind_wat = 2    !< index for vegetation surfaces, used to assess surface-fraction, albedo, etc.                          
+                    
+!
 !-- 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
@@ -649,22 +709,22 @@
 !--                                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
+                                 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 /) )
 
@@ -682,4 +742,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 /) )
+
 
 !
@@ -747,12 +808,12 @@
 !
 !-- TO BE FILLED
-!-- Water parameters  temperature,     z0,      z0h, albedo_type, emissivity,
-    REAL(wp), DIMENSION(0:4,1:5), PARAMETER :: water_pars = RESHAPE( (/ &
-                         283.0_wp, 0.01_wp, 0.001_wp, 1.0_wp, 0.99_wp, & ! 1
-                         283.0_wp, 0.01_wp, 0.001_wp, 1.0_wp, 0.99_wp, & ! 2
-                         283.0_wp, 0.01_wp, 0.001_wp, 1.0_wp, 0.99_wp, & ! 3
-                         283.0_wp, 0.01_wp, 0.001_wp, 1.0_wp, 0.99_wp, & ! 4
-                         283.0_wp, 0.01_wp, 0.001_wp, 1.0_wp, 0.99_wp  & ! 5
-                                                                /), (/ 5, 5 /) )                                                                     
+!-- 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
@@ -764,9 +825,10 @@
 !
 !-- Public functions
-    PUBLIC lsm_check_data_output, lsm_check_data_output_pr,                    &
+    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_read_restart_data, lsm_last_actions
+           lsm_swap_timelevel, lsm_read_restart_data, lsm_write_restart_data
 ! !vegetat
 !-- Public parameters, constants and initial values
@@ -781,4 +843,7 @@
     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
@@ -842,9 +907,74 @@
     END INTERFACE lsm_read_restart_data
 
-    INTERFACE lsm_last_actions
-       MODULE PROCEDURE lsm_last_actions
-    END INTERFACE lsm_last_actions
+    INTERFACE lsm_write_restart_data
+       MODULE PROCEDURE lsm_write_restart_data
+    END INTERFACE lsm_write_restart_data
 
  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
+
+    koff = surf_lsm_h%koff
+    DO  m = 1, surf_lsm_h%ns
+       i = surf_lsm_h%i(m)
+       j = surf_lsm_h%j(m)
+       k = surf_lsm_h%k(m)
+       pt(k+koff,j,i) = pt(k,j,i)
+    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
+       koff = surf_lsm_h%koff
+       DO  m = 1, surf_lsm_h%ns
+          i = surf_lsm_h%i(m)
+          j = surf_lsm_h%j(m)
+          k = surf_lsm_h%k(m)
+          q(k+koff,j,i)   = q(k,j,i)
+          vpt(k+koff,j,i) = vpt(k,j,i)
+       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
 
 !------------------------------------------------------------------------------!
@@ -975,4 +1105,5 @@
 
  END SUBROUTINE lsm_check_data_output
+
 
 
@@ -1060,8 +1191,5 @@
         ONLY:  bc_pt_b, bc_q_b, constant_flux_layer, message_string,           &
                most_method
-                 
-    USE radiation_model_mod,                                                   &
-        ONLY:  radiation
-    
+                     
     
     IMPLICIT NONE
@@ -1075,8 +1203,8 @@
          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 ) /= 'netcdf' )  THEN  
+       message_string = 'unknown surface type surface_type = "' //             &
                         TRIM( surface_type ) // '"'
-                CALL message( 'check_parameters', 'PA0019', 1, 2, 0, 6, 0 )
+       CALL message( 'check_parameters', 'PA0019', 1, 2, 0, 6, 0 )
     ENDIF
 
@@ -1164,5 +1292,5 @@
           ENDIF
        ENDIF
-     
+
        IF ( vegetation_type == 1 )  THEN
           IF ( vegetation_coverage /= 9999999.9_wp  .AND.  vegetation_coverage &
@@ -1260,11 +1388,30 @@
     
     ENDIF
+
+    IF ( TRIM( surface_type ) == 'netcdf' )  THEN
+       IF ( ANY( water_type_f%var /= water_type_f%fill )  .AND.                &
+            TRIM( most_method ) == 'lookup' )  THEN    
+          WRITE( message_string, * ) 'water-surfaces are not allowed in ' //   &
+                                     'combination with most_method = ',        &
+                                     TRIM( most_method )
+          CALL message( 'check_parameters', 'PA0999', 2, 2, 0, 6, 0 )
+       ENDIF
+!
+!--    MS: Some problme here, after calling message everythings stucks at
+!--        MPI_FINALIZE call. 
+       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( 'check_parameters', 'PA0999', 2, 2, 0, 6, 0 )
+       ENDIF
+    ENDIF
     
 !
 !-- Temporary message as long as NetCDF input is not available
-    IF ( TRIM( surface_type ) == 'netcdf' )  THEN
-             message_string = 'surface_type = netcdf '//                       &
-                              'is not supported at the moment'
-             CALL message( 'check_parameters', 'PA0465', 1, 2, 0, 6, 0 )
+    IF ( TRIM( surface_type ) == 'netcdf'  .AND.  .NOT.  input_pids_static )   &
+    THEN
+       message_string = 'surface_type = netcdf requires static input file.'
+       CALL message( 'check_parameters', 'PA0465', 1, 2, 0, 6, 0 )
     ENDIF
 
@@ -1362,5 +1509,5 @@
     DO  k = nzb_soil, nzt_soil
        IF ( soil_moisture(k) > saturation_moisture )  THEN 
-          message_string = 'soil_moisture must not exceed its saturation' //   &
+          message_string = 'soil_moisture must not exceed its saturation' //    &
                             ' value'
           CALL message( 'check_parameters', 'PA0458', 1, 2, 0, 6, 0 )
@@ -1378,4 +1525,5 @@
     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)
@@ -1428,5 +1576,4 @@
     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) ::  k_rad     !< index to access radiation array
     INTEGER(iwp) ::  ks        !< running index
     INTEGER(iwp) ::  l         !< surface-facing index
@@ -1454,7 +1601,5 @@
                 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
-                pt1,         & !< potential temperature at first grid level
-                qv1            !< specific humidity at first grid level
+                m_liq_max      !< maxmimum value of the liq. water reservoir
 
     TYPE(surf_type_lsm), POINTER ::  surf_t_surface
@@ -1472,4 +1617,5 @@
     IF ( horizontal )  THEN
        surf              => surf_lsm_h
+
        surf_t_surface    => t_surface_h
        surf_t_surface_p  => t_surface_h_p
@@ -1480,10 +1626,7 @@
        surf_m_soil       => m_soil_h
        surf_t_soil       => t_soil_h
-
-       k_off     = -1
-       j_off     = 0
-       i_off     = 0
     ELSE
        surf              => surf_lsm_v(l)
+
        surf_t_surface    => t_surface_v(l)
        surf_t_surface_p  => t_surface_v_p(l)
@@ -1494,20 +1637,12 @@
        surf_m_soil       => m_soil_v(l)
        surf_t_soil       => t_soil_v(l)
-
-       k_off = 0
-       IF ( l == 0 )  THEN 
-          j_off = -1 
-          i_off = 0
-       ELSEIF ( l == 1 )  THEN 
-          j_off = 1 
-          i_off = 0
-       ELSEIF ( l == 2 )  THEN 
-          j_off = 0 
-          i_off = -1
-       ELSEIF ( l == 3 )  THEN 
-          j_off = 0 
-          i_off = 1
-       ENDIF
     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
 
 !
@@ -1520,10 +1655,4 @@
        j   = surf%j(m)
        k   = surf%k(m)
-!
-!--    Determine height index for radiation. Note, in clear-sky case radiation
-!--    arrays have rank 0 in first dimensions, so index must be zero. In case
-!--    of RRTMG radiation arrays have non-zero rank in first dimension, so that 
-!--    radiation can be obtained at respective height level
-       k_rad = MERGE( 0, k + k_off, radiation_scheme /= 'rrtmg' )
 
 !
@@ -1589,18 +1718,18 @@
 !--    time step is used here. Note that this formulation is the
 !--    equivalent to the ECMWF formulation using drag coefficients
-       IF ( cloud_physics )  THEN
-          pt1 = pt(k,j,i) + l_d_cp * pt_d_t(k) * ql(k,j,i)
-          qv1 = q(k,j,i) - ql(k,j,i)
-       ELSEIF ( cloud_droplets ) THEN
-          pt1 = pt(k,j,i) + l_d_cp * pt_d_t(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
+!        IF ( cloud_physics )  THEN
+!           pt1 = pt(k,j,i) + l_d_cp * pt_d_t(k) * ql(k,j,i)
+!           qv1 = q(k,j,i) - ql(k,j,i)
+!        ELSEIF ( cloud_droplets ) THEN
+!           pt1 = pt(k,j,i) + l_d_cp * pt_d_t(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
 !
 !--    Calculate aerodynamical resistance. For horizontal and vertical 
@@ -1608,19 +1737,23 @@
 !--    can be obtain via parameterization of Mason (2000) / 
 !--    Krayenhoff and Voogt (2006).
-!--    To do: detailed investigation which approach is better!
+!--    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 ( horizontal  .OR.  .NOT. aero_resist_kray )  THEN
-          surf%r_a(m) = ( pt1 - surf_lsm_h%pt_surface(m) ) /                   &
-                        ( surf%ts(m) * surf%us(m) + 1.0E-20_wp )
+          surf%r_a(m) = ABS( ( surf%pt1(m) - surf%pt_surface(m) ) /            &
+                             ( surf%ts(m) * surf%us(m) + 1.0E-20_wp ) )
        ELSE
           surf%r_a(m) = 1.0_wp / ( 11.8_wp + 4.2_wp *                          &
-                        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 )      &
+                        SQRT( MAX( ( ( 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,  &
+                              0.01_wp ) )                                      &
                                  )
        ENDIF
 !
 !--    Make sure that the resistance does not drop to zero for neutral 
-!--    stratification
-       IF ( ABS( surf%r_a(m) ) < 1.0_wp )  surf%r_a(m) = 1.0_wp
+!--    stratification. 
+       IF ( surf%r_a(m) < 1.0_wp )  surf%r_a(m) = 1.0_wp
 !
 !--    Second step: calculate canopy resistance r_canopy
@@ -1629,7 +1762,7 @@
 !--    f1: correction for incoming shortwave radiation (stomata close at 
 !--    night)
-       f1 = MIN( 1.0_wp, ( 0.004_wp * rad_sw_in(k_rad,j+j_off,i+i_off)         &
-                 + 0.05_wp ) / (0.81_wp * (0.004_wp                            &
-                 * rad_sw_in(k_rad,j+j_off,i+i_off) + 1.0_wp)) )
+       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 
@@ -1665,5 +1798,5 @@
 !
 !--       Calculate vapour pressure
-          e  = qv1 * surface_pressure / ( qv1 + 0.622_wp )
+          e  = surf%qv1(m) * surface_pressure / ( surf%qv1(m) + 0.622_wp )
           f3 = EXP ( - surf%g_d(m) * (e_s - e) )
        ELSE
@@ -1682,6 +1815,6 @@
 
 
-       f2 = ( surf_m_soil%var_2d(nzb_soil,m) - m_min )                         &
-            / ( surf%m_fc(nzb_soil,m) - m_min )
+       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     )
@@ -1698,5 +1831,5 @@
        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 )
+          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)              &
@@ -1710,5 +1843,5 @@
 !--    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
+       IF ( humidity  .AND.  q_s <= surf%qv1(m) )  THEN
           surf%r_canopy(m) = 0.0_wp
           surf%r_soil(m)   = 0.0_wp
@@ -1747,6 +1880,9 @@
        dq_s_dt = 0.622_wp * e_s_dt / ( surface_pressure - e_s_dt )
 !
-!--    Add LW up so that it can be removed in prognostic equation
-       surf%rad_net_l(m) = rad_net(j,i) + rad_lw_out(nzb,j,i)
+!--    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
@@ -1754,25 +1890,27 @@
 !
 !--       Numerator of the prognostic equation
-          coef_1 = surf%rad_net_l(m) + rad_lw_out_change_0(j,i)                &
-                   * surf_t_surface%var_1d(m) - rad_lw_out(nzb,j,i)            &
-                   + f_shf * pt1 + f_qsws * ( qv1 - q_s                        &
+          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 = rad_lw_out_change_0(j,i) + f_qsws * dq_s_dt                 &
+          coef_2 = surf%rad_lw_out_change_0(m) + f_qsws * dq_s_dt              &
                    + lambda_surface + f_shf / exn
        ELSE
 !
 !--       Numerator of the prognostic equation
-          coef_1 = surf%rad_net_l(m) + rad_lw_out_change_0(j,i)                &
-                   * surf_t_surface%var_1d(m) - rad_lw_out(nzb,j,i)            &
-                   + f_shf * pt1  + lambda_surface                             &
+          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 = rad_lw_out_change_0(j,i) + lambda_surface + f_shf / exn
+          coef_2 = surf%rad_lw_out_change_0(m) + lambda_surface + f_shf / exn
 
        ENDIF
+
 
        tend = 0.0_wp
@@ -1819,9 +1957,21 @@
 !--    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
+            > 0.2_wp  .AND. &
+            unscheduled_radiation_calls )  THEN
           force_radiation_call_l = .TRUE.
        ENDIF
 
-       pt(k+k_off,j+j_off,i+i_off) = surf_t_surface_p%var_1d(m) / exn  !is actually no air temperature
+
+!        IF ( surf_t_surface_p%var_1d(m) < 270.0_wp .OR. surf_t_surface_p%var_1d(m) > 350.0_wp )  THEN
+!           PRINT*, "myid: ", myid
+!           PRINT*, "m: ", m
+!           PRINT*, "i,j,k: ", i, j, k
+!           PRINT*, "pt_p: ", surf_t_surface_p%var_1d(m)
+!           PRINT*, "f_shf: ", f_shf
+!           PRINT*, "f_qsws: ", f_qsws
+!         ENDIF
+
+
+!        pt(k+k_off,j+j_off,i+i_off) = surf_t_surface_p%var_1d(m) / exn  !is actually no air temperature
        surf%pt_surface(m)          = surf_t_surface_p%var_1d(m) / exn
 
@@ -1829,10 +1979,10 @@
 !--    Calculate fluxes
        surf%rad_net_l(m) = surf%rad_net_l(m) +                                 &
-                            rad_lw_out_change_0(j,i)                           &
-                          * surf_t_surface%var_1d(m) - rad_lw_out(nzb,j,i)     &
-                          - rad_lw_out_change_0(j,i) * surf_t_surface_p%var_1d(m)
-
-       rad_net(j,i) = surf%rad_net_l(m)
-       rad_lw_out(nzb,j,i) = rad_lw_out(nzb,j,i) + rad_lw_out_change_0(j,i) *  &
+                            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) )
 
@@ -1840,21 +1990,20 @@
                                              - surf_t_soil%var_2d(nzb_soil,m) )
 
-       surf%shf(m) = - f_shf * ( pt1 - surf%pt_surface(m) ) / cp
-
+       surf%shf(m) = - f_shf * ( surf%pt1(m) - surf%pt_surface(m) ) / cp
 
        IF ( humidity )  THEN
-          surf%qsws(m)  = - f_qsws * ( qv1 - q_s + dq_s_dt                     &
+          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  * ( qv1 - q_s                      &
+          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 * ( qv1 - q_s                      &
+          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  * ( qv1 - q_s                      &
+          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) )
@@ -1866,5 +2015,5 @@
           surf%r_s(m) = 1.0E10_wp
        ELSE
-          surf%r_s(m) = - rho_lv * ( qv1 - q_s + dq_s_dt                       &
+          surf%r_s(m) = - rho_lv * ( surf%qv1(m) - q_s + dq_s_dt               &
                           * surf_t_surface%var_1d(m) - dq_s_dt *               &
                             surf_t_surface_p%var_1d(m) ) /                     &
@@ -1954,5 +2103,5 @@
                       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)
+                                           5.3125_wp * surf_tm_liq_m%var_1d(m)
              ENDIF
           ENDIF
@@ -2015,5 +2164,5 @@
           q_s = 0.622_wp * e_s / ( surface_pressure - e_s )
 
-          resistance = surf%r_a(m) / ( surf%r_a(m) + surf%r_s(m) )
+          resistance = surf%r_a(m) / ( surf%r_a(m) + surf%r_s(m) + 1E-5_wp )
 
 !
@@ -2028,5 +2177,4 @@
                                           q(k,j,i)
           ENDIF
-
 !
 !--       Update virtual potential temperature
@@ -2098,7 +2246,11 @@
        ENDIF
 
-       WRITE( io, 4 ) TRIM( vegetation_type_name(vegetation_type) ),           &
-                        TRIM (soil_type_name(soil_type) )
-       WRITE( io, 5 ) TRIM( soil_depth_chr ), TRIM( t_soil_chr ),              &
+       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 )
@@ -2111,5 +2263,7 @@
 4   FORMAT ('    --> Land surface type  : ',A,/                                &
             '    --> Soil porosity type : ',A)
-5   FORMAT (/'    Initial soil temperature and moisture profile:'//            &
+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'/                                  &
@@ -2117,4 +2271,5 @@
             '       Root fraction: ',A,'  '/                                   &
             '       Grid point:    ',A)
+
 
     END SUBROUTINE lsm_header
@@ -2133,19 +2288,18 @@
        IMPLICIT NONE
 
-       INTEGER(iwp) ::  i     !< running index
-       INTEGER(iwp) ::  i_off !< index offset of surface element, seen from atmospheric grid point 
-       INTEGER(iwp) ::  j     !< running index
-       INTEGER(iwp) ::  j_off !< index offset of surface element, seen from atmospheric grid point 
-       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) ::  i                       !< running index
+       INTEGER(iwp) ::  i_off                   !< index offset of surface element, seen from atmospheric grid point 
+       INTEGER(iwp) ::  j                       !< running index
+       INTEGER(iwp) ::  j_off                   !< index offset of surface element, seen from atmospheric grid point 
+       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 
-
-
-       REAL(wp) :: pt1   !< potential temperature at first grid level
+       INTEGER(iwp) ::  n_surf                  !< number of surface types of given surface element 
 
        REAL(wp), DIMENSION(:), ALLOCATABLE ::  bound, bound_root_fr  !< temporary arrays for storing index bounds
@@ -2157,5 +2311,6 @@
 !--    If no cloud physics is used, rho_surface has not been calculated before
        IF (  .NOT.  cloud_physics )  THEN
-          rho_surface = surface_pressure * 100.0_wp / ( r_d * pt_surface * exn )
+          CALL calc_mean_profile( pt, 4 )
+          rho_surface = surface_pressure * 100.0_wp / ( r_d * hom(nzb+1,1,4,0) * exn )
        ENDIF
 
@@ -2206,5 +2361,18 @@
           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
+          t_soil_h%var_2d = 0.0_wp
+          m_soil_h%var_2d = 0.0_wp
+          m_liq_h%var_1d  = 0.0_wp
+
+          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
@@ -2261,50 +2429,143 @@
           ENDIF      
        ENDDO
-
+!
+!--    Allocate albedo type and emissivity for vegetation, water and pavement 
+!--    fraction.
+!--    Set default values at each surface element. 
+       ALLOCATE ( surf_lsm_h%albedo_type(0:2,1:surf_lsm_h%ns) )
+       ALLOCATE ( surf_lsm_h%emissivity(0:2,1:surf_lsm_h%ns) )
+       surf_lsm_h%albedo_type = 0      
+       surf_lsm_h%emissivity  = emissivity
+       DO  l = 0, 3
+          ALLOCATE ( surf_lsm_v(l)%albedo_type(0:2,1:surf_lsm_v(l)%ns) )
+          ALLOCATE ( surf_lsm_v(l)%emissivity(0:2,1:surf_lsm_v(l)%ns)  )
+          surf_lsm_v(l)%albedo_type = 0
+          surf_lsm_v(l)%emissivity  = emissivity
+       ENDDO
+!
+!--    Allocate arrays for relative surface fraction. 
+!--    0 - vegetation fraction, 2 - water fraction, 1 - pavement fraction
+       ALLOCATE( surf_lsm_h%frac(0:2,1:surf_lsm_h%ns) )
+       surf_lsm_h%frac = 0.0_wp
+       DO  l = 0, 3
+          ALLOCATE( surf_lsm_v(l)%frac(0:2,1:surf_lsm_v(l)%ns) )
+          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
 !
 !--    Set flag parameter for the prescribed surface type depending on user 
-!--    input.
-       DO  m = 1, surf_lsm_h%ns
-
-          SELECT CASE ( TRIM( surface_type ) )
+!--    input. Set surface fraction to 1 for the respective type.
+       SELECT CASE ( TRIM( surface_type ) )
           
-             CASE ( 'vegetation' )
+          CASE ( 'vegetation' )
          
-                surf_lsm_h%vegetation_surface(m)    = .TRUE.
+             surf_lsm_h%vegetation_surface = .TRUE.
+             surf_lsm_h%frac(ind_veg,:) = 1.0_wp
+             DO  l = 0, 3
+                surf_lsm_v(l)%vegetation_surface = .TRUE.
+                surf_lsm_v(l)%frac(ind_veg,:) = 1.0_wp
+             ENDDO
    
-             CASE ( 'water' )
+          CASE ( 'water' )
              
-                surf_lsm_h%water_surface(m)      = .TRUE.
-
-             CASE ( 'pavement' )
+             surf_lsm_h%water_surface = .TRUE.
+             surf_lsm_h%frac(ind_wat,:) = 1.0_wp
+!
+!--          Note, vertical water surface does not really make sense.
+             DO  l = 0, 3  
+                surf_lsm_v(l)%water_surface   = .TRUE.
+                surf_lsm_v(l)%frac(ind_wat,:) = 1.0_wp
+             ENDDO
+
+          CASE ( 'pavement' )
              
-                surf_lsm_h%pavement_surface(m)   = .TRUE.
-    
-          END SELECT
-  
-       ENDDO
-       
-       DO  l = 0, 3
-          SELECT CASE ( TRIM( surface_type ) )
-          
-             CASE ( 'vegetation' )
-         
-                surf_lsm_v(l)%vegetation_surface = .TRUE.
-   
-             CASE ( 'water' )
-
-                surf_lsm_v(l)%water_surface   = .TRUE.
-
-             CASE ( 'pavement' )
-             
-                surf_lsm_h%pavement_surface   = .TRUE.
-
-          END SELECT   
-
-       ENDDO
-!
-!--    Initialize standard soil types. It is possible to overwrite each
-!--    parameter by setting the respecticy NAMELIST variable to a 
-!--    value /= 9999999.9. 
+             surf_lsm_h%pavement_surface = .TRUE.
+                surf_lsm_h%frac(ind_pav,:) = 1.0_wp
+             DO  l = 0, 3
+                surf_lsm_v(l)%pavement_surface   = .TRUE.
+                surf_lsm_v(l)%frac(ind_pav,:) = 1.0_wp
+             ENDDO
+
+          CASE ( 'netcdf' )
+
+             DO  m = 1, surf_lsm_h%ns
+                i = surf_lsm_h%i(m)
+                j = surf_lsm_h%j(m)
+                IF ( vegetation_type_f%var(j,i) /= vegetation_type_f%fill )        &
+                   surf_lsm_h%vegetation_surface(m) = .TRUE.
+                IF ( pavement_type_f%var(j,i)   /= pavement_type_f%fill )          &
+                   surf_lsm_h%pavement_surface(m) = .TRUE.
+                IF ( water_type_f%var(j,i)      /= water_type_f%fill )             &
+                   surf_lsm_h%water_surface(m) = .TRUE.
+             ENDDO
+             DO  l = 0, 3
+                DO  m = 1, surf_lsm_v(l)%ns
+!
+!--                Only for vertical surfaces. Check if natural walls at reference
+!--                grid point are covered by any building. This case, problems 
+!--                with initialization will aris if index offsets are used. 
+!--                In order to deal with this, set special flag. 
+                   surf_lsm_v(l)%building_covered(m) = .FALSE.
+                   IF ( building_type_f%from_file )  THEN
+                      i = surf_lsm_v(l)%i(m) + surf_lsm_v(l)%ioff
+                      j = surf_lsm_v(l)%j(m) + surf_lsm_v(l)%joff
+                      IF ( building_type_f%var(j,i) /= 0 )                     &
+                         surf_lsm_v(l)%building_covered(m) = .TRUE.
+                   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.
+                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 ( input_pids_static )  THEN
+          DO  m = 1, surf_lsm_h%ns
+             i = surf_lsm_h%i(m)
+             j = surf_lsm_h%j(m)
+!
+!--          0 - vegetation fraction, 1 - pavement fraction, 2 - water fraction             
+             surf_lsm_h%frac(ind_veg,m) = surface_fraction_f%frac(ind_veg,j,i)         
+             surf_lsm_h%frac(ind_pav,m) = surface_fraction_f%frac(ind_pav,j,i)        
+             surf_lsm_h%frac(ind_wat,m) = surface_fraction_f%frac(ind_wat,j,i)
+
+          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        
+                surf_lsm_v(l)%frac(ind_veg,m) = surface_fraction_f%frac(ind_veg,j,i)         
+                surf_lsm_v(l)%frac(ind_pav,m) = surface_fraction_f%frac(ind_pav,j,i)        
+                surf_lsm_v(l)%frac(ind_wat,m) = surface_fraction_f%frac(ind_wat,j,i)
+
+             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  
  
@@ -2339,131 +2600,4 @@
           IF ( residual_moisture == 9999999.9_wp )  THEN
              residual_moisture = soil_pars(7,soil_type)       
-          ENDIF
-
-       ENDIF    
-  
-!
-!--    Check whether parameters from the lookup tables are to be used
-       IF ( vegetation_type /= 0 )  THEN
-
-          IF ( min_canopy_resistance == 9999999.9_wp )  THEN
-             min_canopy_resistance = vegetation_pars(0,vegetation_type)
-          ENDIF
-
-          IF ( leaf_area_index == 9999999.9_wp )  THEN
-             leaf_area_index = vegetation_pars(1,vegetation_type)         
-          ENDIF
-
-          IF ( vegetation_coverage == 9999999.9_wp )  THEN
-             vegetation_coverage = vegetation_pars(2,vegetation_type)     
-          ENDIF
-
-          IF ( canopy_resistance_coefficient == 9999999.9_wp )  THEN
-              canopy_resistance_coefficient= vegetation_pars(3,vegetation_type)     
-          ENDIF
-
-          IF ( z0_vegetation == 9999999.9_wp )  THEN
-             z0_vegetation  = vegetation_pars(4,vegetation_type) 
-          ENDIF
-
-          IF ( z0h_vegetation == 9999999.9_wp )  THEN
-             z0h_vegetation = vegetation_pars(5,vegetation_type)
-          ENDIF   
-          
-          IF ( lambda_surface_stable == 9999999.9_wp )  THEN
-             lambda_surface_stable = vegetation_pars(6,vegetation_type) 
-          ENDIF
-
-          IF ( lambda_surface_unstable == 9999999.9_wp )  THEN
-             lambda_surface_unstable = vegetation_pars(7,vegetation_type)           
-          ENDIF
-
-          IF ( f_shortwave_incoming == 9999999.9_wp )  THEN
-             f_shortwave_incoming = vegetation_pars(8,vegetation_type)        
-          ENDIF
-
-          IF ( c_surface == 9999999.9_wp )  THEN
-             c_surface = vegetation_pars(9,vegetation_type)        
-          ENDIF
- 
-          IF ( albedo_type == 9999999  .AND.  albedo == 9999999.9_wp )  THEN
-             albedo_type = INT(vegetation_pars(10,vegetation_type))       
-          ENDIF
-   
-          IF ( emissivity == 9999999.9_wp )  THEN
-             emissivity = vegetation_pars(11,vegetation_type)     
-          ENDIF
-          
-       ENDIF
-
-       IF ( water_type /= 0 )  THEN
-
-          IF ( water_temperature == 9999999.9_wp )  THEN
-             water_temperature = water_pars(0,water_type)       
-          ENDIF
-
-          IF ( z0_water == 9999999.9_wp )  THEN
-             z0_water = water_pars(1,water_type)
-          ENDIF       
-
-          IF ( z0h_water == 9999999.9_wp )  THEN
-             z0h_water = water_pars(2,water_type)    
-          ENDIF  
-
-          IF ( albedo_type == 9999999  .AND.  albedo == 9999999.9_wp )  THEN
-             albedo_type = INT(water_pars(3,water_type))        
-          ENDIF
-   
-          IF ( emissivity == 9999999.9_wp )  THEN
-             emissivity = water_pars(4,water_type)        
-          ENDIF
-
-       ENDIF 
-       
-       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(0,pavement_type) 
-          ENDIF
-
-          IF ( z0h_pavement == 9999999.9_wp )  THEN
-             z0h_pavement = pavement_pars(1,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(2,pavement_type))        
-          ENDIF
-   
-          IF ( emissivity == 9999999.9_wp )  THEN
-             emissivity = pavement_pars(3,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
 
@@ -2494,76 +2628,1348 @@
           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  m = 1, surf_lsm_h%ns
+                i = surf_lsm_h%i(m)
+                j = surf_lsm_h%j(m)
+             
+                st = soil_type_f%var_2d(j,i)
+                IF ( st /= soil_type_f%fill )  THEN
+                   surf_lsm_h%alpha_vg(:,m)    = soil_pars(0,st)
+                   surf_lsm_h%l_vg(:,m)        = soil_pars(1,st)
+                   surf_lsm_h%n_vg(:,m)        = soil_pars(2,st)
+                   surf_lsm_h%gamma_w_sat(:,m) = soil_pars(3,st)
+                   surf_lsm_h%m_sat(:,m)       = soil_pars(4,st)
+                   surf_lsm_h%m_fc(:,m)        = soil_pars(5,st)
+                   surf_lsm_h%m_wilt(:,m)      = soil_pars(6,st)
+                   surf_lsm_h%m_res(:,m)       = soil_pars(7,st)
+                ENDIF
+             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  m = 1, surf_lsm_h%ns
+                i = surf_lsm_h%i(m)
+                j = surf_lsm_h%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%alpha_vg(k,m)    = soil_pars(0,st)
+                      surf_lsm_h%l_vg(k,m)        = soil_pars(1,st)
+                      surf_lsm_h%n_vg(k,m)        = soil_pars(2,st)
+                      surf_lsm_h%gamma_w_sat(k,m) = soil_pars(3,st)
+                      surf_lsm_h%m_sat(k,m)       = soil_pars(4,st)
+                      surf_lsm_h%m_fc(k,m)        = soil_pars(5,st)
+                      surf_lsm_h%m_wilt(k,m)      = soil_pars(6,st)
+                      surf_lsm_h%m_res(k,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) ) 
+
+                   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  m = 1, surf_lsm_h%ns
+                i = surf_lsm_h%i(m)
+                j = surf_lsm_h%j(m)
+
+                IF ( soil_pars_f%pars_xy(0,j,i) /= soil_pars_f%fill )              &
+                   surf_lsm_h%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_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%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%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%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%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%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%m_res(:,m)       = soil_pars_f%pars_xy(7,j,i)
+
+             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  m = 1, surf_lsm_h%ns
+                i = surf_lsm_h%i(m)
+                j = surf_lsm_h%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%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_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%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%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%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%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%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%m_res(k,m)       = soil_pars_f%pars_xyz(7,k,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) ) 
+
+                   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 ( 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  m = 1, surf_lsm_h%ns
+          IF ( surf_lsm_h%vegetation_surface(m) )  THEN
+             surf_lsm_h%r_canopy_min(m)     = min_canopy_resistance
+             surf_lsm_h%lai(m)              = leaf_area_index
+             surf_lsm_h%c_veg(m)            = vegetation_coverage
+             surf_lsm_h%g_d(m)              = canopy_resistance_coefficient
+             surf_lsm_h%z0(m)               = z0_vegetation
+             surf_lsm_h%z0h(m)              = z0h_vegetation
+             surf_lsm_h%z0q(m)              = z0h_vegetation
+             surf_lsm_h%lambda_surface_s(m) = lambda_surface_stable
+             surf_lsm_h%lambda_surface_u(m) = lambda_surface_unstable
+             surf_lsm_h%f_sw_in(m)          = f_shortwave_incoming
+             surf_lsm_h%c_surface(m)        = c_surface
+             surf_lsm_h%albedo_type(ind_veg,m) = albedo_type
+             surf_lsm_h%emissivity(ind_veg,m)  = emissivity
+          ELSE
+             surf_lsm_h%lai(m)   = 0.0_wp
+             surf_lsm_h%c_veg(m) = 0.0_wp
+             surf_lsm_h%g_d(m)   = 0.0_wp
+          ENDIF
+  
+       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)              = z0h_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(ind_veg,m) = albedo_type
+                surf_lsm_v(l)%emissivity(ind_veg,m)  = emissivity
+             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  m = 1, surf_lsm_h%ns
+             i = surf_lsm_h%i(m)
+             j = surf_lsm_h%j(m)
+             
+             st = vegetation_type_f%var(j,i)
+             IF ( st /= vegetation_type_f%fill  .AND.  st /= 0 )  THEN
+                surf_lsm_h%r_canopy_min(m)     = vegetation_pars(ind_v_rc_min,st)
+                surf_lsm_h%lai(m)              = vegetation_pars(ind_v_rc_lai,st)
+                surf_lsm_h%c_veg(m)            = vegetation_pars(ind_v_c_veg,st)
+                surf_lsm_h%g_d(m)              = vegetation_pars(ind_v_gd,st)
+                surf_lsm_h%z0(m)               = vegetation_pars(ind_v_z0,st)
+                surf_lsm_h%z0h(m)              = vegetation_pars(ind_v_z0qh,st)
+                surf_lsm_h%z0q(m)              = vegetation_pars(ind_v_z0qh,st)
+                surf_lsm_h%lambda_surface_s(m) = vegetation_pars(ind_v_lambda_s,st)
+                surf_lsm_h%lambda_surface_u(m) = vegetation_pars(ind_v_lambda_u,st)
+                surf_lsm_h%f_sw_in(m)          = vegetation_pars(ind_v_f_sw_in,st)
+                surf_lsm_h%c_surface(m)        = vegetation_pars(ind_v_c_surf,st)
+                surf_lsm_h%albedo_type(ind_veg,m) = INT( vegetation_pars(ind_v_at,st) )
+                surf_lsm_h%emissivity(ind_veg,m)  = vegetation_pars(ind_v_emis,st)
+             ENDIF
+          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(ind_veg,m) = INT( vegetation_pars(ind_v_at,st) )
+                   surf_lsm_v(l)%emissivity(ind_veg,m)  = vegetation_pars(ind_v_emis,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  m = 1, surf_lsm_h%ns
+
+             i = surf_lsm_h%i(m)
+             j = surf_lsm_h%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%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 vegation surface, ',        &
+                                 'so that information given in ',              &
+                                 'vegetation_pars at this point is neglected.' 
+                CALL message( 'land_surface_model_mod', 'PA0999', 0, 0, 0, 6, 0 )
+             ELSE
+
+                IF ( vegetation_pars_f%pars_xy(ind_v_rc_min,j,i) /=            &
+                     vegetation_pars_f%fill )                                  &
+                   surf_lsm_h%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%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%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%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%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%z0h(m)           =                               &
+                                   vegetation_pars_f%pars_xy(ind_v_z0qh,j,i)
+                   surf_lsm_h%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%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%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%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%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%albedo_type(ind_veg,m) =                         &
+                                   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%emissivity(ind_veg,m)  =                         &
+                                   vegetation_pars_f%pars_xy(ind_v_emis,j,i)
+             ENDIF
+          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 vegation surface, ',        &
+                                 'so that information given in ',              &
+                                 'vegetation_pars at this point is neglected.' 
+                   CALL message( 'land_surface_model_mod', 'PA0999', 0, 0, 0, 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(ind_veg,m) =                   &
+                                   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(ind_veg,m)  =                   &
+                                   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 ( 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  m = 1, surf_lsm_h%ns
+          IF ( surf_lsm_h%water_surface(m) )  THEN
+             IF ( TRIM( initializing_actions ) /= 'read_restart_data' )        &
+                t_soil_h%var_2d(:,m)           = water_temperature
+             surf_lsm_h%z0(m)               = z0_water
+             surf_lsm_h%z0h(m)              = z0h_water
+             surf_lsm_h%z0q(m)              = z0h_water
+             surf_lsm_h%lambda_surface_s(m) = 1.0E10_wp
+             surf_lsm_h%lambda_surface_u(m) = 1.0E10_wp               
+             surf_lsm_h%c_surface(m)        = 0.0_wp
+             surf_lsm_h%albedo_type(ind_wat,m) = albedo_type
+             surf_lsm_h%emissivity(ind_wat,m)  = emissivity
+          ENDIF
+       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)              = z0h_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(ind_wat,m) = albedo_type
+                surf_lsm_v(l)%emissivity(ind_wat,m)  = emissivity
+             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  m = 1, surf_lsm_h%ns
+             i = surf_lsm_h%i(m)
+             j = surf_lsm_h%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%var_2d(:,m) = water_pars(ind_w_temp,st)
+                surf_lsm_h%z0(m)     = water_pars(ind_w_z0,st)
+                surf_lsm_h%z0h(m)    = water_pars(ind_w_z0h,st)
+                surf_lsm_h%z0q(m)    = water_pars(ind_w_z0h,st)
+                surf_lsm_h%lambda_surface_s(m) = water_pars(ind_w_lambda_s,st)
+                surf_lsm_h%lambda_surface_u(m) = water_pars(ind_w_lambda_u,st)              
+                surf_lsm_h%c_surface(m)        = 0.0_wp
+                surf_lsm_h%albedo_type(ind_wat,m) = INT( water_pars(ind_w_at,st) )
+                surf_lsm_h%emissivity(ind_wat,m)  = water_pars(ind_w_emis,st)
+             ENDIF
+          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(ind_wat,m) =                      &
+                                                  INT( water_pars(ind_w_at,st) )
+                   surf_lsm_v(l)%emissivity(ind_wat,m)  =                      &
+                                                  water_pars(ind_w_emis,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  m = 1, surf_lsm_h%ns
+             i = surf_lsm_h%i(m)
+             j = surf_lsm_h%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%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', 'PA0999', 0, 0, 0, 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%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%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%z0h(m)    = water_pars_f%pars_xy(ind_w_z0h,j,i)
+                   surf_lsm_h%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%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%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%albedo_type(ind_wat,m) =                         &
+                                       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%emissivity(ind_wat,m) =                          &
+                   water_pars_f%pars_xy(ind_w_emis,j,i)  
+             ENDIF
+          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', 'PA0999',           &
+                                  0, 0, 0, 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(ind_wat,m)    =                &
+                                      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(ind_wat,m)     =                &
+                                      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 ( 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
+       surf_lsm_h%nzt_pavement = pavement_depth_level
+       DO  m = 1, surf_lsm_h%ns
+          IF ( surf_lsm_h%pavement_surface(m) )  THEN
+             surf_lsm_h%nzt_pavement(m)        = nzt_pavement
+             surf_lsm_h%z0(m)                  = z0_pavement
+             surf_lsm_h%z0h(m)                 = z0h_pavement
+             surf_lsm_h%z0q(m)                 = z0h_pavement
+             surf_lsm_h%lambda_surface_s(m)    = pavement_heat_conduct         &
+                                                  * ddz_soil(nzb_soil)         &
+                                                  * 2.0_wp    
+             surf_lsm_h%lambda_surface_u(m)    = pavement_heat_conduct         &
+                                                  * ddz_soil(nzb_soil)         &
+                                                  * 2.0_wp           
+             surf_lsm_h%c_surface(m)           = pavement_heat_capacity        &
+                                                        * dz_soil(nzb_soil)    &
+                                                        * 0.25_wp                                   
+
+             surf_lsm_h%albedo_type(ind_pav,m) = albedo_type
+             surf_lsm_h%emissivity(ind_pav,m)  = emissivity      
+      
+             IF ( pavement_type /= 0 )  THEN
+                DO  k = nzb_soil, surf_lsm_h%nzt_pavement(m)
+                   surf_lsm_h%lambda_h_def(k,m)    =                           &
+                                     pavement_subsurface_pars_1(k,pavement_type)                       
+                   surf_lsm_h%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                               
+
+       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)                 = z0h_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(ind_pav,m) = albedo_type
+                surf_lsm_v(l)%emissivity(ind_pav,m)  = emissivity
+
+                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  m = 1, surf_lsm_h%ns
+             i = surf_lsm_h%i(m)
+             j = surf_lsm_h%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%nzt_pavement(m) = k-1
+                      EXIT
+                   ENDIF
+                ENDDO
+
+                surf_lsm_h%z0(m)                = pavement_pars(ind_p_z0,st)
+                surf_lsm_h%z0h(m)               = pavement_pars(ind_p_z0h,st)
+                surf_lsm_h%z0q(m)               = pavement_pars(ind_p_z0h,st)
+
+                surf_lsm_h%lambda_surface_s(m)  =                              &
+                                              pavement_subsurface_pars_1(0,st) &
+                                                  * ddz_soil(nzb_soil)         &
+                                                  * 2.0_wp    
+                surf_lsm_h%lambda_surface_u(m)  =                              &
+                                              pavement_subsurface_pars_1(0,st) &
+                                                  * ddz_soil(nzb_soil)         &
+                                                  * 2.0_wp        
+                surf_lsm_h%c_surface(m)         =                              &
+                                               pavement_subsurface_pars_2(0,st)&
+                                                        * dz_soil(nzb_soil)    &
+                                                        * 0.25_wp                               
+                surf_lsm_h%albedo_type(ind_pav,m) = INT( pavement_pars(ind_p_at,st) )
+                surf_lsm_h%emissivity(ind_pav,m)  = pavement_pars(ind_p_emis,st)  
+
+                DO  k = nzb_soil, surf_lsm_h%nzt_pavement(m)
+                   surf_lsm_h%lambda_h_def(k,m)    =                           &
+                                     pavement_subsurface_pars_1(k,pavement_type)                       
+                   surf_lsm_h%rho_c_total_def(k,m) =                           &
+                                     pavement_subsurface_pars_2(k,pavement_type) 
+                ENDDO   
+             ENDIF
+          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(ind_pav,m) =                      &
+                                              INT( pavement_pars(ind_p_at,st) )
+                   surf_lsm_v(l)%emissivity(ind_pav,m)  =                      &
+                                              pavement_pars(ind_p_emis,st)    
+
+                   DO  k = nzb_soil, surf_lsm_h%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  m = 1, surf_lsm_h%ns
+             i = surf_lsm_h%i(m)
+             j = surf_lsm_h%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%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', 'PA0999', 0, 0, 0, 6, 0 )
+             ELSE
+                IF ( pavement_pars_f%pars_xy(ind_p_z0,j,i) /=                  &
+                     pavement_pars_f%fill )                                    &
+                   surf_lsm_h%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%z0h(m) = pavement_pars_f%pars_xy(ind_p_z0h,j,i)
+                   surf_lsm_h%z0q(m) = pavement_pars_f%pars_xy(ind_p_z0h,j,i)
+                ENDIF
+                IF ( pavement_subsurface_pars_f%pars_xyz(ind_p_lambda_h,0,j,i) &
+                     /= pavement_subsurface_pars_f%fill )  THEN
+                   surf_lsm_h%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%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%c_surface(m)     =                               &
+                      pavement_subsurface_pars_f%pars_xyz(ind_p_rho_c,0,j,i)   &
+                                                  * dz_soil(nzb_soil)          &
+                                                  * 0.25_wp                                    
+                ENDIF
+                IF ( pavement_pars_f%pars_xy(ind_p_at,j,i) /=                  &
+                     pavement_pars_f%fill )                                    &
+                   surf_lsm_h%albedo_type(ind_pav,m) =                         &
+                                              INT( pavement_pars(ind_p_at,st) )
+                IF ( pavement_pars_f%pars_xy(ind_p_emis,j,i) /=                &
+                     pavement_pars_f%fill )                                    &
+                   surf_lsm_h%emissivity(ind_pav,m)  =                         &
+                                              pavement_pars(ind_p_emis,st) 
+             ENDIF 
+
+          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', 'PA0999', 0, 0, 0, 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_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
+                   IF ( pavement_pars_f%pars_xy(ind_p_at,j,i) /=               &
+                        pavement_pars_f%fill )                                 &
+                      surf_lsm_v(l)%albedo_type(ind_pav,m) =                   &
+                                            INT( pavement_pars(ind_p_at,st) )
+
+                   IF ( pavement_pars_f%pars_xy(ind_p_emis,j,i) /=             &
+                        pavement_pars_f%fill )                                 &
+                      surf_lsm_v(l)%emissivity(ind_pav,m)  =                   &
+                                            pavement_pars(ind_p_emis,st)  
+                ENDIF 
+             ENDDO
+          ENDDO
+       ENDIF
+!
+!--    Moreover, for grid points which are flagged with pavement-type 0 or whre 
+!--    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  m = 1, surf_lsm_h%ns
+             IF ( surf_lsm_h%pavement_surface(m) )  THEN
+
+                i = surf_lsm_h%i(m)
+                j = surf_lsm_h%j(m)
+
+                surf_lsm_h%nzt_pavement(m) = nzt_soil
+
+                DO  k = nzb_soil, nzt_soil  
+                   surf_lsm_h%lambda_h_def(k,m) =                              &
+                       pavement_subsurface_pars_f%pars_xyz(ind_p_lambda_h,k,j,i)
+                   surf_lsm_h%rho_c_total_def(k,m) =                           &
+                       pavement_subsurface_pars_f%pars_xyz(ind_p_rho_c,k,j,i)
+                ENDDO
+
+             ENDIF
+          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
+
+                   DO  k = nzb_soil, nzt_soil  
+                      surf_lsm_v(l)%lambda_h_def(k,m) =                        &
+                       pavement_subsurface_pars_f%pars_xyz(ind_p_lambda_h,k,j,i)
+                      surf_lsm_v(l)%rho_c_total_def(k,m) =                     &
+                       pavement_subsurface_pars_f%pars_xyz(ind_p_rho_c,k,j,i)
+                   ENDDO
+
+                ENDIF
+             ENDDO
+          ENDDO
+       ENDIF
 !
 !--    Initial run actions
        IF (  TRIM( initializing_actions ) /= 'read_restart_data' )  THEN
 !
-!--       First, for horizontal surfaces
-!
-!--       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
+!--       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  m = 1, surf_lsm_h%ns
-
-             t_soil_h%var_2d(:,m)    = 0.0_wp
-             m_soil_h%var_2d(:,m)    = 0.0_wp
-             m_liq_h%var_1d(m)       = 0.0_wp
-
-!--          Map user settings of T and q for each soil layer
-!--          (make sure that the soil moisture does not drop below the permanent
-!--          wilting point) -> problems with devision by zero)
-             IF ( surf_lsm_h%water_surface(m) )  THEN
-
-                surf_lsm_h%z0(m)          = z0_water
-                surf_lsm_h%z0h(m)         = z0h_water
-                surf_lsm_h%z0q(m)         = z0h_water
-                t_soil_h%var_2d(:,m)      = water_temperature
-                surf_lsm_h%lambda_surface_s(m) = 1.0E10_wp
-                surf_lsm_h%lambda_surface_u(m) = 1.0E10_wp               
-                surf_lsm_h%c_surface(m)        = 0.0_wp
-                
-             ELSEIF ( surf_lsm_h%pavement_surface(m) )  THEN
-
-                surf_lsm_h%z0(m)          = z0_pavement
-                surf_lsm_h%z0h(m)         = z0h_pavement
-                surf_lsm_h%z0q(m)         = z0h_pavement   
+             IF ( surf_lsm_h%vegetation_surface(m)  .OR.                       &
+                  surf_lsm_h%pavement_surface(m) )  THEN
                 DO  k = nzb_soil, nzt_soil  
-                   t_soil_h%var_2d(k,m)   = soil_temperature(k)
-                   m_soil_h%var_2d(k,m)   = soil_moisture(k)
+                   t_soil_h%var_2d(k,m) = soil_temperature(k)
+                   m_soil_h%var_2d(k,m) = soil_moisture(k)
                 ENDDO
                 t_soil_h%var_2d(nzt_soil+1,m) = soil_temperature(nzt_soil+1)
-                surf_lsm_h%lambda_surface_s(m) = pavement_heat_conduct         &
-                                                 * ddz_soil(nzb_soil)          &
-                                                 * 2.0_wp
-                surf_lsm_h%lambda_surface_u(m) = surf_lsm_h%lambda_surface_s(m)                                         
-                surf_lsm_h%c_surface(m)        = pavement_heat_capacity        &
-                                                 * dz_soil(nzb_soil)           &
-                                                 * 0.25_wp
-
-                IF ( pavement_type /= 0 )  THEN
+             ENDIF
+          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  
-                      surf_lsm_h%lambda_h_def(k,m)      =  pavement_subsurface_pars_1(k,pavement_type)                       
-                      surf_lsm_h%rho_c_total_def(k,m)   =  pavement_subsurface_pars_2(k,pavement_type) 
+                      t_soil_v(l)%var_2d(k,m) = soil_temperature(k)
+                      m_soil_v(l)%var_2d(k,m) = soil_moisture(k)
                    ENDDO
-                ELSE
-                    surf_lsm_h%lambda_h_def(:,m)     = pavement_heat_conduct
-                    surf_lsm_h%rho_c_total_def(:,m)  = pavement_heat_capacity
+                   t_soil_v(l)%var_2d(nzt_soil+1,m) = soil_temperature(nzt_soil+1)
                 ENDIF
-
-             ELSEIF ( surf_lsm_h%vegetation_surface(m) )  THEN
-
-                surf_lsm_h%z0(m)          = z0_vegetation
-                surf_lsm_h%z0h(m)         = z0h_vegetation
-                surf_lsm_h%z0q(m)         = z0h_vegetation   
-                DO  k = nzb_soil, nzt_soil                        
-                   t_soil_h%var_2d(k,m)   = soil_temperature(k)
-                   m_soil_h%var_2d(k,m)   = soil_moisture(k)       
-                ENDDO 
-                t_soil_h%var_2d(nzt_soil+1,m) = soil_temperature(nzt_soil+1)
-                surf_lsm_h%lambda_surface_s(m) = lambda_surface_stable
-                surf_lsm_h%lambda_surface_u(m) = lambda_surface_unstable
-                surf_lsm_h%c_surface(m)        = c_surface
-
+             ENDDO
+          ENDDO
+!
+!--       Level 2, if soil moisture and/or temperature  are 
+!--       provided from file, interpolate / extrapolate the provided data
+!--       onto the respective soil layers. Please note, both, zs as well as 
+!--       init_3d%z_soil indicate a depth with positive values, so that no 
+!--       distinction between atmosphere is required concerning interpolation.
+!--       Start with soil moisture
+          IF ( init_3d%from_file_msoil )  THEN
+
+             IF ( init_3d%lod_msoil == 1 )  THEN
+                DO  m = 1, surf_lsm_h%ns
+
+                   CALL netcdf_data_input_interpolate(                         &
+                                       m_soil_h%var_2d(nzb_soil:nzt_soil,m),   &
+                                       init_3d%msoil_init(:),                  &
+                                       zs(nzb_soil:nzt_soil), init_3d%z_soil,  &
+                                       nzb_soil, nzt_soil,                     &
+                                       nzb_soil, init_3d%nzs-1 )
+                ENDDO
+                DO  l = 0, 3
+                   DO  m = 1, surf_lsm_v(l)%ns
+
+                      CALL netcdf_data_input_interpolate(                      &
+                                       m_soil_v(l)%var_2d(nzb_soil:nzt_soil,m),&
+                                       init_3d%msoil_init(:),                  &
+                                       zs(nzb_soil:nzt_soil), init_3d%z_soil,  &
+                                       nzb_soil, nzt_soil,                     &
+                                       nzb_soil, init_3d%nzs-1 )
+                   ENDDO
+                ENDDO
+             ELSE
+
+                DO  m = 1, surf_lsm_h%ns
+                   i = surf_lsm_h%i(m)
+                   j = surf_lsm_h%j(m)
+
+                   IF ( init_3d%msoil(0,j,i) /= init_3d%fill_msoil )           &
+                      CALL netcdf_data_input_interpolate(                      &
+                                       m_soil_h%var_2d(nzb_soil:nzt_soil,m),   &
+                                       init_3d%msoil(:,j,i),                   &
+                                       zs(nzb_soil:nzt_soil), init_3d%z_soil,  &
+                                       nzb_soil, nzt_soil,                     &
+                                       nzb_soil, init_3d%nzs-1 )
+                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 ( init_3d%msoil(0,j,i) /= init_3d%fill_msoil )        &
+                         CALL netcdf_data_input_interpolate(                   &
+                                       m_soil_v(l)%var_2d(nzb_soil:nzt_soil,m),&
+                                       init_3d%msoil(:,j,i),                   &
+                                       zs(nzb_soil:nzt_soil), init_3d%z_soil,  &
+                                       nzb_soil, nzt_soil,                     &
+                                       nzb_soil, init_3d%nzs-1 )
+                   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  m = 1, surf_lsm_h%ns
+
+                   CALL netcdf_data_input_interpolate(                         &
+                                       t_soil_h%var_2d(nzb_soil:nzt_soil,m),   &
+                                       init_3d%tsoil_init(:),                  &
+                                       zs(nzb_soil:nzt_soil), init_3d%z_soil,  &
+                                       nzb_soil, nzt_soil,                     &
+                                       nzb_soil, init_3d%nzs-1 )
+                   t_soil_h%var_2d(nzt_soil+1,m) = t_soil_h%var_2d(nzt_soil,m)
+                ENDDO
+                DO  l = 0, 3
+                   DO  m = 1, surf_lsm_v(l)%ns
+
+                      CALL netcdf_data_input_interpolate(                      &
+                                       t_soil_v(l)%var_2d(nzb_soil:nzt_soil,m),&
+                                       init_3d%tsoil_init(:),                  &
+                                       zs(nzb_soil:nzt_soil), init_3d%z_soil,  &
+                                       nzb_soil, nzt_soil,                     &
+                                       nzb_soil, init_3d%nzs-1 )
+                      t_soil_v(l)%var_2d(nzt_soil+1,m) =                       &
+                                                 t_soil_v(l)%var_2d(nzt_soil,m)
+                   ENDDO
+                ENDDO
+             ELSE
+
+                DO  m = 1, surf_lsm_h%ns
+                   i = surf_lsm_h%i(m)
+                   j = surf_lsm_h%j(m)
+
+                   IF ( init_3d%msoil(0,j,i) /= init_3d%fill_msoil )           &
+                      CALL netcdf_data_input_interpolate(                      &
+                                       t_soil_h%var_2d(nzb_soil:nzt_soil,m),   &
+                                       init_3d%tsoil(:,j,i),                   &
+                                       zs(nzb_soil:nzt_soil), init_3d%z_soil,  &
+                                       nzb_soil, nzt_soil,                     &
+                                       nzb_soil, init_3d%nzs-1 )
+                   t_soil_h%var_2d(nzt_soil+1,m) = t_soil_h%var_2d(nzt_soil,m)
+                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 ( init_3d%msoil(0,j,i) /= init_3d%fill_msoil )        &
+                         CALL netcdf_data_input_interpolate(                   &
+                                       t_soil_v(l)%var_2d(nzb_soil:nzt_soil,m),&
+                                       init_3d%tsoil(:,j,i),                   &
+                                       zs(nzb_soil:nzt_soil), init_3d%z_soil,  &
+                                       nzb_soil, nzt_soil,                     &
+                                       nzb_soil, init_3d%nzs-1 )
+                      t_soil_v(l)%var_2d(nzt_soil+1,m) =                       &
+                                                 t_soil_v(l)%var_2d(nzt_soil,m)
+                   ENDDO
+                ENDDO
+             ENDIF
+          ENDIF
+!
+!--       Further initialization
+          DO  m = 1, surf_lsm_h%ns
+
              i   = surf_lsm_h%i(m)            
              j   = surf_lsm_h%j(m)
@@ -2575,92 +3981,35 @@
              IF ( surf_lsm_h%lambda_surface_s(m) == 0.0_wp )  THEN
                 t_surface_h%var_1d(:)    = t_soil_h%var_2d(nzb_soil,m)
-                surf_lsm_h%pt_surface(:) = t_soil_h%var_2d(nzb_soil,m) / exn
+                surf_lsm_h%pt_surface(m) = t_soil_h%var_2d(nzb_soil,m) / exn
              ELSE
-                t_surface_h%var_1d(:)    = pt_surface * exn
-                surf_lsm_h%pt_surface(:) = pt_surface  
+                t_surface_h%var_1d(m)    = pt(k-1,j,i) * exn
+                surf_lsm_h%pt_surface(m) = pt(k-1,j,i)  
              ENDIF
              
-             IF ( cloud_physics  .OR.  cloud_droplets )  THEN
-                pt1 = pt(k,j,i) + l_d_cp * pt_d_t(k) * ql(k,j,i)
+             IF ( cloud_physics  .OR. cloud_droplets ) THEN
+                surf_lsm_h%pt1(m) = pt(k,j,i) + l_d_cp * pt_d_t(k) * ql(k,j,i)
              ELSE
-                pt1 = pt(k,j,i)
-             ENDIF
+                surf_lsm_h%pt1(m) = pt(k,j,i)
+             ENDIF 
+
 
 !
 !--          Assure that r_a cannot be zero at model start
-             IF ( pt1 == surf_lsm_h%pt_surface(m) )  pt1 = pt1 + 1.0E-10_wp
+             IF ( surf_lsm_h%pt1(m) == surf_lsm_h%pt_surface(m) )              &
+                surf_lsm_h%pt1(m) = surf_lsm_h%pt1(m) + 1.0E-20_wp
 
              surf_lsm_h%us(m)   = 0.1_wp
-             surf_lsm_h%ts(m)   = ( pt1 - surf_lsm_h%pt_surface(m) )           &
+             surf_lsm_h%ts(m)   = ( surf_lsm_h%pt1(m) - surf_lsm_h%pt_surface(m) )&
                                   / surf_lsm_h%r_a(m)
              surf_lsm_h%shf(m)  = - surf_lsm_h%us(m) * surf_lsm_h%ts(m)        &
                                   * rho_surface
-
          ENDDO
-
 !
 !--      Vertical surfaces
          DO  l = 0, 3
              DO  m = 1, surf_lsm_v(l)%ns
-             
-                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
-
-             
-!--             Map user settings of T and q for each soil layer
-!--             (make sure that the soil moisture does not drop below the permanent
-!--             wilting point) -> problems with devision by zero)
-                IF ( surf_lsm_v(l)%water_surface(m) )  THEN
-                   surf_lsm_v(l)%z0(m)          = z0_water
-                   surf_lsm_v(l)%z0h(m)         = z0h_water 
-                   surf_lsm_v(l)%z0q(m)         = z0h_water                   
-                   t_soil_v(l)%var_2d(:,m)      = water_temperature
-                   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
-                   
-                ELSEIF ( surf_lsm_v(l)%pavement_surface(m) )  THEN
-                   surf_lsm_v(l)%z0(m)          = z0_pavement
-                   surf_lsm_v(l)%z0h(m)         = z0h_pavement
-                   surf_lsm_v(l)%z0q(m)         = z0h_pavement  
-                   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)  = soil_temperature(nzt_soil+1)
-                   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) = surf_lsm_v(l)%lambda_surface_s(m)
-                   surf_lsm_v(l)%c_surface(m) = pavement_heat_capacity         &
-                                                * dz_soil(nzb_soil)            &
-                                                * 0.25_wp
-                IF ( pavement_type /= 0 )  THEN
-                   DO  k = nzb_soil, nzt_soil  
-                      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
-                        
-                   
-                ELSEIF ( surf_lsm_v(l)%vegetation_surface(m) )  THEN
-
-                   surf_lsm_v(l)%z0(m)          = z0_vegetation
-                   surf_lsm_v(l)%z0h(m)         = z0h_vegetation
-                   surf_lsm_v(l)%z0q(m)         = z0h_vegetation   
-                   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) = soil_temperature(nzt_soil+1)
-                   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)%c_surface(m)        = c_surface
-                ENDIF        
-         
+                i   = surf_lsm_v(l)%i(m)            
+                j   = surf_lsm_v(l)%j(m)
+                k   = surf_lsm_v(l)%k(m)         
 !
 !--             Calculate surface temperature. In case of bare soil, the surface 
@@ -2668,32 +4017,34 @@
 !--             layer
                 IF ( surf_lsm_v(l)%lambda_surface_s(m) == 0.0_wp )  THEN
-                   t_surface_v(l)%var_1d(:)      = t_soil_v(l)%var_2d(nzb_soil,m)
-                   surf_lsm_v(l)%pt_surface(:)   = t_soil_v(l)%var_2d(nzb_soil,m) / exn
+                   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) / exn
                 ELSE
-                   t_surface_v(l)%var_1d(:)      = pt_surface * exn
-                   surf_lsm_v(l)%pt_surface(:)   = pt_surface               
+                   j_off = surf_lsm_v(l)%joff
+                   i_off = surf_lsm_v(l)%ioff
+
+                   t_surface_v(l)%var_1d(m)      = pt(k,j+j_off,i+i_off) * exn
+                   surf_lsm_v(l)%pt_surface(m)   = pt(k,j+j_off,i+i_off)           
                 ENDIF
 
+
+                IF ( cloud_physics  .OR. cloud_droplets ) THEN
+                   surf_lsm_v(l)%pt1(m) = pt(k,j,i) + l_d_cp * pt_d_t(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
-
-                i   = surf_lsm_v(l)%i(m)            
-                j   = surf_lsm_v(l)%j(m)
-                k   = surf_lsm_v(l)%k(m)
-
-                IF ( cloud_physics  .OR.  cloud_droplets )  THEN
-                   pt1 = pt(k,j,i) + l_d_cp * pt_d_t(k) * ql(k,j,i)
-                ELSE
-                   pt1 = pt(k,j,i)
-                ENDIF
-
-!
-!--             Assure that r_a cannot be zero at model start
-                IF ( pt1 == surf_lsm_v(l)%pt_surface(m) )  pt1 = pt1 + 1.0E-10_wp
-
                 surf_lsm_v(l)%us(m)   = 0.1_wp
-                surf_lsm_v(l)%ts(m)   = ( pt1 - 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
+                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
@@ -2715,17 +4066,7 @@
 !
 !--          Set index offset of surface element, seen from atmospheric grid point 
-             IF ( l == 0 )  THEN 
-                j_off = -1 
-                i_off = 0
-             ELSEIF ( l == 1 )  THEN 
-                j_off = 1 
-                i_off = 0
-             ELSEIF ( l == 2 )  THEN 
-                j_off = 0 
-                i_off = -1
-             ELSEIF ( l == 3 )  THEN 
-                j_off = 0 
-                i_off = 1
-             ENDIF
+             j_off = surf_lsm_v(l)%joff
+             i_off = surf_lsm_v(l)%ioff
+
              DO  m = 1, surf_lsm_v(l)%ns
                 i   = surf_lsm_v(l)%i(m)            
@@ -2738,21 +4079,14 @@
        ENDIF
 !
-!--    Initialize root fraction
-!--    Horizontal surfaces
+!--    Level 1 initialization of root distribution - provided by the user via
+!--    via namelist.
        DO  m = 1, surf_lsm_h%ns
-          i   = surf_lsm_h%i(m)            
-          j   = surf_lsm_h%j(m)
-
           DO  k = nzb_soil, nzt_soil
              surf_lsm_h%root_fr(k,m) = root_fraction(k)
           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)
-
              DO  k = nzb_soil, nzt_soil
                 surf_lsm_v(l)%root_fr(k,m) = root_fraction(k)
@@ -2762,8 +4096,8 @@
 
 !
+!--    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
+!--    the root fraction in the individual soil layers.
        IF ( ALL( root_fraction == 9999999.9_wp ) )  THEN
-
 !
 !--       First, calculate the index bounds for integration
@@ -2820,15 +4154,13 @@
 !--       Map calculated root fractions
           DO  m = 1, surf_lsm_h%ns
-             i   = surf_lsm_h%i(m)            
-             j   = surf_lsm_h%j(m)
              DO  k = nzb_soil, nzt_soil 
                 IF ( surf_lsm_h%pavement_surface(m)  .AND.                     &
-                     k <= nzt_pavement )  THEN
+                     k <= surf_lsm_h%nzt_pavement(m) )  THEN
                    surf_lsm_h%root_fr(k,m) = 0.0_wp
                 ELSE
                    surf_lsm_h%root_fr(k,m) = root_fraction(k)
                 ENDIF
-             ENDDO
-
+
+             ENDDO
 !
 !--          Normalize so that the sum = 1. Only relevant when the root         
@@ -2840,14 +4172,10 @@
                 ENDDO
              ENDIF
-
           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)
-
                 DO  k = nzb_soil, nzt_soil
                    IF ( surf_lsm_v(l)%pavement_surface(m)  .AND.               &
-                        k <= nzt_pavement )  THEN
+                        k <= surf_lsm_h%nzt_pavement(m) )  THEN
                       surf_lsm_v(l)%root_fr(k,m) = 0.0_wp
                    ELSE
@@ -2864,27 +4192,41 @@
                    ENDDO
                 ENDIF
-
              ENDDO
            ENDDO
        ENDIF
 !
-!--    Map vegetation parameters to the respective 2D arrays
-       surf_lsm_h%r_canopy_min      = min_canopy_resistance
-       surf_lsm_h%lai               = leaf_area_index
-       surf_lsm_h%c_veg             = vegetation_coverage
-       surf_lsm_h%g_d               = canopy_resistance_coefficient
-       surf_lsm_h%f_sw_in           = f_shortwave_incoming
-
-!--    Vertical surfaces
-       DO  l = 0, 3
-
-!
-!--       Map vegetation parameters to the respective 2D arrays
-          surf_lsm_v(l)%r_canopy_min      = min_canopy_resistance
-          surf_lsm_v(l)%lai               = leaf_area_index
-          surf_lsm_v(l)%c_veg             = vegetation_coverage
-          surf_lsm_v(l)%g_d               = canopy_resistance_coefficient
-          surf_lsm_v(l)%f_sw_in           = f_shortwave_incoming
-       ENDDO
+!--    Level 3 initialization of root distribution.
+!--    Take value from file
+       IF ( root_area_density_lsm_f%from_file )  THEN
+          DO  m = 1, surf_lsm_h%ns
+             IF ( surf_lsm_h%vegetation_surface(m) )  THEN
+                i = surf_lsm_h%i(m) + MERGE( 0, surf_lsm_v(l)%ioff,            &
+                                             surf_lsm_v(l)%building_covered(m) ) 
+                j = surf_lsm_h%j(m) + MERGE( 0, surf_lsm_v(l)%joff,            &
+                                             surf_lsm_v(l)%building_covered(m) ) 
+                DO  k = nzb_soil, nzt_soil 
+                   surf_lsm_h%root_fr(k,m) = root_area_density_lsm_f%var(k,j,i) 
+                ENDDO
+
+             ENDIF
+          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
  
 !
@@ -2912,8 +4254,32 @@
 !--    Store initial profiles of t_soil and m_soil (assuming they are 
 !--    horizontally homogeneous on this 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 )
+!--    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. 
+!--    Ceck for eck for illegal combination of LAI and vegetation coverage.
+       IF ( ANY( .NOT. surf_lsm_h%pavement_surface  .AND.                      &
+                 surf_lsm_h%lai == 0.0_wp  .AND.  surf_lsm_h%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_read_restart_data', 'PA0999', 2, 2, 0, 6, 0 )
+       ENDIF
+
+       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_read_restart_data', 'PA0999', 2, 2, 0, 6, 0 )
+          ENDIF
+       ENDDO
+
 
     END SUBROUTINE lsm_init
@@ -2943,11 +4309,8 @@
 !
 !--    Horizontal surfaces
-       ALLOCATE ( m_liq_h%var_1d(1:surf_lsm_h%ns)                        )
        ALLOCATE ( m_liq_h_p%var_1d(1:surf_lsm_h%ns)                      )
        ALLOCATE ( t_surface_h%var_1d(1:surf_lsm_h%ns)                    )
        ALLOCATE ( t_surface_h_p%var_1d(1:surf_lsm_h%ns)                  )
-       ALLOCATE ( m_soil_h%var_2d(nzb_soil:nzt_soil,1:surf_lsm_h%ns)     )
        ALLOCATE ( m_soil_h_p%var_2d(nzb_soil:nzt_soil,1:surf_lsm_h%ns)   )
-       ALLOCATE ( t_soil_h%var_2d(nzb_soil:nzt_soil+1,1:surf_lsm_h%ns)   )
        ALLOCATE ( t_soil_h_p%var_2d(nzb_soil:nzt_soil+1,1:surf_lsm_h%ns) )
 
@@ -2963,4 +4326,22 @@
           ALLOCATE ( t_soil_v(l)%var_2d(nzb_soil:nzt_soil+1,1:surf_lsm_v(l)%ns)   )
           ALLOCATE ( t_soil_v_p(l)%var_2d(nzb_soil:nzt_soil+1,1:surf_lsm_v(l)%ns) )
+       ENDDO
+!
+!--    Allocate soil temperature and moisture. As these variables might be 
+!--    already allocated in case of restarts, check this. 
+       IF ( .NOT. ALLOCATED( m_liq_h%var_1d ) )                                &
+          ALLOCATE ( m_liq_h%var_1d(1:surf_lsm_h%ns) )
+       IF ( .NOT. ALLOCATED( m_soil_h%var_2d ) )                               &
+          ALLOCATE ( m_soil_h%var_2d(nzb_soil:nzt_soil,1:surf_lsm_h%ns) )
+       IF ( .NOT. ALLOCATED( t_soil_h%var_2d ) )                               &
+          ALLOCATE ( t_soil_h%var_2d(nzb_soil:nzt_soil,1:surf_lsm_h%ns) )
+
+       DO  l = 0, 3
+          IF ( .NOT. ALLOCATED( m_liq_v(l)%var_1d ) )                          &
+             ALLOCATE ( m_liq_v(l)%var_1d(1:surf_lsm_v(l)%ns) )
+          IF ( .NOT. ALLOCATED( m_soil_v(l)%var_2d ) )                         &
+             ALLOCATE ( m_soil_v(l)%var_2d(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns) )
+          IF ( .NOT. ALLOCATED( t_soil_v(l)%var_2d ) )                         &
+             ALLOCATE ( t_soil_v(l)%var_2d(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns) )
        ENDDO
 #else
@@ -2988,4 +4369,12 @@
        ENDDO
 #endif
+!
+!--    Allocate array for heat flux in W/m2, required for radiation?
+!--    Consider to remove this array
+       ALLOCATE( surf_lsm_h%surfhf(1:surf_lsm_h%ns) )
+       DO  l = 0, 3
+          ALLOCATE( surf_lsm_v(l)%surfhf(1:surf_lsm_v(l)%ns) )
+       ENDDO
+
 
 !
@@ -3004,67 +4393,63 @@
           ALLOCATE ( tt_soil_v_m(l)%var_2d(nzb_soil:nzt_soil,1:surf_lsm_v(l)%ns)  )
        ENDDO 
-!
-!--    Allocate skin-surface temperature
-       ALLOCATE ( surf_lsm_h%pt_surface(1:surf_lsm_h%ns) )
-       DO  l = 0, 3
-          ALLOCATE ( surf_lsm_v(l)%pt_surface(1:surf_lsm_v(l)%ns) )
-       ENDDO 
 
 !
 !--    Allocate 2D vegetation model arrays
 !--    Horizontal surfaces
-       ALLOCATE ( surf_lsm_h%building_surface(1:surf_lsm_h%ns) )
-       ALLOCATE ( surf_lsm_h%c_liq(1:surf_lsm_h%ns)            )
-       ALLOCATE ( surf_lsm_h%c_surface(1:surf_lsm_h%ns)        )
-       ALLOCATE ( surf_lsm_h%c_veg(1:surf_lsm_h%ns)            )
-       ALLOCATE ( surf_lsm_h%f_sw_in(1:surf_lsm_h%ns)          )
-       ALLOCATE ( surf_lsm_h%ghf(1:surf_lsm_h%ns)              )
-       ALLOCATE ( surf_lsm_h%g_d(1:surf_lsm_h%ns)              )
-       ALLOCATE ( surf_lsm_h%lai(1:surf_lsm_h%ns)              )
-       ALLOCATE ( surf_lsm_h%lambda_surface_u(1:surf_lsm_h%ns) )
-       ALLOCATE ( surf_lsm_h%lambda_surface_s(1:surf_lsm_h%ns) )
+       ALLOCATE ( surf_lsm_h%building_surface(1:surf_lsm_h%ns)    )
+       ALLOCATE ( surf_lsm_h%c_liq(1:surf_lsm_h%ns)               )
+       ALLOCATE ( surf_lsm_h%c_surface(1:surf_lsm_h%ns)           )
+       ALLOCATE ( surf_lsm_h%c_veg(1:surf_lsm_h%ns)               )
+       ALLOCATE ( surf_lsm_h%f_sw_in(1:surf_lsm_h%ns)             )
+       ALLOCATE ( surf_lsm_h%ghf(1:surf_lsm_h%ns)                 )
+       ALLOCATE ( surf_lsm_h%g_d(1:surf_lsm_h%ns)                 )
+       ALLOCATE ( surf_lsm_h%lai(1:surf_lsm_h%ns)                 )
+       ALLOCATE ( surf_lsm_h%lambda_surface_u(1:surf_lsm_h%ns)    )
+       ALLOCATE ( surf_lsm_h%lambda_surface_s(1:surf_lsm_h%ns)    )
+       ALLOCATE ( surf_lsm_h%nzt_pavement(1:surf_lsm_h%ns)        )
+       ALLOCATE ( surf_lsm_h%pavement_surface(1:surf_lsm_h%ns)    )
+       ALLOCATE ( surf_lsm_h%qsws_soil(1:surf_lsm_h%ns)           )
+       ALLOCATE ( surf_lsm_h%qsws_liq(1:surf_lsm_h%ns)            )
+       ALLOCATE ( surf_lsm_h%qsws_veg(1:surf_lsm_h%ns)            )
+       ALLOCATE ( surf_lsm_h%rad_net_l(1:surf_lsm_h%ns)           ) 
+       ALLOCATE ( surf_lsm_h%r_a(1:surf_lsm_h%ns)                 )
+       ALLOCATE ( surf_lsm_h%r_canopy(1:surf_lsm_h%ns)            )
+       ALLOCATE ( surf_lsm_h%r_soil(1:surf_lsm_h%ns)              )
+       ALLOCATE ( surf_lsm_h%r_soil_min(1:surf_lsm_h%ns)          )
+       ALLOCATE ( surf_lsm_h%r_s(1:surf_lsm_h%ns)                 )
+       ALLOCATE ( surf_lsm_h%r_canopy_min(1:surf_lsm_h%ns)        )
        ALLOCATE ( surf_lsm_h%vegetation_surface(1:surf_lsm_h%ns)  )
-       ALLOCATE ( surf_lsm_h%pavement_surface(1:surf_lsm_h%ns) )
-       ALLOCATE ( surf_lsm_h%qsws_soil(1:surf_lsm_h%ns)        )
-       ALLOCATE ( surf_lsm_h%qsws_liq(1:surf_lsm_h%ns)         )
-       ALLOCATE ( surf_lsm_h%qsws_veg(1:surf_lsm_h%ns)         )
-       ALLOCATE ( surf_lsm_h%rad_net_l(1:surf_lsm_h%ns)        ) 
-       ALLOCATE ( surf_lsm_h%r_a(1:surf_lsm_h%ns)              )
-       ALLOCATE ( surf_lsm_h%r_canopy(1:surf_lsm_h%ns)         )
-       ALLOCATE ( surf_lsm_h%r_soil(1:surf_lsm_h%ns)           )
-       ALLOCATE ( surf_lsm_h%r_soil_min(1:surf_lsm_h%ns)       )
-       ALLOCATE ( surf_lsm_h%r_s(1:surf_lsm_h%ns)              )
-       ALLOCATE ( surf_lsm_h%r_canopy_min(1:surf_lsm_h%ns)     )
-       ALLOCATE ( surf_lsm_h%water_surface(1:surf_lsm_h%ns)    )
-
-       surf_lsm_h%water_surface     = .FALSE.
-       surf_lsm_h%pavement_surface  = .FALSE.
+       ALLOCATE ( surf_lsm_h%water_surface(1:surf_lsm_h%ns)       )
+
+       surf_lsm_h%water_surface        = .FALSE.
+       surf_lsm_h%pavement_surface     = .FALSE.
        surf_lsm_h%vegetation_surface   = .FALSE. 
 !
 !--    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)%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)%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)%water_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.
@@ -3073,4 +4458,5 @@
           
        ENDDO
+
    
 #if ! defined( __nopointer )
@@ -3088,4 +4474,5 @@
        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
 
@@ -3122,5 +4509,6 @@
                                   residual_moisture, root_fraction,            &
                                   saturation_moisture, skip_time_do_lsm,       &
-                                  soil_moisture, soil_temperature, soil_type,  &
+                                  soil_moisture, soil_temperature,             &
+                                  soil_type,                                   &
                                   surface_type,                                &
                                   vegetation_coverage, vegetation_type,        &
@@ -3204,4 +4592,5 @@
        IF ( horizontal )  THEN
           surf           => surf_lsm_h
+
           surf_m_soil    => m_soil_h
           surf_m_soil_p  => m_soil_h_p
@@ -3212,4 +4601,5 @@
        ELSE
           surf           => surf_lsm_v(l)
+
           surf_m_soil    => m_soil_v(l)
           surf_m_soil_p  => m_soil_v_p(l)
@@ -3225,6 +4615,7 @@
              DO  k = nzb_soil, nzt_soil
 
-                IF ( surf%pavement_surface(m)  .AND.  k <= nzt_pavement )  THEN
-                    
+                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) 
@@ -3266,26 +4657,27 @@
              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)
+             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)
+                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) )
+                                       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) )
 
 !
@@ -3299,7 +4691,7 @@
                          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)
+                      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
@@ -3312,11 +4704,11 @@
 !--             In order to prevent water tranport through paved surfaces, 
 !--             conductivity and diffusivity are set to zero
-                IF ( surf%pavement_surface(m)  .AND.  k <= nzt_pavement )  THEN
-
+                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
@@ -3332,7 +4724,8 @@
                    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)) &
+                                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 )  &
+                            )**(                                               &
+                          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)
@@ -3340,9 +4733,13 @@
                    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) ))
+                                                                  )**(         &
+                              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
 
@@ -3381,5 +4778,7 @@
 !--             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
+                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
@@ -3404,5 +4803,5 @@
                     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)
+                                         * surf_m_soil%var_2d(k,m)
                     ENDIF
                 ENDDO  
@@ -3411,5 +4810,5 @@
                       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
+                                      * surf_m_soil%var_2d(k,m) / m_total
                       ELSE
                          root_extr(k) = 0.0_wp
@@ -3428,4 +4827,5 @@
                             + surf%qsws_soil(m) ) * drho_l_lv )                &
                             * ddz_soil(nzb_soil)
+
 
                 DO  k = nzb_soil+1, nzt_soil-1
@@ -3451,6 +4851,7 @@
                 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) )   
+                                         + dt_3d * ( tsc(2) * tend(:)          &
+                                         + tsc(3) * surf_tm_soil_m%var_2d(:,m) )   
+   
 !
 !--             Account for dry soils (find a better solution here!)
@@ -3473,4 +4874,5 @@
                                                     * surf_tm_soil_m%var_2d(k,m)
                       ENDDO
+
                    ENDIF
                 ENDIF
@@ -3526,4 +4928,5 @@
                 m_liq_h   => m_liq_h_1;     m_liq_h_p      => m_liq_h_2
              ENDIF
+
 !
 !--          Vertical surfaces
@@ -3533,4 +4936,5 @@
                 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
 
@@ -3545,4 +4949,5 @@
                 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
 !
@@ -3891,4 +5296,5 @@
                 ENDDO
              ENDDO
+
 !
 !-- 
@@ -4327,5 +5733,5 @@
 !> Write restart data for land surface model
 !------------------------------------------------------------------------------!
- SUBROUTINE lsm_last_actions
+ SUBROUTINE lsm_write_restart_data
  
 
@@ -4335,4 +5741,7 @@
 
     IMPLICIT NONE
+
+    CHARACTER (LEN=1) ::  dum    !< dummy to create correct string for creating variable string
+    INTEGER(iwp)      ::  l      !< index variable for surface orientation
 
     IF ( write_binary )  THEN
@@ -4352,9 +5761,7 @@
           WRITE ( 14 )  'lai_av              ';  WRITE ( 14 )  lai_av
        ENDIF
-       WRITE ( 14 )     'm_liq               ';  WRITE ( 14 )  m_liq_h%var_1d
        IF ( ALLOCATED( m_liq_av ) )  THEN
           WRITE ( 14 )  'm_liq_av            ';  WRITE ( 14 )  m_liq_av
        ENDIF
-       WRITE ( 14 )     'm_soil              ';  WRITE ( 14 )  m_soil_h%var_2d
        IF ( ALLOCATED( m_soil_av ) )  THEN
           WRITE ( 14 )  'm_soil_av           ';  WRITE ( 14 )  m_soil_av
@@ -4369,14 +5776,71 @@
           WRITE ( 14 )  'qsws_veg_av         ';  WRITE ( 14 )  qsws_veg_av
        ENDIF 
-       WRITE ( 14 )     't_soil              ';  WRITE ( 14 )  t_soil_h%var_2d
        IF ( ALLOCATED( t_soil_av ) )  THEN
           WRITE ( 14 )  't_soil_av           ';  WRITE ( 14 )  t_soil_av
        ENDIF
 
+
+       WRITE ( 14 ) 'ns_h_on_file_lsm    '
+       WRITE ( 14 ) surf_lsm_h%ns
+       WRITE ( 14 ) 'ns_v_on_file_lsm    '
+       WRITE ( 14 ) surf_lsm_v(0:3)%ns
+       
+       WRITE ( 14 ) 'lsm_start_index_h   '
+       WRITE ( 14 ) surf_lsm_h%start_index
+       WRITE ( 14 ) 'lsm_end_index_h     '
+       WRITE ( 14 ) surf_lsm_h%end_index
+       WRITE ( 14 ) 't_soil_h            '
+       WRITE ( 14 ) t_soil_h%var_2d
+       
+       DO  l = 0, 3
+          WRITE ( 14 ) 'lsm_start_index_v   '
+          WRITE ( 14 ) surf_lsm_v(l)%start_index
+          WRITE ( 14 ) 'lsm_end_index_v     '
+          WRITE ( 14 ) surf_lsm_v(l)%end_index
+          WRITE( dum, '(I1)')  l          
+          WRITE ( 14 ) 't_soil_v(' // dum // ')         ' 
+          WRITE ( 14 ) t_soil_v(l)%var_2d          
+       ENDDO
+
+       WRITE ( 14 ) 'lsm_start_index_h   '
+       WRITE ( 14 ) surf_lsm_h%start_index
+       WRITE ( 14 ) 'lsm_end_index_h     '
+       WRITE ( 14 ) surf_lsm_h%end_index
+       WRITE ( 14 ) 'm_soil_h            '
+       WRITE ( 14 ) m_soil_h%var_2d
+       
+       DO  l = 0, 3
+          WRITE ( 14 ) 'lsm_start_index_v   '
+          WRITE ( 14 ) surf_lsm_v(l)%start_index
+          WRITE ( 14 ) 'lsm_end_index_v     '
+          WRITE ( 14 ) surf_lsm_v(l)%end_index
+          WRITE( dum, '(I1)')  l          
+          WRITE ( 14 ) 'm_soil_v(' // dum // ')         ' 
+          WRITE ( 14 ) m_soil_v(l)%var_2d          
+       ENDDO
+
+
+       WRITE ( 14 ) 'lsm_start_index_h   '
+       WRITE ( 14 ) surf_lsm_h%start_index
+       WRITE ( 14 ) 'lsm_end_index_h     '
+       WRITE ( 14 ) surf_lsm_h%end_index
+       WRITE ( 14 ) 'm_liq_h             '
+       WRITE ( 14 ) m_liq_h%var_1d
+       
+       DO  l = 0, 3
+          WRITE ( 14 ) 'lsm_start_index_v   '
+          WRITE ( 14 ) surf_lsm_v(l)%start_index
+          WRITE ( 14 ) 'lsm_end_index_v     '
+          WRITE ( 14 ) surf_lsm_v(l)%end_index
+          WRITE( dum, '(I1)')  l          
+          WRITE ( 14 ) 'm_liq_v(' // dum // ')          ' 
+          WRITE ( 14 ) m_liq_v(l)%var_1d          
+       ENDDO
+
        WRITE ( 14 )  '*** end lsm ***     '
 
     ENDIF
 
- END SUBROUTINE lsm_last_actions
+ END SUBROUTINE lsm_write_restart_data
 
 
@@ -4399,19 +5863,23 @@
     CHARACTER (LEN=20) :: field_char   !< 
 
-    INTEGER(iwp) ::  i               !< 
-    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(iwp) ::  overlap_count   !< 
+    INTEGER(iwp) ::  i                 !< 
+    INTEGER(iwp) ::  k                 !< 
+    INTEGER(iwp) ::  l                 !< running index surface orientation
+    INTEGER(iwp) ::  ns_h_on_file_lsm  !< number of horizontal surface elements (natural type) on file
+    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(iwp) ::  overlap_count     !< 
+
+    INTEGER(iwp) ::  ns_v_on_file_lsm(0:3) !< number of vertical surface elements (natural type) on file
 
     INTEGER(iwp), DIMENSION(numprocs_previous_run,1000) ::  nxlfa       !< 
@@ -4422,4 +5890,7 @@
     INTEGER(iwp), DIMENSION(numprocs_previous_run,1000) ::  offset_ya   !< 
 
+    INTEGER(iwp), DIMENSION(nys_on_file:nyn_on_file,nxl_on_file:nxr_on_file) ::  start_index_on_file
+    INTEGER(iwp), DIMENSION(nys_on_file:nyn_on_file,nxl_on_file:nxr_on_file) ::  end_index_on_file
+
     REAL(wp),                                                                  &
        DIMENSION(nys_on_file-nbgp:nyn_on_file+nbgp,nxl_on_file-nbgp:nxr_on_file+nbgp) :: &
@@ -4434,18 +5905,42 @@
           tmp_3d2   !< 
 
-    REAL(wp),                                                                  &
-       DIMENSION(1:surf_lsm_h%ns) ::                                           &
-          tmp_walltype_1d   !< 
-
-    REAL(wp),                                                                  &
-       DIMENSION(nzb_soil:nzt_soil+1,1:surf_lsm_h%ns) ::                       &
-          tmp_walltype_2d   !< 
-
-    REAL(wp),                                                                  &
-       DIMENSION(nzb_soil:nzt_soil,1:surf_lsm_h%ns) ::                         &
-          tmp_walltype_2d2  !< 
-
+    TYPE(surf_type_lsm) :: tmp_walltype_h_1d   !< temporary 1D array containing the respective surface variable stored on file, horizontal surfaces
+    TYPE(surf_type_lsm) :: tmp_walltype_h_2d   !< temporary 2D array containing the respective surface variable stored on file, horizontal surfaces
+    TYPE(surf_type_lsm) :: tmp_walltype_h_2d2  !< temporary 2D array containing the respective surface variable stored on file, horizontal surfaces 
+
+    TYPE(surf_type_lsm), DIMENSION(0:3) :: tmp_walltype_v_1d   !< temporary 1D array containing the respective surface variable stored on file, vertical surfaces 
+    TYPE(surf_type_lsm), DIMENSION(0:3) :: tmp_walltype_v_2d   !< temporary 2D array containing the respective surface variable stored on file, vertical surfaces 
+    TYPE(surf_type_lsm), DIMENSION(0:3) :: tmp_walltype_v_2d2  !< temporary 2D array containing the respective surface variable stored on file, vertical surfaces
 
    IF ( initializing_actions == 'read_restart_data' )  THEN
+      READ ( 13 )  field_char
+
+!
+!--   At first, determine the number of surface elements (with certain orientation) on file
+      IF ( TRIM( field_char ) /= 'ns_h_on_file_lsm' )  THEN
+!
+!--      Add a proper error message
+      ENDIF
+      READ ( 13 ) ns_h_on_file_lsm
+
+      READ ( 13 )  field_char
+      IF ( TRIM( field_char ) /= 'ns_v_on_file_lsm' )  THEN
+!
+!--      Add a proper error message
+      ENDIF
+      READ ( 13 ) ns_v_on_file_lsm
+
+!
+!--   Allocate temporary arrays to store surface data
+      ALLOCATE( tmp_walltype_h_1d%var_1d(1:ns_h_on_file_lsm)                     )
+      ALLOCATE( tmp_walltype_h_2d%var_2d(nzb_soil:nzt_soil+1,1:ns_h_on_file_lsm) )
+      ALLOCATE( tmp_walltype_h_2d2%var_2d(nzb_soil:nzt_soil,1:ns_h_on_file_lsm)  )
+
+      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
+     
       READ ( 13 )  field_char
 
@@ -4463,4 +5958,5 @@
             nync = nynfa(i,k) + offset_ya(i,k)
 
+
             SELECT CASE ( TRIM( field_char ) )
 
@@ -4495,11 +5991,6 @@
                    ENDIF
                    IF ( k == 1 )  READ ( 13 )  tmp_2d
-                   ghf_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =        &
+                   ghf_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =           &
                                   tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-                CASE ( 'm_liq' )
-                   IF ( k == 1 )  READ ( 13 )  tmp_walltype_1d !tmp_2d
-                   m_liq_h%var_1d(1:surf_lsm_h%ns)  =                       &
-                                 tmp_walltype_1d(1:surf_lsm_h%ns)
 
                 CASE ( 'lai_av' )
@@ -4518,9 +6009,4 @@
                    m_liq_av(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp) =         &
                                   tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
-                CASE ( 'm_soil' )
-                   IF ( k == 1 )  READ ( 13 )  tmp_walltype_2d2(:,:)
-                   m_soil_h%var_2d(:,1:surf_lsm_h%ns) =                        &
-                          tmp_walltype_2d2(:,1:surf_lsm_h%ns)   
 
                 CASE ( 'm_soil_av' )
@@ -4556,9 +6042,4 @@
                                           tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
 
-                CASE ( 't_soil' )
-                   IF ( k == 1 )  READ ( 13 )  tmp_walltype_2d(:,:)
-                   t_soil_h%var_2d(:,1:surf_lsm_h%ns) =                        &
-                         tmp_walltype_2d(:,1:surf_lsm_h%ns)      
-
                 CASE ( 't_soil_av' )
                    IF ( .NOT. ALLOCATED( t_soil_av ) )  THEN
@@ -4569,4 +6050,288 @@
                                     tmp_3d2(:,nysf-nbgp:nynf+nbgp,             &
                                     nxlf-nbgp:nxrf+nbgp)
+
+                CASE ( 'lsm_start_index_h', 'lsm_start_index_v'  )   
+                   IF ( k == 1 )                                               &
+                      READ ( 13 )  start_index_on_file
+                      
+                CASE ( 'lsm_end_index_h', 'lsm_end_index_v' )   
+                   IF ( k == 1 )                                               &
+                      READ ( 13 )  end_index_on_file
+                
+                CASE ( 't_soil_h' )
+                 
+                   IF ( k == 1 )  THEN
+                      IF ( .NOT.  ALLOCATED( t_soil_h%var_2d ) )               &
+                         ALLOCATE( t_soil_h%var_2d(nzb_soil:nzt_soil+1,1:surf_lsm_h%ns) )
+                      READ ( 13 )  tmp_walltype_h_2d%var_2d
+                   ENDIF
+                   CALL surface_restore_elements(                              &
+                                              t_soil_h%var_2d,                 &
+                                              tmp_walltype_h_2d%var_2d,        &
+                                              surf_lsm_h%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' )
+                 
+                   IF ( k == 1 )  THEN
+                      IF ( .NOT.  ALLOCATED( m_soil_h%var_2d ) )               &
+                         ALLOCATE( m_soil_h%var_2d(nzb_soil:nzt_soil+1,1:surf_lsm_h%ns) )
+                      READ ( 13 )  tmp_walltype_h_2d2%var_2d
+                   ENDIF
+                   CALL surface_restore_elements(                              &
+                                             m_soil_h%var_2d,                  &
+                                             tmp_walltype_h_2d2%var_2d,        &
+                                             surf_lsm_h%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' )
+                 
+                   IF ( k == 1 )  THEN
+                      IF ( .NOT.  ALLOCATED( m_liq_h%var_1d ) )                &
+                         ALLOCATE( m_liq_h%var_1d(1:surf_lsm_h%ns) )
+                      READ ( 13 )  tmp_walltype_h_1d%var_1d
+                   ENDIF
+                   CALL surface_restore_elements(                              &
+                                              m_liq_h%var_1d,                  &
+                                              tmp_walltype_h_1d%var_1d,        &
+                                              surf_lsm_h%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 )
 
 
@@ -4645,5 +6410,5 @@
 !--          Charnock relation is used.
              surf_lsm_h%z0(m)  = ( 0.11_wp * molecular_viscosity /             &
-                                 surf_lsm_h%us(m) )  &
+                                 surf_lsm_h%us(m) )                            &
                                + ( alpha_ch * surf_lsm_h%us(m)**2 / g )
 
Index: palm/trunk/SOURCE/large_scale_forcing_nudging_mod.f90
===================================================================
--- palm/trunk/SOURCE/large_scale_forcing_nudging_mod.f90	(revision 2689)
+++ palm/trunk/SOURCE/large_scale_forcing_nudging_mod.f90	(revision 2696)
@@ -1,5 +1,5 @@
-!> @file lsf_nudging_mod.f90
-!------------------------------------------------------------------------------!
-! This file is part of PALM.
+!> @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
@@ -25,4 +25,7 @@
 ! -----------------
 ! $Id$
+! Forcing with larger-scale models implemented (MS)
+! 
+! 2342 2017-08-08 11:00:43Z boeske
 ! fixed check if surface forcing data is available until end of simulation
 ! 
@@ -46,19 +49,25 @@
 
     USE arrays_3d,                                                             &
-        ONLY:  heatflux_input_conversion, pt, pt_init, q, q_init, tend,        &
-               u, u_init, ug, v, v_init, vg, w_subs,                           &
-               waterflux_input_conversion, zu                  
+        ONLY:  dzw, 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, data_output_pr, dt_3d, end_time, &  
+        ONLY:  bc_lr, bc_ns, bc_pt_b, bc_q_b, constant_diffusion,              &
+               data_output_pr, dt_3d, end_time, forcing,                       &
+               force_bound_l, force_bound_n, force_bound_r, force_bound_s,     &  
                humidity, intermediate_timestep_count, ibc_pt_b, ibc_q_b,       &
                large_scale_forcing, large_scale_subsidence, lsf_surf, lsf_vert,&
-               lsf_exception, message_string, nudging, passive_scalar,         &
+               lsf_exception, message_string, neutral, nudging, passive_scalar,&
                pt_surface, ocean, q_surface, surface_pressure, topography,     &
                use_subsidence_tendencies
 
+    USE grid_variables
+
+    USE pegrid
 
     USE indices,                                                               &
-        ONLY:  ngp_sums_ls, nxl, nxr, nys, nyn, nzb, nz, nzt, wall_flags_0
+        ONLY:  nbgp, ngp_sums_ls, nx, nxl, nxlg, nxlu, nxr, nxrg, ny, nys,     &
+               nysv, nysg, nyn, nyng, nzb, nz, nzt, wall_flags_0
 
     USE kinds
@@ -70,7 +79,11 @@
         ONLY:  hom, statistic_regions, sums_ls_l, weight_substep
 
+    USE netcdf_data_input_mod,                                                 &
+        ONLY:  force, netcdf_data_input_interpolate
 
     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) ::  d_area_t
 
     REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  ptnudge     !< vertical profile of pot. temperature interpolated to vertical grid (nudging)
@@ -107,9 +120,11 @@
            lsf_nudging_check_parameters, nudge_init,                           &
            lsf_nudging_check_data_output_pr, lsf_nudging_header,               &
-           calc_tnudge, nudge, nudge_ref
+           calc_tnudge, nudge, nudge_ref, forcing_bc_mass_conservation,        &
+           forcing_bc
 !
 !-- Public variables
     PUBLIC qsws_surf, shf_surf, td_lsa_lpt, td_lsa_q, td_sub_lpt,              &
-           td_sub_q, time_vert
+           td_sub_q, time_vert, force
+
 
     INTERFACE ls_advec
@@ -125,4 +140,523 @@
  CONTAINS
 
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> @todo Missing subroutine description.
+!------------------------------------------------------------------------------!
+    SUBROUTINE forcing_bc_mass_conservation
+
+       USE control_parameters,                                                 &
+           ONLY:  volume_flow
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i !<
+       INTEGER(iwp) ::  j !<
+       INTEGER(iwp) ::  k !<
+
+       REAL(wp) ::  w_correct !< 
+       REAL(wp), DIMENSION(1:3) ::  volume_flow_l   !<
+
+       volume_flow   = 0.0_wp
+       volume_flow_l = 0.0_wp
+
+       d_area_t = 1.0_wp / ( ( nx + 1 ) * dx * ( ny + 1 ) * dy )
+
+       IF ( force_bound_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   &
+                                     * MERGE( 1.0_wp, 0.0_wp,                  &
+                                              BTEST( wall_flags_0(k,j,i), 1 ) )
+             ENDDO
+          ENDDO
+       ENDIF
+       IF ( force_bound_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   &
+                                     * MERGE( 1.0_wp, 0.0_wp,                  &
+                                              BTEST( wall_flags_0(k,j,i), 1 ) )
+             ENDDO
+          ENDDO
+       ENDIF
+       IF ( force_bound_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   &
+                                     * MERGE( 1.0_wp, 0.0_wp,                  &
+                                              BTEST( wall_flags_0(k,j,i), 2 ) )
+             ENDDO
+          ENDDO
+       ENDIF
+       IF ( force_bound_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   &
+                                     * MERGE( 1.0_wp, 0.0_wp,                  &
+                                              BTEST( wall_flags_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
+
+       w_correct = SUM( volume_flow ) * d_area_t
+
+       DO  i = nxl, nxr
+          DO  j = nys, nyn
+             DO  k = nzt, nzt + 1
+                w(k,j,i) = w(k,j,i) + w_correct
+             ENDDO
+          ENDDO
+       ENDDO
+
+    END SUBROUTINE forcing_bc_mass_conservation
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> @todo Missing subroutine description.
+!------------------------------------------------------------------------------!
+    SUBROUTINE forcing_bc
+
+       USE control_parameters,                                                 &
+           ONLY:  force_bound_l, force_bound_n, force_bound_r, force_bound_s,  &
+                  humidity, neutral, passive_scalar, simulated_time
+
+       USE netcdf_data_input_mod,                                              &
+           ONLY:  force                              
+
+       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) ::  t !< running index for time levels
+
+       REAL(wp) ::  ddt_lsf !< inverse value of time resolution of forcing data
+       REAL(wp) ::  t_ref   !< time past since last reference step
+
+!
+!--    If required, interpolate and/or extrapolate data vertically. This is 
+!--    required as Inifor outputs only equidistant vertical data.
+       IF ( ANY( zu(1:nzt+1) /= force%zu_atmos(1:force%nzu) ) )  THEN
+          IF ( .NOT. force%interpolated )  THEN
+
+             DO  t = 0, 1
+                IF ( force_bound_l )  THEN
+                   CALL netcdf_data_input_interpolate( force%u_left(t,:,:),    &
+                                                       zu(nzb+1:nzt+1),        &
+                                                       force%zu_atmos )
+                   CALL netcdf_data_input_interpolate( force%v_left(t,:,:),    &
+                                                       zu(nzb+1:nzt+1),        &
+                                                       force%zu_atmos )
+                   CALL netcdf_data_input_interpolate( force%w_left(t,:,:),    &
+                                                       zw(nzb+1:nzt+1),        &
+                                                       force%zw_atmos )
+                   IF ( .NOT. neutral )                                        &
+                      CALL netcdf_data_input_interpolate( force%pt_left(t,:,:),&
+                                                          zu(nzb+1:nzt+1),     &
+                                                          force%zu_atmos )
+                   IF ( humidity )                                             &
+                      CALL netcdf_data_input_interpolate( force%q_left(t,:,:), &
+                                                          zu(nzb+1:nzt+1),     &
+                                                          force%zu_atmos )
+                ENDIF
+                IF ( force_bound_r )  THEN
+                   CALL netcdf_data_input_interpolate( force%u_right(t,:,:),   &
+                                                       zu(nzb+1:nzt+1),        &
+                                                       force%zu_atmos )
+                   CALL netcdf_data_input_interpolate( force%v_right(t,:,:),   &
+                                                       zu(nzb+1:nzt+1),        &
+                                                       force%zu_atmos )
+                   CALL netcdf_data_input_interpolate( force%w_right(t,:,:),   &
+                                                       zw(nzb+1:nzt+1),        &
+                                                       force%zw_atmos )
+                   IF ( .NOT. neutral )                                        &
+                      CALL netcdf_data_input_interpolate( force%pt_right(t,:,:),&
+                                                          zu(nzb+1:nzt+1),     &
+                                                          force%zu_atmos )
+                   IF ( humidity )                                             &
+                      CALL netcdf_data_input_interpolate( force%q_right(t,:,:),&
+                                                          zu(nzb+1:nzt+1),     &
+                                                          force%zu_atmos )
+                ENDIF
+                IF ( force_bound_n )  THEN
+                   CALL netcdf_data_input_interpolate( force%u_north(t,:,:),   &
+                                                       zu(nzb+1:nzt+1),        &
+                                                       force%zu_atmos )
+                   CALL netcdf_data_input_interpolate( force%v_north(t,:,:),   &
+                                                       zu(nzb+1:nzt+1),        &
+                                                       force%zu_atmos )
+                   CALL netcdf_data_input_interpolate( force%w_north(t,:,:),   &
+                                                       zw(nzb+1:nzt+1),        &
+                                                       force%zw_atmos )
+                   IF ( .NOT. neutral )                                        &
+                      CALL netcdf_data_input_interpolate( force%pt_north(t,:,:),&
+                                                          zu(nzb+1:nzt+1),     &
+                                                          force%zu_atmos )
+                   IF ( humidity )                                             &
+                      CALL netcdf_data_input_interpolate( force%q_north(t,:,:),&
+                                                          zu(nzb+1:nzt+1),     &
+                                                          force%zu_atmos )
+                ENDIF
+                IF ( force_bound_s )  THEN
+                   CALL netcdf_data_input_interpolate( force%u_south(t,:,:),   &
+                                                       zu(nzb+1:nzt+1),        &
+                                                       force%zu_atmos )
+                   CALL netcdf_data_input_interpolate( force%v_south(t,:,:),   &
+                                                       zu(nzb+1:nzt+1),        &
+                                                       force%zu_atmos )
+                   CALL netcdf_data_input_interpolate( force%w_south(t,:,:),   &
+                                                       zw(nzb+1:nzt+1),        &
+                                                       force%zw_atmos )
+                   IF ( .NOT. neutral )                                        &
+                      CALL netcdf_data_input_interpolate( force%pt_south(t,:,:),&
+                                                          zu(nzb+1:nzt+1),     &
+                                                          force%zu_atmos )
+                   IF ( humidity )                                             &
+                      CALL netcdf_data_input_interpolate( force%q_south(t,:,:),&
+                                                          zu(nzb+1:nzt+1),     &
+                                                          force%zu_atmos )
+                ENDIF
+             ENDDO
+!
+!--          Note, no interpolation of top boundary. Just use initial value. 
+!--          No physical meaningful extrapolation possible if only one layer is
+!--          given. 
+
+             force%interpolated = .TRUE. 
+          ENDIF
+       ENDIF
+      
+!
+!--    Calculate time interval of forcing data       
+       ddt_lsf = 1.0_wp / ( force%time(force%tind_p) - force%time(force%tind) )
+!
+!--    Calculate reziproke time past since last reference step. Please note, 
+!--    as simulated time is still not updated, the actual time here is 
+!--    simulated time + dt_3d
+       t_ref = simulated_time + dt_3d - force%time(force%tind)
+
+       IF ( force_bound_l )  THEN
+
+          DO  j = nys, nyn
+             DO  k = nzb+1, nzt+1
+                u(k,j,nxlg:nxl) = force%u_left(0,k,j) + ddt_lsf * t_ref *      &
+                         ( force%u_left(1,k,j) - force%u_left(0,k,j) ) *       &
+                           MERGE( 1.0_wp, 0.0_wp,                              &
+                                  BTEST( wall_flags_0(k,j,nxlg:nxl), 1 ) )
+             ENDDO
+          ENDDO
+
+          DO  j = nys, nyn
+             DO  k = nzb+1, nzt
+                w(k,j,nxlg:nxl-1) = force%w_left(0,k,j) + ddt_lsf * t_ref *    &
+                         ( force%w_left(1,k,j) - force%w_left(0,k,j) ) *       &
+                           MERGE( 1.0_wp, 0.0_wp,                              &
+                                  BTEST( wall_flags_0(k,j,nxlg:nxl-1), 3 ) )
+             ENDDO
+          ENDDO
+
+          DO  j = nysv, nyn
+             DO  k = nzb+1, nzt+1
+                v(k,j,nxlg:nxl-1) = force%v_left(0,k,j) + ddt_lsf * t_ref *    &
+                         ( force%v_left(1,k,j) - force%v_left(0,k,j) ) *       &
+                           MERGE( 1.0_wp, 0.0_wp,                              &
+                                  BTEST( wall_flags_0(k,j,nxlg:nxl-1), 2 ) )
+             ENDDO
+          ENDDO
+
+          IF ( .NOT. neutral )  THEN
+             DO  j = nys, nyn
+                DO  k = nzb+1, nzt+1
+                   pt(k,j,nxlg:nxl-1) = force%pt_left(0,k,j) + ddt_lsf *       &
+                                                                  t_ref   *    &
+                       ( force%pt_left(1,k,j) - force%pt_left(0,k,j) )
+ 
+                ENDDO
+             ENDDO
+          ENDIF
+
+          IF ( humidity )  THEN
+             DO  j = nys, nyn
+                DO  k = nzb+1, nzt+1
+                   q(k,j,nxlg:nxl-1) = force%q_left(0,k,j) + ddt_lsf   *       &
+                                                                  t_ref   *    &
+                       ( force%q_left(1,k,j) - force%q_left(0,k,j) )
+ 
+                ENDDO
+             ENDDO
+          ENDIF
+
+       ENDIF
+
+       IF ( force_bound_r )  THEN
+
+          DO  j = nys, nyn
+             DO  k = nzb+1, nzt+1
+                u(k,j,nxr+1:nxrg) = force%u_right(0,k,j) + ddt_lsf * t_ref *   &
+                        ( force%u_right(1,k,j) - force%u_right(0,k,j) ) *      &
+                           MERGE( 1.0_wp, 0.0_wp,                              &
+                                  BTEST( wall_flags_0(k,j,nxr+1:nxrg), 1 ) )
+
+             ENDDO
+          ENDDO
+          DO  j = nys, nyn
+             DO  k = nzb+1, nzt
+                w(k,j,nxr+1:nxrg) = force%w_right(0,k,j) + ddt_lsf * t_ref *   &
+                        ( force%w_right(1,k,j) - force%w_right(0,k,j) ) *      &
+                           MERGE( 1.0_wp, 0.0_wp,                              &
+                                  BTEST( wall_flags_0(k,j,nxr+1:nxrg), 3 ) )
+             ENDDO
+          ENDDO
+
+          DO  j = nysv, nyn
+             DO  k = nzb+1, nzt+1
+                v(k,j,nxr+1:nxrg) = force%v_right(0,k,j) + ddt_lsf * t_ref *   &
+                        ( force%v_right(1,k,j) - force%v_right(0,k,j) ) *      &
+                           MERGE( 1.0_wp, 0.0_wp,                              &
+                                  BTEST( wall_flags_0(k,j,nxr+1:nxrg), 2 ) )
+             ENDDO
+          ENDDO
+
+          IF ( .NOT. neutral )  THEN
+             DO  j = nys, nyn
+                DO  k = nzb+1, nzt+1
+                   pt(k,j,nxr+1:nxrg) = force%pt_right(0,k,j) + ddt_lsf *      &
+                                                                  t_ref   *    &
+                     ( force%pt_right(1,k,j) - force%pt_right(0,k,j) )
+ 
+                ENDDO
+             ENDDO
+          ENDIF
+
+          IF ( humidity )  THEN
+             DO  j = nys, nyn
+                DO  k = nzb+1, nzt+1
+                   q(k,j,nxr+1:nxrg) = force%q_right(0,k,j) + ddt_lsf   *      &
+                                                                  t_ref   *    &
+                       ( force%q_right(1,k,j) - force%q_right(0,k,j) )
+ 
+                ENDDO
+             ENDDO
+          ENDIF
+
+       ENDIF
+
+       IF ( force_bound_s )  THEN
+
+          DO  i = nxl, nxr
+             DO  k = nzb+1, nzt+1
+                v(k,nysg:nys,i)   = force%v_south(0,k,i) + ddt_lsf * t_ref *   &
+                        ( force%v_south(1,k,i) - force%v_south(0,k,i) ) *      &
+                           MERGE( 1.0_wp, 0.0_wp,                              &
+                                  BTEST( wall_flags_0(k,nysg:nys,i), 2 ) )
+             ENDDO
+          ENDDO
+
+          DO  i = nxl, nxr
+             DO  k = nzb+1, nzt
+                w(k,nysg:nys-1,i) = force%w_south(0,k,i) + ddt_lsf * t_ref *   &
+                        ( force%w_south(1,k,i) - force%w_south(0,k,i) ) *      &
+                           MERGE( 1.0_wp, 0.0_wp,                              &
+                                  BTEST( wall_flags_0(k,nysg:nys-1,i), 3 ) )
+             ENDDO
+          ENDDO
+
+          DO  i = nxlu, nxr
+             DO  k = nzb+1, nzt+1
+                u(k,nysg:nys-1,i) = force%u_south(0,k,i) + ddt_lsf * t_ref *   &
+                        ( force%u_south(1,k,i) - force%u_south(0,k,i) ) *      &
+                           MERGE( 1.0_wp, 0.0_wp,                              &
+                                  BTEST( wall_flags_0(k,nysg:nys-1,i), 1 ) )
+             ENDDO
+          ENDDO
+
+          IF ( .NOT. neutral )  THEN
+             DO  i = nxl, nxr
+                DO  k = nzb+1, nzt+1
+                   pt(k,nysg:nys-1,i) = force%pt_south(0,k,i) + ddt_lsf *      &
+                                                                  t_ref   *    &
+                     ( force%pt_south(1,k,i) - force%pt_south(0,k,i) )
+ 
+                ENDDO
+             ENDDO
+          ENDIF
+
+          IF ( humidity )  THEN
+             DO  i = nxl, nxr
+                DO  k = nzb+1, nzt+1
+                   q(k,nysg:nys-1,i) = force%q_south(0,k,i) + ddt_lsf   *      &
+                                                                  t_ref   *    &
+                       ( force%q_south(1,k,i) - force%q_south(0,k,i) )
+ 
+                ENDDO
+             ENDDO
+          ENDIF
+
+       ENDIF
+
+       IF ( force_bound_n )  THEN
+
+          DO  i = nxl, nxr
+             DO  k = nzb+1, nzt+1
+                v(k,nyn+1:nyng,i)   = force%v_north(0,k,i) + ddt_lsf * t_ref * &
+                        ( force%v_north(1,k,i) - force%v_north(0,k,i) ) *      &
+                           MERGE( 1.0_wp, 0.0_wp,                              &
+                                  BTEST( wall_flags_0(k,nyn+1:nyng,i), 2 ) )
+             ENDDO
+          ENDDO
+          DO  i = nxl, nxr
+             DO  k = nzb+1, nzt
+                w(k,nyn+1:nyng,i) = force%w_north(0,k,i) + ddt_lsf * t_ref *   &
+                        ( force%w_north(1,k,i) - force%w_north(0,k,i) ) *      &
+                           MERGE( 1.0_wp, 0.0_wp,                              &
+                                  BTEST( wall_flags_0(k,nyn+1:nyng,i), 3 ) )
+             ENDDO
+          ENDDO
+
+          DO  i = nxlu, nxr
+             DO  k = nzb+1, nzt+1
+                u(k,nyn+1:nyng,i) = force%u_north(0,k,i) + ddt_lsf * t_ref *   &
+                        ( force%u_north(1,k,i) - force%u_north(0,k,i) ) *      &
+                           MERGE( 1.0_wp, 0.0_wp,                              &
+                                  BTEST( wall_flags_0(k,nyn+1:nyng,i), 1 ) )
+
+             ENDDO
+          ENDDO
+
+          IF ( .NOT. neutral )  THEN
+             DO  i = nxl, nxr
+                DO  k = nzb+1, nzt+1
+                   pt(k,nyn+1:nyng,i) = force%pt_north(0,k,i) + ddt_lsf *      &
+                                                                  t_ref   *    &
+                     ( force%pt_north(1,k,i) - force%pt_north(0,k,i) )
+ 
+                ENDDO
+             ENDDO
+          ENDIF
+
+          IF ( humidity )  THEN
+             DO  i = nxl, nxr
+                DO  k = nzb+1, nzt+1
+                   q(k,nyn+1:nyng,i) = force%q_north(0,k,i) + ddt_lsf   *      &
+                                                                  t_ref   *    &
+                       ( force%q_north(1,k,i) - force%q_north(0,k,i) )
+ 
+                ENDDO
+             ENDDO
+          ENDIF
+
+       ENDIF
+!
+!--    Top boundary. 
+!--    Please note, only map Inifor data on model top in case the numeric is
+!--    identical to the Inifor grid. At the top boundary an extrapolation is 
+!--    not possible. 
+       IF ( ANY( zu(1:nzt+1) /= force%zu_atmos(1:force%nzu) ) )  THEN
+          DO  i = nxlu, nxr
+             DO  j = nys, nyn
+                u(nzt+1,j,i) = force%u_top(0,j,i) + ddt_lsf * t_ref *          &
+                           ( force%u_top(1,j,i) - force%u_top(0,j,i) ) *       &
+                              MERGE( 1.0_wp, 0.0_wp,                           &
+                                     BTEST( wall_flags_0(nzt+1,j,i), 1 ) )
+             ENDDO
+          ENDDO
+
+          DO  i = nxl, nxr
+             DO  j = nysv, nyn
+                v(nzt+1,j,i) = force%v_top(0,j,i) + ddt_lsf * t_ref *          &
+                           ( force%v_top(1,j,i) - force%v_top(0,j,i) ) *       &
+                              MERGE( 1.0_wp, 0.0_wp,                           &
+                                     BTEST( wall_flags_0(nzt+1,j,i), 2 ) )
+             ENDDO
+          ENDDO
+
+          DO  i = nxl, nxr
+             DO  j = nys, nyn
+                w(nzt:nzt+1,j,i) = force%w_top(0,j,i) + ddt_lsf * t_ref *      &
+                           ( force%w_top(1,j,i) - force%w_top(0,j,i) ) *       &
+                              MERGE( 1.0_wp, 0.0_wp,                           &
+                                     BTEST( wall_flags_0(nzt:nzt+1,j,i), 3 ) )
+             ENDDO
+          ENDDO
+
+
+          IF ( .NOT. neutral )  THEN
+             DO  i = nxl, nxr
+                DO  j = nys, nyn
+                   pt(nzt+1,j,i) = force%pt_top(0,j,i) + ddt_lsf * t_ref *     &
+                           ( force%pt_top(1,j,i) - force%pt_top(0,j,i) )
+                ENDDO
+             ENDDO
+          ENDIF
+
+          IF ( humidity )  THEN
+             DO  i = nxl, nxr
+                DO  j = nys, nyn
+                   q(nzt+1,j,i) = force%q_top(0,j,i) + ddt_lsf * t_ref *       &
+                           ( force%q_top(1,j,i) - force%q_top(0,j,i) )
+                ENDDO
+             ENDDO
+          ENDIF
+       ENDIF
+!
+!--    Moreover, set Neumann boundary condition for subgrid-scale TKE and 
+!--    passive scalar
+       IF ( .NOT. constant_diffusion )  THEN
+          IF (  force_bound_l )  e(:,:,nxl-1) = e(:,:,nxl)
+          IF (  force_bound_r )  e(:,:,nxr+1) = e(:,:,nxr)
+          IF (  force_bound_s )  e(:,nys-1,:) = e(:,nys,:)
+          IF (  force_bound_n )  e(:,nyn+1,:) = e(:,nyn,:)
+          e(nzt+1,:,:) = e(nzt,:,:)
+       ENDIF
+       IF ( passive_scalar )  THEN
+          IF (  force_bound_l )  s(:,:,nxl-1) = s(:,:,nxl)
+          IF (  force_bound_r )  s(:,:,nxr+1) = s(:,:,nxr)
+          IF (  force_bound_s )  s(:,nys-1,:) = s(:,nys,:)
+          IF (  force_bound_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 )
+
+!
+!--    Set surface pressure. Please note, time-dependent surface
+!--    pressure would require changes in anelastic approximation and 
+!--    treatment of fluxes. 
+!--    For the moment, comment this out! 
+!      surface_pressure = force%surface_pressure(force%tind) +                 &
+!                                                      ddt_lsf * t_ref *       &
+!                                    ( force%surface_pressure(force%tind_p)    &
+!                                    - force%surface_pressure(force%tind) )
+
+    END SUBROUTINE forcing_bc
 
 !------------------------------------------------------------------------------!
@@ -403,4 +937,7 @@
     SUBROUTINE lsf_init
 
+       USE netcdf_data_input_mod,                                              &
+           ONLY:  netcdf_data_input_lsf  
+
        IMPLICIT NONE
 
@@ -411,5 +948,6 @@
        INTEGER(iwp) ::  finput = 90   !<
        INTEGER(iwp) ::  k             !<
-       INTEGER(iwp) ::  nt             !<
+       INTEGER(iwp) ::  nt            !<
+       INTEGER(iwp) ::  t             !< running index for time levels
 
        REAL(wp) ::  fac               !<
@@ -432,105 +970,224 @@
        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 ( forcing )  THEN
+!
+!--       Allocate arrays for reading boundary values. Arrays will incorporate 2 
+!--       time levels in order to interpolate in between. 
+          IF ( force_bound_l )  THEN
+             ALLOCATE( force%u_left(0:1,nzb+1:nzt+1,nys:nyn)  )
+             ALLOCATE( force%v_left(0:1,nzb+1:nzt+1,nysv:nyn) )
+             ALLOCATE( force%w_left(0:1,nzb+1:nzt,nys:nyn)    )
+             IF ( humidity )      ALLOCATE( force%q_left(0:1,nzb+1:nzt+1,nys:nyn)  )
+             IF ( .NOT. neutral ) ALLOCATE( force%pt_left(0:1,nzb+1:nzt+1,nys:nyn) )
+          ENDIF
+          IF ( force_bound_r )  THEN
+             ALLOCATE( force%u_right(0:1,nzb+1:nzt+1,nys:nyn)  )
+             ALLOCATE( force%v_right(0:1,nzb+1:nzt+1,nysv:nyn) )
+             ALLOCATE( force%w_right(0:1,nzb+1:nzt,nys:nyn)    )
+             IF ( humidity )      ALLOCATE( force%q_right(0:1,nzb+1:nzt+1,nys:nyn)  )
+             IF ( .NOT. neutral ) ALLOCATE( force%pt_right(0:1,nzb+1:nzt+1,nys:nyn) )
+          ENDIF
+          IF ( force_bound_n )  THEN
+             ALLOCATE( force%u_north(0:1,nzb+1:nzt+1,nxlu:nxr) )
+             ALLOCATE( force%v_north(0:1,nzb+1:nzt+1,nxl:nxr)  )
+             ALLOCATE( force%w_north(0:1,nzb+1:nzt,nxl:nxr)    )
+             IF ( humidity )      ALLOCATE( force%q_north(0:1,nzb+1:nzt+1,nxl:nxr)  )
+             IF ( .NOT. neutral ) ALLOCATE( force%pt_north(0:1,nzb+1:nzt+1,nxl:nxr) )
+          ENDIF
+          IF ( force_bound_s )  THEN
+             ALLOCATE( force%u_south(0:1,nzb+1:nzt+1,nxlu:nxr) )
+             ALLOCATE( force%v_south(0:1,nzb+1:nzt+1,nxl:nxr)  )
+             ALLOCATE( force%w_south(0:1,nzb+1:nzt,nxl:nxr)    )
+             IF ( humidity )      ALLOCATE( force%q_south(0:1,nzb+1:nzt+1,nxl:nxr)  )
+             IF ( .NOT. neutral ) ALLOCATE( force%pt_south(0:1,nzb+1:nzt+1,nxl:nxr) )
+          ENDIF
+          
+          ALLOCATE( force%u_top(0:1,nys:nyn,nxlu:nxr) )
+          ALLOCATE( force%v_top(0:1,nysv:nyn,nxl:nxr) )
+          ALLOCATE( force%w_top(0:1,nys:nyn,nxl:nxr)  )
+          IF ( humidity )      ALLOCATE( force%q_top(0:1,nys:nyn,nxl:nxr)  )
+          IF ( .NOT. neutral ) ALLOCATE( force%pt_top(0:1,nys:nyn,nxl:nxr) )
+
+!
+!--       Initial call of input. Time array, initial 3D data of u, v, w, 
+!--       potential temperature, as well as mixing ratio, will be read. 
+!--       Moreover, data at lateral and top boundary will be read.  
+          CALL netcdf_data_input_lsf
+!
+!--       Please note, at the moment INIFOR assumes only an equidistant vertical
+!--       grid. In case of vertical grid stretching, input of inital 3D data 
+!--       need to be inter- and/or extrapolated. 
+!--       Therefore, check if zw grid on file is identical to numeric zw grid.   
+          IF ( ANY( zu(1:nzt+1) /= force%zu_atmos(1:force%nzu) ) )  THEN
+!
+!--          Also data at the boundaries need to be inter/extrapolated at both
+!--          time levels
+             DO  t = 0, 1
+                IF ( force_bound_l )  THEN
+                   CALL netcdf_data_input_interpolate( force%u_left(t,:,:),    &
+                                                       zu(1:nzt+1),            &
+                                                       force%zu_atmos )
+                   CALL netcdf_data_input_interpolate( force%v_left(t,:,:),    &
+                                                       zu(1:nzt+1),            &
+                                                       force%zu_atmos )
+                   CALL netcdf_data_input_interpolate( force%w_left(t,:,:),    &
+                                                       zw(1:nzt+1),            &
+                                                       force%zw_atmos )
+                   IF ( .NOT. neutral )                                        &
+                      CALL netcdf_data_input_interpolate( force%pt_left(t,:,:),&
+                                                          zu(1:nzt+1),         &
+                                                          force%zu_atmos )
+                   IF ( humidity )                                             &
+                      CALL netcdf_data_input_interpolate( force%q_left(t,:,:), &
+                                                          zu(1:nzt+1),         &
+                                                          force%zu_atmos )
+                ENDIF
+                IF ( force_bound_r )  THEN
+                   CALL netcdf_data_input_interpolate( force%u_right(t,:,:),   &
+                                                       zu(1:nzt+1),            &
+                                                       force%zu_atmos )
+                   CALL netcdf_data_input_interpolate( force%v_right(t,:,:),   &
+                                                       zu(1:nzt+1),            &
+                                                       force%zu_atmos )
+                   CALL netcdf_data_input_interpolate( force%w_right(t,:,:),   &
+                                                       zw(1:nzt+1),            &
+                                                       force%zw_atmos )
+                   IF ( .NOT. neutral )                                        &
+                      CALL netcdf_data_input_interpolate( force%pt_right(t,:,:),&
+                                                          zu(1:nzt+1),          &
+                                                          force%zu_atmos )
+                   IF ( humidity )                                             &
+                      CALL netcdf_data_input_interpolate( force%q_right(t,:,:),&
+                                                          zu(1:nzt+1),         &
+                                                          force%zu_atmos )
+                ENDIF
+                IF ( force_bound_n )  THEN
+                   CALL netcdf_data_input_interpolate( force%u_north(t,:,:),   &
+                                                       zu(1:nzt+1),            &
+                                                       force%zu_atmos )
+                   CALL netcdf_data_input_interpolate( force%v_north(t,:,:),   &
+                                                       zu(1:nzt+1),            &
+                                                       force%zu_atmos )
+                   CALL netcdf_data_input_interpolate( force%w_north(t,:,:),   &
+                                                       zw(1:nzt+1),            &
+                                                       force%zw_atmos )
+                   IF ( .NOT. neutral )                                        &
+                      CALL netcdf_data_input_interpolate( force%pt_north(t,:,:),&
+                                                          zu(1:nzt+1),          &
+                                                          force%zu_atmos )
+                   IF ( humidity )                                             &
+                      CALL netcdf_data_input_interpolate( force%q_north(t,:,:),&
+                                                          zu(1:nzt+1),         &
+                                                          force%zu_atmos )
+                ENDIF
+                IF ( force_bound_s )  THEN
+                   CALL netcdf_data_input_interpolate( force%u_south(t,:,:),   &
+                                                       zu(1:nzt+1),            &
+                                                       force%zu_atmos )
+                   CALL netcdf_data_input_interpolate( force%v_south(t,:,:),   &
+                                                       zu(1:nzt+1),            &
+                                                       force%zu_atmos )
+                   CALL netcdf_data_input_interpolate( force%w_south(t,:,:),   &
+                                                       zw(1:nzt+1),            &
+                                                       force%zw_atmos )
+                   IF ( .NOT. neutral )                                        &
+                      CALL netcdf_data_input_interpolate( force%pt_south(t,:,:),&
+                                                          zu(1:nzt+1),          &
+                                                          force%zu_atmos )
+                   IF ( humidity )                                             &
+                      CALL netcdf_data_input_interpolate( force%q_south(t,:,:),&
+                                                          zu(1:nzt+1),         &
+                                                          force%zu_atmos )
+                ENDIF
+             ENDDO
+          ENDIF
+
+!
+!--       Exchange ghost points
+          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 )
+!
+!--       At lateral boundaries, set also initial boundary conditions
+          IF ( force_bound_l )  THEN
+             u(:,:,nxl)   = u(:,:,nxlu)
+             v(:,:,nxl-1) = v(:,:,nxl)
+             w(:,:,nxl-1) = w(:,:,nxl)
+             IF ( .NOT. neutral )  pt(:,:,nxl-1) = pt(:,:,nxl)
+             IF ( humidity      )  q(:,:,nxl-1)  = q(:,:,nxl)
+          ENDIF
+          IF ( force_bound_r )  THEN
+             u(:,:,nxr+1) = u(:,:,nxr)
+             v(:,:,nxr+1) = v(:,:,nxr)
+             w(:,:,nxr+1) = w(:,:,nxr)
+             IF ( .NOT. neutral )  pt(:,:,nxr+1) = pt(:,:,nxr)
+             IF ( humidity      )  q(:,:,nxr+1)  = q(:,:,nxr)
+          ENDIF
+          IF ( force_bound_s )  THEN
+             u(:,nys-1,:) = u(:,nys,:)
+             v(:,nys,:)   = v(:,nysv,:)
+             w(:,nys-1,:) = w(:,nys,:)
+             IF ( .NOT. neutral )  pt(:,nys-1,:) = pt(:,nys,:)
+             IF ( humidity      )  q(:,nys-1,:)  = q(:,nys,:)
+          ENDIF
+          IF ( force_bound_n )  THEN
+             u(:,nyn+1,:) = u(:,nyn,:)
+             v(:,nyn+1,:) = v(:,nyn,:)
+             w(:,nyn+1,:) = w(:,nyn,:)
+             IF ( .NOT. neutral )  pt(:,nyn+1,:) = pt(:,nyn,:)
+             IF ( humidity      )  q(:,nyn+1,:)  = q(:,nyn,:)
+          ENDIF
+
+!
+!--       After 3D data is initialized, ensure mass conservation
+          CALL forcing_bc_mass_conservation
+!
+!--       Initialize surface pressure. Please note, time-dependent surface
+!--       pressure would require changes in anelastic approximation and 
+!--       treatment of fluxes. 
+!--       For the moment, comment this out! 
+!         surface_pressure = force%surface_pressure(0)
+
+       ELSE
+
+          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
-            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
+             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'
@@ -538,81 +1195,146 @@
           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 )
+!
+!--       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
 
-!
-!--          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 )
-
+             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 )
+
+       ENDIF
 
     END SUBROUTINE lsf_init
@@ -1396,3 +2118,4 @@
     END SUBROUTINE nudge_ref
 
+
  END MODULE lsf_nudging_mod
Index: palm/trunk/SOURCE/local_stop.f90
===================================================================
--- palm/trunk/SOURCE/local_stop.f90	(revision 2689)
+++ palm/trunk/SOURCE/local_stop.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file local_stop.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/local_system.f90
===================================================================
--- palm/trunk/SOURCE/local_system.f90	(revision 2689)
+++ palm/trunk/SOURCE/local_system.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file local_system.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/local_tremain.f90
===================================================================
--- palm/trunk/SOURCE/local_tremain.f90	(revision 2689)
+++ palm/trunk/SOURCE/local_tremain.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file local_tremain.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/local_tremain_ini.f90
===================================================================
--- palm/trunk/SOURCE/local_tremain_ini.f90	(revision 2689)
+++ palm/trunk/SOURCE/local_tremain_ini.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file local_tremain_ini.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/lpm.f90
===================================================================
--- palm/trunk/SOURCE/lpm.f90	(revision 2689)
+++ palm/trunk/SOURCE/lpm.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file lpm.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/lpm_advec.f90
===================================================================
--- palm/trunk/SOURCE/lpm_advec.f90	(revision 2689)
+++ palm/trunk/SOURCE/lpm_advec.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file lpm_advec.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/lpm_boundary_conds.f90
===================================================================
--- palm/trunk/SOURCE/lpm_boundary_conds.f90	(revision 2689)
+++ palm/trunk/SOURCE/lpm_boundary_conds.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file lpm_boundary_conds.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/lpm_calc_liquid_water_content.f90
===================================================================
--- palm/trunk/SOURCE/lpm_calc_liquid_water_content.f90	(revision 2689)
+++ palm/trunk/SOURCE/lpm_calc_liquid_water_content.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file lpm_calc_liquid_water_content.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/lpm_collision_kernels.f90
===================================================================
--- palm/trunk/SOURCE/lpm_collision_kernels.f90	(revision 2689)
+++ palm/trunk/SOURCE/lpm_collision_kernels.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file lpm_collision_kernels.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/lpm_data_output_particles.f90
===================================================================
--- palm/trunk/SOURCE/lpm_data_output_particles.f90	(revision 2689)
+++ palm/trunk/SOURCE/lpm_data_output_particles.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file lpm_data_output_particles.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/lpm_droplet_collision.f90
===================================================================
--- palm/trunk/SOURCE/lpm_droplet_collision.f90	(revision 2689)
+++ palm/trunk/SOURCE/lpm_droplet_collision.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file lpm_droplet_collision.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/lpm_droplet_condensation.f90
===================================================================
--- palm/trunk/SOURCE/lpm_droplet_condensation.f90	(revision 2689)
+++ palm/trunk/SOURCE/lpm_droplet_condensation.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file lpm_droplet_condensation.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/lpm_exchange_horiz.f90
===================================================================
--- palm/trunk/SOURCE/lpm_exchange_horiz.f90	(revision 2689)
+++ palm/trunk/SOURCE/lpm_exchange_horiz.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file lpm_exchange_horiz.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/lpm_init.f90
===================================================================
--- palm/trunk/SOURCE/lpm_init.f90	(revision 2689)
+++ palm/trunk/SOURCE/lpm_init.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file lpm_init.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/lpm_init_sgs_tke.f90
===================================================================
--- palm/trunk/SOURCE/lpm_init_sgs_tke.f90	(revision 2689)
+++ palm/trunk/SOURCE/lpm_init_sgs_tke.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file lpm_init_sgs_tke.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/lpm_merging.f90
===================================================================
--- palm/trunk/SOURCE/lpm_merging.f90	(revision 2689)
+++ palm/trunk/SOURCE/lpm_merging.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file lpm_merging.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/lpm_pack_arrays.f90
===================================================================
--- palm/trunk/SOURCE/lpm_pack_arrays.f90	(revision 2689)
+++ palm/trunk/SOURCE/lpm_pack_arrays.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file lpm_pack_arrays.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/lpm_read_restart_file.f90
===================================================================
--- palm/trunk/SOURCE/lpm_read_restart_file.f90	(revision 2689)
+++ palm/trunk/SOURCE/lpm_read_restart_file.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file lpm_read_restart_file.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/lpm_set_attributes.f90
===================================================================
--- palm/trunk/SOURCE/lpm_set_attributes.f90	(revision 2689)
+++ palm/trunk/SOURCE/lpm_set_attributes.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file lpm_set_attributes.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/lpm_splitting.f90
===================================================================
--- palm/trunk/SOURCE/lpm_splitting.f90	(revision 2689)
+++ palm/trunk/SOURCE/lpm_splitting.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file lpm_splitting.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
@@ -25,4 +25,7 @@
 ! -----------------
 !
+! 
+! 
+! 
 ! Added comments
 ! 
Index: palm/trunk/SOURCE/lpm_write_exchange_statistics.f90
===================================================================
--- palm/trunk/SOURCE/lpm_write_exchange_statistics.f90	(revision 2689)
+++ palm/trunk/SOURCE/lpm_write_exchange_statistics.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file lpm_write_exchange_statistics.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/lpm_write_restart_file.f90
===================================================================
--- palm/trunk/SOURCE/lpm_write_restart_file.f90	(revision 2689)
+++ palm/trunk/SOURCE/lpm_write_restart_file.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file lpm_write_restart_file.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/message.f90
===================================================================
--- palm/trunk/SOURCE/message.f90	(revision 2689)
+++ palm/trunk/SOURCE/message.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file message.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/microphysics_mod.f90
===================================================================
--- palm/trunk/SOURCE/microphysics_mod.f90	(revision 2689)
+++ palm/trunk/SOURCE/microphysics_mod.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file microphysics_mod.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/mod_kinds.f90
===================================================================
--- palm/trunk/SOURCE/mod_kinds.f90	(revision 2689)
+++ palm/trunk/SOURCE/mod_kinds.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file mod_kinds.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/mod_particle_attributes.f90
===================================================================
--- palm/trunk/SOURCE/mod_particle_attributes.f90	(revision 2689)
+++ palm/trunk/SOURCE/mod_particle_attributes.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file mod_particle_attributes.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/model_1d_mod.f90
===================================================================
--- palm/trunk/SOURCE/model_1d_mod.f90	(revision 2689)
+++ palm/trunk/SOURCE/model_1d_mod.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file model_1d_mod.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
@@ -25,4 +25,9 @@
 ! -----------------
 ! $Id$
+! implement TKE-e closure
+! modification of dissipation production according to Detering and Etling
+! reduced factor for timestep criterion to 0.125 and first dt to 1s (TG)
+! 
+! 2339 2017-08-07 13:55:26Z gronemeier
 ! corrected timestamp in header
 ! 
@@ -131,5 +136,6 @@
                intermediate_timestep_count_max, kappa, km_constant,            &
                message_string, mixing_length_1d, prandtl_number,               &
-               roughness_length, run_description_header, simulated_time_chr, timestep_scheme, tsc, z0h_factor
+               roughness_length, run_description_header, simulated_time_chr,   &
+               timestep_scheme, tsc, z0h_factor
 
     USE indices,                                                               &
@@ -143,38 +149,47 @@
     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) !#
+    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) ::  c_1 = 1.44_wp                 !< model constant
+    REAL(wp) ::  c_2 = 1.92_wp                 !< model constant
+    REAL(wp) ::  c_3 = 1.44_wp                 !< model constant
+    REAL(wp) ::  c_h = 0.0015_wp               !< model constant according to Detering and Etling (1985)
     REAL(wp) ::  c_m = 0.4_wp                  !< model constant, 0.4 according to Detering and Etling (1985)
-    REAL(wp) ::  damp_level_1d = -1.0_wp       !< namelist parameter    !#
+    REAL(wp) ::  c_mu = 0.09_wp                !< 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) ::  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) ::  qs1d                          !< characteristic humidity scale (1d-model)
     REAL(wp) ::  simulated_time_1d = 0.0_wp    !< updated simulated time (1d-model)
+    REAL(wp) ::  sig_diss = 1.3_wp             !< model constant
     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) ::  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 ::  e1d      !< tke (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 ::  kh1d     !< turbulent diffusion coefficient for heat (1d-model)
+    REAL(wp), DIMENSION(:), ALLOCATABLE ::  km1d     !< turbulent diffusion coefficient for momentum (1d-model)
     REAL(wp), DIMENSION(:), ALLOCATABLE ::  l_black  !< mixing length Blackadar (1d-model)
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  l1d      !< mixing length for turbulent diffusion coefficients (1d-model) !#
+    REAL(wp), DIMENSION(:), ALLOCATABLE ::  l1d      !< mixing length for turbulent diffusion coefficients (1d-model)
     REAL(wp), DIMENSION(:), ALLOCATABLE ::  l1d_diss !< mixing length for dissipation (1d-model)
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  rif1d    !< Richardson flux number (1d-model)      !#
+    REAL(wp), DIMENSION(:), ALLOCATABLE ::  rif1d    !< Richardson flux 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)
@@ -183,7 +198,7 @@
     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      !< 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      !< v-velocity component (1d-model)
     REAL(wp), DIMENSION(:), ALLOCATABLE ::  v1d_p    !< prognostic value of v-velocity component (1d-model)
 
@@ -227,7 +242,7 @@
 !
 !-- Public variables
-    PUBLIC  damp_level_1d, damp_level_ind_1d, dt_pr_1d, dt_run_control_1d,     &
-            e1d, end_time_1d, kh1d, km1d, l1d, rif1d, u1d, us1d, usws1d, v1d,  &
-            vsws1d
+    PUBLIC  damp_level_1d, damp_level_ind_1d, diss1d, dt_pr_1d,                &
+            dt_run_control_1d, e1d, end_time_1d, kh1d, km1d, l1d, rif1d, u1d,  &
+            us1d, usws1d, v1d, vsws1d
 
 
@@ -238,15 +253,17 @@
     IMPLICIT NONE
 
-    CHARACTER (LEN=9) ::  time_to_string  !<
+    CHARACTER (LEN=9) ::  time_to_string  !< function to transform time from real to character string
+
+    INTEGER(iwp) ::  k  !< loop index
     
-    INTEGER(iwp) ::  k  !< 
-    
-    REAL(wp) ::  lambda !<
+    REAL(wp) ::  lambda !< maximum mixing length
 
 !
 !-- Allocate required 1D-arrays
-    ALLOCATE( e1d(nzb:nzt+1), e1d_p(nzb:nzt+1), kh1d(nzb:nzt+1),               &
+    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), l_black(nzb:nzt+1), l1d(nzb:nzt+1),             &
-              l1d_diss(nzb:nzt+1), rif1d(nzb:nzt+1), te_e(nzb:nzt+1),          &
+              l1d_diss(nzb:nzt+1), rif1d(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),               &
@@ -259,4 +276,5 @@
        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
@@ -309,4 +327,5 @@
        us1d = 0.1_wp   ! without initial friction the flow would not change
     ELSE
+       diss1d(nzb+1) = 1.0_wp
        e1d(nzb+1)  = 1.0_wp
        km1d(nzb+1) = 1.0_wp
@@ -323,4 +342,5 @@
 !-- Tendencies must be preset in order to avoid runtime errors within the
 !-- first Runge-Kutta step
+    te_dissm = 0.0_wp
     te_em = 0.0_wp
     te_um = 0.0_wp
@@ -354,11 +374,10 @@
     IMPLICIT NONE
 
-    CHARACTER (LEN=9) ::  time_to_string  !<
-    
+    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) ::  dissipation  !< dissipation of TKE
     REAL(wp) ::  dpt_dz       !< vertical temperature gradient
     REAL(wp) ::  flux         !< vertical temperature gradient
@@ -372,5 +391,5 @@
 !-- Determine the time step at the start of a 1D-simulation and
 !-- determine and printout quantities used for run control
-    dt_1d = 10.0_wp
+    dt_1d = 1.0_wp
     CALL run_control_1d
 
@@ -392,6 +411,6 @@
 
 !
-!--       Compute all tendency terms. If a Prandtl-layer is simulated, k starts 
-!--       at nzb+2.
+!--       Compute all tendency terms. If a constant-flux layer is simulated, 
+!--       k starts at nzb+2.
           DO  k = nzb_diff, nzt
 
@@ -414,5 +433,5 @@
              DO  k = nzb_diff, nzt
 !
-!--             TKE
+!--             TKE and dissipation rate
                 kmzm = 0.5_wp * ( km1d(k-1) + km1d(k) )
                 kmzp = 0.5_wp * ( km1d(k) + km1d(k+1) )
@@ -428,14 +447,15 @@
                 ENDIF
 
+!
+!--             Calculate dissipation rate if no prognostic equation is used for
+!--             dissipation rate
                 IF ( dissipation_1d == 'detering' )  THEN
-!
-!--                According to Detering, c_e=c_m^3
-                   dissipation = c_m**3 * e1d(k) * SQRT( e1d(k) ) / l1d_diss(k)
+                   diss1d(k) = c_m**3 * e1d(k) * SQRT( e1d(k) ) / l1d_diss(k)
                 ELSEIF ( dissipation_1d == 'as_in_3d_model' )  THEN
-                   dissipation = ( 0.19_wp                                     &
-                                   + 0.74_wp * l1d_diss(k) /  l_grid(k)        &
-                                 ) * e1d(k) * SQRT( e1d(k) ) / l1d_diss(k)
-                ENDIF
-
+                   diss1d(k) = ( 0.19_wp + 0.74_wp * l1d_diss(k) /  l_grid(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&
@@ -446,10 +466,30 @@
                                    - kmzm * ( e1d(k) - e1d(k-1) ) * ddzu(k)    &
                                                  ) * ddzw(k)                   &
-                                   - dissipation
+                                   - diss1d(k)
+
+                IF ( dissipation_1d == 'prognostic' )  THEN
+!
+!--                dissipation rate
+                   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_mu**0.75 / c_h * f / us1d        &
+                                    * SQRT(e1d(k))                             &
+                                  - g / pt_0 * kh1d(k) * flux * c_3            &
+                                    * 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                     &
+                                  - c_2 * diss1d(k)**2 / ( e1d(k) + 1.0E-20_wp )
+
+                ENDIF
+
              ENDDO
           ENDIF
 
 !
-!--       Tendency terms at the top of the Prandtl-layer.
+!--       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 
@@ -470,11 +510,12 @@
              ENDIF
 
+!
+!--          Calculate dissipation rate if no prognostic equation is used for
+!--          dissipation rate
              IF ( dissipation_1d == 'detering' )  THEN
-!
-!--             According to Detering, c_e=0.064
-                dissipation = 0.064_wp * e1d(k) * SQRT( e1d(k) ) / l1d_diss(k)
+                diss1d(k) = c_m**3 * e1d(k) * SQRT( e1d(k) ) / l1d_diss(k)
              ELSEIF ( dissipation_1d == 'as_in_3d_model' )  THEN
-                dissipation = ( 0.19_wp + 0.74_wp * l1d_diss(k) / l_grid(k) )  &
-                              * e1d(k) * SQRT( e1d(k) ) / l1d_diss(k)
+                diss1d(k) = ( 0.19_wp + 0.74_wp * l1d_diss(k) / l_grid(k) )    &
+                            * e1d(k) * SQRT( e1d(k) ) / l1d_diss(k)
              ENDIF
 
@@ -491,13 +532,16 @@
 !
 !--          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)                      &
-                                - dissipation
+             IF ( .NOT. dissipation_1d == 'prognostic' )  THEN
+                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)                   &
+                                   - diss1d(k)
+             ENDIF
+
           ENDIF
 
@@ -513,10 +557,16 @@
           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
+
+             IF ( dissipation_1d == 'prognostic' )  THEN
+                DO  k = nzb_diff, nzt
+                   diss1d_p(k) = diss1d(k) + dt_1d * ( tsc(2) * te_diss(k) + &
+                                                 tsc(3) * te_dissm(k) )
+                ENDDO
+             ENDIF
 !
 !--          Eliminate negative TKE values, which can result from the
@@ -540,4 +590,9 @@
                       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
 
@@ -554,4 +609,9 @@
                       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
 
@@ -562,8 +622,8 @@
 !
 !--       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 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 (e(nzb)=e(nzb+1)).
+!--       and Neumann condition for e and diss (e(nzb)=e(nzb+1)).
           u1d_p(nzb) = 0.0_wp
           v1d_p(nzb) = 0.0_wp
@@ -575,4 +635,7 @@
           IF ( .NOT. constant_diffusion )  THEN
              e1d  = e1d_p
+             IF ( dissipation_1d == 'prognostic' )  THEN
+                diss1d = diss1d_p
+             ENDIF
           ENDIF
 
@@ -582,5 +645,5 @@
 
 !
-!--          First compute the vertical fluxes in the Prandtl-layer
+!--          First compute the vertical fluxes in the constant-flux layer
              IF ( constant_flux_layer )  THEN
 !
@@ -609,7 +672,7 @@
 !
 !--          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.
+!--          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 rif-numbers of the previous time step are used.
 
              IF ( constant_flux_layer )  THEN
@@ -689,10 +752,15 @@
 
 !
-!--             Boundary condition for the turbulent kinetic energy at the top
-!--             of the Prandtl-layer. c_m = 0.4 according to Detering.
+!--             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_m )**2
+                ENDIF
+                IF ( dissipation_1d == 'prognostic' )  THEN
+                   e1d(nzb+1) = us1d**2 / SQRT( c_mu )
+                   diss1d(nzb+1) = us1d**3 / ( kappa * zu(nzb+1) )
+                   diss1d(nzb) = diss1d(nzb+1)
                 ENDIF
                 e1d(nzb) = e1d(nzb+1)
@@ -767,7 +835,13 @@
                 ENDIF
              ENDIF
-             DO  k = nzb_diff, nzt
-                km1d(k) = c_m * SQRT( e1d(k) ) * l1d(k)
-             ENDDO
+             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_m * SQRT( e1d(k) ) * l1d(k)
+                ENDDO
+             ENDIF
 
 !
@@ -918,5 +992,5 @@
 !-- Compute the currently feasible time step according to the diffusion
 !-- criterion. At nzb+1 the half grid length is used.
-    fac = 0.35_wp
+    fac = 0.125  !0.35_wp                                                       !### changed from 0.35
     dt_diff = dt_max_1d
     DO  k = nzb+2, nzt
@@ -977,5 +1051,5 @@
        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
+                            rif1d(k), km1d(k), kh1d(k), l1d(k), diss1d(k)
        ENDDO
        WRITE ( 17, 101 )
@@ -993,9 +1067,8 @@
 100 FORMAT ('# ',A/'#',10('-')/'# 1d-model profiles')
 104 FORMAT (//'# Time: ',A)
-101 FORMAT ('#',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)
+101 FORMAT ('#',111('-'))
+102 FORMAT ('#  k     zu      u          v          pt         e          ',   &
+            'rif        Km         Kh         l          diss   ')
+103 FORMAT (1X,I4,1X,F7.1,9(1X,E10.3))
 
 
Index: palm/trunk/SOURCE/modules.f90
===================================================================
--- palm/trunk/SOURCE/modules.f90	(revision 2689)
+++ palm/trunk/SOURCE/modules.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file modules.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
@@ -25,4 +25,13 @@
 ! -----------------
 ! $Id$
+! Implementation of uv exposure model (FK)
+! + turbulence closure variables (control_parameters)
+! + arrays for prognostic equation of disspiation (arrays_3d)
+! + km_av, kh_av (TG)
+! Implementation of chemistry module (FK)
+! -lod
+! +topo_distinct (MS)
+! 
+! 2669 2017-12-06 16:03:27Z raasch
 ! CONTIGUOUS-attribut added to 3d pointer arrays,
 ! coupling_char extended to LEN=8
@@ -601,4 +610,5 @@
     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    
@@ -615,4 +625,5 @@
     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 
@@ -638,54 +649,57 @@
     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       !< TKE dissipation rate
-    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_nr  !< artificial numerical dissipation flux at left face of grid box - raindrop-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 - 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_qr  !< artificial numerical dissipation flux at left face of grid box - rainwater
-    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_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_nr  !< 6th-order advective flux at south face of grid box - raindrop-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_qr  !< 6th-order advective flux at south face of grid box - rainwater
-    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 ::  kh         !< eddy diffusivity for heat 
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  km         !< eddy diffusivity for momentum
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  l_wall     !< near-wall mixing length
-    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 ::  u_m_l      !< velocity data (u at left boundary) from time level t-dt required for radiation boundary condition
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  u_m_n      !< velocity data (u at north boundary) from time level t-dt required for radiation boundary condition
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  u_m_r      !< velocity data (u at right boundary) from time level t-dt required for radiation boundary condition
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  u_m_s      !< velocity data (u at south boundary) from time level t-dt required for radiation boundary condition
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  v_m_l      !< velocity data (v at left boundary) from time level t-dt required for radiation boundary condition
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  v_m_n      !< velocity data (v at north boundary) from time level t-dt required for radiation boundary condition
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  v_m_r      !< velocity data (v at right boundary) from time level t-dt required for radiation boundary condition
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  v_m_s      !< velocity data (v at south boundary) from time level t-dt required for radiation boundary condition
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  w_m_l      !< velocity data (w at left boundary) from time level t-dt required for radiation boundary condition
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  w_m_n      !< velocity data (w at north boundary) from time level t-dt required for radiation boundary condition
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  w_m_r      !< velocity data (w at right boundary) from time level t-dt required for radiation boundary condition
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  w_m_s      !< velocity data (w at south boundary) from time level t-dt required for radiation boundary condition
+    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_nr   !< artificial numerical dissipation flux at left face of grid box - raindrop-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 - 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_qr   !< artificial numerical dissipation flux at left face of grid box - rainwater
+    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_nr   !< 6th-order advective flux at south face of grid box - raindrop-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_qr   !< 6th-order advective flux at south face of grid box - rainwater
+    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 ::  kh          !< eddy diffusivity for heat 
+    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  km          !< eddy diffusivity for momentum
+    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  l_wall      !< near-wall mixing length
+    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 ::  u_m_l       !< velocity data (u at left boundary) from time level t-dt required for radiation boundary condition
+    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  u_m_n       !< velocity data (u at north boundary) from time level t-dt required for radiation boundary condition
+    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  u_m_r       !< velocity data (u at right boundary) from time level t-dt required for radiation boundary condition
+    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  u_m_s       !< velocity data (u at south boundary) from time level t-dt required for radiation boundary condition
+    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  v_m_l       !< velocity data (v at left boundary) from time level t-dt required for radiation boundary condition
+    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  v_m_n       !< velocity data (v at north boundary) from time level t-dt required for radiation boundary condition
+    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  v_m_r       !< velocity data (v at right boundary) from time level t-dt required for radiation boundary condition
+    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  v_m_s       !< velocity data (v at south boundary) from time level t-dt required for radiation boundary condition
+    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  w_m_l       !< velocity data (w at left boundary) from time level t-dt required for radiation boundary condition
+    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  w_m_n       !< velocity data (w at north boundary) from time level t-dt required for radiation boundary condition
+    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  w_m_r       !< velocity data (w at right boundary) from time level t-dt required for radiation boundary condition
+    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  w_m_s       !< velocity data (w at south boundary) from time level t-dt required for radiation boundary condition
 
 #if defined( __nopointer )
+    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  diss       !< TKE dissipation
+    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  diss_p     !< prognostic value TKE dissipation
     REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  e          !< subgrid-scale turbulence kinetic energy (sgs tke)
     REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  e_p        !< prognostic value of sgs tke
@@ -715,4 +729,5 @@
     REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  sa         !< ocean salinity
     REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  sa_p       !< prognostic value of ocean salinity
+    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  tdiss_m    !< weighted tendency of diss for previous sub-timestep (Runge-Kutta)
     REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  te_m       !< weighted tendency of e for previous sub-timestep (Runge-Kutta)
     REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  tnc_m      !< weighted tendency of nc for previous sub-timestep (Runge-Kutta)
@@ -735,4 +750,7 @@
     REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  w_p        !< prognostic value of w
 #else
+    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
@@ -780,4 +798,6 @@
     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
@@ -803,4 +823,5 @@
     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)
@@ -867,5 +888,8 @@
     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
@@ -1018,4 +1042,5 @@
     CHARACTER (LEN=20)   ::  reference_state = 'initial_profile'          !< namelist parameter  
     CHARACTER (LEN=20)   ::  timestep_scheme = 'runge-kutta-3'            !< namelist parameter       
+    CHARACTER (LEN=20)   ::  turbulence_closure = 'Moeng_Wyngaard'        !< namelist parameter
     CHARACTER (LEN=40)   ::  topography = 'flat'                          !< namelist parameter 
     CHARACTER (LEN=64)   ::  host = '????'                                !< hostname on which PALM is running, ENVPAR namelist parameter provided by mrun
@@ -1086,5 +1111,4 @@
     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) ::  lod = 1                           !< level of detail, topography input parameter 
     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
@@ -1157,4 +1181,5 @@
     LOGICAL ::  aerosol_c3h4o4 =.FALSE.                      !< malonic acid aerosol for bulk scheme
     LOGICAL ::  aerosol_nh4no3 =.FALSE.                      !< malonic acid aerosol for bulk scheme
+    LOGICAL ::  air_chemistry = .FALSE.                      !< chemistry model switch
     LOGICAL ::  bc_lr_cyc =.TRUE.                            !< left-right boundary condition cyclic?
     LOGICAL ::  bc_lr_dirrad = .FALSE.                       !< left-right boundary condition dirichlet/radiation?
@@ -1193,4 +1218,9 @@
     LOGICAL ::  first_call_lpm = .TRUE.                      !< call lpm only once per timestep?
     LOGICAL ::  force_print_header = .FALSE.                 !< namelist parameter
+    LOGICAL ::  force_bound_l = .FALSE.                      !< flag indicating domain boundary on left side to set forcing boundary conditions
+    LOGICAL ::  force_bound_n = .FALSE.                      !< flag indicating domain boundary on north side to set forcing boundary conditions
+    LOGICAL ::  force_bound_r = .FALSE.                      !< flag indicating domain boundary on right side to set forcing boundary conditions
+    LOGICAL ::  force_bound_s = .FALSE.                      !< flag indicating domain boundary on south side to set forcing boundary conditions
+    LOGICAL ::  forcing = .FALSE.                            !< flag controlling forcing from large-scale model     
     LOGICAL ::  galilei_transformation = .FALSE.             !< namelist parameter
     LOGICAL ::  humidity = .FALSE.                           !< namelist parameter
@@ -1203,4 +1233,5 @@
     LOGICAL ::  large_scale_subsidence = .FALSE.             !< namelist parameter
     LOGICAL ::  land_surface = .FALSE.                       !< use land surface model?
+    LOGICAL ::  les_mw = .FALSE.                             !< use Moeng-Wyngaard 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)?
@@ -1212,8 +1243,8 @@
     LOGICAL ::  microphysics_seifert = .FALSE.               !< use 2-moment Seifert and Beheng scheme
     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 ::  nest_bound_l = .FALSE.                       !< nested boundary on left side?
-    LOGICAL ::  nest_bound_n = .FALSE.                       !< nested boundary on north side?
-    LOGICAL ::  nest_bound_r = .FALSE.                       !< nested boundary on right side?
-    LOGICAL ::  nest_bound_s = .FALSE.                       !< nested boundary on south side?
+    LOGICAL ::  nest_bound_l = .FALSE.                       !< flag indicating nested domain boundary on left side
+    LOGICAL ::  nest_bound_n = .FALSE.                       !< flag indicating nested domain boundary on north side
+    LOGICAL ::  nest_bound_r = .FALSE.                       !< flag indicating nested domain boundary on right side
+    LOGICAL ::  nest_bound_s = .FALSE.                       !< flag indicating nested domain boundary on south side
     LOGICAL ::  nest_domain  = .FALSE.                       !< domain is nested into a parent domain?
     LOGICAL ::  neutral = .FALSE.                            !< namelist parameter
@@ -1227,4 +1258,7 @@
     LOGICAL ::  precipitation = .FALSE.                      !< namelist parameter
     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 ::  recycling_yshift = .FALSE.                   !< namelist parameter
     LOGICAL ::  run_control_header = .FALSE.                 !< onetime output of RUN_CONTROL header
@@ -1237,4 +1271,5 @@
     LOGICAL ::  synthetic_turbulence_generator = .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
@@ -1251,4 +1286,5 @@
     LOGICAL ::  use_ug_for_galilei_tr = .TRUE.               !< namelist parameter
     LOGICAL ::  use_upstream_for_tke = .FALSE.               !< namelist parameter
+    LOGICAL ::  uv_exposure = .FALSE.                        !< switch for uv exposure model
     LOGICAL ::  virtual_flight = .FALSE.                     !< use virtual flight model?
     LOGICAL ::  wall_adjustment = .TRUE.                     !< namelist parameter
@@ -1865,14 +1901,14 @@
     INTEGER(iwp), DIMENSION(MPI_STATUS_SIZE,100) ::  wait_stat  !< MPI status variable used in various MPI calls
     
-    INTEGER(iwp) ::  ngp_yz_int   !< number of ghost points in yz-plane 
-    INTEGER(iwp) ::  type_xz_int  !< derived MPI datatype for 3-D integer ghost-point exchange - north / south
-    INTEGER(iwp) ::  type_yz_int  !< derived MPI datatype for 3-D integer ghost-point exchange - left / right
-
     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
Index: palm/trunk/SOURCE/netcdf_data_input_mod.f90
===================================================================
--- palm/trunk/SOURCE/netcdf_data_input_mod.f90	(revision 2696)
+++ palm/trunk/SOURCE/netcdf_data_input_mod.f90	(revision 2696)
@@ -0,0 +1,4001 @@
+!> @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-2017 Leibniz Universitaet Hannover
+!------------------------------------------------------------------------------!
+!
+! Current revisions:
+! -----------------
+! 
+! 
+! Former revisions:
+! -----------------
+! $Id$
+! Initial revision
+! 
+! 
+!
+!
+! Authors:
+! --------
+! @author Matthias Suehring
+! 
+! Description:
+! ------------
+!> Modulue contains routines to input data according to Palm input data       
+!> standart using dynamic and static input files. 
+!>
+!> @todo - Order input alphabetically
+!> @todo - Revise error messages and error numbers
+!> @todo - Input of missing quantities (chemical species, emission rates)
+!> @todo - Defninition and input of still missing variable attributes
+!> @todo - Input of initial geostrophic wind profiles with cyclic conditions.
+!------------------------------------------------------------------------------!
+ MODULE netcdf_data_input_mod
+ 
+    USE control_parameters,                                                    &
+        ONLY:  coupling_char, io_blocks, io_group
+
+    USE kinds
+
+#if defined ( __netcdf )
+    USE NETCDF
+#endif
+
+    USE pegrid
+
+!
+!-- 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 force_type
+
+       CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE ::  var_names
+
+       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   !< time index for reference time in large-scale forcing data
+       INTEGER(iwp) ::  tind_p !< time index for following time in large-scale forcing data
+
+       LOGICAL      ::  init         = .FALSE.
+       LOGICAL      ::  interpolated = .FALSE.
+       LOGICAL      ::  from_file    = .FALSE.
+
+       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 ::  u_left   !< u-component at left boundary
+       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  v_left   !< v-component at left boundary
+       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  w_left   !< w-component at left boundary
+       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  q_left   !< mixing ratio at left boundary
+       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  pt_left  !< potentital temperautre at left boundary
+
+       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  u_north  !< u-component at north boundary
+       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  v_north  !< v-component at north boundary
+       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  w_north  !< w-component at north boundary
+       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  q_north  !< mixing ratio at north boundary
+       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  pt_north !< potentital temperautre at north boundary
+
+       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  u_right  !< u-component at right boundary
+       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  v_right  !< v-component at right boundary
+       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  w_right  !< w-component at right boundary
+       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  q_right  !< mixing ratio at right boundary
+       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  pt_right !< potentital temperautre at right boundary
+
+       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  u_south  !< u-component at south boundary
+       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  v_south  !< v-component at south boundary
+       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  w_south  !< w-component at south boundary
+       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  q_south  !< mixing ratio at south boundary
+       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  pt_south !< potentital temperautre at south boundary
+
+       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  u_top    !< u-component at top boundary
+       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  v_top    !< v-component at top boundary
+       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  w_top    !< w-component at top boundary
+       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  q_top    !< mixing ratio at top boundary
+       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  pt_top   !< potentital temperautre at top boundary
+
+    END TYPE force_type
+
+    TYPE init_type
+
+       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
+
+       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_v      = .FALSE. !< flag indicating whether v is already initialized from file 
+       LOGICAL ::  from_file_w      = .FALSE. !< flag indicating whether w is already initialized 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         !< latitude of the southern model boundary
+       REAL(wp) ::  longitude        !< longitude of the western model boundary
+
+       REAL(wp), DIMENSION(:), ALLOCATABLE ::  msoil_init   !< 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_init   !< 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 ::  msoil        !< initial 3d soil moisture provide by Inifor and interpolated onto soil grid
+       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  tsoil        !< initial 3d soil temperature provide by Inifor and interpolated onto soil grid
+
+    END TYPE init_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
+!
+!-- 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 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  
+
+       REAL(wp) ::  fill = -9999.9_wp                !< fill value
+       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  var !< respective variable
+    END TYPE real_2d
+
+!
+!-- Define data type to read 2D 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)
+
+       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)
+    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
+
+    TYPE(force_type) ::  force !< input variable for lateral and top boundaries derived from large-scale model  
+
+    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 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
+!
+!-- Define 3D variables of type NC_FLOAT
+    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
+    TYPE(real_3d) ::  root_area_density_lsm_f !< input variable for root area density - parametrized vegetation
+
+!
+!-- 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
+
+
+    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=10) ::  char_lon  = 'origin_lon'  !< name of global attribute for longitude in NetCDF file
+    CHARACTER(LEN=10) ::  char_lat  = 'origin_lat'  !< name of global attribute for latitude 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
+
+    INTEGER(iwp) ::  nc_stat         !< return value of nf90 function call
+
+    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
+
+    SAVE
+
+    PRIVATE
+
+    INTERFACE netcdf_data_input_interpolate
+       MODULE PROCEDURE netcdf_data_input_interpolate_1d
+       MODULE PROCEDURE netcdf_data_input_interpolate_1d_soil
+       MODULE PROCEDURE netcdf_data_input_interpolate_2d
+       MODULE PROCEDURE netcdf_data_input_interpolate_3d
+    END INTERFACE netcdf_data_input_interpolate
+
+    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_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_lsf
+       MODULE PROCEDURE netcdf_data_input_lsf
+    END INTERFACE netcdf_data_input_lsf
+
+    INTERFACE netcdf_data_input_surface_data
+       MODULE PROCEDURE netcdf_data_input_surface_data
+    END INTERFACE netcdf_data_input_surface_data
+
+    INTERFACE netcdf_data_input_topo
+       MODULE PROCEDURE netcdf_data_input_topo
+    END INTERFACE netcdf_data_input_topo
+
+    INTERFACE get_variable
+       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_3d_int8
+       MODULE PROCEDURE get_variable_3d_real
+       MODULE PROCEDURE get_variable_4d_real
+    END INTERFACE get_variable
+
+    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
+
+!
+!-- Public variables
+    PUBLIC albedo_pars_f, albedo_type_f, basal_area_density_f, buildings_f,    &
+           building_id_f, building_pars_f, building_type_f, force, init_3d,    &
+           init_model, input_file_static, input_pids_static,                   &
+           input_pids_dynamic, leaf_area_density_f,                            &
+           pavement_pars_f, pavement_subsurface_pars_f, pavement_type_f,       &
+           root_area_density_lad_f, root_area_density_lsm_f, soil_pars_f,      &
+           soil_type_f, street_crossing_f, street_type_f, surface_fraction_f,  &
+           terrain_height_f, vegetation_pars_f, vegetation_type_f,             &
+           water_pars_f, water_type_f
+
+!
+!-- Public subroutines
+    PUBLIC netcdf_data_input_check_dynamic, netcdf_data_input_check_static,    &
+           netcdf_data_input_inquire_file,                                     &
+           netcdf_data_input_init, netcdf_data_input_init_3d,                  &
+           netcdf_data_input_interpolate, netcdf_data_input_lsf,               &
+           netcdf_data_input_surface_data, netcdf_data_input_topo
+
+ 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:  land_surface, message_string, topo_no_distinct, urban_surface
+
+       IMPLICIT NONE
+
+       LOGICAL ::  check_nest  !< flag indicating whether a check passed or not
+
+#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 )
+#endif
+
+       IF ( .NOT. input_pids_static )  THEN
+          message_string = 'File ' // TRIM( input_file_static ) //             &
+                           TRIM( coupling_char ) // ' does ' //                &
+                           'not exist - input from external files ' //         &
+                           'is read from separate ASCII files, ' //            &
+                           'if required.' 
+          CALL message( 'netcdf_data_input_mod', 'PA0430', 0, 0, 0, 6, 0 )
+!
+!--       As long as topography can be input via ASCII format, no distinction 
+!--       between building and terrain can be made. This case, classify all
+!--       surfaces as default type. Same in case land-surface and urban-surface
+!--       model are not applied.
+          topo_no_distinct = .TRUE. 
+       ENDIF
+
+    END SUBROUTINE netcdf_data_input_inquire_file
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Reads global attributes required for initialization of the model.
+!------------------------------------------------------------------------------!
+    SUBROUTINE netcdf_data_input_init
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  id_mod   !< NetCDF id of input file
+       INTEGER(iwp) ::  ii       !< running index for IO blocks
+
+       IF ( .NOT. input_pids_static )  RETURN  
+
+       DO  ii = 0, io_blocks-1
+          IF ( ii == io_group )  THEN
+#if defined ( __netcdf )
+!
+!--          Open file in read-only mode
+             CALL open_read_file( TRIM( input_file_static ) //                 &
+                                  TRIM( coupling_char ), id_mod )
+!
+!--          Read global attribute for latitude and longitude
+             CALL get_attribute( id_mod, char_lat,                             &
+                                 init_model%latitude, .TRUE. )
+
+             CALL get_attribute( id_mod, char_lon,                             &
+                                 init_model%longitude, .TRUE. )
+!
+!--          Finally, close input file
+             CALL close_file( id_mod )
+#endif
+          ENDIF
+#if defined( __parallel )
+          CALL MPI_BARRIER( comm2d, ierr )
+#endif
+       ENDDO
+
+    END SUBROUTINE netcdf_data_input_init
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Reads surface classification data, such as vegetation and soil type, etc. .
+!------------------------------------------------------------------------------!
+    SUBROUTINE netcdf_data_input_surface_data
+
+       USE control_parameters,                                                 &
+           ONLY:  bc_lr_cyc, bc_ns_cyc, land_surface, message_string,          &
+                  urban_surface
+
+       USE indices,                                                            &
+           ONLY:  nbgp, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg
+
+       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) ::  ii        !< running index for IO blocks
+       INTEGER(iwp) ::  id_surf   !< NetCDF id of input file
+       INTEGER(iwp) ::  j         !< running index along y-direction
+       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
+
+       INTEGER(iwp), DIMENSION(nysg:nyng,nxlg:nxrg) ::  var_exchange_int !< dummy variables used to exchange 32-bit Integer arrays
+       INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE  ::  var_dum_int_3d !< dummy variables used to exchange real arrays
+
+       REAL(wp), DIMENSION(nysg:nyng,nxlg:nxrg) ::  var_exchange_real !< dummy variables used to exchange real arrays
+
+       REAL(wp), DIMENSION(:,:,:),   ALLOCATABLE ::  var_dum_real_3d !< dummy variables used to exchange real arrays
+       REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE ::  var_dum_real_4d !< dummy variables used to exchange real arrays
+
+!
+!--    If not static input file is available, skip this routine
+       IF ( .NOT. input_pids_static )  RETURN  
+!
+!--    Moreover, skip routine if no land-surface or urban-surface module are 
+!--    applied as no variable is used anyway.  
+       IF (  .NOT. land_surface  .OR.  .NOT. urban_surface )  RETURN
+!
+!--    Initialize dummy arrays used for ghost-point exchange
+       var_exchange_int  = 0
+       var_exchange_real = 0.0_wp
+
+       DO  ii = 0, io_blocks-1
+          IF ( ii == io_group )  THEN
+#if defined ( __netcdf )
+!
+!--          Open file in read-only mode
+             CALL open_read_file( TRIM( input_file_static ) //                 &
+                                  TRIM( coupling_char ) , id_surf )
+
+!
+!--          At first, inquire all variable names. 
+!--          This will be used to check whether an optional input variable exist 
+!--          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' )
+!
+!--             PE-wise reading of 2D vegetation type.
+                ALLOCATE ( vegetation_type_f%var(nys:nyn,nxl:nxr)  )
+                DO  i = nxl, nxr
+                   CALL get_variable( id_surf, 'vegetation_type',              &
+                                      i, vegetation_type_f%var(:,i) )
+                ENDDO
+             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
+!
+!--                PE-wise reading of 2D soil type.
+                   ALLOCATE ( soil_type_f%var_2d(nys:nyn,nxl:nxr)  )
+                   DO  i = nxl, nxr
+                      CALL get_variable( id_surf, 'soil_type',                 &
+                                         i, soil_type_f%var_2d(:,i) ) 
+                   ENDDO
+                ELSEIF ( soil_type_f%lod == 2 )  THEN
+!
+!--                Obtain number of soil layers from file.
+                   CALL get_dimension_length( id_surf, nz_soil, 'zsoil' )
+!
+!--                PE-wise reading of 3D soil type.
+                   ALLOCATE ( soil_type_f%var_3d(0:nz_soil,nys:nyn,nxl:nxr) )
+                   DO  i = nxl, nxr
+                      DO  j = nys, nyn
+                         CALL get_variable( id_surf, 'soil_type', i, j,        &
+                                            soil_type_f%var_3d(:,j,i) )   
+                      ENDDO
+                   ENDDO 
+                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' )  
+!
+!--             PE-wise reading of 2D pavement type.
+                ALLOCATE ( pavement_type_f%var(nys:nyn,nxl:nxr)  )
+                DO  i = nxl, nxr
+                   CALL get_variable( id_surf, 'pavement_type',                &
+                                      i, pavement_type_f%var(:,i) )  
+                ENDDO
+             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' )
+!
+!--             PE-wise reading of 2D water type.
+                ALLOCATE ( water_type_f%var(nys:nyn,nxl:nxr)  )
+                DO  i = nxl, nxr
+                   CALL get_variable( id_surf, 'water_type', i,                &
+                                      water_type_f%var(:,i) ) 
+                ENDDO
+             ELSE
+                water_type_f%from_file = .FALSE.
+             ENDIF
+!
+!--          Read surface fractions and related information
+             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
+                DO  i = nxl, nxr
+                   DO  j = nys, nyn
+                      CALL get_variable( id_surf, 'surface_fraction', i, j,    &
+                                         surface_fraction_f%frac(:,j,i) ) 
+                   ENDDO
+                ENDDO
+             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
+                DO  i = nxl, nxr
+                   DO  j = nys, nyn
+                      CALL get_variable( id_surf, 'building_pars', i, j,       &
+                                         building_pars_f%pars_xy(:,j,i) )   
+                   ENDDO
+                ENDDO
+             ELSE
+                building_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' ) 
+!
+!--             PE-wise reading of 2D water type.
+                ALLOCATE ( albedo_type_f%var(nys:nyn,nxl:nxr)  )
+                DO  i = nxl, nxr
+                   CALL get_variable( id_surf, 'albedo_type',                  &
+                                      i, albedo_type_f%var(:,i) )  
+                ENDDO
+             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 )
+
+                DO  i = nxl, nxr
+                   DO  j = nys, nyn
+                      CALL get_variable( id_surf, 'albedo_pars', i, j,         &
+                                         albedo_pars_f%pars_xy(:,j,i) )   
+                   ENDDO
+                ENDDO
+             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 )
+   
+                DO  i = nxl, nxr
+                   DO  j = nys, nyn
+                      CALL get_variable( id_surf, 'pavement_pars', i, j,       &
+                                         pavement_pars_f%pars_xy(:,j,i) )   
+                   ENDDO
+                ENDDO
+             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 )
+   
+                DO  i = nxl, nxr
+                   DO  j = nys, nyn
+                      CALL get_variable(                                       &
+                                  id_surf, 'pavement_subsurface_pars',         &
+                                  i, j,                                        &
+                                  pavement_subsurface_pars_f%pars_xyz(:,:,j,i),&
+                                  pavement_subsurface_pars_f%nz,               &
+                                  pavement_subsurface_pars_f%np )   
+                   ENDDO
+                ENDDO
+             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 )
+
+                DO  i = nxl, nxr
+                   DO  j = nys, nyn
+                      CALL get_variable( id_surf, 'vegetation_pars', i, j,     &
+                                         vegetation_pars_f%pars_xy(:,j,i) ) 
+                   ENDDO
+                ENDDO
+             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) )       
+                   DO  i = nxl, nxr
+                      DO  j = nys, nyn
+                         CALL get_variable( id_surf, 'soil_pars', i, j,        &
+                                            soil_pars_f%pars_xy(:,j,i) ) 
+                      ENDDO
+                   ENDDO
+
+                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) )
+                   DO  i = nxl, nxr
+                      DO  j = nys, nyn
+                         CALL get_variable( id_surf, 'soil_pars', i, j,        &
+                                            soil_pars_f%pars_xyz(:,:,j,i),     &
+                                            soil_pars_f%nz, soil_pars_f%np )  
+                      ENDDO
+                   ENDDO
+                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 )
+
+                DO  i = nxl, nxr
+                   DO  j = nys, nyn
+                      CALL get_variable( id_surf, 'water_pars', i, j,          &
+                                         water_pars_f%pars_xy(:,j,i) )   
+                   ENDDO
+                ENDDO
+             ELSE
+                water_pars_f%from_file = .FALSE. 
+             ENDIF
+
+!
+!--          Read leaf area density - resolved vegetation
+             IF ( check_existence( var_names, 'leaf_area_density' ) )  THEN
+                leaf_area_density_f%from_file = .TRUE. 
+                CALL get_attribute( id_surf, char_fill,                        &
+                                    leaf_area_density_f%fill,                  &
+                                    .FALSE., 'leaf_area_density' )  
+!
+!--             Inquire number of vertical vegetation layer
+                CALL get_dimension_length( id_surf, 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) )
+
+                DO  i = nxl, nxr
+                   DO  j = nys, nyn
+                      CALL get_variable( id_surf, 'leaf_area_density', i, j,   &
+                                         leaf_area_density_f%var(:,j,i) ) 
+                   ENDDO
+                ENDDO
+             ELSE
+                leaf_area_density_f%from_file = .FALSE. 
+             ENDIF
+
+!
+!--          Read basal area density - resolved vegetation
+             IF ( check_existence( var_names, 'basal_area_density' ) )  THEN
+                basal_area_density_f%from_file = .TRUE. 
+                CALL get_attribute( id_surf, char_fill,                        &
+                                    basal_area_density_f%fill,                 &
+                                    .FALSE., 'basal_area_density' )  
+!
+!--             Inquire number of vertical vegetation layer
+                CALL get_dimension_length( id_surf, 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) )
+
+                DO  i = nxl, nxr
+                   DO  j = nys, nyn
+                      CALL get_variable( id_surf, 'basal_area_density', i, j,  &
+                                         basal_area_density_f%var(:,j,i) ) 
+                   ENDDO
+                ENDDO
+             ELSE
+                basal_area_density_f%from_file = .FALSE. 
+             ENDIF
+
+!
+!--          Read root area density - resolved vegetation
+             IF ( check_existence( var_names, 'root_area_density_lad' ) )  THEN
+                root_area_density_lad_f%from_file = .TRUE. 
+                CALL get_attribute( id_surf, char_fill,                        &
+                                    root_area_density_lad_f%fill,              &
+                                    .FALSE., 'root_area_density_lad' )  
+!
+!--             Inquire number of vertical soil layers
+                CALL get_dimension_length( id_surf, 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) )
+
+                DO  i = nxl, nxr
+                   DO  j = nys, nyn
+                      CALL get_variable( id_surf, 'root_area_density_lad', i, j,&
+                                         root_area_density_lad_f%var(:,j,i) ) 
+                   ENDDO
+                ENDDO
+             ELSE
+                root_area_density_lad_f%from_file = .FALSE. 
+             ENDIF
+
+!
+!--          Read root area density - parametrized vegetation
+             IF ( check_existence( var_names, 'root_area_density_lsm' ) )  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_density_lsm' )
+!
+!--             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
+                DO  i = nxl, nxr
+                   DO  j = nys, nyn
+                      CALL get_variable( id_surf, 'root_area_density_lsm',     &
+                                         i, j,                                 &
+                                         root_area_density_lsm_f%var(:,j,i) )   
+                   ENDDO
+                ENDDO
+
+             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' )  
+!
+!--             PE-wise reading of 2D pavement type.
+                ALLOCATE ( street_type_f%var(nys:nyn,nxl:nxr)  )
+                DO  i = nxl, nxr
+                   CALL get_variable( id_surf, 'street_type',                  &
+                                      i, street_type_f%var(:,i) )  
+                ENDDO
+             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' )  
+!
+!--             PE-wise reading of 2D pavement type.
+                ALLOCATE ( street_crossing_f%var(nys:nyn,nxl:nxr)  )
+                DO  i = nxl, nxr
+                   CALL get_variable( id_surf, 'street_crossing',              &
+                                      i, street_crossing_f%var(:,i) )  
+                ENDDO
+             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_file( id_surf )
+#endif
+          ENDIF
+#if defined( __parallel )
+          CALL MPI_BARRIER( comm2d, ierr )
+#endif
+       ENDDO
+!
+!--    Exchange 1 ghost points for surface variables. Please note, ghost point
+!--    exchange for 3D parameter lists should be revised by using additional
+!--    MPI datatypes or rewriting exchange_horiz.
+!--    Moreover, varialbes will be resized in the following, including ghost
+!--    points. 
+!--    Start with 2D Integer variables. Please note, for 8-bit integer 
+!--    variables must be swapt to 32-bit integer before calling exchange_horiz.
+       IF ( albedo_type_f%from_file )  THEN
+          var_exchange_int                  = INT( albedo_type_f%fill, KIND = 1 )
+          var_exchange_int(nys:nyn,nxl:nxr) =                                  &
+                            INT( albedo_type_f%var(nys:nyn,nxl:nxr), KIND = 4 )
+          CALL exchange_horiz_2d_int( var_exchange_int, nys, nyn, nxl, nxr, nbgp )
+          DEALLOCATE( albedo_type_f%var )
+          ALLOCATE( albedo_type_f%var(nysg:nyng,nxlg:nxrg) )
+          albedo_type_f%var = INT( var_exchange_int, KIND = 1 )
+       ENDIF
+       IF ( pavement_type_f%from_file )  THEN
+          var_exchange_int                  = INT( pavement_type_f%fill, KIND = 1 )
+          var_exchange_int(nys:nyn,nxl:nxr) =                                  &
+                          INT( pavement_type_f%var(nys:nyn,nxl:nxr), KIND = 4 )
+          CALL exchange_horiz_2d_int( var_exchange_int, nys, nyn, nxl, nxr, nbgp )
+          DEALLOCATE( pavement_type_f%var )
+          ALLOCATE( pavement_type_f%var(nysg:nyng,nxlg:nxrg) )
+          pavement_type_f%var = INT( var_exchange_int, KIND = 1 )
+       ENDIF
+       IF ( soil_type_f%from_file  .AND.  ALLOCATED( soil_type_f%var_2d ) )  THEN
+          var_exchange_int                  = INT( soil_type_f%fill, KIND = 1 )
+          var_exchange_int(nys:nyn,nxl:nxr) =                                  &
+                            INT( soil_type_f%var_2d(nys:nyn,nxl:nxr), KIND = 4 )
+          CALL exchange_horiz_2d_int( var_exchange_int, nys, nyn, nxl, nxr, nbgp )
+          DEALLOCATE( soil_type_f%var_2d )
+          ALLOCATE( soil_type_f%var_2d(nysg:nyng,nxlg:nxrg) )
+          soil_type_f%var_2d = INT( var_exchange_int, KIND = 1 )
+       ENDIF
+       IF ( vegetation_type_f%from_file )  THEN
+          var_exchange_int                  = INT( vegetation_type_f%fill, KIND = 1 )
+          var_exchange_int(nys:nyn,nxl:nxr) =                                  &
+                        INT( vegetation_type_f%var(nys:nyn,nxl:nxr), KIND = 4 )
+          CALL exchange_horiz_2d_int( var_exchange_int, nys, nyn, nxl, nxr, nbgp )
+          DEALLOCATE( vegetation_type_f%var )
+          ALLOCATE( vegetation_type_f%var(nysg:nyng,nxlg:nxrg) )
+          vegetation_type_f%var = INT( var_exchange_int, KIND = 1 )
+       ENDIF
+       IF ( water_type_f%from_file )  THEN
+          var_exchange_int                  = INT( water_type_f%fill, KIND = 1 )
+          var_exchange_int(nys:nyn,nxl:nxr) =                                  &
+                         INT( water_type_f%var(nys:nyn,nxl:nxr), KIND = 4 )
+          CALL exchange_horiz_2d_int( var_exchange_int, nys, nyn, nxl, nxr, nbgp )
+          DEALLOCATE( water_type_f%var )
+          ALLOCATE( water_type_f%var(nysg:nyng,nxlg:nxrg) )
+          water_type_f%var = INT( var_exchange_int, KIND = 1 )
+       ENDIF
+!
+!--    Exchange 1 ghost point for 3/4-D variables. For the sake of simplicity,
+!--    loop further dimensions to use 2D exchange routines. 
+!--    This should be revised later by introducing new MPI datatypes.
+       IF ( soil_type_f%from_file  .AND.  ALLOCATED( soil_type_f%var_3d ) )    &
+       THEN
+          ALLOCATE( var_dum_int_3d(0:nz_soil,nys:nyn,nxl:nxr) ) 
+          var_dum_int_3d = soil_type_f%var_3d
+          DEALLOCATE( soil_type_f%var_3d )
+          ALLOCATE( soil_type_f%var_3d(0:nz_soil,nysg:nyng,nxlg:nxrg) )
+          soil_type_f%var_3d = soil_type_f%fill
+
+          DO  k = 0, nz_soil
+             var_exchange_int(nys:nyn,nxl:nxr) = var_dum_int_3d(k,nys:nyn,nxl:nxr)
+             CALL exchange_horiz_2d_int( var_exchange_int, nys, nyn, nxl, nxr, nbgp )
+             soil_type_f%var_3d(k,:,:) = INT( var_exchange_int(:,:), KIND = 1 )
+          ENDDO
+          DEALLOCATE( var_dum_int_3d )
+       ENDIF
+
+       IF ( surface_fraction_f%from_file )  THEN
+          ALLOCATE( var_dum_real_3d(0:surface_fraction_f%nf-1,nys:nyn,nxl:nxr) )
+          var_dum_real_3d = surface_fraction_f%frac
+          DEALLOCATE( surface_fraction_f%frac )
+          ALLOCATE( surface_fraction_f%frac(0:surface_fraction_f%nf-1,         &
+                                            nysg:nyng,nxlg:nxrg) )
+          surface_fraction_f%frac = surface_fraction_f%fill
+
+          DO  k = 0, surface_fraction_f%nf-1
+             var_exchange_real(nys:nyn,nxl:nxr) = var_dum_real_3d(k,nys:nyn,nxl:nxr)
+             CALL exchange_horiz_2d( var_exchange_real, nbgp )
+             surface_fraction_f%frac(k,:,:) = var_exchange_real(:,:)
+          ENDDO
+          DEALLOCATE( var_dum_real_3d )
+       ENDIF
+
+       IF ( building_pars_f%from_file )  THEN
+          ALLOCATE( var_dum_real_3d(0:building_pars_f%np-1,nys:nyn,nxl:nxr) )
+          var_dum_real_3d = building_pars_f%pars_xy
+          DEALLOCATE( building_pars_f%pars_xy )
+          ALLOCATE( building_pars_f%pars_xy(0:building_pars_f%np-1,            &
+                                            nysg:nyng,nxlg:nxrg) )
+          building_pars_f%pars_xy = building_pars_f%fill
+          DO  k = 0, building_pars_f%np-1
+             var_exchange_real(nys:nyn,nxl:nxr) =                              &
+                                              var_dum_real_3d(k,nys:nyn,nxl:nxr)
+             CALL exchange_horiz_2d( var_exchange_real, nbgp )
+             building_pars_f%pars_xy(k,:,:) = var_exchange_real(:,:)
+          ENDDO
+          DEALLOCATE( var_dum_real_3d )
+       ENDIF
+
+       IF ( albedo_pars_f%from_file )  THEN
+          ALLOCATE( var_dum_real_3d(0:albedo_pars_f%np-1,nys:nyn,nxl:nxr) )
+          var_dum_real_3d = albedo_pars_f%pars_xy
+          DEALLOCATE( albedo_pars_f%pars_xy )
+          ALLOCATE( albedo_pars_f%pars_xy(0:albedo_pars_f%np-1,                &
+                                          nysg:nyng,nxlg:nxrg) )
+          albedo_pars_f%pars_xy = albedo_pars_f%fill
+          DO  k = 0, albedo_pars_f%np-1
+             var_exchange_real(nys:nyn,nxl:nxr) =                              &
+                                              var_dum_real_3d(k,nys:nyn,nxl:nxr)
+             CALL exchange_horiz_2d( var_exchange_real, nbgp )
+             albedo_pars_f%pars_xy(k,:,:) = var_exchange_real(:,:)
+          ENDDO
+          DEALLOCATE( var_dum_real_3d )
+       ENDIF
+
+       IF ( pavement_pars_f%from_file )  THEN
+          ALLOCATE( var_dum_real_3d(0:pavement_pars_f%np-1,nys:nyn,nxl:nxr) )
+          var_dum_real_3d = pavement_pars_f%pars_xy
+          DEALLOCATE( pavement_pars_f%pars_xy )
+          ALLOCATE( pavement_pars_f%pars_xy(0:pavement_pars_f%np-1,            &
+                                            nysg:nyng,nxlg:nxrg) )
+          pavement_pars_f%pars_xy = pavement_pars_f%fill
+          DO  k = 0, pavement_pars_f%np-1
+             var_exchange_real(nys:nyn,nxl:nxr) =                              &
+                                              var_dum_real_3d(k,nys:nyn,nxl:nxr)
+             CALL exchange_horiz_2d( var_exchange_real, nbgp )
+             pavement_pars_f%pars_xy(k,:,:) = var_exchange_real(:,:)
+          ENDDO
+          DEALLOCATE( var_dum_real_3d )
+       ENDIF
+
+       IF ( vegetation_pars_f%from_file )  THEN
+          ALLOCATE( var_dum_real_3d(0:vegetation_pars_f%np-1,nys:nyn,nxl:nxr) )
+          var_dum_real_3d = vegetation_pars_f%pars_xy
+          DEALLOCATE( vegetation_pars_f%pars_xy )
+          ALLOCATE( vegetation_pars_f%pars_xy(0:vegetation_pars_f%np-1,        &
+                                            nysg:nyng,nxlg:nxrg) )
+          vegetation_pars_f%pars_xy = vegetation_pars_f%fill
+          DO  k = 0, vegetation_pars_f%np-1
+             var_exchange_real(nys:nyn,nxl:nxr) =                              &
+                                              var_dum_real_3d(k,nys:nyn,nxl:nxr)
+             CALL exchange_horiz_2d( var_exchange_real, nbgp )
+             vegetation_pars_f%pars_xy(k,:,:) = var_exchange_real(:,:)
+          ENDDO
+          DEALLOCATE( var_dum_real_3d )
+       ENDIF
+
+       IF ( water_pars_f%from_file )  THEN
+          ALLOCATE( var_dum_real_3d(0:water_pars_f%np-1,nys:nyn,nxl:nxr) )
+          var_dum_real_3d = water_pars_f%pars_xy
+          DEALLOCATE( water_pars_f%pars_xy )
+          ALLOCATE( water_pars_f%pars_xy(0:water_pars_f%np-1,                  &
+                                         nysg:nyng,nxlg:nxrg) )
+          water_pars_f%pars_xy = water_pars_f%fill
+          DO  k = 0, water_pars_f%np-1
+             var_exchange_real(nys:nyn,nxl:nxr) =                              &
+                                              var_dum_real_3d(k,nys:nyn,nxl:nxr)
+             CALL exchange_horiz_2d( var_exchange_real, nbgp )
+             water_pars_f%pars_xy(k,:,:) = var_exchange_real(:,:)
+          ENDDO
+          DEALLOCATE( var_dum_real_3d )
+       ENDIF
+
+       IF ( root_area_density_lsm_f%from_file )  THEN
+          ALLOCATE( var_dum_real_3d(0:root_area_density_lsm_f%nz-1,nys:nyn,nxl:nxr) )
+          var_dum_real_3d = root_area_density_lsm_f%var
+          DEALLOCATE( root_area_density_lsm_f%var )
+          ALLOCATE( root_area_density_lsm_f%var(0:root_area_density_lsm_f%nz-1,&
+                                                nysg:nyng,nxlg:nxrg) )
+          root_area_density_lsm_f%var = root_area_density_lsm_f%fill
+
+          DO  k = 0, root_area_density_lsm_f%nz-1
+             var_exchange_real(nys:nyn,nxl:nxr) =                              &
+                                              var_dum_real_3d(k,nys:nyn,nxl:nxr)
+             CALL exchange_horiz_2d( var_exchange_real, nbgp )
+             root_area_density_lsm_f%var(k,:,:) = var_exchange_real(:,:)
+          ENDDO
+          DEALLOCATE( var_dum_real_3d )
+       ENDIF
+
+       IF ( soil_pars_f%from_file )  THEN
+          IF ( soil_pars_f%lod == 1 )  THEN
+
+             ALLOCATE( var_dum_real_3d(0:soil_pars_f%np-1,nys:nyn,nxl:nxr) )
+             var_dum_real_3d = soil_pars_f%pars_xy
+             DEALLOCATE( soil_pars_f%pars_xy )
+             ALLOCATE( soil_pars_f%pars_xy(0:soil_pars_f%np-1,                 &
+                                            nysg:nyng,nxlg:nxrg) )
+             soil_pars_f%pars_xy = soil_pars_f%fill
+
+             DO  k = 0, soil_pars_f%np-1
+                var_exchange_real(nys:nyn,nxl:nxr) =                           &
+                                              var_dum_real_3d(k,nys:nyn,nxl:nxr)
+                CALL exchange_horiz_2d( var_exchange_real, nbgp )
+                soil_pars_f%pars_xy(k,:,:) = var_exchange_real(:,:)
+             ENDDO
+             DEALLOCATE( var_dum_real_3d )
+          ELSEIF ( soil_pars_f%lod == 2 )  THEN
+             ALLOCATE( var_dum_real_4d(0:soil_pars_f%np-1,                     &
+                                       0:soil_pars_f%nz-1,                     &
+                                       nys:nyn,nxl:nxr) )
+             var_dum_real_4d = soil_pars_f%pars_xyz
+             DEALLOCATE( soil_pars_f%pars_xyz )
+             ALLOCATE( soil_pars_f%pars_xyz(0:soil_pars_f%np-1,                &
+                                            0:soil_pars_f%nz-1,                &
+                                            nysg:nyng,nxlg:nxrg) )
+             soil_pars_f%pars_xyz = soil_pars_f%fill
+
+             DO  k2 = 0, soil_pars_f%nz-1
+                DO  k = 0, soil_pars_f%np-1
+                   var_exchange_real(nys:nyn,nxl:nxr) =                        &
+                                           var_dum_real_4d(k,k2,nys:nyn,nxl:nxr)
+                   CALL exchange_horiz_2d( var_exchange_real, nbgp )
+
+                   soil_pars_f%pars_xyz(k,k2,:,:) = var_exchange_real(:,:)
+                ENDDO
+             ENDDO
+             DEALLOCATE( var_dum_real_4d )
+          ENDIF 
+       ENDIF
+
+       IF ( pavement_subsurface_pars_f%from_file )  THEN
+          ALLOCATE( var_dum_real_4d(0:pavement_subsurface_pars_f%np-1,         &
+                                    0:pavement_subsurface_pars_f%nz-1,         &
+                                    nys:nyn,nxl:nxr) )
+          var_dum_real_4d = pavement_subsurface_pars_f%pars_xyz
+          DEALLOCATE( pavement_subsurface_pars_f%pars_xyz )
+          ALLOCATE( pavement_subsurface_pars_f%pars_xyz                        &
+                                          (0:pavement_subsurface_pars_f%np-1,  &
+                                           0:pavement_subsurface_pars_f%nz-1,  &
+                                           nysg:nyng,nxlg:nxrg) )
+          pavement_subsurface_pars_f%pars_xyz = pavement_subsurface_pars_f%fill
+
+          DO  k2 = 0, pavement_subsurface_pars_f%nz-1
+             DO  k = 0, pavement_subsurface_pars_f%np-1
+                var_exchange_real(nys:nyn,nxl:nxr) =                           &
+                                          var_dum_real_4d(k,k2,nys:nyn,nxl:nxr)
+                CALL exchange_horiz_2d( var_exchange_real, nbgp )
+                pavement_subsurface_pars_f%pars_xyz(k,k2,:,:) =                &
+                                                        var_exchange_real(:,:)
+             ENDDO
+          ENDDO
+          DEALLOCATE( var_dum_real_4d )
+       ENDIF
+
+!
+!--    In case of non-cyclic boundary conditions, set Neumann conditions at the
+!--    lateral boundaries.
+       IF ( .NOT. bc_ns_cyc )  THEN
+          IF ( nys == 0  )  THEN
+             IF ( albedo_type_f%from_file )                                    &
+                albedo_type_f%var(-1,:) = albedo_type_f%var(0,:)
+             IF ( pavement_type_f%from_file )                                  &
+                pavement_type_f%var(-1,:) = pavement_type_f%var(0,:)
+             IF ( soil_type_f%from_file )  THEN
+                IF ( ALLOCATED( soil_type_f%var_2d ) )  THEN
+                   soil_type_f%var_2d(-1,:) = soil_type_f%var_2d(0,:)
+                ELSE
+                   soil_type_f%var_3d(:,-1,:) = soil_type_f%var_3d(:,0,:)
+                ENDIF
+             ENDIF
+             IF ( vegetation_type_f%from_file )                                &
+                vegetation_type_f%var(-1,:) = vegetation_type_f%var(0,:)
+             IF ( water_type_f%from_file )                                     &
+                water_type_f%var(-1,:) = water_type_f%var(0,:)
+             IF ( surface_fraction_f%from_file )                               &
+                surface_fraction_f%frac(:,-1,:) = surface_fraction_f%frac(:,0,:)
+             IF ( building_pars_f%from_file )                                  &
+                building_pars_f%pars_xy(:,-1,:) = building_pars_f%pars_xy(:,0,:)
+             IF ( albedo_pars_f%from_file )                                    &
+                albedo_pars_f%pars_xy(:,-1,:) = albedo_pars_f%pars_xy(:,0,:)
+             IF ( pavement_pars_f%from_file )                                  &
+                pavement_pars_f%pars_xy(:,-1,:) = pavement_pars_f%pars_xy(:,0,:)
+             IF ( vegetation_pars_f%from_file )                                &
+                vegetation_pars_f%pars_xy(:,-1,:) =                            &
+                                               vegetation_pars_f%pars_xy(:,0,:)
+             IF ( water_pars_f%from_file )                                     &
+                water_pars_f%pars_xy(:,-1,:) = water_pars_f%pars_xy(:,0,:)
+             IF ( root_area_density_lsm_f%from_file )                          &
+                root_area_density_lsm_f%var(:,-1,:) =                          &
+                                            root_area_density_lsm_f%var(:,0,:)
+             IF ( soil_pars_f%from_file )  THEN
+                IF ( soil_pars_f%lod == 1 )  THEN
+                   soil_pars_f%pars_xy(:,-1,:) = soil_pars_f%pars_xy(:,0,:)
+                ELSE
+                   soil_pars_f%pars_xyz(:,:,-1,:) = soil_pars_f%pars_xyz(:,:,0,:)
+                ENDIF
+             ENDIF
+             IF ( pavement_subsurface_pars_f%from_file )                       &
+                pavement_subsurface_pars_f%pars_xyz(:,:,-1,:) =                &
+                                   pavement_subsurface_pars_f%pars_xyz(:,:,0,:)
+          ENDIF
+
+          IF ( nyn == ny )  THEN
+             IF ( albedo_type_f%from_file )                                    &
+                albedo_type_f%var(ny+1,:) = albedo_type_f%var(ny,:)
+             IF ( pavement_type_f%from_file )                                  &
+                pavement_type_f%var(ny+1,:) = pavement_type_f%var(ny,:)
+             IF ( soil_type_f%from_file )  THEN
+                IF ( ALLOCATED( soil_type_f%var_2d ) )  THEN
+                   soil_type_f%var_2d(ny+1,:) = soil_type_f%var_2d(ny,:)
+                ELSE
+                   soil_type_f%var_3d(:,ny+1,:) = soil_type_f%var_3d(:,ny,:)
+                ENDIF
+             ENDIF
+             IF ( vegetation_type_f%from_file )                                &
+                vegetation_type_f%var(ny+1,:) = vegetation_type_f%var(ny,:)
+             IF ( water_type_f%from_file )                                     &
+                water_type_f%var(ny+1,:) = water_type_f%var(ny,:)
+             IF ( surface_fraction_f%from_file )                               &
+                surface_fraction_f%frac(:,ny+1,:) =                            &
+                                             surface_fraction_f%frac(:,ny,:)
+             IF ( building_pars_f%from_file )                                  &
+                building_pars_f%pars_xy(:,ny+1,:) =                            &
+                                             building_pars_f%pars_xy(:,ny,:)
+             IF ( albedo_pars_f%from_file )                                    &
+                albedo_pars_f%pars_xy(:,ny+1,:) = albedo_pars_f%pars_xy(:,ny,:)
+             IF ( pavement_pars_f%from_file )                                  &
+                pavement_pars_f%pars_xy(:,ny+1,:) =                            &
+                                             pavement_pars_f%pars_xy(:,ny,:)
+             IF ( vegetation_pars_f%from_file )                                &
+                vegetation_pars_f%pars_xy(:,ny+1,:) =                          &
+                                               vegetation_pars_f%pars_xy(:,ny,:)
+             IF ( water_pars_f%from_file )                                     &
+                water_pars_f%pars_xy(:,ny+1,:) = water_pars_f%pars_xy(:,ny,:)
+             IF ( root_area_density_lsm_f%from_file )                          &
+                root_area_density_lsm_f%var(:,ny+1,:) =                        &
+                                            root_area_density_lsm_f%var(:,ny,:)
+             IF ( soil_pars_f%from_file )  THEN
+                IF ( soil_pars_f%lod == 1 )  THEN
+                   soil_pars_f%pars_xy(:,ny+1,:) = soil_pars_f%pars_xy(:,ny,:)
+                ELSE
+                   soil_pars_f%pars_xyz(:,:,ny+1,:) =                          &
+                                              soil_pars_f%pars_xyz(:,:,ny,:)
+                ENDIF
+             ENDIF
+             IF ( pavement_subsurface_pars_f%from_file )                       &
+                pavement_subsurface_pars_f%pars_xyz(:,:,ny+1,:) =              &
+                                   pavement_subsurface_pars_f%pars_xyz(:,:,ny,:)
+          ENDIF
+       ENDIF
+
+       IF ( .NOT. bc_lr_cyc )  THEN
+          IF ( nxl == 0 )  THEN
+            IF ( albedo_type_f%from_file )                                     &
+                albedo_type_f%var(:,-1) = albedo_type_f%var(:,0)
+             IF ( pavement_type_f%from_file )                                  &
+                pavement_type_f%var(:,-1) = pavement_type_f%var(:,0)
+             IF ( soil_type_f%from_file )  THEN
+                IF ( ALLOCATED( soil_type_f%var_2d ) )  THEN
+                   soil_type_f%var_2d(:,-1) = soil_type_f%var_2d(:,0)
+                ELSE
+                   soil_type_f%var_3d(:,:,-1) = soil_type_f%var_3d(:,:,0)
+                ENDIF
+             ENDIF
+             IF ( vegetation_type_f%from_file )                                &
+                vegetation_type_f%var(:,-1) = vegetation_type_f%var(:,0)
+             IF ( water_type_f%from_file )                                     &
+                water_type_f%var(:,-1) = water_type_f%var(:,0)
+             IF ( surface_fraction_f%from_file )                               &
+                surface_fraction_f%frac(:,:,-1) = surface_fraction_f%frac(:,:,0)
+             IF ( building_pars_f%from_file )                                  &
+                building_pars_f%pars_xy(:,:,-1) = building_pars_f%pars_xy(:,:,0)
+             IF ( albedo_pars_f%from_file )                                    &
+                albedo_pars_f%pars_xy(:,:,-1) = albedo_pars_f%pars_xy(:,:,0)
+             IF ( pavement_pars_f%from_file )                                  &
+                pavement_pars_f%pars_xy(:,:,-1) = pavement_pars_f%pars_xy(:,:,0)
+             IF ( vegetation_pars_f%from_file )                                &
+                vegetation_pars_f%pars_xy(:,:,-1) =                            &
+                                               vegetation_pars_f%pars_xy(:,:,0)
+             IF ( water_pars_f%from_file )                                     &
+                water_pars_f%pars_xy(:,:,-1) = water_pars_f%pars_xy(:,:,0)
+             IF ( root_area_density_lsm_f%from_file )                          &
+                root_area_density_lsm_f%var(:,:,-1) =                          &
+                                            root_area_density_lsm_f%var(:,:,0)
+             IF ( soil_pars_f%from_file )  THEN
+                IF ( soil_pars_f%lod == 1 )  THEN
+                   soil_pars_f%pars_xy(:,:,-1) = soil_pars_f%pars_xy(:,:,0)
+                ELSE
+                   soil_pars_f%pars_xyz(:,:,:,-1) = soil_pars_f%pars_xyz(:,:,:,0)
+                ENDIF
+             ENDIF
+             IF ( pavement_subsurface_pars_f%from_file )                       &
+                pavement_subsurface_pars_f%pars_xyz(:,:,:,-1) =                &
+                                    pavement_subsurface_pars_f%pars_xyz(:,:,:,0)
+          ENDIF
+
+          IF ( nxr == nx )  THEN
+             IF ( albedo_type_f%from_file )                                    &
+                albedo_type_f%var(:,nx+1) = albedo_type_f%var(:,nx)
+             IF ( pavement_type_f%from_file )                                  &
+                pavement_type_f%var(:,nx+1) = pavement_type_f%var(:,nx)
+             IF ( soil_type_f%from_file )  THEN
+                IF ( ALLOCATED( soil_type_f%var_2d ) )  THEN
+                   soil_type_f%var_2d(:,nx+1) = soil_type_f%var_2d(:,nx)
+                ELSE
+                   soil_type_f%var_3d(:,:,nx+1) = soil_type_f%var_3d(:,:,nx)
+                ENDIF
+             ENDIF
+             IF ( vegetation_type_f%from_file )                                &
+                vegetation_type_f%var(:,nx+1) = vegetation_type_f%var(:,nx)
+             IF ( water_type_f%from_file )                                     &
+                water_type_f%var(:,nx+1) = water_type_f%var(:,nx)
+             IF ( surface_fraction_f%from_file )                               &
+                surface_fraction_f%frac(:,:,nx+1) =                            &
+                                             surface_fraction_f%frac(:,:,nx)
+             IF ( building_pars_f%from_file )                                  &
+                building_pars_f%pars_xy(:,:,nx+1) =                            &
+                                             building_pars_f%pars_xy(:,:,nx)
+             IF ( albedo_pars_f%from_file )                                    &
+                albedo_pars_f%pars_xy(:,:,nx+1) = albedo_pars_f%pars_xy(:,:,nx)
+             IF ( pavement_pars_f%from_file )                                  &
+                pavement_pars_f%pars_xy(:,:,nx+1) =                            &
+                                             pavement_pars_f%pars_xy(:,:,nx)
+             IF ( vegetation_pars_f%from_file )                                &
+                vegetation_pars_f%pars_xy(:,:,nx+1) =                          &
+                                               vegetation_pars_f%pars_xy(:,:,nx)
+             IF ( water_pars_f%from_file )                                     &
+                water_pars_f%pars_xy(:,:,nx+1) = water_pars_f%pars_xy(:,:,nx)
+             IF ( root_area_density_lsm_f%from_file )                          &
+                root_area_density_lsm_f%var(:,:,nx+1) =                        &
+                                            root_area_density_lsm_f%var(:,:,nx)
+             IF ( soil_pars_f%from_file )  THEN
+                IF ( soil_pars_f%lod == 1 )  THEN
+                   soil_pars_f%pars_xy(:,:,nx+1) = soil_pars_f%pars_xy(:,:,nx)
+                ELSE
+                   soil_pars_f%pars_xyz(:,:,:,nx+1) =                          &
+                                              soil_pars_f%pars_xyz(:,:,:,nx)
+                ENDIF
+             ENDIF
+             IF ( pavement_subsurface_pars_f%from_file )                       &
+                pavement_subsurface_pars_f%pars_xyz(:,:,:,nx+1) =              &
+                                   pavement_subsurface_pars_f%pars_xyz(:,:,:,nx)
+          ENDIF
+       ENDIF
+
+    END SUBROUTINE netcdf_data_input_surface_data
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Reads orography and building information.
+!------------------------------------------------------------------------------!
+    SUBROUTINE netcdf_data_input_topo
+
+       USE control_parameters,                                                 &
+           ONLY:  bc_lr_cyc, bc_ns_cyc, message_string, topography
+
+       USE indices,                                                            &
+           ONLY:  nbgp, nx, nxl, nxr, ny, nyn, nys, nzb, nzt
+                  
+
+       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) ::  ii            !< running index for IO blocks
+       INTEGER(iwp) ::  id_topo       !< NetCDF id of topograhy input file
+       INTEGER(iwp) ::  j             !< running index along y-direction
+       INTEGER(iwp) ::  k             !< running index along z-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
+
+       INTEGER(iwp), DIMENSION(nys-nbgp:nyn+nbgp,nxl-nbgp:nxr+nbgp) ::  var_exchange_int !< dummy variables used to exchange 32-bit Integer arrays
+
+       REAL(wp) ::  dum           !< dummy variable to skip columns while reading topography file   
+
+       IF ( TRIM( topography ) /= 'read_from_file' )  RETURN
+
+       DO  ii = 0, io_blocks-1
+          IF ( ii == io_group )  THEN
+#if defined ( __netcdf )
+!
+!--          Input via palm-input data standard 
+             IF ( input_pids_static )  THEN
+!
+!--             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 exist 
+!--             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 )
+!
+!--             Terrain height. First, get variable-related _FillValue attribute
+                IF ( check_existence( var_names, 'orography_2D' ) )  THEN
+                   terrain_height_f%from_file = .TRUE. 
+                   CALL get_attribute( id_topo, char_fill,                     &
+                                       terrain_height_f%fill,                  &
+                                       .FALSE., 'orography_2D' ) 
+!
+!--                PE-wise reading of 2D terrain height.
+                   ALLOCATE ( terrain_height_f%var(nys:nyn,nxl:nxr)  )
+                   DO  i = nxl, nxr
+                      CALL get_variable( id_topo, 'orography_2D',              &
+                                         i, terrain_height_f%var(:,i) )  
+                   ENDDO
+                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 topography
+                   IF ( buildings_f%lod == 1 )  THEN
+                      ALLOCATE ( buildings_f%var_2d(nys:nyn,nxl:nxr) )
+                      DO  i = nxl, nxr
+                         CALL get_variable( id_topo, 'buildings_2D',           &
+                                            i, buildings_f%var_2d(:,i) ) 
+                      ENDDO
+                   ELSE 
+                      message_string = 'NetCDF attribute lod ' //              &
+                                       '(level of detail) is not set properly.'
+                      CALL message( 'netcdf_data_input_mod', 'PA0999',         &
+                                     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' )
+!  
+!                    IF ( buildings_f%lod == 2 )  THEN
+!                       ALLOCATE( buildings_f%var_3d(nzb:buildings_f%nz,         &
+!                                                    nys:nyn,nxl:nxr) )
+!                       buildings_f%var_3d = 0
+! !
+! !--                   Read data PE-wise. Read yz-slices.
+!                       DO  i = nxl, nxr
+!                          DO  j = nys, nyn
+!                             CALL get_variable( id_topo, 'buildings_3D',        &
+!                                                i, j,                           &
+!                                                buildings_f%var_3d(:,j,i) )
+!                          ENDDO
+!                       ENDDO
+!                    ELSE 
+!                       message_string = 'NetCDF attribute lod ' //              &
+!                                        '(level of detail) is not set properly.'
+!                       CALL message( 'netcdf_data_input_mod', 'PA0999',         &
+!                                      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) )
+                   DO  i = nxl, nxr
+                      CALL get_variable( id_topo, 'building_id',               &
+                                          i, building_id_f%var(:,i) ) 
+                   ENDDO
+                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) )
+                   DO  i = nxl, nxr
+                      CALL get_variable( id_topo, 'building_type',             &
+                                         i, building_type_f%var(:,i) )
+                   ENDDO
+                ELSE
+                   building_type_f%from_file = .FALSE.
+                ENDIF
+
+!
+!--             Close topography input file
+                CALL close_file( id_topo )
+#endif
+!
+!--          ASCII input
+             ELSE
+
+                OPEN( 90, FILE='TOPOGRAPHY_DATA'//TRIM( coupling_char ),       &
+                      STATUS='OLD', FORM='FORMATTED', ERR=10 )
+!
+!--             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, *, ERR=11, END=11 )                               &
+                                   ( dum, i = 0, nxl-1 ),                      &
+                                   ( buildings_f%var_2d(j,i), i = nxl, nxr )
+                ENDDO
+
+                GOTO 12
+          
+ 10             message_string = 'file TOPOGRAPHY'//TRIM( coupling_char )//    &
+                                 ' does not exist'
+                CALL message( 'netcdf_data_input_mod', 'PA0208', 1, 2, 0, 6, 0 )
+
+ 11             message_string = 'errors in file TOPOGRAPHY_DATA'//            &
+                                 TRIM( coupling_char )
+                CALL message( 'netcdf_data_input_mod', 'PA0209', 1, 2, 0, 6, 0 )
+
+ 12             CLOSE( 90 )
+                buildings_f%from_file = .TRUE.
+
+             ENDIF 
+
+          ENDIF
+#if defined( __parallel )
+          CALL MPI_BARRIER( comm2d, ierr )
+#endif
+       ENDDO
+!
+!--    Check for minimum requirement of topography data in case
+!--    static input file is used. 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 ( .NOT. terrain_height_f%from_file  .OR.                          &
+               .NOT. building_id_f%from_file     .OR.                          &
+               .NOT. buildings_f%from_file )  THEN                        
+             message_string = 'Minimum requirement for topography input ' //   &
+                              'is not fulfilled. ' //                          &
+                              'Orography, buildings, as well as building ' //  &
+                              'IDs are required.'
+             CALL message( 'netcdf_data_input_mod', 'PA0999', 1, 2, 0, 6, 0 )
+          ENDIF
+       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
+          var_exchange_int                  = building_id_f%fill
+          var_exchange_int(nys:nyn,nxl:nxr) = building_id_f%var(nys:nyn,nxl:nxr)
+          CALL exchange_horiz_2d_int( var_exchange_int, nys, nyn, nxl, nxr, nbgp )
+          DEALLOCATE( building_id_f%var )
+          ALLOCATE( building_id_f%var(nys-nbgp:nyn+nbgp,nxl-nbgp:nxr+nbgp) )
+          building_id_f%var = var_exchange_int
+
+          IF ( .NOT. bc_ns_cyc )  THEN
+             IF ( nys == 0  )  building_id_f%var(-1,:)   = building_id_f%var(0,:)
+             IF ( nyn == ny )  building_id_f%var(ny+1,:) = building_id_f%var(ny,:)
+          ENDIF
+          IF ( .NOT. bc_lr_cyc )  THEN
+             IF ( nxl == 0  )  building_id_f%var(:,-1)   = building_id_f%var(:,0)  
+             IF ( nxr == nx )  building_id_f%var(:,nx+1) = building_id_f%var(:,nx)        
+          ENDIF
+       ENDIF
+
+       IF ( building_type_f%from_file )  THEN
+          var_exchange_int                  = INT( building_type_f%fill, KIND = 4 )
+          var_exchange_int(nys:nyn,nxl:nxr) =                                  &
+                          INT( building_type_f%var(nys:nyn,nxl:nxr), KIND = 4 )
+          CALL exchange_horiz_2d_int( var_exchange_int, nys, nyn, nxl, nxr, nbgp )
+          DEALLOCATE( building_type_f%var )
+          ALLOCATE( building_type_f%var(nys-nbgp:nyn+nbgp,nxl-nbgp:nxr+nbgp) )
+          building_type_f%var = INT( var_exchange_int, KIND = 1 )
+
+          IF ( .NOT. bc_ns_cyc )  THEN
+             IF ( nys == 0  )  building_type_f%var(-1,:)   = building_type_f%var(0,:)
+             IF ( nyn == ny )  building_type_f%var(ny+1,:) = building_type_f%var(ny,:)
+          ENDIF
+          IF ( .NOT. bc_lr_cyc )  THEN
+             IF ( nxl == 0  )  building_type_f%var(:,-1)   = building_type_f%var(:,0)  
+             IF ( nxr == nx )  building_type_f%var(:,nx+1) = building_type_f%var(:,nx)        
+          ENDIF
+       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:  q, pt, u, v, w
+
+       USE control_parameters,                                                 &
+           ONLY:  bc_lr_cyc, bc_ns_cyc, forcing, humidity, message_string,     &
+                  neutral, surface_pressure
+
+       USE indices,                                                            &
+           ONLY:  nx, nxl, nxlu, nxr, ny, nyn, nys, nysv, nzb, nzt
+
+       IMPLICIT NONE
+
+       CHARACTER(LEN=100), DIMENSION(:), ALLOCATABLE ::  var_names
+
+       INTEGER(iwp) ::  i          !< running index along x-direction
+       INTEGER(iwp) ::  ii         !< running index for IO blocks
+       INTEGER(iwp) ::  id_dynamic !< NetCDF id of dynamic input file
+       INTEGER(iwp) ::  j          !< running index along y-direction
+       INTEGER(iwp) ::  k          !< running index along z-direction
+       INTEGER(iwp) ::  num_vars   !< number of variables in netcdf input file
+       INTEGER(iwp) ::  off_i      !< offset in x-direction used for reading the u-component
+       INTEGER(iwp) ::  off_j      !< offset in y-direction used for reading the v-component
+
+!
+!--    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
+
+       DO  ii = 0, io_blocks-1
+          IF ( ii == io_group )  THEN
+#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. Will be used for
+!--          inter- and extrapolation in case of stretched numeric grid. 
+!--          This will be removed when Inifor is able to handle stretched grids.
+             CALL get_dimension_length( id_dynamic, init_3d%nzu, 'z'     )
+             CALL get_dimension_length( id_dynamic, init_3d%nzw, 'zw'    )
+             CALL get_dimension_length( id_dynamic, init_3d%nzs, 'depth' )
+!
+!--          Read also the horizontal dimensions. These are used just used fo
+!--          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 dimension. Please note, u- and v-grid
+!--          hase 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 inifor grid points does not '  //  &
+                                 'match the number of numeric grid points.'
+                CALL message( 'netcdf_data_input_mod', 'PA0999', 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
+             IF ( check_existence( var_names, 'depth' ) )  THEN
+                ALLOCATE( init_3d%z_soil(1:init_3d%nzs) )
+                CALL get_variable( id_dynamic, 'depth', init_3d%z_soil )
+             ENDIF
+!
+!--          Read geostrophic wind components
+!              IF ( check_existence( var_names, 'ls_forcing_ug' ) )  THEN
+! 
+!              ENDIF
+!              IF ( check_existence( var_names, 'ls_forcing_vg' ) )  THEN
+! 
+!              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. Moreover, i and j are used 
+!--          as start index in the NF90 interface.
+!--          The passed arguments for u, and v are (i,j)-1, respectively, 
+!--          in contrast to the remaining quantities. This is because in case
+!--          of forcing is applied, the input data for u and v has one 
+!--          element less along the x- and y-direction respectively. 
+!--          Read u-component
+             IF ( check_existence( var_names, 'init_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_u' )
+                CALL get_attribute( id_dynamic, char_lod, init_3d%lod_u,       &
+                                    .FALSE., 'init_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_u',                    &
+                                      init_3d%u_init(nzb+1:nzt+1) )
+!
+!--             level-of-detail 2 - read 3D initialization data
+                ELSEIF ( init_3d%lod_u == 2 )  THEN
+!
+!--                Set offset value. In case of Dirichlet conditions at the left 
+!--                domain boundary, the u component starts at nxl+1. This case, 
+!--                the passed start-index for reading the NetCDF data is shifted
+!--                by -1.  
+                   off_i = 1 !MERGE( 1, 0, forcing )
+
+                   DO  i = nxlu, nxr
+                      DO  j = nys, nyn    
+                         CALL get_variable( id_dynamic, 'init_u', i-off_i, j,  &
+                                            u(nzb+1:nzt+1,j,i) )
+                      ENDDO
+                   ENDDO
+
+                ENDIF
+                init_3d%from_file_u = .TRUE.
+             ENDIF
+!
+!--          Read v-component
+             IF ( check_existence( var_names, 'init_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_v' )
+                CALL get_attribute( id_dynamic, char_lod, init_3d%lod_v,       &
+                                    .FALSE., 'init_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_v',                    &
+                                      init_3d%v_init(nzb+1:nzt+1) )
+
+!
+!--             level-of-detail 2 - read 3D initialization data
+                ELSEIF ( init_3d%lod_v == 2 )  THEN
+!
+!--                Set offset value. In case of Dirichlet conditions at the south 
+!--                domain boundary, the v component starts at nys+1. This case, 
+!--                the passed start-index for reading the NetCDF data is shifted
+!--                by -1.  
+                   off_j = 1 !MERGE( 1, 0, forcing )
+
+                   DO  i = nxl, nxr
+                      DO  j = nysv, nyn   
+                         CALL get_variable( id_dynamic, 'init_v', i, j-off_j,  &
+                                            v(nzb+1:nzt+1,j,i) )
+                      ENDDO
+                   ENDDO
+
+                ENDIF
+                init_3d%from_file_v = .TRUE.
+             ENDIF
+!
+!--          Read w-component
+             IF ( check_existence( var_names, 'init_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_w' )
+                CALL get_attribute( id_dynamic, char_lod, init_3d%lod_w,       &
+                                    .FALSE., 'init_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_w',                    &
+                                      init_3d%w_init(nzb+1:nzt) )
+
+!
+!--             level-of-detail 2 - read 3D initialization data
+                ELSEIF ( init_3d%lod_w == 2 )  THEN
+                   DO  i = nxl, nxr
+                      DO  j = nys, nyn
+                         CALL get_variable( id_dynamic, 'init_w', i, j,        &
+                                            w(nzb+1:nzt,j,i) )
+                      ENDDO
+                   ENDDO
+
+                ENDIF
+                init_3d%from_file_w = .TRUE.
+             ENDIF
+!
+!--          Read potential temperature
+             IF ( .NOT. neutral )  THEN      
+                IF ( check_existence( var_names, 'init_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_pt' )
+                   CALL get_attribute( id_dynamic, char_lod, init_3d%lod_pt,   &
+                                       .FALSE., 'init_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_pt',                &
+                                         init_3d%pt_init(nzb+1:nzt+1) )
+!
+!--                   Set Neumann surface boundary condition for initial profil
+                      init_3d%pt_init(nzb) = init_3d%pt_init(nzb+1)
+!
+!--                level-of-detail 2 - read 3D initialization data
+                   ELSEIF ( init_3d%lod_pt == 2 )  THEN
+                      DO  i = nxl, nxr
+                         DO  j = nys, nyn
+                            CALL get_variable( id_dynamic, 'init_pt', i, j,    &
+                                               pt(nzb+1:nzt+1,j,i) )
+                         ENDDO
+                      ENDDO
+
+                   ENDIF 
+                   init_3d%from_file_pt = .TRUE.
+                ENDIF
+             ENDIF
+!
+!--          Read mixing ratio
+             IF ( humidity )  THEN
+                IF ( check_existence( var_names, 'init_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_qv' )
+                   CALL get_attribute( id_dynamic, char_lod, init_3d%lod_q,    &
+                                       .FALSE., 'init_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_qv',               &
+                                         init_3d%q_init(nzb+1:nzt+1) )
+!
+!--                   Set Neumann surface boundary condition for initial profil
+                      init_3d%q_init(nzb) = init_3d%q_init(nzb+1)
+
+!
+!--                level-of-detail 2 - read 3D initialization data
+                   ELSEIF ( init_3d%lod_q == 2 )  THEN
+                      DO  i = nxl, nxr
+                         DO  j = nys, nyn
+                            CALL get_variable( id_dynamic, 'init_qv', i, j,    &
+                                               q(nzb+1:nzt+1,j,i) )
+                         ENDDO
+                      ENDDO
+
+                   ENDIF
+                   init_3d%from_file_q = .TRUE.
+                ENDIF
+             ENDIF
+!
+!--          Read soil moisture
+             IF ( check_existence( var_names, 'init_soil_m' ) )  THEN
+!
+!--             Read attributes for the fill value and level-of-detail
+                CALL get_attribute( id_dynamic, char_fill, init_3d%fill_msoil, &
+                                    .FALSE., 'init_soil_m' )
+                CALL get_attribute( id_dynamic, 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_init(0:init_3d%nzs-1) )
+
+                   CALL get_variable( id_dynamic, 'init_soil_m',               &
+                                      init_3d%msoil_init(0:init_3d%nzs-1) )
+!
+!--             level-of-detail 2 - read 3D initialization data
+                ELSEIF ( init_3d%lod_msoil == 2 )  THEN  ! need to be corrected
+                   ALLOCATE ( init_3d%msoil(0:init_3d%nzs-1,nys:nyn,nxl:nxr) )
+                   DO  i = nxl, nxr
+                      DO  j = nys, nyn
+                         CALL get_variable( id_dynamic, 'init_soil_m', i, j,   &
+                                            init_3d%msoil(0:init_3d%nzs-1,j,i) )
+                      ENDDO
+                   ENDDO
+                ENDIF
+                init_3d%from_file_msoil = .TRUE.
+             ENDIF
+!
+!--          Read soil temperature
+             IF ( check_existence( var_names, 'init_soil_t' ) )  THEN
+!
+!--             Read attributes for the fill value and level-of-detail
+                CALL get_attribute( id_dynamic, char_fill, init_3d%fill_tsoil, &
+                                    .FALSE., 'init_soil_t' )
+                CALL get_attribute( id_dynamic, 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_init(0:init_3d%nzs-1) )
+
+                   CALL get_variable( id_dynamic, 'init_soil_t',               &
+                                      init_3d%tsoil_init(0:init_3d%nzs-1) )
+
+!
+!--             level-of-detail 2 - read 3D initialization data
+                ELSEIF ( init_3d%lod_tsoil == 2 )  THEN  ! need to be corrected
+                   ALLOCATE ( init_3d%tsoil(0:init_3d%nzs-1,nys:nyn,nxl:nxr) )
+                   DO  i = nxl, nxr
+                      DO  j = nys, nyn
+                         CALL get_variable( id_dynamic, 'init_soil_t', i, j,   &
+                                            init_3d%tsoil(0:init_3d%nzs-1,j,i) )
+                      ENDDO
+                   ENDDO
+                ENDIF
+                init_3d%from_file_tsoil = .TRUE.
+             ENDIF
+!
+!--          Close input file
+             CALL close_file( id_dynamic )
+#endif
+          ENDIF
+#if defined( __parallel )
+          CALL MPI_BARRIER( comm2d, ierr )
+#endif
+       ENDDO
+!
+!--    Finally, check if the input data has any fill values.
+       IF ( init_3d%from_file_u )  THEN
+          IF ( ANY( u(nzb+1:nzt+1,nys:nyn,nxlu:nxr) == init_3d%fill_u ) )  THEN
+             message_string = 'NetCDF input for u_init must not contain ' //   &
+                              'any _FillValues'
+             CALL message( 'netcdf_data_input_mod', 'PA0999', 2, 2, 0, 6, 0 )
+          ENDIF
+       ENDIF
+       IF ( init_3d%from_file_v )  THEN
+          IF ( ANY( v(nzb+1:nzt+1,nysv:nyn,nxl:nxr) == init_3d%fill_v ) )  THEN
+             message_string = 'NetCDF input for v_init must not contain ' //   &
+                              'any _FillValues'
+             CALL message( 'netcdf_data_input_mod', 'PA0999', 2, 2, 0, 6, 0 )
+          ENDIF
+       ENDIF
+       IF ( init_3d%from_file_w )  THEN
+          IF ( ANY( w(nzb+1:nzt,nys:nyn,nxl:nxr) == init_3d%fill_w ) )  THEN
+             message_string = 'NetCDF input for w_init must not contain ' //   &
+                              'any _FillValues'
+             CALL message( 'netcdf_data_input_mod', 'PA0999', 2, 2, 0, 6, 0 )
+          ENDIF
+       ENDIF
+       IF ( init_3d%from_file_pt )  THEN
+          IF ( ANY( pt(nzb+1:nzt+1,nys:nyn,nxl:nxr) == init_3d%fill_pt ) )  THEN
+             message_string = 'NetCDF input for pt_init must not contain ' //  &
+                              'any _FillValues'
+             CALL message( 'netcdf_data_input_mod', 'PA0999', 2, 2, 0, 6, 0 )
+          ENDIF
+       ENDIF
+       IF ( init_3d%from_file_q )  THEN
+          IF ( ANY( q(nzb+1:nzt+1,nys:nyn,nxl:nxr) == init_3d%fill_q ) )  THEN
+             message_string = 'NetCDF input for q_init must not contain ' //   &
+                              'any _FillValues'
+             CALL message( 'netcdf_data_input_mod', 'PA0999', 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:
+! ------------
+!> Reads data at lateral and top boundaries derived from larger-scale model 
+!> (COSMO) by Inifor.
+!------------------------------------------------------------------------------!
+    SUBROUTINE netcdf_data_input_lsf
+
+       USE control_parameters,                                                 &
+           ONLY:  force_bound_l, force_bound_n, force_bound_r, force_bound_s,  &
+                  forcing, humidity, message_string, neutral, simulated_time
+
+       USE indices,                                                            &
+           ONLY:  nx, nxl, nxlu, nxr, ny, nyn, nys, nysv, nzb, nzt
+
+       IMPLICIT NONE
+
+
+       INTEGER(iwp) ::  i          !< running index along x-direction
+       INTEGER(iwp) ::  ii         !< running index for IO blocks
+       INTEGER(iwp) ::  id_dynamic !< NetCDF id of dynamic input file
+       INTEGER(iwp) ::  j          !< running index along y-direction
+       INTEGER(iwp) ::  k          !< running index along z-direction
+       INTEGER(iwp) ::  num_vars   !< number of variables in netcdf input file
+       INTEGER(iwp) ::  t          !< running index time dimension
+
+       REAL(wp) ::  dum           !< dummy variable to skip columns while reading topography file   
+
+       force%from_file = MERGE( .TRUE., .FALSE., input_pids_dynamic ) 
+!
+!--    Skip input if no forcing from larger-scale models is applied.
+       IF ( .NOT. forcing )  RETURN
+
+       DO  ii = 0, io_blocks-1
+          IF ( ii == io_group )  THEN
+#if defined ( __netcdf )
+!
+!--          Open file in read-only mode
+             CALL open_read_file( TRIM( input_file_dynamic ) //                &
+                                  TRIM( coupling_char ), id_dynamic )  
+!
+!--          Initialize INIFOR forcing. 
+             IF ( .NOT. force%init )  THEN
+!
+!--             At first, inquire all variable names. 
+                CALL inquire_num_variables( id_dynamic, num_vars )
+!
+!--             Allocate memory to store variable names.
+                ALLOCATE( force%var_names(1:num_vars) )
+                CALL inquire_variable_names( id_dynamic, force%var_names )
+!
+!--             Read time dimension, allocate memory and finally read time array
+                CALL get_dimension_length( id_dynamic, force%nt, 'time' )
+
+                IF ( check_existence( force%var_names, 'time' ) )  THEN
+                   ALLOCATE( force%time(0:force%nt-1) )
+                   CALL get_variable( id_dynamic, 'time', force%time )
+                ENDIF
+!
+!--             Read vertical dimension of scalar und w grid
+                CALL get_dimension_length( id_dynamic, force%nzu, 'z' )
+                CALL get_dimension_length( id_dynamic, force%nzw, 'zw' )
+
+                IF ( check_existence( force%var_names, 'z' ) )  THEN
+                   ALLOCATE( force%zu_atmos(1:force%nzu) )
+                   CALL get_variable( id_dynamic, 'z', force%zu_atmos )
+                ENDIF
+                IF ( check_existence( force%var_names, 'zw' ) )  THEN
+                   ALLOCATE( force%zw_atmos(1:force%nzw) )
+                   CALL get_variable( id_dynamic, 'zw', force%zw_atmos )
+                ENDIF
+
+!
+!--             Read surface pressure
+                IF ( check_existence( force%var_names,                         &
+                                  'surface_forcing_surface_pressure' ) )  THEN
+                   ALLOCATE( force%surface_pressure(0:force%nt-1) )
+                   CALL get_variable( id_dynamic,                              &
+                                      'surface_forcing_surface_pressure',      &
+                                      force%surface_pressure )
+                ENDIF
+!
+!--             Set control flag to indicate that initialization is already done
+                force%init = .TRUE.
+
+             ENDIF
+
+!
+!--          Obtain time index for current input starting at 0. 
+!--          @todo: At the moment time, in INIFOR and simulated time correspond 
+!--                 to each other. If required, adjust to daytime. 
+             force%tind = MINLOC( ABS( force%time - simulated_time ), DIM = 1 )&
+                          - 1
+             force%tind_p = force%tind + 1  
+!
+!--          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. 
+!--          The function get_variable_bc assumes the start indices with respect
+!--          to the netcdf file convention (data starts at index 1). For this 
+!--          reason, nys+1 / nxl+1 are passed instead of nys / nxl. For the 
+!--          the u- and v-component at the north/south, and left/right boundary,
+!--          nxlu and nysv are passed, respectively, since these always starts 
+!--          at index 1 in case of forcing. 
+
+             IF ( force_bound_l )  THEN
+                DO  j = nys, nyn
+                   DO  t = force%tind, force%tind_p
+                      CALL get_variable_bc( id_dynamic, 'ls_forcing_left_u',   &
+                                      t+1,                                     &
+                                      nzb+1, nzt+1-(nzb+1)+1,                  &
+                                      j+1, 1,                                  &
+                                      force%u_left(t-force%tind,nzb+1:nzt+1,j) )
+                   ENDDO
+                ENDDO
+
+                DO  j = nysv, nyn
+                   DO  t = force%tind, force%tind_p
+                      CALL get_variable_bc( id_dynamic, 'ls_forcing_left_v',   &
+                                      t+1,                                     &
+                                      nzb+1, nzt+1-(nzb+1)+1,                  &
+                                      j, 1,                                    &
+                                      force%v_left(t-force%tind,nzb+1:nzt+1,j) )
+                   ENDDO
+                ENDDO
+                DO  j = nys, nyn
+                   DO  t = force%tind, force%tind_p
+                      CALL get_variable_bc( id_dynamic,                        &
+                                      'ls_forcing_left_w',                     &
+                                      t+1,                                     &
+                                      nzb+1, nzt-(nzb+1) + 1,                  &
+                                      j+1, 1,                                  &
+                                      force%w_left(t-force%tind,nzb+1:nzt,j) )
+                   ENDDO
+                ENDDO
+                IF ( .NOT. neutral )  THEN
+                   DO  j = nys, nyn
+                      DO  t = force%tind, force%tind_p
+                         CALL get_variable_bc( id_dynamic,                     &
+                                      'ls_forcing_left_pt',                    &
+                                      t+1,                                     &
+                                      nzb+1, nzt+1-(nzb+1)+1,                  &
+                                      j+1, 1,                                  &
+                                      force%pt_left(t-force%tind,nzb+1:nzt+1,j) )
+                      ENDDO
+                   ENDDO
+                ENDIF
+                IF ( humidity )  THEN
+                   DO  j = nys, nyn
+                      DO  t = force%tind, force%tind_p
+                         CALL get_variable_bc( id_dynamic,                     &
+                                      'ls_forcing_left_qv',                    &
+                                      t+1,                                     &
+                                      nzb+1, nzt+1-(nzb+1)+1,                  &
+                                      j+1, 1,                                  &
+                                      force%q_left(t-force%tind,nzb+1:nzt+1,j) )
+                      ENDDO
+                   ENDDO
+                ENDIF
+             ENDIF
+
+             IF ( force_bound_r )  THEN
+                DO  j = nys, nyn
+                   DO  t = force%tind, force%tind_p
+                      CALL get_variable_bc( id_dynamic, 'ls_forcing_right_u',  &
+                                      t+1,                                     &
+                                      nzb+1, nzt+1-(nzb+1)+1,                  &
+                                      j+1, 1,                                  &
+                                      force%u_right(t-force%tind,nzb+1:nzt+1,j) )
+                   ENDDO
+                ENDDO
+                DO  j = nysv, nyn
+                   DO  t = force%tind, force%tind_p
+                      CALL get_variable_bc( id_dynamic, 'ls_forcing_right_v',  &
+                                      t+1,                                     &
+                                      nzb+1, nzt+1-(nzb+1)+1,                  &
+                                      j, 1,                                    &
+                                      force%v_right(t-force%tind,nzb+1:nzt+1,j) )
+                   ENDDO
+                ENDDO
+                DO  j = nys, nyn
+                   DO  t = force%tind, force%tind_p
+                      CALL get_variable_bc( id_dynamic, 'ls_forcing_right_w',  &
+                                      t+1,                                     &
+                                      nzb+1, nzt-(nzb+1)+1,                    &
+                                      j+1, 1,                                  &
+                                      force%w_right(t-force%tind,nzb+1:nzt,j) )
+                   ENDDO
+                ENDDO
+                IF ( .NOT. neutral )  THEN
+                   DO  j = nys, nyn
+                      DO  t = force%tind, force%tind_p
+                         CALL get_variable_bc( id_dynamic,                     &
+                                      'ls_forcing_right_pt',                   &
+                                      t+1,                                     &
+                                      nzb+1, nzt+1-(nzb+1)+1,                  &
+                                      j+1, 1,                                  &
+                                      force%pt_right(t-force%tind,nzb+1:nzt+1,j) )
+                      ENDDO
+                   ENDDO
+                ENDIF
+                IF ( humidity )  THEN
+                   DO  j = nys, nyn
+                      DO  t = force%tind, force%tind_p
+                         CALL get_variable_bc( id_dynamic,                     &
+                                      'ls_forcing_right_qv',                   &
+                                      t+1,                                     &
+                                      nzb+1, nzt+1-(nzb+1)+1,                  &
+                                      j+1, 1,                                  &
+                                      force%q_right(t-force%tind,nzb+1:nzt+1,j) )
+                      ENDDO
+                   ENDDO
+                ENDIF
+             ENDIF
+
+             IF ( force_bound_n )  THEN
+                DO  i = nxlu, nxr
+                   DO  t = force%tind, force%tind_p
+                      CALL get_variable_bc( id_dynamic, 'ls_forcing_north_u',  &
+                                      t+1,                                     &
+                                      nzb+1, nzt+1-(nzb+1)+1,                  &
+                                      i, 1,                                    &
+                                      force%u_north(t-force%tind,nzb+1:nzt+1,i) )
+                   ENDDO
+                ENDDO
+                DO  i = nxl, nxr
+                   DO  t = force%tind, force%tind_p
+                      CALL get_variable_bc( id_dynamic, 'ls_forcing_north_v',  &
+                                      t+1,                                     &
+                                      nzb+1, nzt+1-(nzb+1)+1,                  &
+                                      i+1, 1,                                  &
+                                      force%v_north(t-force%tind,nzb+1:nzt+1,i) )
+                   ENDDO
+                ENDDO
+                DO  i = nxl, nxr
+                   DO  t = force%tind, force%tind_p
+                      CALL get_variable_bc( id_dynamic, 'ls_forcing_north_w',  &
+                                      t+1,                                     &
+                                      nzb+1, nzt-(nzb+1)+1,                    &
+                                      i+1, 1,                                  &
+                                      force%w_north(t-force%tind,nzb+1:nzt,i) )
+                   ENDDO
+                ENDDO
+                IF ( .NOT. neutral )  THEN
+                   DO  i = nxl, nxr
+                      DO  t = force%tind, force%tind_p
+                         CALL get_variable_bc( id_dynamic,                     &
+                                      'ls_forcing_north_pt',                   &
+                                      t+1,                                     &
+                                      nzb+1, nzt+1-(nzb+1)+1,                  &
+                                      i+1, 1,                                  &
+                                      force%pt_north(t-force%tind,nzb+1:nzt+1,i) )
+                      ENDDO
+                   ENDDO
+                ENDIF
+                IF ( humidity )  THEN
+                   DO  i = nxl, nxr
+                      DO  t = force%tind, force%tind_p
+                         CALL get_variable_bc( id_dynamic,                     &
+                                      'ls_forcing_north_qv',                   &
+                                      t+1,                                     &
+                                      nzb+1, nzt+1-(nzb+1)+1,                  &
+                                      i+1, 1,                                  &
+                                      force%q_north(t-force%tind,nzb+1:nzt+1,i) )
+                      ENDDO
+                   ENDDO
+                ENDIF
+             ENDIF
+
+             IF ( force_bound_s )  THEN
+                DO  i = nxlu, nxr
+                   DO  t = force%tind, force%tind_p
+                      CALL get_variable_bc( id_dynamic, 'ls_forcing_south_u',  &
+                                      t+1,                                     &
+                                      nzb+1, nzt+1-(nzb+1)+1,                  &
+                                      i, 1,                                    &
+                                      force%u_south(t-force%tind,nzb+1:nzt+1,i) )
+                   ENDDO
+                ENDDO
+                DO  i = nxl, nxr
+                   DO  t = force%tind, force%tind_p
+                      CALL get_variable_bc( id_dynamic, 'ls_forcing_south_v',  &
+                                      t+1,                                     &
+                                      nzb+1, nzt+1-(nzb+1)+1,                  &
+                                      i+1, 1,                                  &
+                                      force%v_south(t-force%tind,nzb+1:nzt+1,i) )
+                   ENDDO
+                ENDDO
+                DO  i = nxl, nxr
+                   DO  t = force%tind, force%tind_p
+                      CALL get_variable_bc( id_dynamic, 'ls_forcing_south_w',  &
+                                      t+1,                                     &
+                                      nzb+1, nzt-(nzb+1)+1,                    &
+                                      i+1, 1,                                  &
+                                      force%w_south(t-force%tind,nzb+1:nzt,i) )
+                   ENDDO
+                ENDDO
+                IF ( .NOT. neutral )  THEN
+                   DO  i = nxl, nxr
+                      DO  t = force%tind, force%tind_p
+                         CALL get_variable_bc( id_dynamic,                     &
+                                      'ls_forcing_south_pt',                   &
+                                      t+1,                                     &
+                                      nzb+1, nzt+1-(nzb+1)+1,                  &
+                                      i+1, 1,                                  &
+                                      force%pt_south(t-force%tind,nzb+1:nzt+1,i) )
+                      ENDDO
+                   ENDDO
+                ENDIF
+                IF ( humidity )  THEN
+                   DO  i = nxl, nxr
+                      DO  t = force%tind, force%tind_p
+                         CALL get_variable_bc( id_dynamic,                     &
+                                      'ls_forcing_south_qv',                   &
+                                      t+1,                                     &
+                                      nzb+1, nzt+1-(nzb+1)+1,                  &
+                                      i+1, 1,                                  &
+                                      force%q_south(t-force%tind,nzb+1:nzt+1,i) )
+                      ENDDO
+                   ENDDO
+                ENDIF
+             ENDIF
+!
+!--          Top boundary
+             DO  i = nxlu, nxr
+                DO  t = force%tind, force%tind_p
+                   CALL get_variable_bc( id_dynamic, 'ls_forcing_top_u',       &
+                                   t+1,                                        &
+                                   nys+1, nyn-nys+1,                           &
+                                   i, 1,                                       &
+                                   force%u_top(t-force%tind,nys:nyn,i) )
+                ENDDO
+             ENDDO
+             DO  i = nxl, nxr
+                DO  t = force%tind, force%tind_p
+                   CALL get_variable_bc( id_dynamic, 'ls_forcing_top_v',       &
+                                   t+1,                                        &
+                                   nysv, nyn-nysv+1,                           &
+                                   i+1, 1,                                     &
+                                   force%v_top(t-force%tind,nysv:nyn,i) )
+                ENDDO
+             ENDDO
+             DO  i = nxl, nxr
+                DO  t = force%tind, force%tind_p
+                   CALL get_variable_bc( id_dynamic, 'ls_forcing_top_w',       &
+                                   t+1,                                        &
+                                   nys+1, nyn-nys+1,                           &
+                                   i+1, 1,                                     &
+                                   force%w_top(t-force%tind,nys:nyn,i) )
+                ENDDO
+             ENDDO
+             IF ( .NOT. neutral )  THEN
+                DO  i = nxl, nxr
+                   DO  t = force%tind, force%tind_p
+                      CALL get_variable_bc( id_dynamic, 'ls_forcing_top_pt',   &
+                                      t+1,                                     &
+                                      nys+1, nyn-nys+1,                        &
+                                      i+1, 1,                                  &
+                                      force%pt_top(t-force%tind,nys:nyn,i) )
+                   ENDDO
+                ENDDO
+             ENDIF
+             IF ( humidity )  THEN
+                DO  i = nxl, nxr
+                   DO  t = force%tind, force%tind_p
+                      CALL get_variable_bc( id_dynamic, 'ls_forcing_top_qv',   &
+                                      t+1,                                     &
+                                      nys+1, nyn-nys+1,                        &
+                                      i+1, 1,                                  &
+                                      force%q_top(t-force%tind,nys:nyn,i) )
+                   ENDDO
+                ENDDO
+             ENDIF
+
+!
+!--          Close input file
+             CALL close_file( id_dynamic )
+#endif
+          ENDIF
+#if defined( __parallel )
+          CALL MPI_BARRIER( comm2d, ierr )
+#endif
+       ENDDO
+
+!
+!--    Finally, after data input set control flag indicating that vertical 
+!--    inter- and/or extrapolation is required. 
+!--    Please note, inter/extrapolation of INIFOR data is only a workaroud, 
+!--    as long as INIFOR delivers vertically equidistant data. 
+       force%interpolated = .FALSE. 
+
+    END SUBROUTINE netcdf_data_input_lsf
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Checks input file for consistency and minimum requirements.
+!------------------------------------------------------------------------------!
+    SUBROUTINE netcdf_data_input_check_dynamic
+
+       USE control_parameters,                                                 &
+           ONLY:  initializing_actions, forcing, message_string
+
+       USE pmc_interface,                                                      &
+           ONLY:  nested_run
+
+       IMPLICIT NONE
+
+       LOGICAL      ::  check_nest !< flag indicating if a check passed 
+
+!
+!--    In case of forcing, check whether dynamic input file is present
+       IF ( .NOT. input_pids_dynamic  .AND.  forcing )  THEN
+          message_string = 'forcing = .TRUE. requires dynamic input file ' //  &
+                            TRIM( input_file_dynamic ) // TRIM( coupling_char )
+          CALL message( 'netcdf_data_input_mod', 'PA0430', 1, 2, 0, 6, 0 )
+       ENDIF
+!
+!--    Dynamic input file must also be present if initialization via inifor is
+!--    prescribed. 
+       IF ( .NOT. input_pids_dynamic  .AND.                                    &
+            TRIM( initializing_actions ) == 'inifor' )  THEN
+          message_string = 'initializing_actions = inifor requires dynamic ' //&
+                           'input file ' // TRIM( input_file_dynamic ) //      &
+                           TRIM( coupling_char )
+          CALL message( 'netcdf_data_input_mod', 'PA0430', 1, 2, 0, 6, 0 )
+       ENDIF
+!
+!--    In case of nested run assure that all domains are initialized the same
+!--    way, i.e. if at least at one domain is initialized with soil and 
+!--    atmospheric data provided by COSMO, all domains must be initialized the 
+!--    same way, to assure that soil and atmospheric quantities are 
+!--    consistent. 
+       IF ( nested_run )  THEN
+          check_nest = .TRUE.
+#if defined( __parallel )
+          CALL MPI_ALLREDUCE( TRIM( initializing_actions ) == 'inifor',        &
+                              check_nest, 1, MPI_LOGICAL,                      &
+                              MPI_LAND, MPI_COMM_WORLD, ierr )
+
+          IF ( TRIM( initializing_actions ) == 'inifor'  .AND.                 &
+               .NOT.  check_nest )  THEN
+             message_string = 'In case of nesting, if at least in one ' //     &
+                              'domain initializing_actions = inifor, '  //     &
+                              'all domains need to be initialized that way.'
+             CALL message( 'netcdf_data_input_mod', 'PA0430', 3, 2, 0, 6, 0 )
+          ENDIF
+#endif
+       ENDIF
+
+    END SUBROUTINE netcdf_data_input_check_dynamic
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Checks input file for consistency and minimum requirements.
+!------------------------------------------------------------------------------!
+    SUBROUTINE netcdf_data_input_check_static
+
+       USE control_parameters,                                                 &
+           ONLY:  land_surface, message_string, urban_surface
+
+       USE indices,                                                            &
+           ONLY:  nxl, nxr, nyn, nys
+
+       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 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. 
+       IF ( ANY( terrain_height_f%var == terrain_height_f%fill ) )  THEN
+          message_string = 'NetCDF variable orography_2D is not ' //           &
+                           'allowed to have missing data'
+          CALL message( 'netcdf_data_input_mod', 'PA0999', 2, 2, 0, 6, 0 )
+       ENDIF
+!
+!--    Skip further checks concerning buildings and natural surface properties
+!--    if no urban surface and land surface model are applied.
+       IF (  .NOT. land_surface  .OR.  .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. building_type_f%from_file    .OR.                            &
+            .NOT. water_type_f%from_file       .OR.                            &
+            .NOT. soil_type_f%from_file             )  THEN
+          message_string = 'Minimum requirement for surface classification ' //&
+                           'is not fulfilled. At least ' //                    &
+                           'vegetation_type, pavement_type, ' //               &
+                           'building_type, soil_type and water_type are '//    &
+                           'required.'
+          CALL message( 'netcdf_data_input_mod', 'PA0999', 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_density_lsm 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 vegegation_type = 0 at any location, ' // &
+                                 'vegetation_pars is required'
+                CALL message( 'netcdf_data_input_mod', 'PA0999', 2, 2, 0, 6, 0 )
+             ENDIF
+             IF ( .NOT. root_area_density_lsm_f%from_file )  THEN
+                message_string = 'If vegegation_type = 0 at any location, ' // &
+                                 'root_area_density_lsm is required'
+                CALL message( 'netcdf_data_input_mod', 'PA0999', 2, 2, 0, 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', 'PA0999', 2, 2, 0, 6, 0 )          
+          ENDIF
+       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', 'PA0999', 2, 2, 0, 6, 0 )          
+             ENDIF
+          ENDIF
+       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', 'PA0999', 2, 2, 0, 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', 'PA0999', 2, 2, 0, 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', 'PA0999', 2, 2, 0, 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', 'PA0999', 2, 2, 0, 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 ( 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
+                message_string = 'At least one of the paramters '       //     &
+                                 'vegetation_type, pavement_type, '     //     &
+                                 'building_type, or water_type must be set '// &
+                                 'to a non-missing value'
+                CALL message( 'netcdf_data_input_mod', 'PA0999', 2, 2, 0, 6, 0 )
+             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', 'PA0999',            &
+                                  2, 2, 0, 6, 0 )
+                ENDIF
+             ENDIF
+!
+!--          Check for consistency of surface fraction. If more than one type 
+!--          is set, surface fraction need to be given and the sum must not 
+!--          be larger than 1.
+             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
+                IF ( 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', 'PA0999',            &
+                                  2, 2, 0, 6, 0 )
+                ENDIF
+                IF ( SUM ( surface_fraction_f%frac(:,j,i) ) > 1.0_wp )  THEN
+                   message_string = 'surface_fraction must not exceed 1'
+                   CALL message( 'netcdf_data_input_mod', 'PA0999',            &
+                                  2, 2, 0, 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', 'PA0999',         &
+                                     2, 2, 0, 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_density_lsm ' //   &
+                                       'must be set at this location.' 
+                      CALL message( 'netcdf_data_input_mod', 'PA0999',         &
+                                     2, 2, 0, 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', 'PA0999',            &
+                                  2, 2, 0, 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', 'PA0999',         &
+                                     2, 2, 0, 6, 0 )
+                   ENDIF
+                ENDIF
+             ENDIF
+!
+!--          Check if building_type is set at each building
+!              IF ( building_type_f%from_file  .AND.  buildings_f%from_file )  THEN
+!                 IF ( buildings_f%var_2d(j,i) /= buildings_f%fill1  .AND.       &
+!                      building_type_f%var(j,i) == building_type_f%fill )  THEN
+!                       WRITE( message_string, * ) 'Each building requires ' //  &
+!                                        ' a type. i, j = ', i, j
+!                       CALL message( 'netcdf_data_input_mod', 'PA0999',         &
+!                                      2, 2, 0, 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', 'PA0999',         &
+                                     2, 2, 0, 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', 'PA0999',         &
+                                     2, 2, 0, 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', 'PA0999',         &
+                                     2, 2, 0, 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', 'PA0999',         &
+                                     2, 2, 0, 6, 0 )
+                   ENDIF
+                ENDIF
+             ENDIF
+
+          ENDDO
+       ENDDO
+
+    END SUBROUTINE netcdf_data_input_check_static
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Vertical interpolation and extrapolation of 1D variables.
+!------------------------------------------------------------------------------!
+    SUBROUTINE netcdf_data_input_interpolate_1d( var, z_grid, z_file)
+
+       IMPLICIT NONE
+
+       LOGICAL      ::  top     !< flag indicating extrapolation at model top
+
+       INTEGER(iwp) ::  k       !< running index z-direction file
+       INTEGER(iwp) ::  kk      !< running index z-direction stretched model grid
+       INTEGER(iwp) ::  kl      !< lower index bound along z-direction
+       INTEGER(iwp) ::  ku      !< upper index bound along z-direction
+       INTEGER(iwp) ::  nz_file !< number of vertical levels on file 
+
+
+       REAL(wp), DIMENSION(:) ::  z_grid                  !< grid levels on numeric grid 
+       REAL(wp), DIMENSION(:) ::  z_file                  !< grid levels on file grid 
+       REAL(wp), DIMENSION(:), INTENT(INOUT) ::  var      !< treated variable
+       REAL(wp), DIMENSION(:), ALLOCATABLE   ::  var_tmp  !< temporary variable
+
+
+       kl = LBOUND(var,1)
+       ku = UBOUND(var,1)
+       ALLOCATE( var_tmp(kl:ku) )
+
+       DO  k = kl, ku
+
+          kk = MINLOC( ABS( z_file - z_grid(k) ), DIM = 1 )
+
+          IF ( kk < ku )  THEN
+             IF ( z_file(kk) - z_grid(k) <= 0.0_wp )  THEN
+                var_tmp(k) = var(kk) +                                         &
+                                       ( var(kk+1)        - var(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_tmp(k) = var(kk-1) +                                       &
+                                         ( var(kk)     - var(kk-1)    ) /      &
+                                         ( z_file(kk)  - z_file(kk-1) ) *      &
+                                         ( z_grid(k)   - z_file(kk-1) ) 
+             ENDIF
+!
+!--       Extrapolate
+          ELSE
+     
+             var_tmp(k) = var(ku) +   ( var(ku)    - var(ku-1)      ) /        &
+                                      ( z_file(ku) - z_file(ku-1)   ) *        &
+                                      ( z_grid(k)  - z_file(ku)     )  
+    
+          ENDIF
+
+       ENDDO
+       var(:) = var_tmp(:)
+
+       DEALLOCATE( var_tmp )
+
+
+    END SUBROUTINE netcdf_data_input_interpolate_1d
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Vertical interpolation and extrapolation of 1D variables from Inifor grid
+!> onto Palm grid, where both have same dimension. Please note, the passed
+!> paramter list in 1D version is different compared to 2D version.
+!------------------------------------------------------------------------------!
+    SUBROUTINE netcdf_data_input_interpolate_1d_soil( var, var_file,           &
+                                                      z_grid, z_file,          &
+                                                      nzb_var, nzt_var,        & 
+                                                      nzb_file, nzt_file )
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i        !< running index x-direction
+       INTEGER(iwp) ::  j        !< running index y-direction
+       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 
+
+!        LOGICAL, OPTIONAL ::  depth !< flag indicating reverse z-axis, i.e. depth instead of height, e.g. in case of ocean or soil
+
+       REAL(wp), DIMENSION(nzb_var:nzt_var)   ::  z_grid   !< grid levels on numeric grid 
+       REAL(wp), DIMENSION(nzb_file:nzt_file) ::  z_file   !< grid levels on file grid 
+       REAL(wp), DIMENSION(nzb_var:nzt_var)   ::  var      !< treated variable
+       REAL(wp), DIMENSION(nzb_file:nzt_file) ::  var_file !< temporary variable
+
+       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
+          ELSE
+             var(k) = var_file(ku) + ( var_file(ku) - var_file(ku-1) ) /       &
+                                     ( z_file(ku)   - z_file(ku-1)   ) *       &
+                                     ( z_grid(k)    - z_file(ku)     )  
+
+          ENDIF
+
+       ENDDO
+
+    END SUBROUTINE netcdf_data_input_interpolate_1d_soil
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Vertical interpolation and extrapolation of 2D variables at lateral boundaries.
+!------------------------------------------------------------------------------!
+    SUBROUTINE netcdf_data_input_interpolate_2d( var, z_grid, z_file)
+
+       IMPLICIT NONE
+
+       LOGICAL      ::  top     !< flag indicating extrapolation at model top
+
+       INTEGER(iwp) ::  i       !< running index x- or y -direction
+       INTEGER(iwp) ::  il      !< lower index bound along x- or y-direction
+       INTEGER(iwp) ::  iu      !< upper index bound along x- or y-direction
+       INTEGER(iwp) ::  k       !< running index z-direction file
+       INTEGER(iwp) ::  kk      !< running index z-direction stretched model grid
+       INTEGER(iwp) ::  kl      !< lower index bound along z-direction
+       INTEGER(iwp) ::  ku      !< upper index bound along z-direction
+       INTEGER(iwp) ::  nz_file !< number of vertical levels on file 
+
+
+       REAL(wp), DIMENSION(:) ::  z_grid                  !< grid levels on numeric grid 
+       REAL(wp), DIMENSION(:) ::  z_file                  !< grid levels on file grid 
+       REAL(wp), DIMENSION(:,:), INTENT(INOUT) ::  var    !< treated variable
+       REAL(wp), DIMENSION(:), ALLOCATABLE   ::  var_tmp  !< temporary variable
+
+
+       il = LBOUND(var,2)
+       iu = UBOUND(var,2)
+       kl = LBOUND(var,1)
+       ku = UBOUND(var,1)
+       ALLOCATE( var_tmp(kl:ku) )
+
+       DO  i = il, iu
+          DO  k = kl, ku
+
+             kk = MINLOC( ABS( z_file - z_grid(k) ), DIM = 1 )
+
+             IF ( kk < ku )  THEN
+                IF ( z_file(kk) - z_grid(k) <= 0.0_wp )  THEN
+                   var_tmp(k) = var(kk,i) +                                    &
+                                          ( var(kk+1,i)      - var(kk,i)  ) /  &
+                                          ( 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_tmp(k) = var(kk-1,i) +                                  &
+                                            ( var(kk,i)   - var(kk-1,i)  ) /   &
+                                            ( z_file(kk)  - z_file(kk-1) ) *   &
+                                            ( z_grid(k)   - z_file(kk-1) ) 
+                ENDIF
+!
+!--          Extrapolate
+             ELSE
+     
+                var_tmp(k) = var(ku,i) + ( var(ku,i)  - var(ku-1,i)    ) /     &
+                                         ( z_file(ku) - z_file(ku-1)   ) *     &
+                                         ( z_grid(k)  - z_file(ku)     )  
+    
+             ENDIF
+
+          ENDDO
+          var(:,i) = var_tmp(:)
+
+       ENDDO
+
+       DEALLOCATE( var_tmp )
+
+
+    END SUBROUTINE netcdf_data_input_interpolate_2d
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Vertical interpolation and extrapolation of 3D variables.
+!------------------------------------------------------------------------------!
+    SUBROUTINE netcdf_data_input_interpolate_3d( var, z_grid, z_file )
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i       !< running index x-direction
+       INTEGER(iwp) ::  il      !< lower index bound along x-direction
+       INTEGER(iwp) ::  iu      !< upper index bound along x-direction
+       INTEGER(iwp) ::  j       !< running index y-direction
+       INTEGER(iwp) ::  jl      !< lower index bound along x-direction
+       INTEGER(iwp) ::  ju      !< upper index bound along x-direction
+       INTEGER(iwp) ::  k       !< running index z-direction file
+       INTEGER(iwp) ::  kk      !< running index z-direction stretched model grid
+       INTEGER(iwp) ::  kl      !< lower index bound along z-direction
+       INTEGER(iwp) ::  ku      !< upper index bound along z-direction
+       INTEGER(iwp) ::  nz_file !< number of vertical levels on file 
+
+       REAL(wp), DIMENSION(:) ::  z_grid                      !< grid levels on numeric grid 
+       REAL(wp), DIMENSION(:) ::  z_file                      !< grid levels on file grid
+       REAL(wp), DIMENSION(:,:,:), INTENT(INOUT) ::  var      !< treated variable
+       REAL(wp), DIMENSION(:), ALLOCATABLE       ::  var_tmp  !< temporary variable
+
+       il = LBOUND(var,3)
+       iu = UBOUND(var,3)
+       jl = LBOUND(var,2)
+       ju = UBOUND(var,2)
+       kl = LBOUND(var,1)
+       ku = UBOUND(var,1)
+
+       ALLOCATE( var_tmp(kl:ku) )
+
+       DO  i = il, iu
+          DO  j = jl, ju
+             DO  k = kl, ku
+
+                kk = MINLOC( ABS( z_file - z_grid(k) ), DIM = 1 ) 
+
+                IF ( kk < ku )  THEN
+                   IF ( z_file(kk) - z_grid(k) <= 0.0_wp )  THEN
+                      var_tmp(k) = var(kk,j,i) +                               &
+                                             ( var(kk+1,j,i) - var(kk,j,i) ) / &
+                                             ( 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_tmp(k) = var(kk-1,j,i) +                             &
+                                             ( var(kk,j,i) - var(kk-1,j,i) ) / &
+                                             ( z_file(kk)  - z_file(kk-1)  ) * &
+                                             ( z_grid(k)   - z_file(kk-1)  ) 
+                   ENDIF
+!
+!--             Extrapolate
+                ELSE
+                   var_tmp(k) = var(ku,j,i) +                                  &
+                                       ( var(ku,j,i)  - var(ku-1,j,i)   ) /    &
+                                       ( z_file(ku)   - z_file(ku-1)    ) *    &
+                                       ( z_grid(k)    - z_file(ku)      )  
+
+                ENDIF
+             ENDDO
+             var(:,j,i) = var_tmp(:)
+          ENDDO
+       ENDDO
+
+       DEALLOCATE( var_tmp )
+
+
+    END SUBROUTINE netcdf_data_input_interpolate_3d
+
+!------------------------------------------------------------------------------!
+! 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_file( id )
+#if defined( __netcdf )
+
+       USE pegrid
+
+       IMPLICIT NONE
+
+       INTEGER(iwp), INTENT(INOUT)        ::  id        !< file id
+
+       nc_stat = NF90_CLOSE( id )
+       CALL handle_error( 'close', 537 )
+#endif
+    END SUBROUTINE close_file
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Opens an existing netCDF file for reading only and returns its id.
+!------------------------------------------------------------------------------!
+    SUBROUTINE open_read_file( filename, id )
+#if defined( __netcdf )
+
+       USE pegrid
+
+       IMPLICIT NONE
+
+       CHARACTER (LEN=*), INTENT(IN) ::  filename  !< filename
+       INTEGER(iwp), INTENT(INOUT)   ::  id        !< file id
+       LOGICAL                       ::  file_open = .FALSE.
+
+       nc_stat = NF90_OPEN( filename, NF90_NOWRITE, id )
+
+       CALL handle_error( 'open_read_file', 536 )
+
+#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 )
+#if defined( __netcdf )
+
+       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, INTENT(IN) ::  global                   !< flag indicating global attribute
+
+!
+!--    Read global attribute
+       IF ( global )  THEN
+          nc_stat = NF90_GET_ATT( id, NF90_GLOBAL, TRIM( attribute_name ), value )
+          CALL handle_error( 'get_attribute_int32 global', 522 )
+!
+!--    Read attributes referring to a single variable. Therefore, first inquire 
+!--    variable id
+       ELSE
+          nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
+          CALL handle_error( 'get_attribute_int32', 522 )
+          nc_stat = NF90_GET_ATT( id, id_var, TRIM( attribute_name ), value )
+          CALL handle_error( 'get_attribute_int32', 522 )       
+       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 )
+#if defined( __netcdf )
+
+       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, INTENT(IN) ::  global                   !< flag indicating global attribute
+
+!
+!--    Read global attribute
+       IF ( global )  THEN
+          nc_stat = NF90_GET_ATT( id, NF90_GLOBAL, TRIM( attribute_name ), value )
+          CALL handle_error( 'get_attribute_int8 global', 523 )
+!
+!--    Read attributes referring to a single variable. Therefore, first inquire 
+!--    variable id
+       ELSE
+          nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
+          CALL handle_error( 'get_attribute_int8', 523 )
+          nc_stat = NF90_GET_ATT( id, id_var, TRIM( attribute_name ), value )
+          CALL handle_error( 'get_attribute_int8', 523 )       
+       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 )
+#if defined( __netcdf )
+
+       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, INTENT(IN) ::  global                   !< flag indicating global attribute
+
+       REAL(wp), INTENT(INOUT)     ::  value            !< read value
+
+
+!
+!-- Read global attribute
+       IF ( global )  THEN
+          nc_stat = NF90_GET_ATT( id, NF90_GLOBAL, TRIM( attribute_name ), value )
+          CALL handle_error( 'get_attribute_real global', 524 )
+!
+!-- Read attributes referring to a single variable. Therefore, first inquire 
+!-- variable id
+       ELSE
+          nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
+          CALL handle_error( 'get_attribute_real', 524 )
+          nc_stat = NF90_GET_ATT( id, id_var, TRIM( attribute_name ), value )
+          CALL handle_error( 'get_attribute_real', 524 )       
+       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 )
+#if defined( __netcdf )
+
+       USE pegrid
+
+       IMPLICIT NONE
+
+       CHARACTER(LEN=*)                ::  attribute_name   !< attribute name
+       CHARACTER(LEN=*), OPTIONAL      ::  variable_name    !< variable name 
+       CHARACTER(LEN=*), INTENT(INOUT) ::  value            !< read value
+
+       INTEGER(iwp), INTENT(IN)    ::  id               !< file id
+       INTEGER(iwp)                ::  id_var           !< variable id
+
+       LOGICAL, INTENT(IN) ::  global                   !< flag indicating global attribute
+
+!
+!--    Read global attribute
+       IF ( global )  THEN
+          nc_stat = NF90_GET_ATT( id, NF90_GLOBAL, TRIM( attribute_name ), value )
+          CALL handle_error( 'get_attribute_string global', 525 )
+!
+!--    Read attributes referring to a single variable. Therefore, first inquire 
+!--    variable id
+       ELSE
+          nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
+          CALL handle_error( 'get_attribute_string', 525 )
+
+          nc_stat = NF90_GET_ATT( id, id_var, TRIM( attribute_name ), value )
+          CALL handle_error( 'get_attribute_string',525 ) 
+
+       ENDIF
+#endif
+    END SUBROUTINE get_attribute_string
+
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Get dimension array for a given dimension
+!------------------------------------------------------------------------------!
+     SUBROUTINE get_dimension_length( id, dim_len, variable_name )
+#if defined( __netcdf )
+
+       USE pegrid
+
+       IMPLICIT NONE
+
+       CHARACTER(LEN=*)            ::  variable_name    !< dimension name 
+       CHARACTER(LEN=100)          ::  dum              !< dummy variable to receive return character
+
+       INTEGER(iwp)                ::  dim_len          !< dimension size
+       INTEGER(iwp), INTENT(IN)    ::  id               !< file id
+       INTEGER(iwp)                ::  id_dim           !< dimension id
+
+!
+!--    First, inquire dimension ID
+       nc_stat = NF90_INQ_DIMID( id, TRIM( variable_name ), id_dim )
+       CALL handle_error( 'get_dimension_length', 526 )
+!
+!--    Inquire dimension length
+       nc_stat = NF90_INQUIRE_DIMENSION( id, id_dim, dum, LEN = dim_len )
+       CALL handle_error( 'get_dimension_length', 526 ) 
+
+#endif
+    END SUBROUTINE get_dimension_length
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Reads a 1D integer variable from file. 
+!------------------------------------------------------------------------------!
+     SUBROUTINE get_variable_1d_int( id, variable_name, var )
+#if defined( __netcdf )
+
+       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
+
+!
+!--    First, inquire variable ID
+       nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
+       CALL handle_error( 'get_variable_1d_int', 527 )
+!
+!--    Inquire dimension length
+       nc_stat = NF90_GET_VAR( id, id_var, var )
+       CALL handle_error( 'get_variable_1d_int', 527 ) 
+
+#endif
+    END SUBROUTINE get_variable_1d_int
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Reads a 1D float variable from file. 
+!------------------------------------------------------------------------------!
+     SUBROUTINE get_variable_1d_real( id, variable_name, var )
+#if defined( __netcdf )
+
+       USE pegrid
+
+       IMPLICIT NONE
+
+       CHARACTER(LEN=*)            ::  variable_name    !< variable name 
+
+       INTEGER(iwp), INTENT(IN)    ::  id               !< file id
+       INTEGER(iwp)                ::  id_var           !< dimension id
+
+       REAL(wp), DIMENSION(:), INTENT(INOUT) ::  var  !< variable to be read
+
+!
+!--    First, inquire variable ID
+       nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
+       CALL handle_error( 'get_variable_1d_real', 527 )
+!
+!--    Inquire dimension length
+       nc_stat = NF90_GET_VAR( id, id_var, var )
+       CALL handle_error( 'get_variable_1d_real', 527 ) 
+
+#endif
+    END SUBROUTINE get_variable_1d_real
+
+!------------------------------------------------------------------------------!
+! 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, i, var )
+#if defined( __netcdf )
+
+       USE indices
+       USE pegrid
+
+       IMPLICIT NONE
+
+       CHARACTER(LEN=*)              ::  variable_name   !< variable name
+
+       INTEGER(iwp), INTENT(IN)      ::  i               !< index along x direction
+       INTEGER(iwp), INTENT(IN)      ::  id              !< file id
+       INTEGER(iwp)                  ::  id_var          !< variable id
+
+       REAL(wp), DIMENSION(nys:nyn), INTENT(INOUT) ::  var  !< variable to be read
+!
+!--    Inquire variable id
+       nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
+!
+!--    Get variable
+       nc_stat = NF90_GET_VAR( id, id_var, var(nys:nyn),                       &
+                               start = (/ i+1, nys+1 /),                       &
+                               count = (/ 1, nyn - nys + 1 /) )
+
+       CALL handle_error( 'get_variable_2d_real', 528 )
+#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, i, var )
+#if defined( __netcdf )
+
+       USE indices
+       USE pegrid
+
+       IMPLICIT NONE
+
+       CHARACTER(LEN=*)              ::  variable_name   !< variable name
+
+       INTEGER(iwp), INTENT(IN)      ::  i               !< index along x direction
+       INTEGER(iwp), INTENT(IN)      ::  id              !< file id
+       INTEGER(iwp)                  ::  id_var          !< variable id
+       INTEGER(iwp), DIMENSION(nys:nyn), INTENT(INOUT) ::  var  !< variable to be read
+!
+!--    Inquire variable id
+       nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
+!
+!--    Get variable
+       nc_stat = NF90_GET_VAR( id, id_var, var(nys:nyn),                       &
+                               start = (/ i+1, nys+1 /),                       &
+                               count = (/ 1, nyn - nys + 1 /) )
+
+       CALL handle_error( 'get_variable_2d_int32', 529 )
+#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, i, var )
+#if defined( __netcdf )
+
+       USE indices
+       USE pegrid
+
+       IMPLICIT NONE
+
+       CHARACTER(LEN=*)              ::  variable_name   !< variable name
+
+       INTEGER(iwp), INTENT(IN)      ::  i               !< index along x direction
+       INTEGER(iwp), INTENT(IN)      ::  id              !< file id
+       INTEGER(iwp)                  ::  id_var          !< variable id
+       INTEGER(KIND=1), DIMENSION(nys:nyn), INTENT(INOUT) ::  var  !< variable to be read
+!
+!--    Inquire variable id
+       nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
+!
+!--    Get variable
+       nc_stat = NF90_GET_VAR( id, id_var, var(nys:nyn),                       &
+                               start = (/ i+1, nys+1 /),                       &
+                               count = (/ 1, nyn - nys + 1 /) )
+
+       CALL handle_error( 'get_variable_2d_int8', 530 )
+#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, i, j, var )
+#if defined( __netcdf )
+
+       USE indices
+       USE pegrid
+
+       IMPLICIT NONE
+
+       CHARACTER(LEN=*)              ::  variable_name   !< variable name
+
+       INTEGER(iwp), INTENT(IN)      ::  i               !< index along x direction
+       INTEGER(iwp), INTENT(IN)      ::  id              !< file id
+       INTEGER(iwp)                  ::  id_var          !< variable id
+       INTEGER(iwp), INTENT(IN)      ::  j               !< index along y direction
+       INTEGER(iwp)                  ::  n_file          !< number of data-points along 3rd dimension
+
+       INTEGER(iwp), DIMENSION(1:3)  ::  id_dim
+
+       INTEGER( KIND = 1 ), DIMENSION(nzb:nzt+1), INTENT(INOUT) ::  var  !< variable to be read
+
+!
+!--    Inquire variable id
+       nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
+!
+!--    Get length of first dimension, required for the count parameter.
+!--    Therefore, first inquired dimension ids
+       nc_stat = NF90_INQUIRE_VARIABLE( id, id_var, DIMIDS = id_dim )
+       nc_stat = NF90_INQUIRE_DIMENSION( id, id_dim(3), LEN = n_file )
+!
+!--    Get variable
+       nc_stat = NF90_GET_VAR( id, id_var, var,                  &
+                               start = (/ i+1, j+1, 1 /),                      &
+                               count = (/ 1, 1, n_file /) )
+
+       CALL handle_error( 'get_variable_3d_int8', 531 )
+#endif
+    END SUBROUTINE get_variable_3d_int8
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Reads a 3D float variable from file.  
+!------------------------------------------------------------------------------!
+    SUBROUTINE get_variable_3d_real( id, variable_name, i, j, var )
+#if defined( __netcdf )
+
+       USE indices
+       USE pegrid
+
+       IMPLICIT NONE
+
+       CHARACTER(LEN=*)              ::  variable_name   !< variable name
+
+       INTEGER(iwp), INTENT(IN)      ::  i               !< index along x direction
+       INTEGER(iwp), INTENT(IN)      ::  id              !< file id
+       INTEGER(iwp)                  ::  id_var          !< variable id
+       INTEGER(iwp), INTENT(IN)      ::  j               !< index along y direction
+       INTEGER(iwp)                  ::  n3              !< number of data-points along 3rd dimension
+
+       INTEGER(iwp), DIMENSION(3)    ::  id_dim
+
+       REAL(wp), DIMENSION(:), INTENT(INOUT) ::  var     !< variable to be read
+
+!
+!--    Inquire variable id
+       nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
+!
+!--    Get length of first dimension, required for the count parameter.
+!--    Therefore, first inquired dimension ids
+       nc_stat = NF90_INQUIRE_VARIABLE( id, id_var, DIMIDS = id_dim )
+       nc_stat = NF90_INQUIRE_DIMENSION( id, id_dim(3), LEN = n3 )
+!
+!--    Get variable
+       nc_stat = NF90_GET_VAR( id, id_var, var,                                &
+                               start = (/ i+1, j+1, 1 /),                      &
+                               count = (/ 1, 1, n3 /) )
+
+       CALL handle_error( 'get_variable_3d_real', 532 )
+#endif
+    END SUBROUTINE get_variable_3d_real
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Reads a 4D float variable from file. Note, in constrast to 3D versions, 
+!> dimensions are already inquired and passed so that they are known here.
+!------------------------------------------------------------------------------!
+    SUBROUTINE get_variable_4d_real( id, variable_name, i, j, var, n3, n4 )
+#if defined( __netcdf )
+
+       USE indices
+       USE pegrid
+
+       IMPLICIT NONE
+
+       CHARACTER(LEN=*)              ::  variable_name   !< variable name
+
+       INTEGER(iwp), INTENT(IN)      ::  i               !< index along x direction
+       INTEGER(iwp), INTENT(IN)      ::  id              !< file id
+       INTEGER(iwp)                  ::  id_var          !< variable id
+       INTEGER(iwp), INTENT(IN)      ::  j               !< index along y direction
+       INTEGER(iwp), INTENT(IN)      ::  n3              !< number of data-points along 3rd dimension
+       INTEGER(iwp), INTENT(IN)      ::  n4              !< number of data-points along 4th dimension
+
+       INTEGER(iwp), DIMENSION(3)    ::  id_dim
+
+       REAL(wp), DIMENSION(:,:), INTENT(INOUT) ::  var     !< variable to be read
+
+!
+!--    Inquire variable id
+       nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
+!
+!--    Get variable
+       nc_stat = NF90_GET_VAR( id, id_var, var,                                &
+                               start = (/ i+1, j+1, 1, 1 /),                   &
+                               count = (/ 1, 1, n3, n4 /) )
+
+       CALL handle_error( 'get_variable_4d_real', 533 )
+#endif
+    END SUBROUTINE get_variable_4d_real
+
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Reads a 3D float variable at left, right, north, south and top boundaries. 
+!------------------------------------------------------------------------------!
+    SUBROUTINE get_variable_bc( id, variable_name, t_start,                    &
+                                i2_s, count_2, i3_s, count_3,  var )
+#if defined( __netcdf )
+
+       USE indices
+       USE pegrid
+
+       IMPLICIT NONE
+
+       CHARACTER(LEN=*)              ::  variable_name   !< variable name
+
+       INTEGER(iwp)                  ::  count_2         !< number of elements in second dimension
+       INTEGER(iwp)                  ::  count_3         !< number of elements in third dimension (usually 1)
+       INTEGER(iwp)                  ::  i2_s            !< start index of second dimension
+       INTEGER(iwp)                  ::  i3_s            !< start index of third dimension
+       INTEGER(iwp), INTENT(IN)      ::  id              !< file id
+       INTEGER(iwp)                  ::  id_var          !< variable id
+       INTEGER(iwp)                  ::  t_start         !< start index at time dimension with respect to netcdf convention
+
+       REAL(wp), DIMENSION(:), INTENT(INOUT) ::  var     !< input variable 
+
+!
+!--    Inquire variable id
+       nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
+!
+!--    Get variable
+       nc_stat = NF90_GET_VAR( id, id_var, var,                              &
+                               start = (/ i3_s, i2_s, t_start /),            & 
+                               count = (/ count_3, count_2, 1 /) )        
+
+       CALL handle_error( 'get_variable_bc', 532 )
+#endif
+    END SUBROUTINE get_variable_bc
+
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Inquires the number of variables in a file  
+!------------------------------------------------------------------------------!
+    SUBROUTINE inquire_num_variables( id, num_vars )
+#if defined( __netcdf )
+
+       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
+
+       nc_stat = NF90_INQUIRE( id, NVARIABLES = num_vars )
+       CALL handle_error( 'inquire_num_variables', 534 )
+
+#endif
+    END SUBROUTINE inquire_num_variables
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Inquires the variable names belonging to a file. 
+!------------------------------------------------------------------------------!
+    SUBROUTINE inquire_variable_names( id, var_names )
+#if defined( __netcdf )
+
+       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
+
+       ALLOCATE( varids(1:SIZE(var_names)) )
+       nc_stat = NF90_INQ_VARIDS( id, NVARS = num_vars, VARIDS = varids )
+       CALL handle_error( 'inquire_variable_names', 535 )
+
+       DO  i = 1, SIZE(var_names)
+          nc_stat = NF90_INQUIRE_VARIABLE( id, varids(i), NAME = var_names(i) )
+          CALL handle_error( 'inquire_variable_names', 535 )
+       ENDDO
+
+       DEALLOCATE( varids )
+#endif
+    END SUBROUTINE inquire_variable_names
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Prints out a text message corresponding to the current status.
+!------------------------------------------------------------------------------!
+    SUBROUTINE 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 handle_error
+
+
+ END MODULE netcdf_data_input_mod
Index: palm/trunk/SOURCE/netcdf_interface_mod.f90
===================================================================
--- palm/trunk/SOURCE/netcdf_interface_mod.f90	(revision 2689)
+++ palm/trunk/SOURCE/netcdf_interface_mod.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file netcdf_interface_mod.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
@@ -25,4 +25,11 @@
 ! -----------------
 ! $Id$
+! Implementation of uv exposure model (FK)
+! Implemented checks for turbulence_closure_mod (TG)
+! Implementation of chemistry module (FK)
+! Bugfix in setting netcdf grids for LSM variables
+! Enable setting of _FillValue attribute in output files (MS)
+!
+! 2512 2017-10-04 08:26:59Z raasch
 ! upper bounds of cross section and 3d output changed from nx+1,ny+1 to nx,ny
 ! no output of ghost layer data any more
@@ -410,9 +417,12 @@
     INTEGER(iwp), DIMENSION(1:max_masks,0:1,100) ::  id_var_domask
 
+    REAL(wp) ::  fill_value = -999.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, id_set_fl, id_set_mask, id_set_pr,           &
+            do2d_unit, do3d_unit, fill_value,                                  & 
+            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_domask, id_var_dofl, id_var_dopr,     &
@@ -432,8 +442,4 @@
     END INTERFACE netcdf_create_dim
 
-    INTERFACE netcdf_close_file
-       MODULE PROCEDURE netcdf_close_file
-    END INTERFACE netcdf_close_file
-
     INTERFACE netcdf_create_file
        MODULE PROCEDURE netcdf_create_file
@@ -448,28 +454,14 @@
     END INTERFACE netcdf_define_header
 
-    INTERFACE netcdf_get_attribute
-       MODULE PROCEDURE netcdf_get_attribute
-    END INTERFACE netcdf_get_attribute
-
-    INTERFACE netcdf_get_variable
-       MODULE PROCEDURE netcdf_get_variable_2d
-       MODULE PROCEDURE netcdf_get_variable_3d
-    END INTERFACE netcdf_get_variable
-
     INTERFACE netcdf_handle_error
        MODULE PROCEDURE netcdf_handle_error
     END INTERFACE netcdf_handle_error
 
-    INTERFACE netcdf_open_read_file
-       MODULE PROCEDURE netcdf_open_read_file
-    END INTERFACE netcdf_open_read_file
-
     INTERFACE netcdf_open_write_file
        MODULE PROCEDURE netcdf_open_write_file
     END INTERFACE netcdf_open_write_file
 
-    PUBLIC netcdf_create_file, netcdf_close_file, netcdf_define_header,        &
-           netcdf_handle_error, netcdf_get_attribute, netcdf_get_variable,     &
-           netcdf_open_read_file, netcdf_open_write_file
+    PUBLIC netcdf_create_file, netcdf_define_header,                           &
+           netcdf_handle_error, netcdf_open_write_file
 
  CONTAINS
@@ -482,9 +474,14 @@
         ONLY:  zu, zw
 
+#if defined( __chem )
+    USE chemistry_model_mod,                                                   &
+        ONLY:  chem_define_netcdf_grid 
+#endif
+
     USE constants,                                                             &
         ONLY:  pi
 
     USE control_parameters,                                                    &
-        ONLY:  averaging_interval, averaging_interval_pr,                      &
+        ONLY:  air_chemistry, averaging_interval, averaging_interval_pr,       &
                data_output_pr, domask, dopr_n,                                 &
                dopr_time_count, dopts_time_count, dots_time_count,             &
@@ -493,5 +490,5 @@
                dt_do2d_yz, dt_do3d, mask_size, do2d_xy_time_count,             &
                do3d_time_count, domask_time_count, end_time, land_surface,     &
-               lod, mask_size_l, mask_i, mask_i_global, mask_j, mask_j_global, &
+               mask_size_l, mask_i, mask_i_global, mask_j, mask_j_global,      &
                mask_k_global, message_string, mid, ntdim_2d_xy,                &
                ntdim_2d_xz, ntdim_2d_yz, ntdim_3d, nz_do3d, prt_time_count,    &
@@ -500,5 +497,5 @@
                skip_time_do2d_xy, skip_time_do2d_xz, skip_time_do2d_yz,        &
                skip_time_do3d, topography, num_leg, num_var_fl,                &
-               urban_surface
+               urban_surface, uv_exposure
 
     USE grid_variables,                                                        &
@@ -533,6 +530,12 @@
         ONLY:  hom, statistic_regions
 
+    USE turbulence_closure_mod,                                                &
+        ONLY:  tcm_define_netcdf_grid
+
     USE urban_surface_mod,                                                     &
         ONLY:  usm_define_netcdf_grid
+
+    USE uv_exposure_model_mod,                                                 &
+        ONLY:  uvem_define_netcdf_grid
 
 
@@ -894,4 +897,7 @@
                 CASE DEFAULT
 
+                   CALL tcm_define_netcdf_grid( domask(mid,av,i), found, &
+                                                        grid_x, grid_y, grid_z )
+
 !
 !--                Check for land surface quantities
@@ -900,8 +906,7 @@
                                                    grid_x, grid_y, grid_z )
                    ENDIF
-                   
 !
 !--                Check for plant canopy quantities
-                   IF ( plant_canopy )  THEN
+                   IF ( .NOT. found  .AND.  plant_canopy )  THEN
                       CALL pcm_define_netcdf_grid( domask(mid,av,i), found,    &
                                                    grid_x, grid_y, grid_z )
@@ -915,4 +920,14 @@
                                                          grid_z )
                    ENDIF
+
+!
+!--                Check for chemistry quantities                   
+#if defined( __chem )
+                   IF ( .NOT. found  .AND.  air_chemistry )  THEN
+                      CALL chem_define_netcdf_grid( domask(mid,av,i),          &
+                                                    found, grid_x, grid_y,     &
+                                                    grid_z )
+                   ENDIF
+#endif
 
 !
@@ -961,5 +976,5 @@
                                      id_var_domask(mid,av,i),                  &
                                      TRIM( domask_unit(mid,av,i) ),            &
-                                     domask(mid,av,i), 494, 495, 496 )
+                                     domask(mid,av,i), 494, 495, 496, .TRUE. )
 
              var_list = TRIM( var_list ) // TRIM( domask(mid,av,i) ) // ';'
@@ -1425,4 +1440,7 @@
                 CASE DEFAULT
 
+                   CALL tcm_define_netcdf_grid( do3d(av,i), found, &
+                                                   grid_x, grid_y, grid_z )
+
 !
 !--                Check for land surface quantities
@@ -1434,5 +1452,5 @@
 !
 !--                Check for plant canopy quantities
-                   IF ( plant_canopy )  THEN
+                   IF ( .NOT. found  .AND.  plant_canopy )  THEN
                       CALL pcm_define_netcdf_grid( do3d(av,i), found, grid_x,  &
                                                    grid_y, grid_z )
@@ -1446,5 +1464,14 @@
                                                          grid_z )
                    ENDIF
-                   
+
+!
+!--                Check for chemistry quantities                   
+#if defined( __chem )
+                   IF ( .NOT. found  .AND.  air_chemistry )  THEN
+                      CALL chem_define_netcdf_grid( do3d(av,i), found,         &
+                                                    grid_x, grid_y, grid_z )
+                   ENDIF
+#endif
+
 !--                Check for user-defined quantities
                    IF ( .NOT. found )  THEN
@@ -1490,5 +1517,5 @@
                                      nc_precision(4), id_var_do3d(av,i),       &
                                      TRIM( do3d_unit(av,i) ), do3d(av,i), 79,  &
-                                     80, 357 )
+                                     80, 357, .TRUE. )
 #if defined( __netcdf4_parallel )
              IF ( netcdf_data_format > 4 )  THEN
@@ -2029,5 +2056,5 @@
                                            nc_precision(1), id_var_do2d(av,i), &
                                            TRIM( do2d_unit(av,i) ),            &
-                                           do2d(av,i), 119, 120, 354 )
+                                           do2d(av,i), 119, 120, 354, .TRUE. )
 
                 ELSE
@@ -2079,4 +2106,10 @@
                          ENDIF
 
+                         IF ( .NOT. found )  THEN
+                            CALL tcm_define_netcdf_grid( do2d(av,i), found,    &
+                                                         grid_x, grid_y,       &
+                                                         grid_z )
+                         ENDIF
+
 !
 !--                      Check for radiation quantities
@@ -2085,4 +2118,21 @@
                                                          found, grid_x, grid_y,&
                                                          grid_z )
+                         ENDIF
+
+!
+!--                      Check for chemistry quantities
+#if defined( __chem )
+                         IF ( .NOT. found  .AND.  air_chemistry )  THEN
+                            CALL chem_define_netcdf_grid( do2d(av,i), found,   &
+                                                          grid_x, grid_y,      &
+                                                          grid_z )
+                         ENDIF
+#endif
+
+!
+!--                      Check for UV exposure quantities
+                         IF ( .NOT. found  .AND.  uv_exposure )  THEN
+                            CALL uvem_define_netcdf_grid( do2d(av,i), found,    &
+                                                          grid_x, grid_y, grid_z )
                          ENDIF
 
@@ -2132,5 +2182,5 @@
                                            nc_precision(1), id_var_do2d(av,i), &
                                            TRIM( do2d_unit(av,i) ),            &
-                                           do2d(av,i), 119, 120, 354 )
+                                           do2d(av,i), 119, 120, 354, .TRUE. )
 
                 ENDIF
@@ -2777,4 +2827,9 @@
                       ENDIF
 
+                      IF ( .NOT. found )  THEN
+                         CALL tcm_define_netcdf_grid( do2d(av,i), found,       &
+                                                      grid_x, grid_y, grid_z )
+                      ENDIF
+
 !
 !--                   Check for radiation quantities
@@ -2784,4 +2839,14 @@
                                                             grid_z )
                       ENDIF
+
+!
+!--                   Check for chemistry quantities
+#if defined( __chem )
+                      IF ( .NOT. found  .AND.  air_chemistry )  THEN
+                         CALL chem_define_netcdf_grid( do2d(av,i), found,      &
+                                                       grid_x, grid_y,         &
+                                                       grid_z )
+                      ENDIF
+#endif
 
 !
@@ -2829,5 +2894,5 @@
                                         nc_precision(2), id_var_do2d(av,i),    &
                                         TRIM( do2d_unit(av,i) ), do2d(av,i),   &
-                                        159, 160, 355 )
+                                        159, 160, 355, .TRUE. )
 
 #if defined( __netcdf4_parallel )
@@ -3431,4 +3496,9 @@
                       ENDIF
 
+                      IF ( .NOT. found )  THEN
+                         CALL tcm_define_netcdf_grid( do2d(av,i), found,       &
+                                                      grid_x, grid_y, grid_z )
+                      ENDIF
+
 !
 !--                   Check for radiation quantities
@@ -3439,4 +3509,13 @@
                       ENDIF
 
+!
+!--                   Check for chemistry quantities
+#if defined( __chem )
+                      IF ( .NOT. found  .AND.  air_chemistry )  THEN
+                         CALL chem_define_netcdf_grid( do2d(av,i), found,      &
+                                                       grid_x, grid_y,         &
+                                                       grid_z )
+                      ENDIF
+#endif
 !
 !--                   Check for user-defined quantities
@@ -3483,5 +3562,5 @@
                                         nc_precision(3), id_var_do2d(av,i),    &
                                         TRIM( do2d_unit(av,i) ), do2d(av,i),   &
-                                        198, 199, 356 )
+                                        198, 199, 356, .TRUE. )
 
 #if defined( __netcdf4_parallel )
@@ -5453,174 +5532,4 @@
  END SUBROUTINE netcdf_create_file
 
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Closes an existing netCDF file.
-!------------------------------------------------------------------------------!
- 
- SUBROUTINE netcdf_close_file( id, errno )
-#if defined( __netcdf )
-
-    USE pegrid
-
-    IMPLICIT NONE
-
-    INTEGER(iwp), INTENT(IN)           ::  errno     !< error number
-    INTEGER(iwp), INTENT(INOUT)        ::  id        !< file id
-
-    nc_stat = NF90_CLOSE( id )
-    CALL netcdf_handle_error( 'netcdf_close', errno )
-#endif
- END SUBROUTINE netcdf_close_file
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Opens an existing netCDF file for reading only and gives back the id.
-!------------------------------------------------------------------------------!
- 
- SUBROUTINE netcdf_open_read_file( filename, id, errno )
-#if defined( __netcdf )
-
-    USE pegrid
-
-    IMPLICIT NONE
-
-    CHARACTER (LEN=*), INTENT(IN) ::  filename  !< filename
-    INTEGER(iwp), INTENT(IN)      ::  errno     !< error number
-    INTEGER(iwp), INTENT(INOUT)   ::  id        !< file id
-    LOGICAL                       ::  file_open = .FALSE.
-
-    nc_stat = NF90_OPEN( filename, NF90_NOWRITE, id )
-
-    CALL netcdf_handle_error( 'netcdf_open_read_file', errno )
-
-#endif
- END SUBROUTINE netcdf_open_read_file
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Reads the global attributes of a file
-!------------------------------------------------------------------------------!
- 
- SUBROUTINE netcdf_get_attribute( id, attribute_name, value, global, errno, variable_name )
-#if defined( __netcdf )
-
-    USE pegrid
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*)            ::  attribute_name   !< attribute name
-    CHARACTER(LEN=*), OPTIONAL  ::  variable_name    !< variable name 
-
-    INTEGER(iwp), INTENT(IN)    ::  errno            !< error number
-    INTEGER(iwp), INTENT(INOUT) ::  id               !< file id
-    INTEGER(iwp), INTENT(INOUT) ::  value            !< read value
-
-    INTEGER(iwp)                ::  id_var           !< variable id
-
-    LOGICAL, INTENT(IN) ::  global                   !< flag indicating global attributes
-
-!
-!-- Read global attribute
-    IF ( global )  THEN
-       nc_stat = NF90_GET_ATT( id, NF90_GLOBAL, TRIM( attribute_name ), value )
-       CALL netcdf_handle_error( 'netcdf_get_attribute global', errno )
-!
-!-- Read attributes referring to a single variable. Therefore, first inquire 
-!-- variable id
-    ELSE
-       nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
-       CALL netcdf_handle_error( 'netcdf_get_attribute', errno )
-       nc_stat = NF90_GET_ATT( id, id_var, TRIM( attribute_name ), value )
-       CALL netcdf_handle_error( 'netcdf_get_attribute', errno )       
-    ENDIF
-#endif
- END SUBROUTINE netcdf_get_attribute
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Reads a 2D REAL variable of a file. Reading is done processor-wise, 
-!> i.e. each core reads its own domain, as well as in slices along x. 
-!------------------------------------------------------------------------------!
- 
- SUBROUTINE netcdf_get_variable_2d( id, variable_name, i, var, errno )
-#if defined( __netcdf )
-
-    USE indices
-    USE pegrid
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*)              ::  variable_name   !< attribute name
-    INTEGER(iwp), INTENT(IN)      ::  errno           !< error number
-    INTEGER(iwp), INTENT(IN)      ::  i               !< index along x direction
-
-    INTEGER(iwp), INTENT(INOUT)   ::  id              !< file id
-
-    INTEGER(iwp)                  ::  id_var          !< variable id
-
-    REAL(wp), DIMENSION(nys:nyn), INTENT(INOUT) ::  var  !< variable to be read
-    REAL(wp) :: var_dum
-!
-!-- Inquire variable id
-    nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
-!
-!-- Get variable
-    nc_stat = NF90_GET_VAR( id, id_var, var(nys:nyn),                        &
-                            start = (/ i+1, nys+1 /),                          &
-                            count = (/ 1, nyn - nys + 1 /) )
-
-    CALL netcdf_handle_error( 'netcdf_get_variable', errno )
-#endif
- END SUBROUTINE netcdf_get_variable_2d
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Reads a 3D INTEGER variable of a file. Reading is done processor-wise, 
-!> i.e. each core reads its own domain, as well as in slices along x. 
-!------------------------------------------------------------------------------!
- 
- SUBROUTINE netcdf_get_variable_3d( id, variable_name, i, j, var, errno )
-#if defined( __netcdf )
-
-    USE indices
-    USE pegrid
-
-    IMPLICIT NONE
-
-    CHARACTER(LEN=*)              ::  variable_name   !< attribute name
-    INTEGER(iwp), INTENT(IN)      ::  errno           !< error number
-    INTEGER(iwp), INTENT(IN)      ::  i               !< index along x direction
-    INTEGER(iwp), INTENT(IN)      ::  j               !< index along y direction
-
-    INTEGER(iwp), INTENT(INOUT)   ::  id              !< file id
-
-    INTEGER(iwp)                  ::  id_var          !< variable id
-    INTEGER(iwp)                  ::  id_z            !< id of z-dimension
-    INTEGER(iwp)                  ::  nz_file         !< number of grid-points in file
-
-    INTEGER( KIND = 1 ), DIMENSION(nzb:nzt+1), INTENT(INOUT) ::  var  !< variable to be read
-!
-!-- Get dimension of z-axis
-    nc_stat = NF90_INQ_DIMID( id, "z", id_z )
-    nc_stat = NF90_INQUIRE_DIMENSION( id, id_z, len = nz_file )
-!
-!-- Inquire variable id
-    nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
-!
-!-- Get variable
-    nc_stat = NF90_GET_VAR( id, id_var, var(0:nz_file-1),                  &
-                            start = (/ i+1, j+1, 1 /),                         &
-                            count = (/ 1, 1, nz_file /) )
-
-    CALL netcdf_handle_error( 'netcdf_get_variable', errno )
-#endif
- END SUBROUTINE netcdf_get_variable_3d
-
 !------------------------------------------------------------------------------!
 ! Description:
@@ -5629,5 +5538,4 @@
 !> The parallel flag has to be TRUE for parallel netCDF output support.
 !------------------------------------------------------------------------------!
- 
  SUBROUTINE netcdf_open_write_file( filename, id, parallel, errno )
 #if defined( __netcdf )
@@ -5731,5 +5639,5 @@
  SUBROUTINE netcdf_create_var( ncid, dim_id, var_name, var_type, var_id,       &
                                unit_name, long_name, error_no1, error_no2,     &
-                               error_no3 )
+                               error_no3, fill )
 
 #if defined( __netcdf )
@@ -5739,4 +5647,6 @@
     CHARACTER(LEN=*), INTENT(IN) ::  unit_name
     CHARACTER(LEN=*), INTENT(IN) ::  var_name
+
+    LOGICAL, OPTIONAL ::  fill  !< indicates setting of _FillValue attribute 
 
     INTEGER, INTENT(IN)  ::  error_no1
@@ -5777,4 +5687,19 @@
     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
Index: palm/trunk/SOURCE/outflow_turbulence.f90
===================================================================
--- palm/trunk/SOURCE/outflow_turbulence.f90	(revision 2689)
+++ palm/trunk/SOURCE/outflow_turbulence.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file outflow_turbulence.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/package_parin.f90
===================================================================
--- palm/trunk/SOURCE/package_parin.f90	(revision 2689)
+++ palm/trunk/SOURCE/package_parin.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file package_parin.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/palm.f90
===================================================================
--- palm/trunk/SOURCE/palm.f90	(revision 2689)
+++ palm/trunk/SOURCE/palm.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file palm.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
@@ -25,4 +25,10 @@
 ! -----------------
 ! $Id$
+! Implementation of chemistry module (FK)
+! Introduce input-data standard
+! Rename lsm_last_actions into lsm_write_restart_data
+! Move usm_write_restart_data into io_blocks loop (MS)
+! 
+! 2512 2017-10-04 08:26:59Z raasch
 ! user interface required revision updated
 ! 
@@ -185,4 +191,5 @@
 !> @todo create routine last_actions instead of calling lsm_last_actions etc.
 !> @todo eventually move CALL usm_write_restart_data to suitable location
+!> @todo move chem_init call to init_3d_model or to check_parameters
 !------------------------------------------------------------------------------!
  PROGRAM palm
@@ -191,6 +198,14 @@
     USE arrays_3d
 
+#if defined( __chem )
+    USE chemistry_model_mod,                                                   &
+        ONLY:  chem_init, chem_last_actions
+    USE chem_photolysis_mod,                                                   &
+        ONLY:  photolysis_init
+#endif
+
     USE control_parameters,                                                    &
-        ONLY:  cloud_physics, constant_diffusion, coupling_char, coupling_mode,&
+        ONLY:  air_chemistry,                                                  &
+               cloud_physics, constant_diffusion, coupling_char, coupling_mode,&
                do2d_at_begin, do3d_at_begin, humidity, initializing_actions,   &
                io_blocks, io_group, land_surface, large_scale_forcing,         &
@@ -208,8 +223,12 @@
         ONLY:  nbgp
 
+    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 kinds
 
     USE land_surface_model_mod,                                                &
-        ONLY:  lsm_last_actions
+        ONLY:  lsm_write_restart_data
 
     USE particle_attributes,                                                   &
@@ -326,9 +345,34 @@
 !-- Determine processor topology and local array indices
     CALL init_pegrid
-
-!
-!-- Generate grid parameters
+!
+!-- 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
     CALL init_grid
-
+!
+!-- 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
+!
+!-- Initialize chemistry (called before check_parameters due to dependencies)
+!-- --> Needs to be moved!! What is the dependency about?
+#if defined( __chem )
+! IF (  TRIM( initializing_actions ) /= 'read_restart_data' )  THEN
+    IF ( air_chemistry )  THEN
+       CALL chem_init
+       CALL photolysis_init   ! probably also required for restart
+    ENDIF
+! END IF
+#endif
 !
 !-- Check control parameters and deduce further quantities
@@ -443,7 +487,4 @@
 !--    If required, write particle data
        IF ( particle_advection )  CALL lpm_write_restart_file
-!
-!--    If required, write urban surface data
-       IF (urban_surface)  CALL usm_write_restart_data
        
     ENDIF
@@ -460,10 +501,20 @@
     DO  i = 0, io_blocks-1
        IF ( i == io_group )  THEN
+
+          IF ( urban_surface )  THEN
+             CALL usm_write_restart_data
+          ENDIF
           IF ( land_surface )  THEN
-             CALL lsm_last_actions
+             CALL lsm_write_restart_data
           ENDIF
           IF ( radiation )  THEN
              CALL radiation_last_actions
           ENDIF
+#if defined( __chem )
+          IF ( air_chemistry )  THEN
+             CALL chem_last_actions
+          ENDIF
+#endif
+          
           CALL user_last_actions
           IF ( write_binary )  CALL close_file( 14 )
Index: palm/trunk/SOURCE/parin.f90
===================================================================
--- palm/trunk/SOURCE/parin.f90	(revision 2689)
+++ palm/trunk/SOURCE/parin.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file parin.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
@@ -25,4 +25,11 @@
 ! -----------------
 ! $Id$
+! Implementation of uv exposure model (FK)
+! Added rans_mode and turbulence_closure to inipar (TG)
+! Implementation of chemistry module
+! Sorting of USE list (FK)
+! Forcing implemented, and initialization with inifor (MS)
+! 
+! 2600 2017-11-01 14:11:20Z raasch
 ! some comments added and variables renamed concerning r2599
 ! 
@@ -316,17 +323,21 @@
 
     USE arrays_3d,                                                             &
-        ONLY:  pt_init, q_init, ref_state, s_init, sa_init, ug, u_init, v_init,&
-               vg
+        ONLY:  pt_init, q_init, ref_state, s_init, sa_init,                    &     
+               ug, u_init, v_init, vg
+
+#if defined( __chem )
+    USE chemistry_model_mod,                                                   &
+        ONLY:  chem_parin
+        
+    USE chem_modules
+#endif
+
+    USE control_parameters
+
+    USE cpulog,                                                                &
+        ONLY:  cpu_log_barrierwait
 
     USE date_and_time_mod,                                                     &
         ONLY:  day_of_year_init, time_utc_init
-               
-    USE plant_canopy_model_mod,                                                &
-         ONLY: pcm_parin  
-
-    USE control_parameters
-
-    USE cpulog,                                                                &
-        ONLY:  cpu_log_barrierwait
 
     USE dvrp_variables,                                                        &
@@ -353,13 +364,15 @@
                sigma_bulk, ventilation_effect
 
-
     USE model_1d_mod,                                                          &
         ONLY:  damp_level_1d, dt_pr_1d, dt_run_control_1d, end_time_1d
 
-    USE pegrid
-
     USE netcdf_interface,                                                      &
         ONLY:  netcdf_data_format, netcdf_deflate, netcdf_precision
 
+    USE pegrid
+               
+    USE plant_canopy_model_mod,                                                &
+         ONLY: pcm_parin
+
     USE pmc_interface,                                                         &
         ONLY:  nested_run, nesting_mode
@@ -386,9 +399,13 @@
         ONLY: usm_parin
 
+    USE uv_exposure_model_mod,                                                 &
+        ONLY:  uvem_parin
+
+    USE vertical_nesting_mod,                                                  &
+        ONLY:  vnest_start_time
+
     USE wind_turbine_model_mod,                                                &
         ONLY:  wtm_parin
 
-    USE vertical_nesting_mod,                                                  &
-        ONLY:  vnest_start_time
 
     IMPLICIT NONE
@@ -422,5 +439,5 @@
              dz_stretch_factor, dz_stretch_level, end_time_1d,                 &
              ensemble_member_nr, e_init, e_min, fft_method,                    &
-             flux_input_mode, flux_output_mode,                                &
+             flux_input_mode, flux_output_mode, forcing,                       &
              galilei_transformation, humidity,                                 &
              inflow_damping_height, inflow_damping_width,                      &
@@ -439,5 +456,5 @@
              pt_vertical_gradient_level, q_surface, q_surface_initial_change,  &
              q_vertical_gradient, q_vertical_gradient_level,                   &
-             random_generator, random_heatflux,                                &
+             random_generator, random_heatflux, rans_mode,                     &
              rayleigh_damping_factor, rayleigh_damping_height,                 &
              recycling_width, recycling_yshift,                                &
@@ -456,5 +473,5 @@
              top_scalarflux, transpose_compute_overlap,                        &
              tunnel_height, tunnel_length, tunnel_width_x, tunnel_width_y,     &
-             tunnel_wall_depth,                                                &
+             tunnel_wall_depth, turbulence_closure,                            &
              turbulent_inflow, turbulent_outflow,                              &
              use_subsidence_tendencies, ug_surface, ug_vertical_gradient,      &
@@ -617,4 +634,15 @@
           ENDIF
 
+          IF ( forcing )  THEN
+             bc_lr   = 'forcing'
+             bc_ns   = 'forcing'
+             bc_uv_t = 'forcing'
+             bc_pt_t = 'forcing'
+             bc_q_t  = 'forcing'
+             bc_s_t  = 'forcing'  ! scalar boundary condition is not clear
+             bc_p_t  = 'neumann'
+
+          ENDIF
+
 !         
 !--       In case of nested runs, make sure that initializing_actions =
@@ -625,8 +653,9 @@
 !--       are set properly. An exception is made in case of restart runs and
 !--       if user decides to do everything by its own.
-!--       MS: is this setting really necessary?
-          IF ( nest_domain  .AND.  (                                           &
-               TRIM( initializing_actions ) /= 'read_restart_data'  .OR.       &
-               TRIM( initializing_actions ) /= 'by_user' ) )  THEN
+!--       MS: is this really necessary?
+          IF ( nest_domain  .AND.  .NOT. (                                     &
+               TRIM( initializing_actions ) == 'read_restart_data'  .OR.       &
+               TRIM( initializing_actions ) == 'by_user'            .OR.       &
+               TRIM( initializing_actions ) == 'inifor' ) )  THEN
              initializing_actions = 'set_constant_profiles'
           ENDIF
@@ -637,5 +666,6 @@
 !--       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' )  THEN
+               bc_lr /= 'radiation/dirichlet'  .AND.  bc_lr /= 'nested'  .AND. &
+               bc_lr /= 'forcing' )  THEN
              message_string = 'unknown boundary condition: bc_lr = "' // &
                               TRIM( bc_lr ) // '"'
@@ -643,10 +673,10 @@
           ENDIF
           IF ( bc_ns /= 'cyclic'  .AND.  bc_ns /= 'dirichlet/radiation'  .AND. &
-               bc_ns /= 'radiation/dirichlet'  .AND.  bc_ns /= 'nested' )  THEN
+               bc_ns /= 'radiation/dirichlet'  .AND.  bc_ns /= 'nested'  .AND. &
+               bc_ns /= 'forcing' )  THEN
              message_string = 'unknown boundary condition: bc_ns = "' // &
                               TRIM( bc_ns ) // '"'
              CALL message( 'check_parameters', 'PA0050', 1, 2, 0, 6, 0 )
           ENDIF
-
 !
 !--       Set internal variables used for speed optimization in if clauses
@@ -707,4 +737,12 @@
 !--       required
           CALL stg_parin
+!
+!--       Read chemistry variables
+#if defined( __chem )
+          CALL chem_parin
+#endif
+!
+!--       Check if uv exposure model is used and read &uvexposure_par
+          CALL uvem_parin
 !
 !--       Read user-defined variables
Index: palm/trunk/SOURCE/plant_canopy_model_mod.f90
===================================================================
--- palm/trunk/SOURCE/plant_canopy_model_mod.f90	(revision 2689)
+++ palm/trunk/SOURCE/plant_canopy_model_mod.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file plant_canopy_model_mod.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
@@ -25,4 +25,12 @@
 ! -----------------
 ! $Id$
+! Bugfix for vertical loop index pch_index in case of Netcdf input
+! Introduce 2D index array incorporate canopy top index
+! Check if canopy on top of topography do not exceed vertical dimension 
+! Add check for canopy_mode in case of Netcdf input.
+! Enable _FillValue output for 3d quantities
+! Bugfix in reading of PIDS leaf area density (MS)
+! 
+! 2669 2017-12-06 16:03:27Z raasch
 ! coupling_char removed
 ! 
@@ -151,31 +159,30 @@
     CHARACTER (LEN=20)   ::  canopy_mode = 'block' !< 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) ::  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 = .FALSE.          !< switch for use of canopy model
-
-    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) ::  cdc = 0.0_wp               !< canopy drag coeff. (abbreviation used in equations)
-    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) ::  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) ::  lsec = 0.0_wp              !< leaf scalar exchange coeff.
-    REAL(wp) ::  lsc = 0.0_wp               !< leaf surface concentration
-
-    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)
+    LOGICAL ::  usm_lad_rma = .TRUE.            !< use MPI RMA to access LAD for raytracing (instead of global array)
+
+    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) ::  cdc = 0.0_wp                     !< canopy drag coeff. (abbreviation used in equations)
+    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) ::  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) ::  lsec = 0.0_wp                    !< leaf scalar exchange coeff.
+    REAL(wp) ::  lsc = 0.0_wp                     !< leaf surface concentration
+    REAL(wp) ::  prototype_lad                    !< prototype leaf area density for computing effective optical depth
+
+    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), DIMENSION(:), ALLOCATABLE ::  lad            !< leaf area density
@@ -201,5 +208,5 @@
 !-- Public variables and constants
     PUBLIC pc_heating_rate, canopy_mode, cthf, dt_plant_canopy, lad, lad_s,   &
-           pch_index, plant_canopy
+           pch_index, plant_canopy, prototype_lad, usm_lad_rma
            
 
@@ -288,5 +295,9 @@
 
        USE control_parameters,                                                 &
-           ONLY: cloud_physics, message_string, microphysics_seifert
+           ONLY: cloud_physics, coupling_char, message_string,                 &
+                 microphysics_seifert
+
+       USE netcdf_data_input_mod,                                              &
+           ONLY:  input_file_static, input_pids_static
                  
     
@@ -331,4 +342,14 @@
           CALL message( 'check_parameters', 'PA0360', 1, 2, 0, 6, 0 )
        ENDIF
+!
+!--    If dynamic input file is used, canopy need to be read from file
+       IF ( input_pids_static  .AND.                                           &
+            TRIM( canopy_mode ) /= 'read_from_file_3d' )  THEN
+          message_string = 'Usage of dynamic input file ' //                   &
+                           TRIM( input_file_static ) //                        &
+                           TRIM( coupling_char ) // ' requires ' //            &
+                           'canopy_mode = read_from_file_3d'
+          CALL message( 'check_parameters', 'PA0999', 1, 2, 0, 6, 0 )
+       ENDIF
 
  
@@ -342,5 +363,5 @@
 !> Subroutine defining 3D output variables
 !------------------------------------------------------------------------------!
- SUBROUTINE pcm_data_output_3d( av, variable, found, local_pf )
+ SUBROUTINE pcm_data_output_3d( av, variable, found, local_pf, fill_value )
  
     USE control_parameters,                                                    &
@@ -356,11 +377,13 @@
     CHARACTER (LEN=*) ::  variable !< 
 
-    INTEGER(iwp) ::  av    !< 
-    INTEGER(iwp) ::  i     !< 
-    INTEGER(iwp) ::  j     !< 
-    INTEGER(iwp) ::  k     !< 
+    INTEGER(iwp) ::  av     !< 
+    INTEGER(iwp) ::  i      !< 
+    INTEGER(iwp) ::  j      !< 
+    INTEGER(iwp) ::  k      !< 
+    INTEGER(iwp) ::  k_topo !< topography top index
 
     LOGICAL      ::  found !< 
 
+    REAL(wp)     ::  fill_value
     REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb:nz_do3d) ::  local_pf !< 
 
@@ -368,4 +391,5 @@
     found = .TRUE.
 
+    local_pf = REAL( fill_value, KIND = 4 )
 
     SELECT CASE ( TRIM( variable ) )
@@ -375,7 +399,10 @@
             DO  i = nxl, nxr
                DO  j = nys, nyn
-                  DO  k = nzb_s_inner(j,i), nz_do3d
-                     local_pf(i,j,k) = pc_heating_rate(k-nzb_s_inner(j,i),j,i)
-                  ENDDO
+                  IF ( pch_index_ji(j,i) /= 0 )  THEN
+                     k_topo = get_topography_top_index( j, i, 's' )
+                     DO  k = k_topo, k_topo + pch_index_ji(j,i)
+                        local_pf(i,j,k) = pc_heating_rate(k-k_topo,j,i)
+                     ENDDO
+                  ENDIF
                ENDDO
             ENDDO
@@ -387,7 +414,10 @@
             DO  i = nxl, nxr
                DO  j = nys, nyn
-                  DO  k = nzb_s_inner(j,i), nz_do3d
-                     local_pf(i,j,k) = lad_s(k-nzb_s_inner(j,i),j,i)
-                  ENDDO
+                  IF ( pch_index_ji(j,i) /= 0 )  THEN
+                     k_topo = get_topography_top_index( j, i, 's' )
+                     DO  k = k_topo, k_topo + pch_index_ji(j,i)
+                        local_pf(i,j,k) = lad_s(k-k_topo,j,i)
+                     ENDDO
+                  ENDIF
                ENDDO
             ENDDO
@@ -570,4 +600,7 @@
                  passive_scalar, urban_surface
 
+       USE netcdf_data_input_mod,                                              &
+           ONLY:  leaf_area_density_f
+
        USE surface_mod,                                                        &
            ONLY: surf_def_h, surf_lsm_h, surf_usm_h
@@ -716,9 +749,34 @@
           CASE ( 'read_from_file_3d' )
 !
+!--          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
+                   ENDDO
+                ENDDO
+                CALL exchange_horiz( lad_s, nbgp )
+!
+!            ASCII file
 !--          Initialize canopy parameters cdc (canopy drag coefficient),
 !--          lsec (leaf scalar exchange coefficient), lsc (leaf surface concentration)
 !--          from file which contains complete 3D data (separate vertical profiles for
 !--          each location).
-             CALL pcm_read_plant_canopy_3d
+             ELSE
+                CALL pcm_read_plant_canopy_3d
+             ENDIF
 
           CASE DEFAULT
@@ -732,4 +790,28 @@
  
        END SELECT
+!
+!--    Initialize 2D index array indicating canopy top index. 
+       ALLOCATE( pch_index_ji(nysg:nyng,nxlg:nxrg) )
+       pch_index_ji = 0
+
+       DO  i = nxl, nxr
+          DO  j = nys, nyn
+             DO  k = 0, pch_index
+                IF ( lad_s(k,j,i) /= 0 )  pch_index_ji(j,i) = k
+             ENDDO
+!
+!--          Check whether topography and local vegetation on top exceed 
+!--          height of the model domain.
+             k = get_topography_top_index( j, i, 's' )
+             IF ( k + 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', 'PA0999', 2, 2, 0, 6, 0 )
+             ENDIF
+
+          ENDDO
+       ENDDO
+
+       CALL exchange_horiz_2d_int( pch_index_ji, nys, nyn, nxl, nxr, nbgp )
 
 !
@@ -757,6 +839,6 @@
           DO  i = nxlg, nxrg
              DO  j = nysg, nyng
-                DO  k = pch_index-1, 0, -1
-                   IF ( k == pch_index-1 )  THEN
+                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) *                           &
@@ -815,5 +897,5 @@
           DO  i = nxlg, nxrg
              DO  j = nysg, nyng
-                DO  k = 1, pch_index
+                DO  k = 1, pch_index_ji(j,i)
                    IF ( cum_lai_hf(0,j,i) /= 0.0_wp )  THEN
                       pc_heating_rate(k,j,i) = cthf *                             &
@@ -945,5 +1027,5 @@
                     
                 CASE DEFAULT
-                   write(message_string, '(a,i2,a)')   &
+                   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 )
@@ -1029,5 +1111,5 @@
 !--                Determine topography-top index on u-grid
                    k_wall = get_topography_top_index( j, i, 'u' )
-                   DO  k = k_wall+1, k_wall+pch_index
+                   DO  k = k_wall+1, k_wall + pch_index_ji(j,i)
 
                       kk = k - k_wall   !- lad arrays are defined flat
@@ -1094,5 +1176,5 @@
                    k_wall = get_topography_top_index( j, i, 'v' )
 
-                   DO  k = k_wall+1, k_wall+pch_index
+                   DO  k = k_wall+1, k_wall + pch_index_ji(j,i)
 
                       kk = k - k_wall   !- lad arrays are defined flat
@@ -1159,5 +1241,5 @@
                    k_wall = get_topography_top_index( j, i, 'w' )
 
-                   DO  k = k_wall+1, k_wall+pch_index-1
+                   DO  k = k_wall+1, k_wall + pch_index_ji(j,i) - 1
 
                       kk = k - k_wall   !- lad arrays are defined flat
@@ -1211,5 +1293,5 @@
                    k_wall = get_topography_top_index( j, i, 's' )
 
-                   DO  k = k_wall+1, k_wall+pch_index
+                   DO  k = k_wall+1, k_wall + pch_index_ji(j,i)
 
                       kk = k - k_wall   !- lad arrays are defined flat
@@ -1228,5 +1310,5 @@
                    k_wall = get_topography_top_index( j, i, 's' )
 
-                   DO  k = k_wall+1, k_wall+pch_index
+                   DO  k = k_wall+1, k_wall + pch_index_ji(j,i)
 
                       kk = k - k_wall   !- lad arrays are defined flat
@@ -1258,5 +1340,5 @@
                    k_wall = get_topography_top_index( j, i, 's' )
 
-                   DO  k = k_wall+1, k_wall+pch_index
+                   DO  k = k_wall+1, k_wall + pch_index_ji(j,i)
 
                       kk = k - k_wall   !- lad arrays are defined flat
@@ -1287,5 +1369,5 @@
                    k_wall = get_topography_top_index( j, i, 's' )
 
-                   DO  k = k_wall+1, k_wall+pch_index
+                   DO  k = k_wall+1, k_wall + pch_index_ji(j,i)
 
                       kk = k - k_wall   !- lad arrays are defined flat
@@ -1370,5 +1452,4 @@
 
        ddt_3d = 1.0_wp / dt_3d
-
 !
 !--    Compute drag for the three velocity components and the SGS-TKE
@@ -1381,8 +1462,8 @@
 !--          Determine topography-top index on u-grid
              k_wall = get_topography_top_index( j, i, 'u' )
-
-             DO  k = k_wall+1, k_wall+pch_index
+             DO  k = k_wall + 1, k_wall + pch_index_ji(j,i)
 
                 kk = k - k_wall  !- lad arrays are defined flat
+
 !
 !--             In order to create sharp boundaries of the plant canopy, 
@@ -1442,5 +1523,5 @@
              k_wall = get_topography_top_index( j, i, 'v' )
 
-             DO  k = k_wall+1, k_wall+pch_index
+             DO  k = k_wall + 1, k_wall + pch_index_ji(j,i)
 
                 kk = k - k_wall  !- lad arrays are defined flat
@@ -1502,5 +1583,5 @@
              k_wall = get_topography_top_index( j, i, 'w' )
 
-             DO  k = k_wall+1, k_wall+pch_index-1
+             DO  k = k_wall + 1, k_wall + pch_index_ji(j,i) - 1
 
                 kk = k - k_wall  !- lad arrays are defined flat
@@ -1549,5 +1630,5 @@
              k_wall = get_topography_top_index( j, i, 's' )
 
-             DO  k = k_wall+1, k_wall+pch_index
+             DO  k = k_wall + 1, k_wall + pch_index_ji(j,i)
                 kk = k - k_wall  !- lad arrays are defined flat
                 tend(k,j,i) = tend(k,j,i) + pc_heating_rate(kk,j,i)
@@ -1562,5 +1643,5 @@
              k_wall = get_topography_top_index( j, i, 's' )
 
-             DO  k = k_wall+1, k_wall+pch_index
+             DO  k = k_wall + 1, k_wall + pch_index_ji(j,i)
 
                 kk = k - k_wall
@@ -1588,5 +1669,5 @@
              k_wall = get_topography_top_index( j, i, 's' )
 
-             DO  k = k_wall+1, k_wall+pch_index
+             DO  k = k_wall + 1, k_wall + pch_index_ji(j,i)
 
                 kk = k - k_wall
@@ -1614,5 +1695,5 @@
              k_wall = get_topography_top_index( j, i, 's' )
 
-             DO  k = k_wall+1, k_wall+pch_index
+             DO  k = k_wall + 1, k_wall + pch_index_ji(j,i)
 
                 kk = k - k_wall
Index: palm/trunk/SOURCE/pmc_child_mod.f90
===================================================================
--- palm/trunk/SOURCE/pmc_child_mod.f90	(revision 2689)
+++ palm/trunk/SOURCE/pmc_child_mod.f90	(revision 2696)
@@ -2,5 +2,5 @@
 
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/pmc_general_mod.f90
===================================================================
--- palm/trunk/SOURCE/pmc_general_mod.f90	(revision 2689)
+++ palm/trunk/SOURCE/pmc_general_mod.f90	(revision 2696)
@@ -2,5 +2,5 @@
 
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/pmc_handle_communicator_mod.f90
===================================================================
--- palm/trunk/SOURCE/pmc_handle_communicator_mod.f90	(revision 2689)
+++ palm/trunk/SOURCE/pmc_handle_communicator_mod.f90	(revision 2696)
@@ -1,6 +1,5 @@
-  MODULE PMC_handle_communicator
-
+!> @file pmc_handle_communicator_mod.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
@@ -26,4 +25,7 @@
 ! -----------------
 ! $Id$
+! Bugfix, give Intent(inout) attributes in routine reading nestpar-namelist (MS)
+! 
+! 2599 2017-11-01 13:18:45Z hellstea
 ! Separate peer communicator peer_comm introduced for MPI_INTERCOMM_CREATE.
 ! Some cleanup and commenting improvements. 
@@ -99,5 +101,5 @@
 ! Handle MPI communicator in PALM model coupler
 !-------------------------------------------------------------------------------!
-
+ MODULE PMC_handle_communicator
 #if defined( __parallel )
     USE kinds
@@ -168,5 +170,5 @@
 
  SUBROUTINE pmc_init_model( comm, nesting_datatransfer_mode, nesting_mode,      &
-                              pmc_status )
+                            pmc_status )
 
     USE control_parameters,                                                     &
@@ -178,9 +180,9 @@
       IMPLICIT NONE
 
-    CHARACTER(LEN=8), INTENT(OUT) ::  nesting_mode               !<
-    CHARACTER(LEN=7), INTENT(OUT) ::  nesting_datatransfer_mode  !<
-
-    INTEGER, INTENT(OUT) ::  comm        !<
-    INTEGER, INTENT(OUT) ::  pmc_status  !<
+    CHARACTER(LEN=8), INTENT(INOUT) ::  nesting_mode               !<
+    CHARACTER(LEN=7), INTENT(INOUT) ::  nesting_datatransfer_mode  !<
+
+    INTEGER, INTENT(INOUT) ::  comm        !<
+    INTEGER, INTENT(INOUT) ::  pmc_status  !<
 
     INTEGER ::  childcount     !<
Index: palm/trunk/SOURCE/pmc_interface_mod.f90
===================================================================
--- palm/trunk/SOURCE/pmc_interface_mod.f90	(revision 2689)
+++ palm/trunk/SOURCE/pmc_interface_mod.f90	(revision 2696)
@@ -1,6 +1,5 @@
-MODULE pmc_interface
-
+!> @file pmc_interface_mod.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
@@ -26,4 +25,7 @@
 ! -----------------
 ! $Id$
+! - Bugfix in init_tke_factor (MS)
+! 
+! 2669 2017-12-06 16:03:27Z raasch
 ! file extension for nested domains changed to "_N##",
 ! created flag file in order to enable combine_plot_fields to process nest data
@@ -194,4 +196,5 @@
 ! @todo Data transfer of qc and nc is prepared but not activated
 !-------------------------------------------------------------------------------!
+ MODULE pmc_interface
 
 #if defined( __nopointer )
@@ -2685,5 +2688,5 @@
              
              DO  k = k_wall + 1, nzt
-                
+ 
                 kc     = kco(k) + 1
                 glsf   = ( dx * dy * dzu(k) )**p13
@@ -3066,6 +3069,6 @@
                    w(k,j,i)   = MERGE( w(k,j,i), 0.0_wp,                       &
                                        BTEST( wall_flags_0(k,j,i), 3 ) )
-                   e(k,j,i)   = MERGE( e(k,j,i), 0.0_wp,                       &
-                                       BTEST( wall_flags_0(k,j,i), 0 ) )
+!                    e(k,j,i)   = MERGE( e(k,j,i), 0.0_wp,                       &
+!                                        BTEST( wall_flags_0(k,j,i), 0 ) )
                    u_p(k,j,i) = MERGE( u_p(k,j,i), 0.0_wp,                     &
                                        BTEST( wall_flags_0(k,j,i), 1 ) )
@@ -3074,6 +3077,6 @@
                    w_p(k,j,i) = MERGE( w_p(k,j,i), 0.0_wp,                     &
                                        BTEST( wall_flags_0(k,j,i), 3 ) )
-                   e_p(k,j,i) = MERGE( e_p(k,j,i), 0.0_wp,                     &
-                                       BTEST( wall_flags_0(k,j,i), 0 ) )
+!                    e_p(k,j,i) = MERGE( e_p(k,j,i), 0.0_wp,                     &
+!                                        BTEST( wall_flags_0(k,j,i), 0 ) )
                 ENDDO
              ENDDO
@@ -4492,5 +4495,7 @@
       ENDIF
 !
-!--   Store the boundary values also into the other redundant ghost node layers
+!--   Store the boundary values also into the other redundant ghost node layers.
+!--   Please note, in case of only one ghost node layer, e.g. for the PW 
+!--   scheme, the following loops will not be entered.
       IF ( edge == 'l' )  THEN
          DO  ibgp = -nbgp, ib
@@ -4713,5 +4718,7 @@
       ENDIF
 !
-!--   Store the boundary values also into the other redundant ghost node layers
+!--   Store the boundary values also into the other redundant ghost node layers.
+!--   Please note, in case of only one ghost node layer, e.g. for the PW 
+!--   scheme, the following loops will not be entered.
       IF ( edge == 's' )  THEN
          DO  jbgp = -nbgp, jb
Index: palm/trunk/SOURCE/pmc_mpi_wrapper_mod.f90
===================================================================
--- palm/trunk/SOURCE/pmc_mpi_wrapper_mod.f90	(revision 2689)
+++ palm/trunk/SOURCE/pmc_mpi_wrapper_mod.f90	(revision 2696)
@@ -2,5 +2,5 @@
 
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/pmc_parent_mod.f90
===================================================================
--- palm/trunk/SOURCE/pmc_parent_mod.f90	(revision 2689)
+++ palm/trunk/SOURCE/pmc_parent_mod.f90	(revision 2696)
@@ -2,5 +2,5 @@
 
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/poisfft_mod.f90
===================================================================
--- palm/trunk/SOURCE/poisfft_mod.f90	(revision 2689)
+++ palm/trunk/SOURCE/poisfft_mod.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file poisfft_mod.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/poismg_mod.f90
===================================================================
--- palm/trunk/SOURCE/poismg_mod.f90	(revision 2689)
+++ palm/trunk/SOURCE/poismg_mod.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file poismg.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
@@ -25,4 +25,7 @@
 ! -----------------
 ! $Id$
+! - Large-scale forcing implemented (MS)
+! 
+! 2298 2017-06-29 09:28:18Z raasch
 ! sendrecv_in_background related parts removed
 ! 
@@ -96,4 +99,9 @@
  MODULE poismg_mod
  
+    USE control_parameters,                                                    &
+        ONLY:  grid_level, force_bound_l, force_bound_n, force_bound_r,        &
+               force_bound_s, forcing, inflow_l, inflow_n, inflow_r, inflow_s, &
+               nest_bound_l, nest_bound_n, nest_bound_r, nest_bound_s,         &
+               outflow_l, outflow_n, outflow_r, outflow_s
 
     USE cpulog,                                                                &
@@ -274,9 +282,5 @@
 
        USE control_parameters,                                                 &
-           ONLY:  bc_lr_cyc, bc_ns_cyc, grid_level, ibc_p_b, ibc_p_t, inflow_l,&
-                  inflow_n, inflow_r, inflow_s, nest_bound_l, nest_bound_n,    &
-                  nest_bound_r, nest_bound_s, outflow_l, outflow_n, outflow_r, &
-                  outflow_s
-
+           ONLY:  bc_lr_cyc, bc_ns_cyc, ibc_p_b, ibc_p_t
        USE grid_variables,                                                     &
            ONLY:  ddx2_mg, ddy2_mg
@@ -347,8 +351,10 @@
 
        IF ( .NOT. bc_lr_cyc )  THEN
-          IF ( inflow_l .OR. outflow_l .OR. nest_bound_l )  THEN
+          IF ( inflow_l  .OR.  outflow_l  .OR.  nest_bound_l  .OR.             &
+               force_bound_l )  THEN
              r(:,:,nxl_mg(l)-1) = r(:,:,nxl_mg(l))
           ENDIF
-          IF ( inflow_r .OR. outflow_r .OR. nest_bound_r )  THEN
+          IF ( inflow_r  .OR.  outflow_r  .OR.  nest_bound_r  .OR.             &
+               force_bound_r )  THEN
              r(:,:,nxr_mg(l)+1) = r(:,:,nxr_mg(l))
           ENDIF
@@ -356,8 +362,10 @@
 
        IF ( .NOT. bc_ns_cyc )  THEN
-          IF ( inflow_n .OR. outflow_n .OR. nest_bound_n )  THEN
+          IF ( inflow_n  .OR.  outflow_n  .OR.  nest_bound_n  .OR.             &
+               force_bound_n )  THEN
              r(:,nyn_mg(l)+1,:) = r(:,nyn_mg(l),:)
           ENDIF
-          IF ( inflow_s .OR. outflow_s .OR. nest_bound_s )  THEN
+          IF ( inflow_s  .OR.  outflow_s  .OR.  nest_bound_s  .OR.             &
+               force_bound_s )  THEN
              r(:,nys_mg(l)-1,:) = r(:,nys_mg(l),:)
           ENDIF
@@ -398,8 +406,5 @@
 
        USE control_parameters,                                                 &
-           ONLY:  bc_lr_cyc, bc_ns_cyc, grid_level, ibc_p_b, ibc_p_t, inflow_l,&
-                  inflow_n, inflow_r, inflow_s, nest_bound_l, nest_bound_n,    &
-                  nest_bound_r, nest_bound_s, outflow_l, outflow_n, outflow_r, &
-                  outflow_s
+           ONLY:  bc_lr_cyc, bc_ns_cyc, ibc_p_b, ibc_p_t
 
        USE indices,                                                            &
@@ -481,8 +486,10 @@
 !--    Horizontal boundary conditions
        IF ( .NOT. bc_lr_cyc )  THEN
-          IF ( inflow_l .OR. outflow_l .OR. nest_bound_l )  THEN
+          IF ( inflow_l  .OR.  outflow_l  .OR.  nest_bound_l  .OR.             &
+               force_bound_l )  THEN
              f_mg(:,:,nxl_mg(l)-1) = f_mg(:,:,nxl_mg(l))
           ENDIF
-          IF ( inflow_r .OR. outflow_r .OR. nest_bound_r )  THEN
+          IF ( inflow_r  .OR.  outflow_r  .OR.  nest_bound_r  .OR.             &
+               force_bound_r )  THEN
              f_mg(:,:,nxr_mg(l)+1) = f_mg(:,:,nxr_mg(l))
           ENDIF
@@ -490,8 +497,10 @@
 
        IF ( .NOT. bc_ns_cyc )  THEN
-          IF ( inflow_n .OR. outflow_n .OR. nest_bound_n )  THEN
+          IF ( inflow_n  .OR.  outflow_n  .OR.  nest_bound_n  .OR.             &
+               force_bound_n )  THEN
              f_mg(:,nyn_mg(l)+1,:) = f_mg(:,nyn_mg(l),:)
           ENDIF
-          IF ( inflow_s .OR. outflow_s .OR. nest_bound_s )  THEN
+          IF ( inflow_s  .OR.  outflow_s  .OR.  nest_bound_s  .OR.             &
+               force_bound_s )  THEN
              f_mg(:,nys_mg(l)-1,:) = f_mg(:,nys_mg(l),:)
           ENDIF
@@ -535,9 +544,5 @@
 
        USE control_parameters,                                                 &
-           ONLY:  bc_lr_cyc, bc_ns_cyc, grid_level, ibc_p_b, ibc_p_t, inflow_l,&
-                  inflow_n, inflow_r, inflow_s, nest_bound_l, nest_bound_n,    &
-                  nest_bound_r, nest_bound_s, outflow_l, outflow_n,            &
-                  outflow_r, outflow_s
-
+           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
@@ -652,8 +657,10 @@
 
        IF ( .NOT. bc_lr_cyc )  THEN
-          IF ( inflow_l .OR. outflow_l .OR. nest_bound_l )  THEN
+          IF ( inflow_l  .OR.  outflow_l  .OR.  nest_bound_l  .OR.             &
+               force_bound_l )  THEN
              temp(:,:,nxl_mg(l)-1) = temp(:,:,nxl_mg(l))
           ENDIF
-          IF ( inflow_r .OR. outflow_r .OR. nest_bound_r )  THEN
+          IF ( inflow_r  .OR.  outflow_r  .OR.  nest_bound_r  .OR.             &
+               force_bound_r )  THEN
              temp(:,:,nxr_mg(l)+1) = temp(:,:,nxr_mg(l))
           ENDIF
@@ -661,8 +668,10 @@
 
        IF ( .NOT. bc_ns_cyc )  THEN
-          IF ( inflow_n .OR. outflow_n .OR. nest_bound_n )  THEN
+          IF ( inflow_n  .OR.  outflow_n  .OR.  nest_bound_n  .OR.             &
+               force_bound_n )  THEN
              temp(:,nyn_mg(l)+1,:) = temp(:,nyn_mg(l),:)
           ENDIF
-          IF ( inflow_s .OR. outflow_s .OR. nest_bound_s )  THEN
+          IF ( inflow_s  .OR.  outflow_s  .OR.  nest_bound_s  .OR.             &
+               force_bound_s )  THEN
              temp(:,nys_mg(l)-1,:) = temp(:,nys_mg(l),:)
           ENDIF
@@ -705,8 +714,5 @@
 
        USE control_parameters,                                                 &
-           ONLY:  bc_lr_cyc, bc_ns_cyc, grid_level, ibc_p_b, ibc_p_t, inflow_l,&
-                  inflow_n, inflow_r, inflow_s, nest_bound_l, nest_bound_n,    &
-                  nest_bound_r, nest_bound_s, ngsrb, outflow_l, outflow_n,     &
-                  outflow_r, outflow_s
+           ONLY:  bc_lr_cyc, bc_ns_cyc, ibc_p_b, ibc_p_t, ngsrb 
 
        USE grid_variables,                                                     &
@@ -961,8 +967,10 @@
 
              IF ( .NOT. bc_lr_cyc )  THEN
-                IF ( inflow_l .OR. outflow_l .OR. nest_bound_l )  THEN
+                IF ( inflow_l  .OR.  outflow_l  .OR.  nest_bound_l  .OR.       &
+                     force_bound_l )  THEN
                    p_mg(:,:,nxl_mg(l)-1) = p_mg(:,:,nxl_mg(l))
                 ENDIF
-                IF ( inflow_r .OR. outflow_r .OR. nest_bound_r )  THEN
+                IF ( inflow_r  .OR.  outflow_r  .OR.  nest_bound_r  .OR.       &
+                     force_bound_r )  THEN
                    p_mg(:,:,nxr_mg(l)+1) = p_mg(:,:,nxr_mg(l))
                 ENDIF
@@ -970,8 +978,10 @@
 
              IF ( .NOT. bc_ns_cyc )  THEN
-                IF ( inflow_n .OR. outflow_n .OR. nest_bound_n )  THEN
+                IF ( inflow_n  .OR.  outflow_n  .OR.  nest_bound_n  .OR.       &
+                     force_bound_n )  THEN
                    p_mg(:,nyn_mg(l)+1,:) = p_mg(:,nyn_mg(l),:)
                 ENDIF
-                IF ( inflow_s .OR. outflow_s .OR. nest_bound_s )  THEN
+                IF ( inflow_s  .OR.  outflow_s  .OR.  nest_bound_s  .OR.       &
+                     force_bound_s )  THEN
                    p_mg(:,nys_mg(l)-1,:) = p_mg(:,nys_mg(l),:)
                 ENDIF
@@ -1389,9 +1399,7 @@
        USE control_parameters,                                                 &
            ONLY:  bc_lr_dirrad, bc_lr_raddir, bc_ns_dirrad, bc_ns_raddir,      &
-                  gamma_mg, grid_level, grid_level_count, ibc_p_b, ibc_p_t,    &
-                  inflow_l, inflow_n, inflow_r, inflow_s, maximum_grid_level,  &
-                  mg_switch_to_pe0_level, mg_switch_to_pe0, nest_domain,       &
-                  nest_bound_l, nest_bound_n, nest_bound_r, nest_bound_s,      &
-                  ngsrb, outflow_l, outflow_n, outflow_r, outflow_s
+                  gamma_mg, grid_level_count, ibc_p_b, ibc_p_t,                &
+                  maximum_grid_level,  mg_switch_to_pe0_level,                 &
+                  mg_switch_to_pe0, nest_domain, ngsrb 
 
        USE indices,                                                            &
@@ -1544,4 +1552,7 @@
                 nest_bound_l = .TRUE.
                 nest_bound_r = .TRUE.
+             ELSEIF ( forcing )  THEN
+                force_bound_l = .TRUE.
+                force_bound_r = .TRUE.
              ENDIF
 
@@ -1559,4 +1570,7 @@
                 nest_bound_s = .TRUE.
                 nest_bound_n = .TRUE.
+             ELSEIF ( forcing )  THEN
+                force_bound_s = .TRUE.
+                force_bound_n = .TRUE.
              ENDIF
 
@@ -1626,5 +1640,5 @@
              outflow_n = .FALSE.;  outflow_s = .FALSE.
 !
-!--          In case of nesting, restore lateral boundary conditions
+!--          In case of nesting or forcing, restore lateral boundary conditions
              IF ( nest_domain )  THEN
                 nest_bound_l = .FALSE.
@@ -1632,4 +1646,10 @@
                 nest_bound_s = .FALSE.
                 nest_bound_n = .FALSE.      
+             ENDIF
+             IF ( forcing )  THEN
+                force_bound_l = .FALSE.
+                force_bound_r = .FALSE.
+                force_bound_s = .FALSE.
+                force_bound_n = .FALSE.      
              ENDIF
 
@@ -1641,4 +1661,6 @@
                 ELSEIF ( nest_domain )  THEN
                    nest_bound_l = .TRUE.
+                ELSEIF ( forcing )  THEN
+                   force_bound_l = .TRUE.
                 ENDIF
              ENDIF
@@ -1651,4 +1673,6 @@
                 ELSEIF ( nest_domain )  THEN
                    nest_bound_r = .TRUE.
+                ELSEIF ( forcing )  THEN
+                   force_bound_r = .TRUE.
                 ENDIF
              ENDIF
@@ -1661,4 +1685,6 @@
                 ELSEIF ( nest_domain )  THEN
                    nest_bound_s = .TRUE.
+                ELSEIF ( forcing )  THEN
+                   force_bound_s = .TRUE.
                 ENDIF
              ENDIF
@@ -1671,4 +1697,6 @@
                 ELSEIF ( nest_domain )  THEN
                    nest_bound_n = .TRUE.
+                ELSEIF ( forcing )  THEN
+                   force_bound_n = .TRUE.
                 ENDIF
              ENDIF
@@ -1821,7 +1849,6 @@
        USE control_parameters,                                                 &
            ONLY:  bc_lr_cyc, bc_ns_cyc, grid_level, ibc_p_b, ibc_p_t,          &
-                  inflow_l, inflow_n, inflow_r, inflow_s, maximum_grid_level,  &
-                  mg_switch_to_pe0_level, outflow_l, outflow_n, outflow_r,     &
-                  outflow_s, synchronous_exchange
+                  maximum_grid_level,                                          &
+                  mg_switch_to_pe0_level, synchronous_exchange
 
        USE indices,                                                            &
Index: palm/trunk/SOURCE/poismg_noopt.f90
===================================================================
--- palm/trunk/SOURCE/poismg_noopt.f90	(revision 2689)
+++ 	(revision )
@@ -1,1696 +1,0 @@
-!> @file poismg_noopt.f90
-!------------------------------------------------------------------------------!
-! This file is part of PALM.
-!
-! PALM is free software: you can redistribute it and/or modify it under the
-! terms of the GNU General Public License as published by the Free Software
-! Foundation, either version 3 of the License, or (at your option) any later
-! version.
-!
-! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
-! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License along with
-! PALM. If not, see <http://www.gnu.org/licenses/>.
-!
-! Copyright 1997-2017 Leibniz Universitaet Hannover
-!------------------------------------------------------------------------------!
-!
-! Current revisions:
-! -----------------
-! 
-! 
-! Former revisions:
-! -----------------
-! $Id$
-!
-! 2232 2017-05-30 17:47:52Z suehring
-! Bugfixes OpenMP
-! 
-! 2037 2016-10-26 11:15:40Z knoop
-! Anelastic approximation implemented
-! 
-! 2021 2016-10-07 14:08:57Z suehring
-! Bugfix: restore nest_bound_(l/r/s/n) in case of mg_switch_to_pe0
-! 
-! 2000 2016-08-20 18:09:15Z knoop
-! Forced header and separation lines into 80 columns
-! 
-! 1934 2016-06-13 09:46:57Z hellstea
-! Rename subroutines and cpu-measure log points to indicate _noopt version
-! 
-! 1762 2016-02-25 12:31:13Z hellstea
-! Introduction of nested domain feature
-!
-! 1682 2015-10-07 23:56:08Z knoop
-! Code annotations made doxygen readable 
-! 
-! 1353 2014-04-08 15:21:23Z heinze
-! REAL constants provided with KIND-attribute
-!
-! 1322 2014-03-20 16:38:49Z raasch
-! REAL constants defined as wp-kind
-!
-! 1320 2014-03-20 08:40:49Z raasch
-! ONLY-attribute added to USE-statements,
-! kind-parameters added to all INTEGER and REAL declaration statements,
-! kinds are defined in new module kinds,
-! old module precision_kind is removed,
-! revision history before 2012 removed,
-! comment fields (!:) to be used for variable explanations added to
-! all variable declaration statements
-!
-! 1318 2014-03-17 13:35:16Z raasch
-! module interfaces removed
-!
-! 1159 2013-05-21 11:58:22Z fricke
-! bc_lr/ns_dirneu/neudir removed
-!
-! 1092 2013-02-02 11:24:22Z raasch
-! unused variables removed
-!
-! 1056 2012-11-16 15:28:04Z raasch
-! Bugfix: all ghost points have to be used for allocating p3
-! arrays p2, f2, and f2_l changed from allocatable to automatic
-!
-! 1036 2012-10-22 13:43:42Z raasch
-! code put under GPL (PALM 3.9)
-!
-! 996 2012-09-07 10:41:47Z raasch
-! little reformatting
-!
-! 978 2012-08-09 08:28:32Z fricke
-! bc_lr/ns_dirneu/neudir added
-!
-! 880 2012-04-13 06:28:59Z raasch
-! Bugfix: preprocessor statements for parallel execution added
-!
-! 778 2011-11-07 14:18:25Z fricke
-! Allocation of p3 changes when multigrid is used and the collected field on PE0
-! has more grid points than the subdomain of an PE.
-!
-! 707 2011-03-29 11:39:40Z raasch
-! p_loc is used instead of p in the main routine (poismg).
-! On coarse grid levels, gathered data are identically processed on all PEs
-! (before, on PE0 only), so that the subsequent scattering of data is not
-! neccessary any more.
-! bc_lr/ns replaced by bc_lr/ns_cyc/dirrad/raddir
-! Bugfix: bottom (nzb) and top (nzt+1) boundary conditions set in routines
-! resid and restrict. They were missed before which may have led to
-! unpredictable results.
-!
-! 667 2010-12-23 12:06:00Z suehring/gryschka
-! Calls of exchange_horiz are modified.
-!
-! 622 2010-12-10 08:08:13Z raasch
-! optional barriers included in order to speed up collective operations
-!
-! 257 2009-03-11 15:17:42Z heinze
-! Output of messages replaced by message handling routine.
-!
-! 181 2008-07-30 07:07:47Z raasch
-! Bugfix: grid_level+1 has to be used in restrict for flags-array
-!
-! 114 2007-10-10 00:03:15Z raasch
-! Boundary conditions at walls are implicitly set using flag arrays. Only
-! Neumann BC is allowed. Upper walls are still not realized.
-! Bottom and top BCs for array f_mg in restrict removed because boundary
-! values are not needed (right hand side of SOR iteration).
-!
-! 75 2007-03-22 09:54:05Z raasch
-! 2nd+3rd argument removed from exchange horiz
-!
-! RCS Log replace by Id keyword, revision history cleaned up
-!
-! 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.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.
-!------------------------------------------------------------------------------!
- SUBROUTINE poismg_noopt( r )
- 
-
-    USE arrays_3d,                                                             &
-        ONLY:  d, p_loc
-
-    USE control_parameters,                                                    &
-        ONLY:  gathered_size, grid_level, grid_level_count,                    &
-               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)
-    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_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, grid_level, ibc_p_b, ibc_p_t, inflow_l,   &
-               inflow_n, inflow_r, inflow_s, nest_bound_l, nest_bound_n,       &
-               nest_bound_r, nest_bound_s, outflow_l, outflow_n, outflow_r,    &
-               outflow_s
-
-    USE grid_variables,                                                        &
-        ONLY:  ddx2_mg, ddy2_mg
-
-    USE indices,                                                               &
-        ONLY:  flags, 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, 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,                              &
-                    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)                        &
-                        - 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 ( inflow_l .OR. outflow_l .OR. nest_bound_l )  THEN
-          r(:,:,nxl_mg(l)-1) = r(:,:,nxl_mg(l))
-       ENDIF
-       IF ( inflow_r .OR. outflow_r .OR. nest_bound_r )  THEN
-          r(:,:,nxr_mg(l)+1) = r(:,:,nxr_mg(l))
-       ENDIF
-    ENDIF
-
-    IF ( .NOT. bc_ns_cyc )  THEN
-       IF ( inflow_n .OR. outflow_n .OR. nest_bound_n )  THEN
-          r(:,nyn_mg(l)+1,:) = r(:,nyn_mg(l),:)
-       ENDIF
-       IF ( inflow_s .OR. outflow_s .OR. nest_bound_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, inflow_l,   &
-               inflow_n, inflow_r, inflow_s, nest_bound_l, nest_bound_n,       &
-               nest_bound_r, nest_bound_s, outflow_l, outflow_n, outflow_r,    &
-               outflow_s
-
-    USE indices,                                                               &
-        ONLY:  flags, 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, nxl_mg, nxr_mg, nys_mg, nyn_mg,    &
-               nzb, nzt_mg
-
-    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 ( inflow_l .OR. outflow_l .OR. nest_bound_l )  THEN
-          f_mg(:,:,nxl_mg(l)-1) = f_mg(:,:,nxl_mg(l))
-       ENDIF
-       IF ( inflow_r .OR. outflow_r .OR. nest_bound_r )  THEN
-          f_mg(:,:,nxr_mg(l)+1) = f_mg(:,:,nxr_mg(l))
-       ENDIF
-    ENDIF
-
-    IF ( .NOT. bc_ns_cyc )  THEN
-       IF ( inflow_n .OR. outflow_n .OR. nest_bound_n )  THEN
-          f_mg(:,nyn_mg(l)+1,:) = f_mg(:,nyn_mg(l),:)
-       ENDIF
-       IF ( inflow_s .OR. outflow_s .OR. nest_bound_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, grid_level, ibc_p_b, ibc_p_t, inflow_l,   &
-               inflow_n, inflow_r, inflow_s, nest_bound_l, nest_bound_n,       &
-               nest_bound_r, nest_bound_s, outflow_l, outflow_n, outflow_r,    &
-               outflow_s
-
-    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 ( inflow_l .OR. outflow_l .OR. nest_bound_l )  THEN
-          temp(:,:,nxl_mg(l)-1) = temp(:,:,nxl_mg(l))
-       ENDIF
-       IF ( inflow_r .OR. outflow_r .OR. nest_bound_r )  THEN
-          temp(:,:,nxr_mg(l)+1) = temp(:,:,nxr_mg(l))
-       ENDIF
-    ENDIF
-
-    IF ( .NOT. bc_ns_cyc )  THEN
-       IF ( inflow_n .OR. outflow_n .OR. nest_bound_n )  THEN
-          temp(:,nyn_mg(l)+1,:) = temp(:,nyn_mg(l),:)
-       ENDIF
-       IF ( inflow_s .OR. outflow_s .OR. nest_bound_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, grid_level, ibc_p_b, ibc_p_t, inflow_l,   &
-               inflow_n, inflow_r, inflow_s, ngsrb, nest_bound_l,              &
-               nest_bound_n, nest_bound_r, nest_bound_s, outflow_l, outflow_n, &
-               outflow_r, outflow_s
-
-    USE cpulog,                                                                &
-        ONLY:  cpu_log, log_point_s
-
-    USE grid_variables,                                                        &
-        ONLY:  ddx2_mg, ddy2_mg
-
-    USE indices,                                                               &
-        ONLY:  flags, 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, nxl_mg, nxr_mg, nys_mg, nyn_mg,    &
-               nzb, nzt_mg
-
-    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        !<
-
-    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 )
-
-    DO  n = 1, ngsrb
-       
-       DO  color = 1, 2
-
-          IF ( .NOT. unroll )  THEN
-
-             CALL cpu_log( log_point_s(36), 'redblack_no_unroll_noopt', 'start' )
-
-!
-!--          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)                        &
-                           + 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
-   
-             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)                        &
-                           + 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
-  
-             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)                        &
-                           + 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
-
-             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)                        &
-                           + 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)                        &
-                           + 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)                        &
-                           + 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)                        &
-                           + 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)                        &
-                           + 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)                        &
-                           + 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)                        &
-                           + 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)                        &
-                           + 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)                        &
-                           + 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 ( inflow_l .OR. outflow_l .OR. nest_bound_l )  THEN
-                p_mg(:,:,nxl_mg(l)-1) = p_mg(:,:,nxl_mg(l))
-             ENDIF
-             IF ( inflow_r .OR. outflow_r .OR. nest_bound_r )  THEN
-                p_mg(:,:,nxr_mg(l)+1) = p_mg(:,:,nxr_mg(l))
-             ENDIF
-          ENDIF
-
-          IF ( .NOT. bc_ns_cyc )  THEN
-             IF ( inflow_n .OR. outflow_n .OR. nest_bound_n )  THEN
-                p_mg(:,nyn_mg(l)+1,:) = p_mg(:,nyn_mg(l),:)
-             ENDIF
-             IF ( inflow_s .OR. outflow_s .OR. nest_bound_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
-
-!
-!-- 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 gridpoint 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.
-!------------------------------------------------------------------------------!
- SUBROUTINE mg_gather_noopt( 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
-
-    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  !<
-
-
-#if defined( __parallel )
-    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' )
-#endif
-    
- END SUBROUTINE mg_gather_noopt
-
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @todo It may be possible to improve the speed of this routine by using
-!>       non-blocking communication
-!------------------------------------------------------------------------------!
- SUBROUTINE mg_scatter_noopt( 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
-
-    USE kinds
-
-    USE pegrid
-
-    IMPLICIT NONE
-
-    INTEGER(iwp) ::  nwords  !<
-
-    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  !<
-
-!
-!-- 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_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' )
-#endif
-    
- END SUBROUTINE mg_scatter_noopt
-
-
-!------------------------------------------------------------------------------!
-! 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, grid_level_count, ibc_p_b, ibc_p_t,       &
-               inflow_l, inflow_n, inflow_r, inflow_s, maximum_grid_level,     &
-               mg_switch_to_pe0_level, mg_switch_to_pe0, nest_domain,          &
-               nest_bound_l, nest_bound_n, nest_bound_r, nest_bound_s, ngsrb,  &
-               outflow_l, outflow_n, outflow_r, outflow_s
-
-
-    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  !<
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  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_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
-          CALL mg_gather_noopt( 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 all PEs after the switch,
-!--       because then they have the total domain.
-          IF ( bc_lr_dirrad )  THEN
-             inflow_l  = .TRUE.
-             inflow_r  = .FALSE.
-             outflow_l = .FALSE.
-             outflow_r = .TRUE.
-          ELSEIF ( bc_lr_raddir )  THEN
-             inflow_l  = .FALSE.
-             inflow_r  = .TRUE.
-             outflow_l = .TRUE.
-             outflow_r = .FALSE.
-          ELSEIF ( nest_domain )  THEN
-             nest_bound_l = .TRUE.
-             nest_bound_r = .TRUE.
-          ENDIF
-
-          IF ( bc_ns_dirrad )  THEN
-             inflow_n  = .TRUE.
-             inflow_s  = .FALSE.
-             outflow_n = .FALSE.
-             outflow_s = .TRUE.
-          ELSEIF ( bc_ns_raddir )  THEN
-             inflow_n  = .FALSE.
-             inflow_s  = .TRUE.
-             outflow_n = .TRUE.
-             outflow_s = .FALSE.
-          ELSEIF ( nest_domain )  THEN
-             nest_bound_s = .TRUE.
-             nest_bound_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. 
-          inflow_l  = .FALSE.;  inflow_r  = .FALSE.
-          inflow_n  = .FALSE.;  inflow_s  = .FALSE.
-          outflow_l = .FALSE.;  outflow_r = .FALSE.
-          outflow_n = .FALSE.;  outflow_s = .FALSE.
-!
-!--       In case of nesting, restore lateral boundary conditions
-          IF ( nest_domain )  THEN
-             nest_bound_l = .FALSE.
-             nest_bound_r = .FALSE.
-             nest_bound_s = .FALSE.
-             nest_bound_n = .FALSE.      
-          ENDIF
-
-          IF ( pleft == MPI_PROC_NULL )  THEN
-             IF ( bc_lr_dirrad )  THEN
-                inflow_l  = .TRUE.
-             ELSEIF ( bc_lr_raddir )  THEN
-                outflow_l = .TRUE.
-             ELSEIF ( nest_domain )  THEN
-                nest_bound_l = .TRUE.
-             ENDIF
-          ENDIF
-
-          IF ( pright == MPI_PROC_NULL )  THEN
-             IF ( bc_lr_dirrad )  THEN
-                outflow_r = .TRUE.
-             ELSEIF ( bc_lr_raddir )  THEN
-                inflow_r  = .TRUE.
-             ELSEIF ( nest_domain )  THEN
-                nest_bound_r = .TRUE.
-             ENDIF
-          ENDIF
-
-          IF ( psouth == MPI_PROC_NULL )  THEN
-             IF ( bc_ns_dirrad )  THEN
-                outflow_s = .TRUE.
-             ELSEIF ( bc_ns_raddir )  THEN
-                inflow_s  = .TRUE.
-             ELSEIF ( nest_domain )  THEN
-                nest_bound_s = .TRUE.
-             ENDIF
-          ENDIF
-
-          IF ( pnorth == MPI_PROC_NULL )  THEN
-             IF ( bc_ns_dirrad )  THEN
-                inflow_n  = .TRUE.
-             ELSEIF ( bc_ns_raddir )  THEN
-                outflow_n = .TRUE.
-             ELSEIF ( nest_domain )  THEN
-                nest_bound_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
Index: palm/trunk/SOURCE/poismg_noopt_mod.f90
===================================================================
--- palm/trunk/SOURCE/poismg_noopt_mod.f90	(revision 2696)
+++ palm/trunk/SOURCE/poismg_noopt_mod.f90	(revision 2696)
@@ -0,0 +1,1956 @@
+!> @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-2017 Leibniz Universitaet Hannover
+!------------------------------------------------------------------------------!
+!
+! Current revisions:
+! -----------------
+! 
+! 
+! Former revisions:
+! -----------------
+! $Id$
+! - Rename file into poismg_noopt_mod
+! - Modularize poismg_noopt - initialization of masking flags moved from 
+!   init_grid
+! - Masking of downward-facing walls walls 
+! - Large-scale forcing implemented (MS) 
+! 
+! 2591 2017-10-30 08:07:25Z maronga
+! 
+! 2586 2017-10-27 13:03:50Z kanani
+!
+! 2232 2017-05-30 17:47:52Z suehring
+! Bugfixes OpenMP
+! 
+! 2037 2016-10-26 11:15:40Z knoop
+! Anelastic approximation implemented
+! 
+! 2021 2016-10-07 14:08:57Z suehring
+! Bugfix: restore nest_bound_(l/r/s/n) in case of mg_switch_to_pe0
+! 
+! 2000 2016-08-20 18:09:15Z knoop
+! Forced header and separation lines into 80 columns
+! 
+! 1934 2016-06-13 09:46:57Z hellstea
+! Rename subroutines and cpu-measure log points to indicate _noopt version
+! 
+! 1762 2016-02-25 12:31:13Z hellstea
+! Introduction of nested domain feature
+!
+! 1682 2015-10-07 23:56:08Z knoop
+! Code annotations made doxygen readable 
+! 
+! 1353 2014-04-08 15:21:23Z heinze
+! REAL constants provided with KIND-attribute
+!
+! 1322 2014-03-20 16:38:49Z raasch
+! REAL constants defined as wp-kind
+!
+! 1320 2014-03-20 08:40:49Z raasch
+! ONLY-attribute added to USE-statements,
+! kind-parameters added to all INTEGER and REAL declaration statements,
+! kinds are defined in new module kinds,
+! old module precision_kind is removed,
+! revision history before 2012 removed,
+! comment fields (!:) to be used for variable explanations added to
+! all variable declaration statements
+!
+! 1318 2014-03-17 13:35:16Z raasch
+! module interfaces removed
+!
+! 1159 2013-05-21 11:58:22Z fricke
+! bc_lr/ns_dirneu/neudir removed
+!
+! 1092 2013-02-02 11:24:22Z raasch
+! unused variables removed
+!
+! 1056 2012-11-16 15:28:04Z raasch
+! Bugfix: all ghost points have to be used for allocating p3
+! arrays p2, f2, and f2_l changed from allocatable to automatic
+!
+! 1036 2012-10-22 13:43:42Z raasch
+! code put under GPL (PALM 3.9)
+!
+! 996 2012-09-07 10:41:47Z raasch
+! little reformatting
+!
+! 978 2012-08-09 08:28:32Z fricke
+! bc_lr/ns_dirneu/neudir added
+!
+! 880 2012-04-13 06:28:59Z raasch
+! Bugfix: preprocessor statements for parallel execution added
+!
+! 778 2011-11-07 14:18:25Z fricke
+! Allocation of p3 changes when multigrid is used and the collected field on PE0
+! has more grid points than the subdomain of an PE.
+!
+! 707 2011-03-29 11:39:40Z raasch
+! p_loc is used instead of p in the main routine (poismg).
+! On coarse grid levels, gathered data are identically processed on all PEs
+! (before, on PE0 only), so that the subsequent scattering of data is not
+! neccessary any more.
+! bc_lr/ns replaced by bc_lr/ns_cyc/dirrad/raddir
+! Bugfix: bottom (nzb) and top (nzt+1) boundary conditions set in routines
+! resid and restrict. They were missed before which may have led to
+! unpredictable results.
+!
+! 667 2010-12-23 12:06:00Z suehring/gryschka
+! Calls of exchange_horiz are modified.
+!
+! 622 2010-12-10 08:08:13Z raasch
+! optional barriers included in order to speed up collective operations
+!
+! 257 2009-03-11 15:17:42Z heinze
+! Output of messages replaced by message handling routine.
+!
+! 181 2008-07-30 07:07:47Z raasch
+! Bugfix: grid_level+1 has to be used in restrict for flags-array
+!
+! 114 2007-10-10 00:03:15Z raasch
+! Boundary conditions at walls are implicitly set using flag arrays. Only
+! Neumann BC is allowed. Upper walls are still not realized.
+! Bottom and top BCs for array f_mg in restrict removed because boundary
+! values are not needed (right hand side of SOR iteration).
+!
+! 75 2007-03-22 09:54:05Z raasch
+! 2nd+3rd argument removed from exchange horiz
+!
+! RCS Log replace by Id keyword, revision history cleaned up
+!
+! 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.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:  grid_level, force_bound_l, force_bound_n, force_bound_r,        &
+               force_bound_s, forcing, inflow_l, inflow_n, inflow_r, inflow_s, &
+               nest_bound_l, nest_bound_n, nest_bound_r, nest_bound_s,         &
+               outflow_l, outflow_n, outflow_r, outflow_s
+
+    USE cpulog,                                                                &
+        ONLY:  cpu_log, log_point_s
+
+    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:  gathered_size, grid_level_count,                             &
+                  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)
+       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_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, 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, 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,                           &
+                       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 ( inflow_l .OR. outflow_l .OR. nest_bound_l .OR. force_bound_l )  THEN
+             r(:,:,nxl_mg(l)-1) = r(:,:,nxl_mg(l))
+          ENDIF
+          IF ( inflow_r .OR. outflow_r .OR. nest_bound_r .OR. force_bound_r )  THEN
+             r(:,:,nxr_mg(l)+1) = r(:,:,nxr_mg(l))
+          ENDIF
+       ENDIF
+
+       IF ( .NOT. bc_ns_cyc )  THEN
+          IF ( inflow_n .OR. outflow_n .OR. nest_bound_n .OR. force_bound_n )  THEN
+             r(:,nyn_mg(l)+1,:) = r(:,nyn_mg(l),:)
+          ENDIF
+          IF ( inflow_s .OR. outflow_s .OR. nest_bound_s .OR. force_bound_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, 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, nxl_mg, nxr_mg, nys_mg, nyn_mg, &
+                  nzb, nzt_mg
+
+       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 ( inflow_l .OR. outflow_l .OR. nest_bound_l .OR. force_bound_l )  THEN
+             f_mg(:,:,nxl_mg(l)-1) = f_mg(:,:,nxl_mg(l))
+          ENDIF
+          IF ( inflow_r .OR. outflow_r .OR. nest_bound_r .OR. force_bound_r )  THEN
+             f_mg(:,:,nxr_mg(l)+1) = f_mg(:,:,nxr_mg(l))
+          ENDIF
+       ENDIF
+
+       IF ( .NOT. bc_ns_cyc )  THEN
+          IF ( inflow_n .OR. outflow_n .OR. nest_bound_n .OR. force_bound_n )  THEN
+             f_mg(:,nyn_mg(l)+1,:) = f_mg(:,nyn_mg(l),:)
+          ENDIF
+          IF ( inflow_s .OR. outflow_s .OR. nest_bound_s .OR. force_bound_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 ( inflow_l .OR. outflow_l .OR. nest_bound_l .OR. force_bound_l )  THEN
+          temp(:,:,nxl_mg(l)-1) = temp(:,:,nxl_mg(l))
+       ENDIF
+       IF ( inflow_r .OR. outflow_r .OR. nest_bound_r .OR. force_bound_r )  THEN
+          temp(:,:,nxr_mg(l)+1) = temp(:,:,nxr_mg(l))
+       ENDIF
+    ENDIF
+
+    IF ( .NOT. bc_ns_cyc )  THEN
+       IF ( inflow_n .OR. outflow_n .OR. nest_bound_n .OR. force_bound_n )  THEN
+          temp(:,nyn_mg(l)+1,:) = temp(:,nyn_mg(l),:)
+       ENDIF
+       IF ( inflow_s .OR. outflow_s .OR. nest_bound_s .OR. force_bound_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, 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, nxl_mg, nxr_mg, nys_mg, nyn_mg, &
+                  nzb, nzt_mg
+
+       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        !<
+
+       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 )
+
+       DO  n = 1, ngsrb
+          
+          DO  color = 1, 2
+
+             IF ( .NOT. unroll )  THEN
+
+                CALL cpu_log( log_point_s(36), 'redblack_no_unroll_noopt', 'start' )
+
+!
+!--             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
+      
+                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
+     
+                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
+
+                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 ( inflow_l .OR. outflow_l .OR. nest_bound_l .OR. force_bound_l )  THEN
+                   p_mg(:,:,nxl_mg(l)-1) = p_mg(:,:,nxl_mg(l))
+                ENDIF
+                IF ( inflow_r .OR. outflow_r .OR. nest_bound_r .OR. force_bound_r )  THEN
+                   p_mg(:,:,nxr_mg(l)+1) = p_mg(:,:,nxr_mg(l))
+                ENDIF
+             ENDIF
+
+             IF ( .NOT. bc_ns_cyc )  THEN
+                IF ( inflow_n .OR. outflow_n .OR. nest_bound_n .OR. force_bound_n )  THEN
+                   p_mg(:,nyn_mg(l)+1,:) = p_mg(:,nyn_mg(l),:)
+                ENDIF
+                IF ( inflow_s .OR. outflow_s .OR. nest_bound_s .OR. force_bound_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
+
+!
+!--    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 gridpoint 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.
+!------------------------------------------------------------------------------!
+    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  !<
+
+
+#if defined( __parallel )
+       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' )
+#endif
+       
+    END SUBROUTINE mg_gather_noopt
+
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> @todo It may be possible to improve the speed of this routine by using
+!>       non-blocking communication
+!------------------------------------------------------------------------------!
+    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
+
+       INTEGER(iwp) ::  nwords  !<
+
+       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  !<
+
+!
+!--    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_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' )
+#endif
+       
+    END SUBROUTINE mg_scatter_noopt
+
+
+!------------------------------------------------------------------------------!
+! 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, ibc_p_b, ibc_p_t,                &
+                  maximum_grid_level,                                          &
+                  mg_switch_to_pe0_level, mg_switch_to_pe0, nest_domain, 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  !<
+       REAL(wp), DIMENSION(:,:,:), ALLOCATABLE ::  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_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
+             CALL mg_gather_noopt( 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 all PEs after the switch,
+!--          because then they have the total domain.
+             IF ( bc_lr_dirrad )  THEN
+                inflow_l  = .TRUE.
+                inflow_r  = .FALSE.
+                outflow_l = .FALSE.
+                outflow_r = .TRUE.
+             ELSEIF ( bc_lr_raddir )  THEN
+                inflow_l  = .FALSE.
+                inflow_r  = .TRUE.
+                outflow_l = .TRUE.
+                outflow_r = .FALSE.
+             ELSEIF ( nest_domain )  THEN
+                nest_bound_l = .TRUE.
+                nest_bound_r = .TRUE.
+             ELSEIF ( forcing )  THEN
+                force_bound_l = .TRUE.
+                force_bound_r = .TRUE.
+             ENDIF
+
+             IF ( bc_ns_dirrad )  THEN
+                inflow_n  = .TRUE.
+                inflow_s  = .FALSE.
+                outflow_n = .FALSE.
+                outflow_s = .TRUE.
+             ELSEIF ( bc_ns_raddir )  THEN
+                inflow_n  = .FALSE.
+                inflow_s  = .TRUE.
+                outflow_n = .TRUE.
+                outflow_s = .FALSE.
+             ELSEIF ( nest_domain )  THEN
+                nest_bound_s = .TRUE.
+                nest_bound_n = .TRUE.
+             ELSEIF ( forcing )  THEN
+                force_bound_s = .TRUE.
+                force_bound_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. 
+             inflow_l  = .FALSE.;  inflow_r  = .FALSE.
+             inflow_n  = .FALSE.;  inflow_s  = .FALSE.
+             outflow_l = .FALSE.;  outflow_r = .FALSE.
+             outflow_n = .FALSE.;  outflow_s = .FALSE.
+!
+!--          In case of nesting, restore lateral boundary conditions
+             IF ( nest_domain )  THEN
+                nest_bound_l = .FALSE.
+                nest_bound_r = .FALSE.
+                nest_bound_s = .FALSE.
+                nest_bound_n = .FALSE.      
+             ENDIF
+             IF ( forcing )  THEN
+                force_bound_l = .FALSE.
+                force_bound_r = .FALSE.
+                force_bound_s = .FALSE.
+                force_bound_n = .FALSE.      
+             ENDIF
+
+             IF ( pleft == MPI_PROC_NULL )  THEN
+                IF ( bc_lr_dirrad )  THEN
+                   inflow_l  = .TRUE.
+                ELSEIF ( bc_lr_raddir )  THEN
+                   outflow_l = .TRUE.
+                ELSEIF ( nest_domain )  THEN
+                   nest_bound_l = .TRUE.
+                ELSEIF ( forcing )  THEN
+                   force_bound_l = .TRUE.
+                ENDIF
+             ENDIF
+
+             IF ( pright == MPI_PROC_NULL )  THEN
+                IF ( bc_lr_dirrad )  THEN
+                   outflow_r = .TRUE.
+                ELSEIF ( bc_lr_raddir )  THEN
+                   inflow_r  = .TRUE.
+                ELSEIF ( nest_domain )  THEN
+                   nest_bound_r = .TRUE.
+                ELSEIF ( forcing )  THEN
+                   force_bound_r = .TRUE.
+                ENDIF
+             ENDIF
+
+             IF ( psouth == MPI_PROC_NULL )  THEN
+                IF ( bc_ns_dirrad )  THEN
+                   outflow_s = .TRUE.
+                ELSEIF ( bc_ns_raddir )  THEN
+                   inflow_s  = .TRUE.
+                ELSEIF ( nest_domain )  THEN
+                   nest_bound_s = .TRUE.
+                ELSEIF ( forcing )  THEN
+                   force_bound_s = .TRUE.
+                ENDIF
+             ENDIF
+
+             IF ( pnorth == MPI_PROC_NULL )  THEN
+                IF ( bc_ns_dirrad )  THEN
+                   inflow_n  = .TRUE.
+                ELSEIF ( bc_ns_raddir )  THEN
+                   outflow_n = .TRUE.
+                ELSEIF ( nest_domain )  THEN
+                   nest_bound_n = .TRUE.
+                ELSEIF ( forcing )  THEN
+                   force_bound_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
+
+
+
+    SUBROUTINE poismg_noopt_init
+
+       USE control_parameters,                                                 &
+           ONLY:  bc_lr_cyc, bc_ns_cyc, masking_method, maximum_grid_level
+
+       USE indices,                                                            &
+           ONLY:  flags, nxl_mg, nxr_mg, nyn_mg, nys_mg, nzb, nzt_mg,          &
+                  wall_flags_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
+!
+!--    Gridpoint 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 ghoist 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_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 ( inflow_s  .OR.  outflow_s  .OR.  nest_bound_s  .OR.       &
+                     force_bound_s )  THEN
+!                    topo_tmp(:,-2,:) = topo_tmp(:,0,:)
+                   topo_tmp(:,-1,:) = topo_tmp(:,0,:)
+                ENDIF
+                IF ( inflow_n  .OR.  outflow_n  .OR.  nest_bound_n  .OR.       &
+                     force_bound_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 ( inflow_l  .OR.  outflow_l  .OR.  nest_bound_l  .OR.       &
+                     force_bound_l )  THEN
+!                    topo_tmp(:,:,-2) = topo_tmp(:,:,0)
+                   topo_tmp(:,:,-1) = topo_tmp(:,:,0)
+                ENDIF
+                IF ( inflow_r  .OR.  outflow_r  .OR.  nest_bound_r  .OR.       &
+                     force_bound_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_calls_from_fortran.f90
===================================================================
--- palm/trunk/SOURCE/posix_calls_from_fortran.f90	(revision 2689)
+++ palm/trunk/SOURCE/posix_calls_from_fortran.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @posix_calls_from_fortran.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
@@ -12,5 +12,5 @@
 ! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
 !
-! You should have received a copy of the GNU fGeneral Public License along with
+! You should have received a copy of the GNU General Public License along with
 ! PALM. If not, see <http://www.gnu.org/licenses/>.
 !
Index: palm/trunk/SOURCE/pres.f90
===================================================================
--- palm/trunk/SOURCE/pres.f90	(revision 2689)
+++ palm/trunk/SOURCE/pres.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file pres.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
@@ -24,5 +24,8 @@
 ! Former revisions:
 ! -----------------
-! $Id$
+! Id: pres.f90 2298 2017-06-29 09:28:18Z raasch $
+! - poismg_noopt modularized (MS)
+! 
+! 2298 2017-06-29 09:28:18Z raasch
 ! comment changed + some formatting
 ! 
@@ -176,4 +179,6 @@
 
     USE poismg_mod
+
+    USE poismg_noopt_mod
 
     USE statistics,                                                            &
Index: palm/trunk/SOURCE/print_1d.f90
===================================================================
--- palm/trunk/SOURCE/print_1d.f90	(revision 2689)
+++ palm/trunk/SOURCE/print_1d.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file print_1d.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/production_e.f90
===================================================================
--- palm/trunk/SOURCE/production_e.f90	(revision 2689)
+++ 	(revision )
@@ -1,1698 +1,0 @@
-!> @file production_e.f90
-!------------------------------------------------------------------------------!
-! This file is part of PALM.
-!
-! PALM is free software: you can redistribute it and/or modify it under the
-! terms of the GNU General Public License as published by the Free Software
-! Foundation, either version 3 of the License, or (at your option) any later
-! version.
-!
-! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
-! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
-! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
-!
-! You should have received a copy of the GNU General Public License along with
-! PALM. If not, see <http://www.gnu.org/licenses/>.
-!
-! Copyright 1997-2017 Leibniz Universitaet Hannover
-!------------------------------------------------------------------------------!
-!
-! Current revisions:
-! -----------------
-! 
-! 
-! Former revisions:
-! -----------------
-! $Id$
-! - Bugfix in buoyancy production term, wrong base state was set.
-! - Consider use_single_reference_value case if humidity is used.
-! - In case of use_top_fluxes, use correct inverse density at model top
-! - Consider use_surface_fluxes and use_top_fluxes in ocean case  
-! 
-! 2478 2017-09-18 13:37:24Z suehring
-! Bugfix, consider case where no constant-flux layer and no surfaces fluxes 
-! are used
-! 
-! 2329 2017-08-03 14:24:56Z knoop
-! Bugfix: added division by density as kinematic fluxes are needed
-! 
-! 2233 2017-05-30 18:08:54Z suehring
-!
-! 2232 2017-05-30 17:47:52Z suehring
-! Adjustments to new surface concept
-!
-! 2126 2017-01-20 15:54:21Z raasch
-! density in ocean case replaced by potential density
-!
-! 2118 2017-01-17 16:38:49Z raasch
-! OpenACC version of subroutine removed
-! 
-! 2031 2016-10-21 15:11:58Z knoop
-! renamed variable rho to rho_ocean
-! 
-! 2000 2016-08-20 18:09:15Z knoop
-! Forced header and separation lines into 80 columns
-! 
-! 1873 2016-04-18 14:50:06Z maronga
-! Module renamed (removed _mod)
-! 
-! 
-! 1850 2016-04-08 13:29:27Z maronga
-! Module renamed
-! 
-! 
-! 1691 2015-10-26 16:17:44Z maronga
-! Renamed prandtl_layer to constant_flux_layer.
-! 
-! 1682 2015-10-07 23:56:08Z knoop
-! Code annotations made doxygen readable 
-! 
-! 1374 2014-04-25 12:55:07Z raasch
-! nzb_s_outer removed from acc-present-list
-! 
-! 1353 2014-04-08 15:21:23Z heinze
-! REAL constants provided with KIND-attribute
-! 
-! 1342 2014-03-26 17:04:47Z kanani
-! REAL constants defined as wp-kind
-!
-! 1320 2014-03-20 08:40:49Z raasch
-! ONLY-attribute added to USE-statements,
-! kind-parameters added to all INTEGER and REAL declaration statements,
-! kinds are defined in new module kinds,
-! old module precision_kind is removed,
-! revision history before 2012 removed,
-! comment fields (!:) to be used for variable explanations added to
-! all variable declaration statements
-!
-! 1257 2013-11-08 15:18:40Z raasch
-! openacc loop and loop vector clauses removed, declare create moved after
-! the FORTRAN declaration statement
-!
-! 1179 2013-06-14 05:57:58Z raasch
-! use_reference renamed use_single_reference_value
-!
-! 1128 2013-04-12 06:19:32Z raasch
-! loop index bounds in accelerator version replaced by i_left, i_right, j_south,
-! j_north
-!
-! 1036 2012-10-22 13:43:42Z raasch
-! code put under GPL (PALM 3.9)
-!
-! 1015 2012-09-27 09:23:24Z raasch
-! accelerator version (*_acc) added
-!
-! 1007 2012-09-19 14:30:36Z franke
-! Bugfix: calculation of buoyancy production has to consider the liquid water
-! mixing ratio in case of cloud droplets
-!
-! 940 2012-07-09 14:31:00Z raasch
-! TKE production by buoyancy can be switched off in case of runs with pure
-! neutral stratification
-!
-! Revision 1.1  1997/09/19 07:45:35  raasch
-! Initial revision
-!
-!
-! Description:
-! ------------
-!> Production terms (shear + buoyancy) of the TKE.
-!> @warning The case with constant_flux_layer = F and use_surface_fluxes = T is
-!>          not considered well!
-!------------------------------------------------------------------------------!
- MODULE production_e_mod
-
-    USE kinds
-
-    PRIVATE
-    PUBLIC production_e, production_e_init
-
-    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
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for all grid points
-!------------------------------------------------------------------------------!
-    SUBROUTINE production_e
-
-       USE arrays_3d,                                                          &
-           ONLY:  ddzw, dd2zu, drho_air_zw, kh, km, prho, pt, q, ql, tend, u,  &
-                  v, vpt, w
-
-       USE cloud_parameters,                                                   &
-           ONLY:  l_d_cp, l_d_r, pt_d_t, t_d_pt
-
-       USE control_parameters,                                                 &
-           ONLY:  cloud_droplets, cloud_physics, constant_flux_layer, g,       &
-                  humidity, kappa, neutral, ocean, pt_reference,               &
-                  rho_reference, use_single_reference_value,                   &
-                  use_surface_fluxes, use_top_fluxes, vpt_reference
-
-       USE grid_variables,                                                     &
-           ONLY:  ddx, dx, ddy, dy
-
-       USE indices,                                                            &
-           ONLY:  nxl, nxr, nys, nyn, nzb, nzt, wall_flags_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
-
-       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         !< 
-       REAL(wp)     ::  flag        !< flag to mask topography
-       REAL(wp)     ::  k1          !<
-       REAL(wp)     ::  k2          !<
-       REAL(wp)     ::  km_neutral  !< diffusion coefficient assuming neutral conditions - used to compute shear production at surfaces
-       REAL(wp)     ::  theta       !<
-       REAL(wp)     ::  temp        !<
-       REAL(wp)     ::  sign_dir    !< sign of wall-tke flux, depending on wall orientation 
-       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,nys:nyn) ::  dudx  !< Gradient of u-component in x-direction
-       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  dudy  !< Gradient of u-component in y-direction
-       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  dudz  !< Gradient of u-component in z-direction
-       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  dvdx  !< Gradient of v-component in x-direction
-       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  dvdy  !< Gradient of v-component in y-direction
-       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  dvdz  !< Gradient of v-component in z-direction
-       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  dwdx  !< Gradient of w-component in x-direction
-       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  dwdy  !< Gradient of w-component in y-direction
-       REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  dwdz  !< Gradient of w-component in z-direction
-
-       DO  i = nxl, nxr
-
-          IF ( constant_flux_layer )  THEN
-
-!
-!--          Calculate TKE production by shear. Calculate gradients at all grid 
-!--          points first, gradients at surface-bounded grid points will be 
-!--          overwritten further below. 
-             DO  j = nys, nyn
-                DO  k = nzb+1, nzt
-
-                   dudx(k,j) =           ( u(k,j,i+1) - u(k,j,i)     ) * ddx
-                   dudy(k,j) = 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,j) = 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,j) = 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,j) =           ( v(k,j+1,i) - v(k,j,i)     ) * ddy
-                   dvdz(k,j) = 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,j) = 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,j) = 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,j) =           ( w(k,j,i)   - w(k-1,j,i)   ) * ddzw(k)
-
-                ENDDO
-             ENDDO
-
-!
-!--          Position beneath wall
-!--          (2) - Will allways be executed.
-!--          'bottom and wall: use u_0,v_0 and wall functions'
-             DO  j = nys, nyn
-!
-!--             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_0(k,j-1,i), 0 ) ) 
-                      dudy(k,j) = sign_dir * usvs / ( km_neutral + 1E-10_wp )
-                      dwdy(k,j) = 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_0(k,j-1,i), 0 ) ) 
-                      dudy(k,j) = sign_dir * usvs / ( km_neutral + 1E-10_wp )
-                      dwdy(k,j) = 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_0(k,j-1,i), 0 ) ) 
-                      dudy(k,j) = sign_dir * usvs / ( km_neutral + 1E-10_wp )
-                      dwdy(k,j) = 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_0(k,j,i-1), 0 ) ) 
-                      dvdx(k,j) = sign_dir * vsus / ( km_neutral + 1E-10_wp )
-                      dwdx(k,j) = 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_0(k,j,i-1), 0 ) ) 
-                      dvdx(k,j) = sign_dir * vsus / ( km_neutral + 1E-10_wp )
-                      dwdx(k,j) = 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_0(k,j,i-1), 0 ) ) 
-                      dvdx(k,j) = sign_dir * vsus / ( km_neutral + 1E-10_wp )
-                      dwdx(k,j) = 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,j) = ( u(k+1,j,i) - surf_def_h(0)%u_0(m) ) * dd2zu(k)   
-                   dvdz(k,j) = ( v(k+1,j,i) - surf_def_h(0)%v_0(m) ) * dd2zu(k)
-            
-                ENDDO
-!
-!--             Natural surfaces
-                surf_s = surf_lsm_h%start_index(j,i)
-                surf_e = surf_lsm_h%end_index(j,i)
-                DO  m = surf_s, surf_e
-                   k = surf_lsm_h%k(m)
-
-                   dudz(k,j) = ( u(k+1,j,i) - surf_lsm_h%u_0(m) ) * dd2zu(k)   
-                   dvdz(k,j) = ( v(k+1,j,i) - surf_lsm_h%v_0(m) ) * dd2zu(k)
-            
-                ENDDO
-!
-!--             Urban surfaces
-                surf_s = surf_usm_h%start_index(j,i)
-                surf_e = surf_usm_h%end_index(j,i)
-                DO  m = surf_s, surf_e
-                   k = surf_usm_h%k(m)
-
-                   dudz(k,j) = ( u(k+1,j,i) - surf_usm_h%u_0(m) ) * dd2zu(k)   
-                   dvdz(k,j) = ( v(k+1,j,i) - surf_usm_h%v_0(m) ) * dd2zu(k)
-            
-                ENDDO
-!
-!--             Compute gradients at downward-facing walls, only for 
-!--             non-natural 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,j) = ( surf_def_h(1)%u_0(m) - u(k-1,j,i) ) * dd2zu(k)   
-                   dvdz(k,j) = ( surf_def_h(1)%v_0(m) - v(k-1,j,i) ) * dd2zu(k)
-
-                ENDDO
-             ENDDO
-
-             DO  j = nys, nyn
-                DO  k = nzb+1, nzt
-
-                   def = 2.0_wp * ( dudx(k,j)**2 + dvdy(k,j)**2 + dwdz(k,j)**2 ) + &
-                                    dudy(k,j)**2 + dvdx(k,j)**2 + dwdx(k,j)**2 +   &
-                                    dwdy(k,j)**2 + dudz(k,j)**2 + dvdz(k,j)**2 +   &
-                         2.0_wp * ( dvdx(k,j)*dudy(k,j) + dwdx(k,j)*dudz(k,j)  +   &
-                                    dwdy(k,j)*dvdz(k,j) )
-
-                   IF ( def < 0.0_wp )  def = 0.0_wp
-
-                   flag  = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) ) 
-
-                   tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def * flag
-
-                ENDDO
-             ENDDO
-
-          ELSE
-
-             DO  j = nys, nyn
-!
-!--             Calculate TKE production by shear. Here, no additional
-!--             wall-bounded code is considered. 
-!--             Why?
-                DO  k = nzb+1, nzt
-
-                   dudx(k,j)  =           ( u(k,j,i+1) - u(k,j,i)     ) * ddx
-                   dudy(k,j)  = 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,j)  = 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,j)  = 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,j)  =           ( v(k,j+1,i) - v(k,j,i)     ) * ddy
-                   dvdz(k,j)  = 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,j)  = 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,j)  = 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,j)  =           ( w(k,j,i)   - w(k-1,j,i)   ) *      &
-                                                                        ddzw(k)
-      
-                   def = 2.0_wp * (                                            &
-                                dudx(k,j)**2 + dvdy(k,j)**2 + dwdz(k,j)**2     &
-                                  ) +                                          &
-                                dudy(k,j)**2 + dvdx(k,j)**2 + dwdx(k,j)**2 +   &
-                                dwdy(k,j)**2 + dudz(k,j)**2 + dvdz(k,j)**2 +   &
-                         2.0_wp * (                                            &
-                                dvdx(k,j)*dudy(k,j) + dwdx(k,j)*dudz(k,j)  +   &
-                                dwdy(k,j)*dvdz(k,j)                            &
-                                  )
-
-                   IF ( def < 0.0_wp )  def = 0.0_wp
-
-                   flag  = MERGE( 1.0_wp, 0.0_wp,                              &
-                                  BTEST( wall_flags_0(k,j,i), 29 ) ) 
-                   tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def * flag
-      
-                ENDDO
-             ENDDO
-
-          ENDIF
-
-!
-!--       If required, calculate TKE production by buoyancy
-          IF ( .NOT. neutral )  THEN
-
-             IF ( .NOT. humidity )  THEN
-
-                IF ( ocean )  THEN
-!
-!--                So far in the ocean no special treatment of density flux
-!--                in the bottom and top surface layer
-                   DO  j = nys, nyn
-                      DO  k = nzb+1, nzt
-                         tend(k,j,i) = tend(k,j,i) +                           &
-                                       kh(k,j,i) * g /                         &
-                              MERGE( rho_reference, prho(k,j,i),               &
-                                     use_single_reference_value ) *            &
-                                       ( prho(k+1,j,i) - prho(k-1,j,i) ) *     &
-                                       dd2zu(k) *                              &
-                                   MERGE( 1.0_wp, 0.0_wp,                      &
-                                          BTEST( wall_flags_0(k,j,i), 30 )     &
-                                        )                            *         &
-                                   MERGE( 1.0_wp, 0.0_wp,                      &
-                                          BTEST( wall_flags_0(k,j,i), 9 )      &
-                                        )  
-                      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)
-                               tend(k,j,i) = tend(k,j,i) + g /                 &
-                                         MERGE( rho_reference, prho(k,j,i),    &
-                                                use_single_reference_value ) * &
-                                         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)
-                            tend(k,j,i) = tend(k,j,i) + g /                    &
-                                         MERGE( rho_reference, prho(k,j,i),    &
-                                                use_single_reference_value ) * &
-                                         drho_air_zw(k) *                      &
-                                         surf_def_h(2)%shf(m) 
-                         ENDDO
-                      ENDIF
-
-                   ENDDO
-
-                ELSE
-
-                   DO  j = nys, nyn
-                      DO  k = nzb+1, nzt
-!
-!--                      Flag 9 is used to mask top fluxes, flag 30 to mask
-!--                      surface fluxes
-                         tend(k,j,i) = tend(k,j,i) -                           &
-                                       kh(k,j,i) * g /                         &
-                                   MERGE( pt_reference, pt(k,j,i),             &
-                                           use_single_reference_value ) *      &
-                                       ( pt(k+1,j,i) - pt(k-1,j,i) ) *         &
-                                       dd2zu(k)                      *         &
-                                   MERGE( 1.0_wp, 0.0_wp,                      &
-                                          BTEST( wall_flags_0(k,j,i), 30 )     &
-                                        )                            *         &
-                                   MERGE( 1.0_wp, 0.0_wp,                      &
-                                          BTEST( wall_flags_0(k,j,i), 9 )      &
-                                        )  
-                      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)
-                               tend(k,j,i) = tend(k,j,i) + g /                 &
-                                    MERGE( pt_reference, pt(k,j,i),            &
-                                           use_single_reference_value )        &
-                                                      * drho_air_zw(k-1)       &
-                                                      * surf_def_h(l)%shf(m)    
-                            ENDDO      
-                         ENDDO
-!
-!--                      Natural surfaces
-                         surf_s = surf_lsm_h%start_index(j,i)
-                         surf_e = surf_lsm_h%end_index(j,i)
-                         DO  m = surf_s, surf_e
-                            k = surf_lsm_h%k(m)
-                            tend(k,j,i) = tend(k,j,i) + g /                    &
-                                    MERGE( pt_reference, pt(k,j,i),            &
-                                           use_single_reference_value )        &
-                                                      * drho_air_zw(k-1)       &
-                                                      * surf_lsm_h%shf(m)   
-                         ENDDO
-!
-!--                      Urban surfaces
-                         surf_s = surf_usm_h%start_index(j,i)
-                         surf_e = surf_usm_h%end_index(j,i)
-                         DO  m = surf_s, surf_e
-                            k = surf_usm_h%k(m)
-                            tend(k,j,i) = tend(k,j,i) + g /                    &
-                                    MERGE( pt_reference, pt(k,j,i),            &
-                                           use_single_reference_value )        &
-                                                      * drho_air_zw(k-1)       &
-                                                      * surf_usm_h%shf(m)   
-                         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)
-                            tend(k,j,i) = tend(k,j,i) + g /                    &
-                                    MERGE( pt_reference, pt(k,j,i),            &
-                                           use_single_reference_value )        &
-                                                      * drho_air_zw(k)         &
-                                                      * surf_def_h(2)%shf(m) 
-                         ENDDO
-                      ENDIF
-                   ENDDO
-
-                ENDIF
-
-             ELSE
-
-                DO  j = nys, nyn
-
-                   DO  k = nzb+1, nzt
-!
-!--                   Flag 9 is used to mask top fluxes, flag 30 to mask
-!--                   surface fluxes
-                      IF ( .NOT. cloud_physics .AND. .NOT. cloud_droplets ) THEN
-                         k1 = 1.0_wp + 0.61_wp * q(k,j,i)
-                         k2 = 0.61_wp * pt(k,j,i)
-                         tend(k,j,i) = tend(k,j,i) - kh(k,j,i) *               &
-                                         g /                                   &
-                                    MERGE( vpt_reference, vpt(k,j,i),          &
-                                           use_single_reference_value ) *      &
-                                         ( k1 * ( pt(k+1,j,i)-pt(k-1,j,i) ) +  &
-                                           k2 * ( q(k+1,j,i) - q(k-1,j,i) )    &
-                                         ) * dd2zu(k) *                        &
-                                      MERGE( 1.0_wp, 0.0_wp,                   &
-                                             BTEST( wall_flags_0(k,j,i), 30 )  &
-                                           )          *                        &
-                                      MERGE( 1.0_wp, 0.0_wp,                   &
-                                             BTEST( wall_flags_0(k,j,i), 9 )   &
-                                           )
-                      ELSE IF ( cloud_physics )  THEN
-                         IF ( ql(k,j,i) == 0.0_wp )  THEN
-                            k1 = 1.0_wp + 0.61_wp * q(k,j,i)
-                            k2 = 0.61_wp * pt(k,j,i)
-                         ELSE
-                            theta = pt(k,j,i) + pt_d_t(k) * l_d_cp * ql(k,j,i)
-                            temp  = theta * t_d_pt(k)
-                            k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp *               &
-                                          ( q(k,j,i) - ql(k,j,i) ) *           &
-                                 ( 1.0_wp + 0.622_wp * l_d_r / temp ) ) /      &
-                                 ( 1.0_wp + 0.622_wp * l_d_r * l_d_cp *        &
-                                 ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
-                            k2 = theta * ( l_d_cp / temp * k1 - 1.0_wp )
-                         ENDIF
-                         tend(k,j,i) = tend(k,j,i) - kh(k,j,i) *               &
-                                         g /                                   &
-                                    MERGE( vpt_reference, vpt(k,j,i),          &
-                                           use_single_reference_value ) *      &
-                                         ( k1 * ( pt(k+1,j,i)-pt(k-1,j,i) ) +  &
-                                           k2 * ( q(k+1,j,i) - q(k-1,j,i) )    &
-                                         ) * dd2zu(k) *                        &
-                                      MERGE( 1.0_wp, 0.0_wp,                   &
-                                             BTEST( wall_flags_0(k,j,i), 30 )  &
-                                           )          *                        &
-                                      MERGE( 1.0_wp, 0.0_wp,                   &
-                                             BTEST( wall_flags_0(k,j,i), 9 )   &
-                                           )
-                      ELSE IF ( cloud_droplets )  THEN
-                         k1 = 1.0_wp + 0.61_wp * q(k,j,i) - ql(k,j,i)
-                         k2 = 0.61_wp * pt(k,j,i)
-                         tend(k,j,i) = tend(k,j,i) -                           & 
-                                       kh(k,j,i) * g /                         &
-                                    MERGE( vpt_reference, vpt(k,j,i),          &
-                                           use_single_reference_value ) *      &
-                                       ( 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) *          &
-                                      MERGE( 1.0_wp, 0.0_wp,                   &
-                                             BTEST( wall_flags_0(k,j,i), 30 )  &
-                                           )                        *          &
-                                      MERGE( 1.0_wp, 0.0_wp,                   &
-                                             BTEST( wall_flags_0(k,j,i), 9 )   &
-                                           )
-                      ENDIF
-
-                   ENDDO
-
-                ENDDO
-
-                IF ( use_surface_fluxes )  THEN
-
-                   DO  j = nys, nyn
-!
-!--                   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. cloud_physics .AND. .NOT. cloud_droplets ) THEN
-                               k1 = 1.0_wp + 0.61_wp * q(k,j,i)
-                               k2 = 0.61_wp * pt(k,j,i)
-                            ELSE IF ( cloud_physics )  THEN
-                               IF ( ql(k,j,i) == 0.0_wp )  THEN
-                                  k1 = 1.0_wp + 0.61_wp * q(k,j,i)
-                                  k2 = 0.61_wp * pt(k,j,i)
-                               ELSE
-                                  theta = pt(k,j,i) + pt_d_t(k) * l_d_cp * ql(k,j,i)
-                                  temp  = theta * t_d_pt(k)
-                                  k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp *         &
-                                             ( q(k,j,i) - ql(k,j,i) ) *        &
-                                    ( 1.0_wp + 0.622_wp * l_d_r / temp ) ) /   &
-                                    ( 1.0_wp + 0.622_wp * l_d_r * l_d_cp *     &
-                                    ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
-                                  k2 = theta * ( l_d_cp / temp * k1 - 1.0_wp )
-                               ENDIF
-                            ELSE IF ( cloud_droplets )  THEN
-                               k1 = 1.0_wp + 0.61_wp * q(k,j,i) - ql(k,j,i)
-                               k2 = 0.61_wp * pt(k,j,i)
-                            ENDIF
-
-                            tend(k,j,i) = tend(k,j,i) + g /                    &
-                                    MERGE( vpt_reference, vpt(k,j,i),          &
-                                           use_single_reference_value ) *      &
-                                               ( 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
-                      surf_s = surf_lsm_h%start_index(j,i)
-                      surf_e = surf_lsm_h%end_index(j,i)
-                      DO  m = surf_s, surf_e
-                         k = surf_lsm_h%k(m)
-
-                         IF ( .NOT. cloud_physics .AND. .NOT. cloud_droplets ) THEN
-                            k1 = 1.0_wp + 0.61_wp * q(k,j,i)
-                            k2 = 0.61_wp * pt(k,j,i)
-                         ELSE IF ( cloud_physics )  THEN
-                            IF ( ql(k,j,i) == 0.0_wp )  THEN
-                               k1 = 1.0_wp + 0.61_wp * q(k,j,i)
-                               k2 = 0.61_wp * pt(k,j,i)
-                            ELSE
-                               theta = pt(k,j,i) + pt_d_t(k) * l_d_cp * ql(k,j,i)
-                               temp  = theta * t_d_pt(k)
-                               k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp *            &
-                                             ( q(k,j,i) - ql(k,j,i) ) *        &
-                                    ( 1.0_wp + 0.622_wp * l_d_r / temp ) ) /   &
-                                    ( 1.0_wp + 0.622_wp * l_d_r * l_d_cp *     &
-                                    ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
-                               k2 = theta * ( l_d_cp / temp * k1 - 1.0_wp )
-                            ENDIF
-                         ELSE IF ( cloud_droplets )  THEN
-                            k1 = 1.0_wp + 0.61_wp * q(k,j,i) - ql(k,j,i)
-                            k2 = 0.61_wp * pt(k,j,i)
-                         ENDIF
-
-                         tend(k,j,i) = tend(k,j,i) + g /                       &
-                                    MERGE( vpt_reference, vpt(k,j,i),          &
-                                           use_single_reference_value ) *      &
-                                               ( k1 * surf_lsm_h%shf(m) +      &
-                                                 k2 * surf_lsm_h%qsws(m)       &
-                                               ) * drho_air_zw(k-1)
-                      ENDDO
-!
-!--                   Treat horizontal urban surfaces
-                      surf_s = surf_usm_h%start_index(j,i)
-                      surf_e = surf_usm_h%end_index(j,i)
-                      DO  m = surf_s, surf_e
-                         k = surf_lsm_h%k(m)
-
-                         IF ( .NOT. cloud_physics .AND. .NOT. cloud_droplets ) THEN
-                            k1 = 1.0_wp + 0.61_wp * q(k,j,i)
-                            k2 = 0.61_wp * pt(k,j,i)
-                         ELSE IF ( cloud_physics )  THEN
-                            IF ( ql(k,j,i) == 0.0_wp )  THEN
-                               k1 = 1.0_wp + 0.61_wp * q(k,j,i)
-                               k2 = 0.61_wp * pt(k,j,i)
-                            ELSE
-                               theta = pt(k,j,i) + pt_d_t(k) * l_d_cp * ql(k,j,i)
-                               temp  = theta * t_d_pt(k)
-                               k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp *            &
-                                             ( q(k,j,i) - ql(k,j,i) ) *        &
-                                    ( 1.0_wp + 0.622_wp * l_d_r / temp ) ) /   &
-                                    ( 1.0_wp + 0.622_wp * l_d_r * l_d_cp *     &
-                                    ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
-                               k2 = theta * ( l_d_cp / temp * k1 - 1.0_wp )
-                            ENDIF
-                         ELSE IF ( cloud_droplets )  THEN
-                            k1 = 1.0_wp + 0.61_wp * q(k,j,i) - ql(k,j,i)
-                            k2 = 0.61_wp * pt(k,j,i)
-                         ENDIF
-
-                         tend(k,j,i) = tend(k,j,i) + g /                       &
-                                    MERGE( vpt_reference, vpt(k,j,i),          &
-                                           use_single_reference_value ) *      &
-                                               ( k1 * surf_usm_h%shf(m) +      &
-                                                 k2 * surf_usm_h%qsws(m)       &
-                                               ) * drho_air_zw(k-1)
-                      ENDDO
-
-                   ENDDO
-
-                ENDIF
-
-                IF ( use_top_fluxes )  THEN
-
-                   DO  j = nys, nyn
-
-                      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. cloud_physics .AND. .NOT. cloud_droplets ) THEN
-                            k1 = 1.0_wp + 0.61_wp * q(k,j,i)
-                            k2 = 0.61_wp * pt(k,j,i)
-                         ELSE IF ( cloud_physics )  THEN
-                            IF ( ql(k,j,i) == 0.0_wp )  THEN
-                               k1 = 1.0_wp + 0.61_wp * q(k,j,i)
-                               k2 = 0.61_wp * pt(k,j,i)
-                            ELSE
-                               theta = pt(k,j,i) + pt_d_t(k) * l_d_cp * ql(k,j,i)
-                               temp  = theta * t_d_pt(k)
-                               k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp *            &
-                                          ( q(k,j,i) - ql(k,j,i) ) *           &
-                                 ( 1.0_wp + 0.622_wp * l_d_r / temp ) ) /      &
-                                 ( 1.0_wp + 0.622_wp * l_d_r * l_d_cp *        &
-                                 ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
-                               k2 = theta * ( l_d_cp / temp * k1 - 1.0_wp )
-                            ENDIF
-                         ELSE IF ( cloud_droplets )  THEN
-                            k1 = 1.0_wp + 0.61_wp * q(k,j,i) - ql(k,j,i)
-                            k2 = 0.61_wp * pt(k,j,i)
-                         ENDIF
-
-                         tend(k,j,i) = tend(k,j,i) + g /                       &
-                                    MERGE( vpt_reference, vpt(k,j,i),          &
-                                           use_single_reference_value ) *      &
-                                               ( k1 * surf_def_h(2)%shf(m) +   &
-                                                 k2 * surf_def_h(2)%qsws(m)    &
-                                               ) * drho_air_zw(k)
-
-                      ENDDO
-
-                   ENDDO
-
-                ENDIF
-
-             ENDIF
-
-          ENDIF
-
-       ENDDO
-
-    END SUBROUTINE production_e
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Call for grid point i,j
-!------------------------------------------------------------------------------!
-    SUBROUTINE production_e_ij( i, j )
-
-       USE arrays_3d,                                                          &
-           ONLY:  ddzw, dd2zu, drho_air_zw, kh, km, prho, pt, q, ql, tend, u,  &
-                  v, vpt, w
-
-       USE cloud_parameters,                                                   &
-           ONLY:  l_d_cp, l_d_r, pt_d_t, t_d_pt
-
-       USE control_parameters,                                                 &
-           ONLY:  cloud_droplets, cloud_physics, constant_flux_layer, g,       &
-                  humidity, kappa, neutral, ocean, pt_reference,               &
-                  rho_reference, use_single_reference_value,                   &
-                  use_surface_fluxes, use_top_fluxes, vpt_reference
-
-       USE grid_variables,                                                     &
-           ONLY:  ddx, dx, ddy, dy
-
-       USE indices,                                                            &
-           ONLY:  nxl, nxr, nys, nyn, nzb, nzb, nzt, wall_flags_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
-
-       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         !<
-       REAL(wp)     ::  flag        !< flag to mask topography
-       REAL(wp)     ::  k1          !<
-       REAL(wp)     ::  k2          !<
-       REAL(wp)     ::  km_neutral  !< diffusion coefficient assuming neutral conditions - used to compute shear production at surfaces
-       REAL(wp)     ::  theta       !<
-       REAL(wp)     ::  temp        !<
-       REAL(wp)     ::  sign_dir    !< sign of wall-tke flux, depending on wall orientation 
-       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
-
-
-       IF ( constant_flux_layer )  THEN
-!
-!--       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
-!
-!--       Compute gradients at north- and south-facing surfaces.
-!--       Note, no vertical natural surfaces so far.
-          DO  l = 0, 1
-!
-!--          Default surfaces
-             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_0(k,j-1,i), 0 ) ) 
-                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_0(k,j-1,i), 0 ) ) 
-                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_0(k,j-1,i), 0 ) ) 
-                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
-!
-!--          Default surfaces
-             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_0(k,j,i-1), 0 ) )
-                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_0(k,j,i-1), 0 ) ) 
-                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_0(k,j,i-1), 0 ) ) 
-                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 walls, first for 
-!--       non-natural default 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%start_index(j,i)
-          surf_e = surf_lsm_h%end_index(j,i)
-          DO  m = surf_s, surf_e
-             k = surf_lsm_h%k(m)
-
-             dudz(k)     = ( u(k+1,j,i) - surf_lsm_h%u_0(m) ) * dd2zu(k)   
-             dvdz(k)     = ( v(k+1,j,i) - surf_lsm_h%v_0(m) ) * dd2zu(k)
-          ENDDO
-!
-!--       Urban surfaces
-          surf_s = surf_usm_h%start_index(j,i)
-          surf_e = surf_usm_h%end_index(j,i)
-          DO  m = surf_s, surf_e
-             k = surf_usm_h%k(m)
-
-             dudz(k)     = ( u(k+1,j,i) - surf_usm_h%u_0(m) ) * dd2zu(k)   
-             dvdz(k)     = ( v(k+1,j,i) - surf_usm_h%v_0(m) ) * dd2zu(k)
-          ENDDO
-!
-!--       Compute gradients at downward-facing walls, only for 
-!--       non-natural 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
-
-          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_0(k,j,i), 0 ) ) 
-
-             tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def * flag
-
-          ENDDO
-
-       ELSE
-!
-!--       Calculate TKE production by shear. Here, no additional
-!--       wall-bounded code is considered. 
-!--       Why?
-          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)
-
-             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_0(k,j,i), 29 ) ) 
-             tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def * flag
-
-          ENDDO
-
-       ENDIF
-
-!
-!--    If required, calculate TKE production by buoyancy
-       IF ( .NOT. neutral )  THEN
-
-          IF ( .NOT. humidity )  THEN
-
-             IF ( ocean )  THEN
-!
-!--             So far in the ocean no special treatment of density flux in
-!--             the bottom and top surface layer
-                DO  k = nzb+1, nzt
- 
-                   tend(k,j,i) = tend(k,j,i) +                                 &
-                                 kh(k,j,i) * g /                               &
-                                 MERGE( rho_reference, prho(k,j,i),            &
-                                        use_single_reference_value ) *         &
-                                 ( prho(k+1,j,i) - prho(k-1,j,i) ) *           &
-                                 dd2zu(k) *                                    &
-                                   MERGE( 1.0_wp, 0.0_wp,                      &
-                                          BTEST( wall_flags_0(k,j,i), 30 )     &
-                                        ) *                                    &
-                                   MERGE( 1.0_wp, 0.0_wp,                      &
-                                          BTEST( wall_flags_0(k,j,i), 9 )      &
-                                        )           
-                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)
-                         tend(k,j,i) = tend(k,j,i) + g /                       &
-                                   MERGE( rho_reference, prho(k,j,i),          &
-                                          use_single_reference_value ) *       &
-                                   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)
-                      tend(k,j,i) = tend(k,j,i) + g /                          &
-                                   MERGE( rho_reference, prho(k,j,i),          &
-                                          use_single_reference_value ) *       &
-                                   drho_air_zw(k) *                            &
-                                   surf_def_h(2)%shf(m) 
-                   ENDDO
-                ENDIF
-
-             ELSE
-
-                DO  k = nzb+1, nzt
-!
-!--                Flag 9 is used to mask top fluxes, flag 30 to mask
-!--                surface fluxes
-                   tend(k,j,i) = tend(k,j,i) -                                 &
-                                 kh(k,j,i) * g /                               &
-                                   MERGE( pt_reference, pt(k,j,i),             &
-                                          use_single_reference_value ) *       &
-                                 ( pt(k+1,j,i) - pt(k-1,j,i) ) * dd2zu(k) *    &
-                                   MERGE( 1.0_wp, 0.0_wp,                      &
-                                          BTEST( wall_flags_0(k,j,i), 30 )     &
-                                        ) *                                    &
-                                   MERGE( 1.0_wp, 0.0_wp,                      &
-                                          BTEST( wall_flags_0(k,j,i), 9 )      &
-                                        )
-
-                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)
-                         tend(k,j,i) = tend(k,j,i) + g /                       &
-                                   MERGE( pt_reference, pt(k,j,i),             &
-                                          use_single_reference_value ) *       &
-                                   drho_air_zw(k-1) *                          &
-                                   surf_def_h(l)%shf(m)
-                      ENDDO
-                   ENDDO
-!
-!--                Natural surfaces
-                   surf_s = surf_lsm_h%start_index(j,i)
-                   surf_e = surf_lsm_h%end_index(j,i)
-                   DO  m = surf_s, surf_e
-                      k = surf_lsm_h%k(m)
-                      tend(k,j,i) = tend(k,j,i) + g /                          &
-                                   MERGE( pt_reference, pt(k,j,i),             &
-                                          use_single_reference_value ) *       &
-                                   drho_air_zw(k-1) *                          &
-                                   surf_lsm_h%shf(m) 
-                   ENDDO
-!
-!--                Urban surfaces
-                   surf_s = surf_usm_h%start_index(j,i)
-                   surf_e = surf_usm_h%end_index(j,i)
-                   DO  m = surf_s, surf_e
-                      k = surf_usm_h%k(m)
-                      tend(k,j,i) = tend(k,j,i) + g /                          &
-                                   MERGE( pt_reference, pt(k,j,i),             &
-                                          use_single_reference_value ) *       &
-                                   drho_air_zw(k-1) *                          &
-                                   surf_usm_h%shf(m) 
-                   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)
-                      tend(k,j,i) = tend(k,j,i) + g /                          &
-                                   MERGE( pt_reference, pt(k,j,i),             &
-                                          use_single_reference_value ) *       &
-                                   drho_air_zw(k) *                            &
-                                   surf_def_h(2)%shf(m) 
-                   ENDDO
-                ENDIF
-
-             ENDIF
-
-          ELSE
-
-             DO  k = nzb+1, nzt
-!
-!--             Flag 9 is used to mask top fluxes, flag 30 to mask surface fluxes
-                IF ( .NOT. cloud_physics .AND. .NOT. cloud_droplets )  THEN
-                   k1 = 1.0_wp + 0.61_wp * q(k,j,i)
-                   k2 = 0.61_wp * pt(k,j,i)
-                   tend(k,j,i) = tend(k,j,i) - kh(k,j,i) * g /                 &
-                                   MERGE( vpt_reference, vpt(k,j,i),           &
-                                          use_single_reference_value ) *       &
-                                         ( k1 * ( pt(k+1,j,i)-pt(k-1,j,i) ) +  &
-                                           k2 * ( q(k+1,j,i) - q(k-1,j,i) )    &
-                                         ) * dd2zu(k) *                        &
-                                      MERGE( 1.0_wp, 0.0_wp,                   &
-                                             BTEST( wall_flags_0(k,j,i), 30 )  &
-                                           )          *                        &
-                                      MERGE( 1.0_wp, 0.0_wp,                   &
-                                             BTEST( wall_flags_0(k,j,i), 9 )   &
-                                           )
-
-                ELSE IF ( cloud_physics )  THEN
-                   IF ( ql(k,j,i) == 0.0_wp )  THEN
-                      k1 = 1.0_wp + 0.61_wp * q(k,j,i)
-                      k2 = 0.61_wp * pt(k,j,i)
-                   ELSE
-                      theta = pt(k,j,i) + pt_d_t(k) * l_d_cp * ql(k,j,i)
-                      temp  = theta * t_d_pt(k)
-                      k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp *                     &
-                                    ( q(k,j,i) - ql(k,j,i) ) *                 &
-                           ( 1.0_wp + 0.622_wp * l_d_r / temp ) ) /            &
-                           ( 1.0_wp + 0.622_wp * l_d_r * l_d_cp *              &
-                           ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
-                      k2 = theta * ( l_d_cp / temp * k1 - 1.0_wp )
-                   ENDIF
-                   tend(k,j,i) = tend(k,j,i) - kh(k,j,i) * g /                 &
-                                   MERGE( vpt_reference, vpt(k,j,i),           &
-                                          use_single_reference_value ) *       &
-                                         ( k1 * ( pt(k+1,j,i)-pt(k-1,j,i) ) +  &
-                                           k2 * ( q(k+1,j,i) - q(k-1,j,i) )    &
-                                         ) * dd2zu(k) *                        &
-                                      MERGE( 1.0_wp, 0.0_wp,                   &
-                                             BTEST( wall_flags_0(k,j,i), 30 )  &
-                                           )          *                        &
-                                      MERGE( 1.0_wp, 0.0_wp,                   &
-                                             BTEST( wall_flags_0(k,j,i), 9 )   &
-                                           )
-                ELSE IF ( cloud_droplets )  THEN
-                   k1 = 1.0_wp + 0.61_wp * q(k,j,i) - ql(k,j,i)
-                   k2 = 0.61_wp * pt(k,j,i)
-                   tend(k,j,i) = tend(k,j,i) - kh(k,j,i) * g /                 &
-                                   MERGE( vpt_reference, vpt(k,j,i),           &
-                                          use_single_reference_value ) *       &
-                                     ( 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)&
-                                    * MERGE( 1.0_wp, 0.0_wp,                   &
-                                             BTEST( wall_flags_0(k,j,i), 30 )  &
-                                           )                                   &
-                                    * MERGE( 1.0_wp, 0.0_wp,                   &
-                                             BTEST( wall_flags_0(k,j,i), 9 )   &
-                                           )    
-                ENDIF
-             ENDDO
-
-             IF ( use_surface_fluxes )  THEN
-!
-!--             Treat horizontal 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)
-
-                      IF ( .NOT. cloud_physics .AND. .NOT. cloud_droplets ) THEN
-                         k1 = 1.0_wp + 0.61_wp * q(k,j,i)
-                         k2 = 0.61_wp * pt(k,j,i)
-                      ELSE IF ( cloud_physics )  THEN
-                         IF ( ql(k,j,i) == 0.0_wp )  THEN
-                            k1 = 1.0_wp + 0.61_wp * q(k,j,i)
-                            k2 = 0.61_wp * pt(k,j,i)
-                         ELSE
-                           theta = pt(k,j,i) + pt_d_t(k) * l_d_cp * ql(k,j,i)
-                           temp  = theta * t_d_pt(k)
-                           k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp *                &
-                                      ( q(k,j,i) - ql(k,j,i) ) *               &
-                             ( 1.0_wp + 0.622_wp * l_d_r / temp ) ) /          &
-                             ( 1.0_wp + 0.622_wp * l_d_r * l_d_cp *            & 
-                             ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
-                           k2 = theta * ( l_d_cp / temp * k1 - 1.0_wp )
-                         ENDIF
-                      ELSE IF ( cloud_droplets )  THEN
-                         k1 = 1.0_wp + 0.61_wp * q(k,j,i) - ql(k,j,i)
-                         k2 = 0.61_wp * pt(k,j,i)
-                      ENDIF
-
-                      tend(k,j,i) = tend(k,j,i) + g /                          &
-                                   MERGE( vpt_reference, vpt(k,j,i),           &
-                                          use_single_reference_value ) *       &
-                                         ( 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
-                surf_s = surf_lsm_h%start_index(j,i)
-                surf_e = surf_lsm_h%end_index(j,i)
-                DO  m = surf_s, surf_e
-                   k = surf_lsm_h%k(m)
-
-                   IF ( .NOT. cloud_physics .AND. .NOT. cloud_droplets ) THEN
-                       k1 = 1.0_wp + 0.61_wp * q(k,j,i)
-                       k2 = 0.61_wp * pt(k,j,i)
-                   ELSE IF ( cloud_physics )  THEN
-                       IF ( ql(k,j,i) == 0.0_wp )  THEN
-                          k1 = 1.0_wp + 0.61_wp * q(k,j,i)
-                          k2 = 0.61_wp * pt(k,j,i)
-                       ELSE
-                          theta = pt(k,j,i) + pt_d_t(k) * l_d_cp * ql(k,j,i)
-                          temp  = theta * t_d_pt(k)
-                          k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp *                 &
-                                        ( q(k,j,i) - ql(k,j,i) ) *             &
-                               ( 1.0_wp + 0.622_wp * l_d_r / temp ) ) /        &
-                               ( 1.0_wp + 0.622_wp * l_d_r * l_d_cp *          &
-                               ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
-                          k2 = theta * ( l_d_cp / temp * k1 - 1.0_wp )
-                      ENDIF
-                   ELSE IF ( cloud_droplets )  THEN
-                      k1 = 1.0_wp + 0.61_wp * q(k,j,i) - ql(k,j,i)
-                      k2 = 0.61_wp * pt(k,j,i)
-                   ENDIF
-
-                   tend(k,j,i) = tend(k,j,i) + g /                             &
-                                   MERGE( vpt_reference, vpt(k,j,i),           &
-                                          use_single_reference_value ) *       &
-                                            ( k1 * surf_lsm_h%shf(m) +         &
-                                              k2 * surf_lsm_h%qsws(m)          &
-                                            ) * drho_air_zw(k-1)
-                ENDDO
-!
-!--             Treat horizontal urban surfaces
-                surf_s = surf_usm_h%start_index(j,i)
-                surf_e = surf_usm_h%end_index(j,i)
-                DO  m = surf_s, surf_e
-                   k = surf_usm_h%k(m)
-
-                   IF ( .NOT. cloud_physics .AND. .NOT. cloud_droplets ) THEN
-                       k1 = 1.0_wp + 0.61_wp * q(k,j,i)
-                       k2 = 0.61_wp * pt(k,j,i)
-                   ELSE IF ( cloud_physics )  THEN
-                       IF ( ql(k,j,i) == 0.0_wp )  THEN
-                          k1 = 1.0_wp + 0.61_wp * q(k,j,i)
-                          k2 = 0.61_wp * pt(k,j,i)
-                       ELSE
-                          theta = pt(k,j,i) + pt_d_t(k) * l_d_cp * ql(k,j,i)
-                          temp  = theta * t_d_pt(k)
-                          k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp *                 &
-                                        ( q(k,j,i) - ql(k,j,i) ) *             &
-                               ( 1.0_wp + 0.622_wp * l_d_r / temp ) ) /        &
-                               ( 1.0_wp + 0.622_wp * l_d_r * l_d_cp *          &
-                               ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
-                          k2 = theta * ( l_d_cp / temp * k1 - 1.0_wp )
-                      ENDIF
-                   ELSE IF ( cloud_droplets )  THEN
-                      k1 = 1.0_wp + 0.61_wp * q(k,j,i) - ql(k,j,i)
-                      k2 = 0.61_wp * pt(k,j,i)
-                   ENDIF
-
-                   tend(k,j,i) = tend(k,j,i) + g /                             &
-                                   MERGE( vpt_reference, vpt(k,j,i),           &
-                                          use_single_reference_value ) *       &
-                                            ( k1 * surf_usm_h%shf(m) +         &
-                                              k2 * surf_usm_h%qsws(m)          &
-                                            ) * drho_air_zw(k-1)
-                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)
-
-
-
-                   IF ( .NOT. cloud_physics .AND. .NOT. cloud_droplets )  THEN
-                      k1 = 1.0_wp + 0.61_wp * q(k,j,i)
-                      k2 = 0.61_wp * pt(k,j,i)
-                   ELSE IF ( cloud_physics )  THEN
-                      IF ( ql(k,j,i) == 0.0_wp )  THEN
-                         k1 = 1.0_wp + 0.61_wp * q(k,j,i)
-                         k2 = 0.61_wp * pt(k,j,i)
-                      ELSE
-                         theta = pt(k,j,i) + pt_d_t(k) * l_d_cp * ql(k,j,i)
-                         temp  = theta * t_d_pt(k)
-                         k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp *                  &
-                                    ( q(k,j,i) - ql(k,j,i) ) *                 &
-                           ( 1.0_wp + 0.622_wp * l_d_r / temp ) ) /            &
-                           ( 1.0_wp + 0.622_wp * l_d_r * l_d_cp *              &
-                           ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
-                         k2 = theta * ( l_d_cp / temp * k1 - 1.0_wp )
-                      ENDIF
-                   ELSE IF ( cloud_droplets )  THEN
-                      k1 = 1.0_wp + 0.61_wp * q(k,j,i) - ql(k,j,i)
-                      k2 = 0.61_wp * pt(k,j,i)
-                   ENDIF
-
-                   tend(k,j,i) = tend(k,j,i) + g /                             &
-                                   MERGE( vpt_reference, vpt(k,j,i),           &
-                                          use_single_reference_value ) *       &
-                               ( k1* surf_def_h(2)%shf(m) +                    &
-                                 k2 * surf_def_h(2)%qsws(m)                    &
-                               ) * drho_air_zw(k)
-                ENDDO
-
-             ENDIF
-
-          ENDIF
-
-       ENDIF
-
-    END SUBROUTINE production_e_ij
-
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> @todo Missing subroutine description.
-!------------------------------------------------------------------------------!
-    SUBROUTINE production_e_init
-
-       USE arrays_3d,                                                          &
-           ONLY:  kh, km, drho_air_zw, u, v, zu
-
-       USE control_parameters,                                                 &
-           ONLY:  constant_flux_layer, kappa
-
-       USE indices,                                                            &
-           ONLY:  nxl, nxlg, nxr, nxrg, nys, nysg, nyn, nyng, nzb_u_inner,     &
-                  nzb_v_inner
-
-       USE surface_mod,                                                        &
-           ONLY :  surf_def_h, surf_def_v, surf_lsm_h, surf_usm_h 
-
-       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 surface type (up- or downward-facing)
-       INTEGER(iwp) ::  m   !< running index surface elements
-
-       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.
-!--       WARNING: the exact analytical solution would require the determination
-!--                of the eddy diffusivity by km = u* * kappa * zp / phi_m.
-!--       Default surfaces, upward-facing
-          !$OMP PARALLEL DO PRIVATE(i,j,k,m)
-          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, calculatione 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(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(k,j,i)  + 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(k,j,i)  + 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)
-          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)
-
-             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-facing
-          !$OMP PARALLEL DO PRIVATE(i,j,k,m)
-          DO  m = 1, surf_lsm_h%ns
-
-             i = surf_lsm_h%i(m)            
-             j = surf_lsm_h%j(m)
-             k = surf_lsm_h%k(m)
-!
-!--          Note, calculatione 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%u_0(m) = u(k+1,j,i) + surf_lsm_h%usws(m)      *        &
-                                           drho_air_zw(k-1) *                  &
-                                           ( zu(k+1)   - zu(k-1)    )  /       &
-                                           ( km(k,j,i) + 1.0E-20_wp )  
-             surf_lsm_h%v_0(m) = v(k+1,j,i) + surf_lsm_h%vsws(m)      *        &
-                                           drho_air_zw(k-1) *                  &
-                                           ( zu(k+1)   - zu(k-1)    )  /       &
-                                           ( km(k,j,i) + 1.0E-20_wp )
-
-             IF ( ABS( u(k+1,j,i) - surf_lsm_h%u_0(m) )  >                     &
-                  ABS( u(k+1,j,i) - u(k-1,j,i)   )                             &
-                )  surf_lsm_h%u_0(m) = u(k-1,j,i)
-
-             IF ( ABS( v(k+1,j,i) - surf_lsm_h%v_0(m) )  >                     &
-                  ABS( v(k+1,j,i) - v(k-1,j,i)   )                             &
-                )  surf_lsm_h%v_0(m) = v(k-1,j,i)
-
-          ENDDO
-!
-!--       Urban surfaces, upward-facing
-          !$OMP PARALLEL DO PRIVATE(i,j,k,m)
-          DO  m = 1, surf_usm_h%ns
-
-             i = surf_usm_h%i(m)            
-             j = surf_usm_h%j(m)
-             k = surf_usm_h%k(m)
-!
-!--          Note, calculatione 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%u_0(m) = u(k+1,j,i) + surf_usm_h%usws(m)      *        &
-                                           drho_air_zw(k-1) *                  &
-                                           ( zu(k+1)   - zu(k-1)    )  /       &
-                                           ( km(k,j,i) + 1.0E-20_wp )  
-             surf_usm_h%v_0(m) = v(k+1,j,i) + surf_usm_h%vsws(m)      *        &
-                                           drho_air_zw(k-1) *                  &
-                                           ( zu(k+1)   - zu(k-1)    )  /       &
-                                           ( km(k,j,i) + 1.0E-20_wp )
-
-             IF ( ABS( u(k+1,j,i) - surf_usm_h%u_0(m) )  >                     &
-                  ABS( u(k+1,j,i) - u(k-1,j,i)   )                             &
-                )  surf_usm_h%u_0(m) = u(k-1,j,i)
-
-             IF ( ABS( v(k+1,j,i) - surf_usm_h%v_0(m) )  >                     &
-                  ABS( v(k+1,j,i) - v(k-1,j,i)   )                             &
-                )  surf_usm_h%v_0(m) = v(k-1,j,i)
-
-          ENDDO
-
-       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 2689)
+++ palm/trunk/SOURCE/prognostic_equations.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file prognostic_equations.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
@@ -25,4 +25,9 @@
 ! -----------------
 ! $Id$
+! - Moved TKE equation to tcm_prognostic (TG)
+! - Added switch for chemical reactions (RF, FK)
+! - Implementation of chemistry module (RF, BK, FK)
+! 
+! 2563 2017-10-19 15:36:10Z Giersch
 ! Variable wind_turbine moved to module control_parameters
 ! 
@@ -107,5 +112,5 @@
 ! 1484 2014-10-21 10:53:05Z kanani
 ! Changes due to new module structure of the plant canopy model:
-!   parameters cthf and plant_canopy moved to module plant_canopy_model_mod.
+! parameters cthf and plant_canopy moved to module plant_canopy_model_mod.
 ! Removed double-listing of use_upstream_for_tke in ONLY-list of module
 ! control_parameters
@@ -251,8 +256,21 @@
                w, w_p
 
+#if defined( __chem )
+    USE chemistry_model_mod,                                                   &
+        ONLY:  chem_integrate, chem_species,                                   &
+               chem_tendency, nspec, nvar, spc_names
+           
+    USE chem_photolysis_mod,                                                   &
+        ONLY:  photolysis_control
+
+    USE chem_modules,                                                          &
+        ONLY:  call_chem_at_all_substeps, chem_gasphase_on
+#endif
+
     USE control_parameters,                                                    &
-        ONLY:  call_microphysics_at_all_substeps, cloud_physics,               &
-               cloud_top_radiation, constant_diffusion, dp_external,           &
-               dp_level_ind_b, dp_smooth_factor, dpdxy, dt_3d, humidity,       &
+        ONLY:  air_chemistry, call_microphysics_at_all_substeps,               &
+               cloud_physics, cloud_top_radiation, constant_diffusion,         &
+               dp_external, dp_level_ind_b, dp_smooth_factor, dpdxy, dt_3d,    &
+               humidity,                                                       &
                inflow_l, intermediate_timestep_count,                          &
                intermediate_timestep_count_max, large_scale_forcing,           &
@@ -267,5 +285,6 @@
 
     USE cpulog,                                                                &
-        ONLY:  cpu_log, log_point
+        ONLY:  cpu_log, log_point, log_point_s
+
 
     USE eqn_state_seawater_mod,                                                &
@@ -273,6 +292,6 @@
 
     USE indices,                                                               &
-        ONLY:  nxl, nxlg, nxlu, nxr, nxrg, nyn, nyng, nys, nysg, nysv, nzb,    &
-               nzt, wall_flags_0
+        ONLY:  nbgp, nxl, nxlg, nxlu, nxr, nxrg, nyn, nyng, nys, nysg, nysv,   &
+               nzb, nzt, wall_flags_0
 
     USE advec_ws,                                                              &
@@ -315,7 +334,4 @@
         ONLY:  coriolis
 
-    USE diffusion_e_mod,                                                       &
-        ONLY:  diffusion_e
-
     USE diffusion_s_mod,                                                       &
         ONLY:  diffusion_s
@@ -340,7 +356,4 @@
     USE plant_canopy_model_mod,                                                &
         ONLY:  cthf, plant_canopy, pcm_tendency
-
-    USE production_e_mod,                                                      &
-        ONLY:  production_e
 
     USE radiation_model_mod,                                                   &
@@ -353,4 +366,7 @@
     USE subsidence_mod,                                                        &
         ONLY:  subsidence
+
+    USE turbulence_closure_mod,                                                &
+        ONLY:  tcm_prognostic
 
     USE user_actions_mod,                                                      &
@@ -406,4 +422,5 @@
 
     LOGICAL      ::  loop_start          !<
+    INTEGER      ::  n, lsp              !< lsp running index for chem spcs
 
 
@@ -411,4 +428,44 @@
 !-- Time measurement can only be performed for the whole set of equations
     CALL cpu_log( log_point(32), 'all progn.equations', 'start' )
+
+!
+!-- Calculation of chemical reactions. This is done outside of main loop,
+!-- since exchange of ghost points is required after this update of the
+!-- concentrations of chemical species                                    
+#if defined( __chem )
+    IF ( air_chemistry )  THEN
+!
+!--    If required, calculate photolysis frequencies - 
+!--    UNFINISHED: Why not before the intermediate timestep loop?
+       IF ( intermediate_timestep_count ==  1 )  THEN
+          CALL photolysis_control
+       ENDIF
+!
+!--    Chemical reactions
+       CALL cpu_log( log_point(82), '(chem react + exch_h)', 'start' )
+  
+       IF ( chem_gasphase_on ) THEN
+          DO  i = nxl, nxr
+             DO  j = nys, nyn
+
+                IF ( intermediate_timestep_count == 1 .OR.                        &
+                     call_chem_at_all_substeps ) THEN
+                   CALL chem_integrate (i,j)                                                
+                ENDIF
+             ENDDO
+          ENDDO
+       ENDIF
+!
+!--    Loop over chemical species       
+       CALL cpu_log( log_point_s(84), 'chemistry exch-horiz ', 'start' )
+       DO  n = 1, nspec
+          CALL exchange_horiz( chem_species(n)%conc, nbgp )     
+       ENDDO
+       CALL cpu_log( log_point_s(84), 'chemistry exch-horiz ', 'stop' )
+     
+       CALL cpu_log( log_point(82), '(chem react + exch_h)', 'stop' )
+
+    ENDIF       
+#endif     
 
 !
@@ -1225,72 +1282,29 @@
           ENDIF
 !
-!--       If required, compute prognostic equation for turbulent kinetic
-!--       energy (TKE)
-          IF ( .NOT. constant_diffusion )  THEN
-
-!
-!--          Tendency-terms for TKE
-             tend(:,j,i) = 0.0_wp
-             IF ( timestep_scheme(1:5) == 'runge'  &
-                 .AND.  .NOT. use_upstream_for_tke )  THEN
-                 IF ( ws_scheme_sca )  THEN
-                     CALL advec_s_ws( i, j, e, 'e', flux_s_e, diss_s_e, &
-                                      flux_l_e, diss_l_e , i_omp_start, tn )
-                 ELSE
-                     CALL advec_s_pw( i, j, e )
-                 ENDIF
-             ELSE
-                CALL advec_s_up( i, j, e )
-             ENDIF
-             IF ( .NOT. humidity )  THEN
-                IF ( ocean )  THEN
-                   CALL diffusion_e( i, j, prho, prho_reference )
-                ELSE
-                   CALL diffusion_e( i, j, pt, pt_reference )
-                ENDIF
-             ELSE
-                CALL diffusion_e( i, j, vpt, pt_reference )
-             ENDIF
-             CALL production_e( i, j )
-
-!
-!--          Additional sink term for flows through plant canopies
-             IF ( plant_canopy )  CALL pcm_tendency( i, j, 6 )
-
-             CALL user_actions( i, j, 'e-tendency' )
-
-!
-!--          Prognostic equation for TKE.
-!--          Eliminate negative TKE values, which can occur due to numerical
-!--          reasons in the course of the integration. In such cases the old
-!--          TKE value is reduced by 90%.
-             DO  k = nzb+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_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
+!--       Calculate prognostic equations for turbulence closure
+          CALL tcm_prognostic( i, j, i_omp_start, tn )
+
+!
+!--       If required, compute prognostic equation for chemical quantites
+#if defined( __chem )
+          IF ( air_chemistry )  THEN
+             CALL cpu_log( log_point(83), '(chem advec+diff+prog)', 'start' )
+!
+!--          Loop over chemical species
+             DO  lsp = 1,nvar                         
+                CALL chem_tendency ( chem_species(lsp)%conc_p,                 &
+                                     chem_species(lsp)%conc,                   &
+                                     chem_species(lsp)%tconc_m,                &
+                                     chem_species(lsp)%conc_pr_init,           &
+                                     i, j, i_omp_start, tn, lsp,               &
+                                     chem_species(lsp)%flux_s_cs,              &
+                                     chem_species(lsp)%diss_s_cs,              &
+                                     chem_species(lsp)%flux_l_cs,              &
+                                     chem_species(lsp)%diss_l_cs )       
+             ENDDO
+
+             CALL cpu_log( log_point(83), '(chem advec+diff+prog)', 'stop' )             
+          ENDIF   ! Chemicals equations                     
+#endif
 
        ENDDO
@@ -2411,109 +2425,7 @@
 
     ENDIF
-!
-!-- If required, compute prognostic equation for turbulent kinetic
-!-- energy (TKE)
-    IF ( .NOT. constant_diffusion )  THEN
-
-       CALL cpu_log( log_point(16), 'tke-equation', 'start' )
-
-       sbt = tsc(2)
-       IF ( .NOT. use_upstream_for_tke )  THEN
-          IF ( scalar_advec == 'bc-scheme' )  THEN
-
-             IF ( timestep_scheme(1:5) /= 'runge' )  THEN
-!
-!--             Bott-Chlond scheme always uses Euler time step. Thus:
-                sbt = 1.0_wp
-             ENDIF
-             tend = 0.0_wp
-             CALL advec_s_bc( e, 'e' )
-
-          ENDIF
-       ENDIF
-
-!
-!--    TKE-tendency terms with no communication
-       IF ( scalar_advec /= 'bc-scheme'  .OR.  use_upstream_for_tke )  THEN
-          IF ( use_upstream_for_tke )  THEN
-             tend = 0.0_wp
-             CALL advec_s_up( e )
-          ELSE
-             tend = 0.0_wp
-             IF ( timestep_scheme(1:5) == 'runge' )  THEN
-                IF ( ws_scheme_sca )  THEN
-                   CALL advec_s_ws( e, 'e' )
-                ELSE
-                   CALL advec_s_pw( e )
-                ENDIF
-             ELSE
-                CALL advec_s_up( e )
-             ENDIF
-          ENDIF
-       ENDIF
-
-       IF ( .NOT. humidity )  THEN
-          IF ( ocean )  THEN
-             CALL diffusion_e( prho, prho_reference )
-          ELSE
-             CALL diffusion_e( pt, pt_reference )
-          ENDIF
-       ELSE
-          CALL diffusion_e( vpt, pt_reference )
-       ENDIF
-
-       CALL production_e
-
-!
-!--    Additional sink term for flows through plant canopies
-       IF ( plant_canopy )  CALL pcm_tendency( 6 )
-       CALL user_actions( 'e-tendency' )
-
-!
-!--    Prognostic equation for TKE.
-!--    Eliminate negative TKE values, which can occur due to numerical
-!--    reasons in the course of the integration. In such cases the old TKE
-!--    value is reduced by 90%.
-       DO  i = nxl, nxr
-          DO  j = nys, nyn
-             DO  k = nzb+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_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
-             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
-             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(16), 'tke-equation', 'stop' )
-
-    ENDIF
+
+    CALL tcm_prognostic()
+
 
  END SUBROUTINE prognostic_equations_vector
Index: palm/trunk/SOURCE/progress_bar_mod.f90
===================================================================
--- palm/trunk/SOURCE/progress_bar_mod.f90	(revision 2689)
+++ palm/trunk/SOURCE/progress_bar_mod.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file progress_bar_mod.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/radiation_model_mod.f90
===================================================================
--- palm/trunk/SOURCE/radiation_model_mod.f90	(revision 2689)
+++ palm/trunk/SOURCE/radiation_model_mod.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file radiation_model_mod.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
@@ -25,4 +25,14 @@
 ! -----------------
 ! $Id$
+! - Improved reading/writing of SVF from/to file (BM)
+! - Bugfixes concerning RRTMG as well as average_radiation options (M. Salim)
+! - Revised initialization of surface albedo and some minor bugfixes (MS)
+! - Update net radiation after running radiation interaction routine (MS)
+! - Revisions from M Salim included
+! - Adjustment to topography and surface structure (MS)
+! - Initialization of albedo and surface emissivity via input file (MS)
+! - albedo_pars extended (MS)
+! 
+! 2604 2017-11-06 13:29:00Z schwenkel
 ! bugfix for calculation of effective radius using morrison microphysics
 ! 
@@ -179,4 +189,5 @@
 !> @todo Output of other rrtm arrays (such as volume mixing ratios)
 !> @todo Adapt for use with topography
+!> @todo Optimize radiation_tendency routines
 !>
 !> @note Many variables have a leading dummy dimension (0:0) in order to
@@ -188,6 +199,9 @@
         ONLY:  dzw, hyp, nc, pt, q, ql, zu, zw
 
+    USE calc_mean_profile_mod,                                                 &
+        ONLY:  calc_mean_profile
+
     USE cloud_parameters,                                                      &
-        ONLY:  cp, l_d_cp, rho_l
+        ONLY:  cp, l_d_cp, r_d, rho_l
 
     USE constants,                                                             &
@@ -195,8 +209,15 @@
 
     USE control_parameters,                                                    &
-        ONLY:  cloud_droplets, cloud_physics, g, initializing_actions,         &
+        ONLY:  cloud_droplets, cloud_physics, coupling_char, dz, g,            &
+               initializing_actions, io_blocks, io_group,                      &
                latitude, longitude, large_scale_forcing, lsf_surf,             &
-               microphysics_morrison, pt_surface, rho_surface,                 &
-               surface_pressure, time_since_reference_point
+               message_string, microphysics_morrison, pt_surface,              &
+               rho_surface, surface_pressure, time_since_reference_point
+
+    USE cpulog,                                                                &
+        ONLY:  cpu_log, log_point, log_point_s
+
+    USE grid_variables,                                                        &
+         ONLY:  ddx, ddy, dx, dy 
 
     USE date_and_time_mod,                                                     &
@@ -205,5 +226,8 @@
 
     USE indices,                                                               &
-        ONLY:  nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg, nzb, nzt
+        ONLY:  nnx, nny, nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg,   &
+               nzb, nzt
+
+    USE, INTRINSIC :: iso_c_binding
 
     USE kinds
@@ -216,4 +240,13 @@
 #endif
 
+    USE netcdf_data_input_mod,                                                 &
+        ONLY:  albedo_type_f, albedo_pars_f, building_type_f, pavement_type_f, &
+               vegetation_type_f, water_type_f
+
+    USE plant_canopy_model_mod,                                                &
+        ONLY:  plant_canopy, pc_heating_rate, lad_s, usm_lad_rma
+
+    USE pegrid
+
 #if defined ( __rrtmg )
     USE parrrsw,                                                               &
@@ -235,6 +268,10 @@
         ONLY:  rrtmg_sw
 #endif
+    USE statistics,                                                            &
+        ONLY:  hom
+
     USE surface_mod,                                                           &
-        ONLY:  get_topography_top_index
+        ONLY:  get_topography_top_index, surf_def_h, surf_def_v, surf_lsm_h,   &
+               surf_lsm_v, surf_type, surf_usm_h, surf_usm_v
 
     IMPLICIT NONE
@@ -281,5 +318,4 @@
                                                          /)
 
-
     INTEGER(iwp) :: albedo_type  = 9999999, & !< Albedo surface type
                     dots_rad     = 0          !< starting index for timeseries output 
@@ -291,6 +327,12 @@
                 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 indicing whether shortwave radiation shall be calculated
-                sun_direction = .FALSE.                 !< flag parameter indicing whether solar direction shall be calculated
+                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 = .TRUE.,           & !< flag to set the calculation of radiation averaging for the domain
+                atm_surfaces = .FALSE.,               & !< flag parameter indicating wheather surfaces of atmospheric cells will be considered in calculating SVF
+                radiation_interactions = .TRUE.,      & !< flag to control if radiation interactions via sky-view factors shall be considered
+                surf_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
+                                                        !< will be considered. However fewer SVFs are expected.
 
 
@@ -320,11 +362,5 @@
                                  sun_dir_lon       !< solar directional vector in longitudes
 
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE :: &
-                alpha,                       & !< surface broadband albedo (used for clear-sky scheme)
-                emis,                        & !< surface broadband emissivity
-                rad_lw_out_change_0,         & !< change in LW out due to change in surface temperature
-                rad_net,                     & !< net radiation at the surface
-                rad_net_av                     !< average of rad_net
-
+    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  rad_net_av   !< average of rad_net
 !
 !-- Land surface albedos for solar zenith angle of 60Â° after Briegleb (1992)     
@@ -420,9 +456,5 @@
                                            t_snd          !< actual temperature from sounding data (hPa)
 
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE :: aldif,          & !< longwave diffuse albedo solar angle of 60Â°
-                                             aldir,          & !< longwave direct albedo solar angle of 60Â°
-                                             asdif,          & !< shortwave diffuse albedo solar angle of 60Â°
-                                             asdir,          & !< shortwave direct albedo solar angle of 60Â°
-                                             rrtm_ccl4vmr,   & !< CCL4 volume mixing ratio (g/mol)
+    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)
@@ -433,5 +465,5 @@
                                              rrtm_cliqwp,    & !< in-cloud liquid water path (g/mÂ²)
                                              rrtm_co2vmr,    & !< CO2 volume mixing ratio (g/mol)
-                                             rrtm_emis,      & !< surface emissivity (0-1)    
+                                             rrtm_emis,      & !< surface emissivity (0-1)  
                                              rrtm_h2ovmr,    & !< H2O volume mixing ratio
                                              rrtm_n2ovmr,    & !< N2O volume mixing ratio
@@ -459,4 +491,10 @@
                                              rrtm_swhrc        !< RRTM output of incoming shortwave clear sky radiation heating rate (K/d) 
 
+
+    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)
@@ -465,8 +503,4 @@
                                                 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_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
                                                 rrtm_lw_tauaer, & !< lw aerosol optical depth
                                                 rrtm_lw_taucld, & !< lw in-cloud optical depth
@@ -481,4 +515,199 @@
 
 #endif
+!
+!-- Parameters of urban and land surface models
+    INTEGER(iwp)                                   ::  nzu                                !< number of layers of urban surface (will be calculated)
+    INTEGER(iwp)                                   ::  nzub,nzut                          !< bottom and top layer of urban surface (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 = 2                          !< 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                        ::  nsurf_type = 21                    !< number of surf types incl. phys.(land+urban) & (atm.,sky,boundary) surfaces - 1
+
+    INTEGER(iwp), PARAMETER                        ::  iup_u    = 0                       !< 0 - index of urban ubward surface (ground or roof)
+    INTEGER(iwp), PARAMETER                        ::  idown_u  = 1                       !< 1 - index of urban downward surface (overhanging)
+    INTEGER(iwp), PARAMETER                        ::  inorth_u = 2                       !< 2 - index of urban northward facing wall
+    INTEGER(iwp), PARAMETER                        ::  isouth_u = 3                       !< 3 - index of urban southward facing wall
+    INTEGER(iwp), PARAMETER                        ::  ieast_u  = 4                       !< 4 - index of urban eastward facing wall
+    INTEGER(iwp), PARAMETER                        ::  iwest_u  = 5                       !< 5 - index of urban westward facing wall
+
+    INTEGER(iwp), PARAMETER                        ::  iup_l    = 6                       !< 6 - index of land ubward surface (ground or roof)
+    INTEGER(iwp), PARAMETER                        ::  inorth_l = 7                       !< 7 - index of land northward facing wall
+    INTEGER(iwp), PARAMETER                        ::  isouth_l = 8                       !< 8 - index of land southward facing wall
+    INTEGER(iwp), PARAMETER                        ::  ieast_l  = 9                       !< 9 - index of land eastward facing wall
+    INTEGER(iwp), PARAMETER                        ::  iwest_l  = 10                      !< 10- index of land westward facing wall
+
+    INTEGER(iwp), PARAMETER                        ::  iup_a    = 11                      !< 11- index of atm. cell ubward virtual surface
+    INTEGER(iwp), PARAMETER                        ::  idown_a  = 12                      !< 12- index of atm. cell downward virtual surface
+    INTEGER(iwp), PARAMETER                        ::  inorth_a = 13                      !< 13- index of atm. cell northward facing virtual surface
+    INTEGER(iwp), PARAMETER                        ::  isouth_a = 14                      !< 14- index of atm. cell southward facing virtual surface
+    INTEGER(iwp), PARAMETER                        ::  ieast_a  = 15                      !< 15- index of atm. cell eastward facing virtual surface
+    INTEGER(iwp), PARAMETER                        ::  iwest_a  = 16                      !< 16- index of atm. cell westward facing virtual surface
+
+    INTEGER(iwp), PARAMETER                        ::  isky     = 17                      !< 17 - index of top border of the urban surface layer ("urban sky")
+    INTEGER(iwp), PARAMETER                        ::  inorth_b = 18                      !< 18 - index of free north border of the domain (south facing)
+    INTEGER(iwp), PARAMETER                        ::  isouth_b = 19                      !< 19 - index of north south border of the domain (north facing)
+    INTEGER(iwp), PARAMETER                        ::  ieast_b  = 20                      !< 20 - index of east border of the domain (west facing)
+    INTEGER(iwp), PARAMETER                        ::  iwest_b  = 21                      !< 21 - index of wast border of the domain (east facing)
+
+    INTEGER(iwp), DIMENSION(0:nsurf_type), PARAMETER ::  idir = (/0, 0,0, 0,1,-1,0,0, 0,1,-1,0, 0,0, 0,1,-1, 0, 0,0,-1,1/)   !< surface normal direction x indices
+    INTEGER(iwp), DIMENSION(0:nsurf_type), PARAMETER ::  jdir = (/0, 0,1,-1,0, 0,0,1,-1,0, 0,0, 0,1,-1,0, 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,1,0, 0,0, 0,1,-1,0, 0,0, 0,-1, 0,0, 0,0/)   !< surface normal direction z indices
+                                                                                          !< parameter but set in the code
+
+
+!-- indices and sizes of urban and land surface models
+    INTEGER(iwp)                                   ::  nskys            !< number of sky surfaces in local processor
+    INTEGER(iwp)                                   ::  startland        !< start index of block of land and roof surfaces!-- block variables needed for calculation of the plant canopy model inside the urban surface model
+    INTEGER(iwp)                                   ::  endland          !< end index of block of land and roof surfaces    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE      ::  pct              !< top layer of the plant canopy
+    INTEGER(iwp)                                   ::  nlands           !< number of land and roof surfaces in local processor    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE      ::  pch              !< heights of the plant canopy
+    INTEGER(iwp)                                   ::  startwall        !< start index of block of wall surfaces    INTEGER(iwp)                                   ::  npcbl            !< number of the plant canopy gridboxes in local processor
+    INTEGER(iwp)                                   ::  endwall          !< end index of block of wall surfaces    INTEGER(wp), DIMENSION(:,:), ALLOCATABLE       ::  pcbl             !< k,j,i coordinates of l-th local plant canopy box pcbl[:,l] = [k, j,
+    INTEGER(iwp)                                   ::  nwalls           !< number of wall surfaces in local processor    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  pcbinsw          !< array of absorbed sw radiation for local plant canopy box
+    INTEGER(iwp)                                   ::  nborder          !< number of border surfaces in local processor    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  pcbinlw          !< array of absorbed lw radiation for local plant canopy box
+
+
+!-- indices and sizes of urban and land surface models
+    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE      ::  surfl            !< coordinates of i-th local surface in local grid - surfl[:,k] = [d, z, y, x]
+    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE      ::  surf             !< coordinates of i-th surface in grid - surf[:,k] = [d, z, y, x]
+    INTEGER(iwp)                                   ::  nsurfl           !< number of all surfaces in local processor
+    INTEGER(iwp), DIMENSION(:), ALLOCATABLE        ::  nsurfs           !< array of number of all surfaces in individual processors
+    INTEGER(iwp)                                   ::  startsky         !< start index of block of sky
+    INTEGER(iwp)                                   ::  endsky           !< end index of block of sky
+    INTEGER(iwp)                                   ::  startenergy      !< start index of block of real surfaces (land, walls and roofs)
+    INTEGER(iwp)                                   ::  endenergy        !< end index of block of real surfaces (land, walls and roofs)
+    INTEGER(iwp)                                   ::  nenergy          !< number of real surfaces in local processor
+    INTEGER(iwp)                                   ::  nsurf            !< global number of surfaces in index array of surfaces (nsurf = proc nsurfs)
+    INTEGER(iwp)                                   ::  startborder      !< start index of block of border
+    INTEGER(iwp)                                   ::  endborder        !< end index of block of border
+    INTEGER(iwp), DIMENSION(:), ALLOCATABLE        ::  surfstart        !< starts of blocks of surfaces for individual processors in array surf
+                                                                        !< respective block for particular processor is surfstart[iproc]+1 : surfstart[iproc+1]
+
+!-- block variables needed for calculation of the plant canopy model inside the urban surface model
+    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE      ::  pct              !< top layer of the plant canopy
+    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE      ::  pch              !< heights of the plant canopy
+    INTEGER(iwp)                                   ::  npcbl            !< number of the plant canopy gridboxes in local processor
+    INTEGER(wp), 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            ::  pcbinlw          !< array of absorbed lw radiation for local plant canopy box
+
+!-- configuration parameters (they can be setup in PALM config)
+    LOGICAL                                        ::  split_diffusion_radiation = .TRUE. !< split direct and diffusion dw radiation
+                                                                                          !< (.F. in case the radiation model already does it)    
+    LOGICAL                                        ::  energy_balance_surf_h = .TRUE.     !< flag parameter indicating wheather the energy balance is calculated for horizontal surfaces
+    LOGICAL                                        ::  energy_balance_surf_v = .TRUE.     !< flag parameter indicating wheather the energy balance is calculated for vertical surfaces
+    LOGICAL                                        ::  read_svf_on_init = .FALSE.         !< flag parameter indicating wheather SVFs will be read from a file at initialization
+    LOGICAL                                        ::  write_svf_on_init = .FALSE.        !< flag parameter indicating wheather SVFs will be written out to a file
+    LOGICAL                                        ::  mrt_factors = .FALSE.              !< whether to generate MRT factor files during init
+    INTEGER(iwp)                                   ::  nrefsteps = 0                      !< number of reflection steps to perform
+    REAL(wp), PARAMETER                            ::  ext_coef = 0.6_wp                  !< extinction coefficient (a.k.a. alpha)
+    INTEGER(iwp), PARAMETER                        ::  svf_code_len = 15                  !< length of code for verification of the end of svf file
+    CHARACTER(svf_code_len), PARAMETER             ::  svf_code = '*** end svf ***'       !< code for verification of the end of svf file
+    INTEGER(iwp), PARAMETER                        ::  usm_version_len = 10               !< length of identification string of usm version
+    CHARACTER(usm_version_len), PARAMETER          ::  usm_version = 'USM v. 1.0'         !< identification of version of binary svf and restart files
+
+!-- 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            !< 
+        REAL(wp)                                   :: rsvf              !< 
+        REAL(wp)                                   :: rtransp           !< 
+    END TYPE
+
+!-- arrays storing the values of USM
+    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE      ::  svfsurf          !< svfsurf[:,isvf] = index of source and target surface for svf[isvf]
+    REAL(wp), DIMENSION(:,:), ALLOCATABLE          ::  svf              !< array of shape view factors+direct irradiation factors for local surfaces
+    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
+    
+                                                                        !< Inward radiation is also valid for virtual surfaces (radiation leaving domain)
+    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            ::  surfoutsw        !< array of total sw radiation outgoing from nonvirtual surfaces surfaces after all reflection
+    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  surfoutlw        !< array of total lw radiation outgoing from nonvirtual surfaces surfaces after all reflection
+    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  surfhf           !< array of total radiation flux incoming to minus outgoing from local surface
+    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  rad_net_l        !< local copy of rad_net (net radiation at surface)
+
+!-- 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            ::  usm_lad          !< subset of lad_s within urban surface, transformed to plain Z coordinate
+    REAL(wp), DIMENSION(:), POINTER                ::  usm_lad_g        !< usm_lad globalized (used to avoid MPI RMA calls in raytracing)
+    INTEGER(iwp), DIMENSION(:), ALLOCATABLE        ::  nzterr, plantt   !< temporary global arrays for raytracing
+
+!-- arrays and variables for calculation of svf and csf
+    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(:), ALLOCATABLE, TARGET ::  asvf1, asvf2     !< realizations of svf array
+    TYPE(t_csf), DIMENSION(:), ALLOCATABLE, TARGET ::  acsf1, acsf2     !< realizations of csf array
+    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)                                   ::  msvf, mcsf       !< mod for swapping the growing array
+    INTEGER(iwp), PARAMETER                        ::  gasize = 10000   !< initial size of growing arrays
+    REAL(wp)                                       ::  dist_max_svf = -9999.0 !< maximum distance to calculate the minimum svf to be considered. It is
+                                                                        !< used to avoid very small SVFs resulting from too far surfaces with mutual visibility
+    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 usm_calc_svf and usm_raytrace
+    INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE    ::  gridpcbl         !< index of local pcb[k,j,i]
+
+!-- 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      ::  boxes            !< coordinates of gridboxes being crossed by ray
+    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  crlens           !< array of crossing lengths of ray for particular grid boxes
+    INTEGER(iwp), DIMENSION(:), ALLOCATABLE        ::  lad_ip           !< array of numbers of process where lad is stored 
+#if defined( __parallel )
+    INTEGER(kind=MPI_ADDRESS_KIND), &
+                  DIMENSION(:), ALLOCATABLE        ::  lad_disp         !< array of displaycements of lad in local array of proc lad_ip
+#endif
+    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  lad_s_ray        !< array of received lad_s for appropriate gridboxes crossed by ray 
+
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!-- 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
+
 
     INTERFACE radiation_check_data_output
@@ -555,4 +784,29 @@
     END INTERFACE radiation_last_actions
 
+    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_radflux_gridbox
+       MODULE PROCEDURE radiation_radflux_gridbox
+    END INTERFACE radiation_radflux_gridbox
+
+    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
 
@@ -567,17 +821,37 @@
            radiation_data_output_2d, radiation_data_output_3d,                 &
            radiation_define_netcdf_grid, radiation_last_actions,               &
-           radiation_read_restart_data, radiation_data_output_mask
+           radiation_read_restart_data, radiation_data_output_mask,            &
+           radiation_radflux_gridbox, radiation_calc_svf, radiation_write_svf, &
+           radiation_interaction, radiation_interaction_init,                  &
+           radiation_read_svf
+            
+
     
 !
 !-- Public variables and constants / NEEDS SORTING
-    PUBLIC albedo, albedo_type, decl_1, decl_2, decl_3, dots_rad, dt_radiation, emissivity, force_radiation_call,&
-           lat, lon, rad_net, rad_net_av, radiation, radiation_scheme, rad_lw_in,        &
-           rad_lw_in_av, rad_lw_out, rad_lw_out_av, rad_lw_out_change_0,       &
+    PUBLIC albedo, albedo_type, decl_1, decl_2, decl_3, dots_rad, dt_radiation,&
+           emissivity, force_radiation_call,                                   &
+           lat, lon, rad_net_av, radiation, radiation_scheme, 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, sigma_sb,                 &
-           skip_time_do_radiation, solar_constant, time_radiation,             &
-           unscheduled_radiation_calls, zenith, calc_zenith, sun_direction,    &
-           sun_dir_lat, sun_dir_lon
+           rad_sw_cs_hr_av, rad_sw_hr, rad_sw_hr_av, sigma_sb, solar_constant, &
+           skip_time_do_radiation, time_radiation, unscheduled_radiation_calls,&
+           zenith, calc_zenith, sun_direction, sun_dir_lat, sun_dir_lon,       &
+           split_diffusion_radiation,                                          &
+           energy_balance_surf_h, energy_balance_surf_v, write_svf_on_init,    &
+           read_svf_on_init, nrefsteps, mrt_factors, dist_max_svf, nsvfl, svf, &
+           svfsurf, surfinsw, surfinlw, surfins, surfinl, surfinswdir,         &
+           surfinswdif, surfoutsw, surfoutlw, surfinlwdif, rad_sw_in_dir,      &
+           rad_sw_in_diff, rad_lw_in_diff, surfouts, surfoutl, surfoutsl,      &
+           surfoutll, idir, jdir, kdir, id, iz, iy, ix, isky, nenergy, nsurfs, &
+           surfstart, surf, surfl, nsurfl, pcbinsw, pcbinlw, pcbl, npcbl,      &
+           startenergy, endenergy, iup_u, inorth_u, isouth_u, ieast_u, iwest_u,&
+           iup_l, inorth_l, isouth_l, ieast_l, iwest_l, startsky, endsky,      &
+           startborder, endborder, nsurf_type, nzub, nzut, inorth_b,idown_a,   &
+           isouth_b, ieast_b, iwest_b, nzu, pch, nsurf, iup_a, inorth_a,       &
+           isouth_a, ieast_a, iwest_a, idsvf, ndsvf, idcsf, ndcsf, kdcsf, pct, &
+           radiation_interactions, startwall, startland, endland, endwall
+
 
 
@@ -605,5 +879,5 @@
              CALL radiation_constant
           
-          CASE ( 'clear-sky' )
+          CASE ( 'clear-sky' ) 
              CALL radiation_clearsky
        
@@ -648,13 +922,4 @@
              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 "' // TRIM( var ) // '" requi' // &
-                                 'res radiation = .TRUE. and ' //              &
-                                 'radiation_scheme = "rrtmg"'
-                CALL message( 'check_parameters', 'PA0406', 1, 2, 0, 6, 0 )
-             ENDIF
-             unit = 'W/m2'   
 
           CASE ( 'rad_net*', 'rrtm_aldif*', 'rrtm_aldir*', 'rrtm_asdif*',      &
@@ -878,5 +1143,7 @@
        USE control_parameters,                                                 &
            ONLY: message_string, topography, urban_surface
-                 
+
+       USE netcdf_data_input_mod,                                              &
+           ONLY:  input_pids_static                 
     
        IMPLICIT NONE
@@ -904,35 +1171,37 @@
 
        ENDIF
-
-       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 )
+!
+!--    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
 
-       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 )
+!
+!--    Radiation interactions
+       IF ( urban_surface .AND.  .NOT. radiation_interactions )  THEN
+          message_string = 'radiation_interactions = .T. is required '//       &
+                           'when using the urban surface model'
+          CALL message( 'check_parameters', 'PA0999', 1, 2, 0, 6, 0 )
        ENDIF
 
-!
-!--    The following paramter check is temporarily extended by the urban_surface
-!--    flag, until a better solution comes up to omit this check in case of
-!--    urban surface model is used.
-       IF ( topography /= 'flat'  .AND.  .NOT.  urban_surface )  THEN
-          message_string = 'radiation scheme cannot be used ' //               & 
-                           'in combination with  topography /= "flat"'
-          CALL message( 'check_parameters', 'PA0414', 1, 2, 0, 6, 0 )
-       ENDIF
  
     END SUBROUTINE radiation_check_parameters 
@@ -948,29 +1217,224 @@
        IMPLICIT NONE
 
-!
-!--    Allocate array for storing emissivity
-       IF ( .NOT. ALLOCATED ( emis ) )  THEN
-          ALLOCATE ( emis(nysg:nyng,nxlg:nxrg) )
-          emis = emissivity
+       INTEGER(iwp) ::  i         !< running index x-direction 
+       INTEGER(iwp) ::  ind_type  !< index of natural land-surface type with respect to albedo array 
+       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) ::  l         !< running index for orientation of vertical surfaces 
+       INTEGER(iwp) ::  m         !< running index for surface elements  
+
+!
+!--    Allocate array for storing the surface net radiation
+       IF ( .NOT. ALLOCATED ( surf_def_h(0)%rad_net )  .AND.                   &
+                  surf_def_h(0)%ns > 0  )  THEN
+          ALLOCATE( surf_def_h(0)%rad_net(1:surf_def_h(0)%ns) )
+          surf_def_h(0)%rad_net = 0.0_wp 
        ENDIF
-
-!
-!--    Allocate array for storing the surface net radiation
-       IF ( .NOT. ALLOCATED ( rad_net ) )  THEN
-          ALLOCATE ( rad_net(nysg:nyng,nxlg:nxrg) )
-          rad_net = 0.0_wp
+       IF ( .NOT. ALLOCATED ( surf_lsm_h%rad_net )  .AND.                      &
+                  surf_lsm_h%ns > 0  )   THEN
+          ALLOCATE( surf_lsm_h%rad_net(1:surf_lsm_h%ns) )
+          surf_lsm_h%rad_net = 0.0_wp 
        ENDIF
-
-!
-!--    Allocate array for storing the surface net radiation
-       IF ( .NOT. ALLOCATED ( rad_lw_out_change_0 ) )  THEN
-          ALLOCATE ( rad_lw_out_change_0(nysg:nyng,nxlg:nxrg) )
-          rad_lw_out_change_0 = 0.0_wp
+       IF ( .NOT. ALLOCATED ( surf_usm_h%rad_net )  .AND.                      &
+                  surf_usm_h%ns > 0  )  THEN
+          ALLOCATE( surf_usm_h%rad_net(1:surf_usm_h%ns) )
+          surf_usm_h%rad_net = 0.0_wp 
        ENDIF
+       DO  l = 0, 3
+          IF ( .NOT. ALLOCATED ( surf_def_v(l)%rad_net )  .AND.                &
+                     surf_def_v(l)%ns > 0  )  THEN
+             ALLOCATE( surf_def_v(l)%rad_net(1:surf_def_v(l)%ns) )
+             surf_def_v(l)%rad_net = 0.0_wp 
+          ENDIF
+          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
+       IF ( .NOT. ALLOCATED ( surf_def_h(0)%rad_lw_out_change_0 )  .AND.       &
+                  surf_def_h(0)%ns > 0  )  THEN
+          ALLOCATE( surf_def_h(0)%rad_lw_out_change_0(1:surf_def_h(0)%ns) )
+          surf_def_h(0)%rad_lw_out_change_0 = 0.0_wp 
+       ENDIF
+       IF ( .NOT. ALLOCATED ( surf_lsm_h%rad_lw_out_change_0 )  .AND.          &
+                  surf_lsm_h%ns > 0  )   THEN
+          ALLOCATE( surf_lsm_h%rad_lw_out_change_0(1:surf_lsm_h%ns) )
+          surf_lsm_h%rad_lw_out_change_0 = 0.0_wp 
+       ENDIF
+       IF ( .NOT. ALLOCATED ( surf_usm_h%rad_lw_out_change_0 )  .AND.          &
+                  surf_usm_h%ns > 0  )  THEN
+          ALLOCATE( surf_usm_h%rad_lw_out_change_0(1:surf_usm_h%ns) )
+          surf_usm_h%rad_lw_out_change_0 = 0.0_wp 
+       ENDIF
+       DO  l = 0, 3
+          IF ( .NOT. ALLOCATED ( surf_def_v(l)%rad_lw_out_change_0 )  .AND.    &
+                     surf_def_v(l)%ns > 0  )  THEN
+             ALLOCATE( surf_def_v(l)%rad_lw_out_change_0(1:surf_def_v(l)%ns) )
+             surf_def_v(l)%rad_lw_out_change_0 = 0.0_wp 
+          ENDIF
+          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
+       IF ( .NOT. ALLOCATED ( surf_def_h(0)%rad_sw_in )  .AND.                 &
+                  surf_def_h(0)%ns > 0  )  THEN
+          ALLOCATE( surf_def_h(0)%rad_sw_in(1:surf_def_h(0)%ns)  )
+          ALLOCATE( surf_def_h(0)%rad_sw_out(1:surf_def_h(0)%ns) )
+          ALLOCATE( surf_def_h(0)%rad_lw_in(1:surf_def_h(0)%ns)  )
+          ALLOCATE( surf_def_h(0)%rad_lw_out(1:surf_def_h(0)%ns) )
+          surf_def_h(0)%rad_sw_in  = 0.0_wp 
+          surf_def_h(0)%rad_sw_out = 0.0_wp 
+          surf_def_h(0)%rad_lw_in  = 0.0_wp 
+          surf_def_h(0)%rad_lw_out = 0.0_wp 
+       ENDIF
+       IF ( .NOT. ALLOCATED ( surf_lsm_h%rad_sw_in )  .AND.                    &
+                  surf_lsm_h%ns > 0  )   THEN
+          ALLOCATE( surf_lsm_h%rad_sw_in(1:surf_lsm_h%ns)  )
+          ALLOCATE( surf_lsm_h%rad_sw_out(1:surf_lsm_h%ns) )
+          ALLOCATE( surf_lsm_h%rad_lw_in(1:surf_lsm_h%ns)  )
+          ALLOCATE( surf_lsm_h%rad_lw_out(1:surf_lsm_h%ns) )
+          surf_lsm_h%rad_sw_in  = 0.0_wp 
+          surf_lsm_h%rad_sw_out = 0.0_wp 
+          surf_lsm_h%rad_lw_in  = 0.0_wp 
+          surf_lsm_h%rad_lw_out = 0.0_wp 
+       ENDIF
+       IF ( .NOT. ALLOCATED ( surf_usm_h%rad_sw_in )  .AND.                    &
+                  surf_usm_h%ns > 0  )  THEN
+          ALLOCATE( surf_usm_h%rad_sw_in(1:surf_usm_h%ns)  )
+          ALLOCATE( surf_usm_h%rad_sw_out(1:surf_usm_h%ns) )
+          ALLOCATE( surf_usm_h%rad_lw_in(1:surf_usm_h%ns)  )
+          ALLOCATE( surf_usm_h%rad_lw_out(1:surf_usm_h%ns) )
+          surf_usm_h%rad_sw_in  = 0.0_wp 
+          surf_usm_h%rad_sw_out = 0.0_wp 
+          surf_usm_h%rad_lw_in  = 0.0_wp 
+          surf_usm_h%rad_lw_out = 0.0_wp 
+       ENDIF
+       DO  l = 0, 3
+          IF ( .NOT. ALLOCATED ( surf_def_v(l)%rad_sw_in )  .AND.              &
+                     surf_def_v(l)%ns > 0  )  THEN
+             ALLOCATE( surf_def_v(l)%rad_sw_in(1:surf_def_v(l)%ns)  )
+             ALLOCATE( surf_def_v(l)%rad_sw_out(1:surf_def_v(l)%ns) )
+             ALLOCATE( surf_def_v(l)%rad_lw_in(1:surf_def_v(l)%ns)  )
+             ALLOCATE( surf_def_v(l)%rad_lw_out(1:surf_def_v(l)%ns) )
+             surf_def_v(l)%rad_sw_in  = 0.0_wp 
+             surf_def_v(l)%rad_sw_out = 0.0_wp 
+             surf_def_v(l)%rad_lw_in  = 0.0_wp 
+             surf_def_v(l)%rad_lw_out = 0.0_wp 
+          ENDIF
+          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_lw_in(1:surf_lsm_v(l)%ns)  )
+             ALLOCATE( surf_lsm_v(l)%rad_lw_out(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_lw_in  = 0.0_wp 
+             surf_lsm_v(l)%rad_lw_out = 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_lw_in(1:surf_usm_v(l)%ns)  )
+             ALLOCATE( surf_usm_v(l)%rad_lw_out(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_lw_in  = 0.0_wp 
+             surf_usm_v(l)%rad_lw_out = 0.0_wp 
+          ENDIF
+       ENDDO
+!
+!--    If necessary, allocate surface attribute albedo_type. 
+!--    Only for default-surfaces, In case urban- or land-surface scheme is 
+!--    utilized, this has been already allocated. For default surfaces,
+!--    no tile approach between different surface fractions is considered,
+!--    so first dimension is allocated with zero.
+!--    Initialize them with namelist parameter.
+       ALLOCATE ( surf_def_h(0)%albedo_type(0:0,1:surf_def_h(0)%ns) )
+       surf_def_h(0)%albedo_type = albedo_type
+
+       DO  l = 0, 3
+          ALLOCATE ( surf_def_v(l)%albedo_type(0:0,1:surf_def_v(l)%ns) )
+          surf_def_v(l)%albedo_type = albedo_type
+       ENDDO
+!
+!--    If available, overwrite albedo_type by values read from file.
+!--    Again, only required for default-type surfaces.
+       IF ( albedo_type_f%from_file )  THEN
+          DO  i = nxl, nxr
+             DO  j = nys, nyn 
+                IF ( albedo_type_f%var(j,i) /= albedo_type_f%fill )  THEN
+
+                   DO  m = surf_def_h(0)%start_index(j,i),                     &
+                           surf_def_h(0)%end_index(j,i)
+                      surf_def_h(0)%albedo_type(0,m) = albedo_type_f%var(j,i)
+                   ENDDO
+                   DO  l = 0, 3
+                      ioff = surf_def_v(l)%ioff
+                      joff = surf_def_v(l)%joff
+                      DO  m = surf_def_v(l)%start_index(j,i),                  &
+                              surf_def_v(l)%end_index(j,i)
+                         surf_def_v(l)%albedo_type(0,m) =                      &
+                                                albedo_type_f%var(j+joff,i+ioff)
+                      ENDDO
+                   ENDDO
+                ENDIF
+             ENDDO
+          ENDDO
+       ENDIF
+
+!
+!--    If necessary, allocate surface attribute emissivity. 
+!--    Only for default-type surfaces. In case urband- or
+!--    land-surface scheme is utilized, this has been already allocated.
+!--    Initialize them with namelist parameter.
+       ALLOCATE ( surf_def_h(0)%emissivity(0:0,1:surf_def_h(0)%ns) )
+       surf_def_h(0)%emissivity = emissivity
+
+       DO  l = 0, 3
+          ALLOCATE ( surf_def_v(l)%emissivity(0:0,1:surf_def_v(l)%ns) )
+       ENDDO
 
 !
 !--    Fix net radiation in case of radiation_scheme = 'constant'
        IF ( radiation_scheme == 'constant' )  THEN
-          rad_net = net_radiation
+          IF ( ALLOCATED( surf_def_h(0)%rad_net ) )                            &
+             surf_def_h(0)%rad_net = net_radiation
+          IF ( ALLOCATED( surf_lsm_h%rad_net ) )                               &
+             surf_lsm_h%rad_net    = net_radiation
+          IF ( ALLOCATED( surf_usm_h%rad_net ) )                               &
+             surf_usm_h%rad_net    = net_radiation
+!
+!--       Todo: weight with inclination angle
+          DO  l = 0, 3
+             IF ( ALLOCATED( surf_def_v(l)%rad_net ) )                         &
+                surf_def_v(l)%rad_net = net_radiation
+             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.
 !
@@ -986,14 +1450,6 @@
        IF ( radiation_scheme == 'clear-sky'  .OR.                              &
             radiation_scheme == 'constant')  THEN
-
-          ALLOCATE ( alpha(nysg:nyng,nxlg:nxrg) )
-
-          IF ( .NOT. ALLOCATED ( rad_sw_in ) )  THEN
-             ALLOCATE ( rad_sw_in(0:0,nysg:nyng,nxlg:nxrg) )
-          ENDIF
-          IF ( .NOT. ALLOCATED ( rad_sw_out ) )  THEN
-             ALLOCATE ( rad_sw_out(0:0,nysg:nyng,nxlg:nxrg) )
-          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) )
@@ -1003,11 +1459,4 @@
           ENDIF
 
-          IF ( .NOT. ALLOCATED ( rad_lw_in ) )  THEN
-             ALLOCATE ( rad_lw_in(0:0,nysg:nyng,nxlg:nxrg) )
-          ENDIF
-          IF ( .NOT. ALLOCATED ( rad_lw_out ) )  THEN
-             ALLOCATE ( rad_lw_out(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) )
@@ -1016,19 +1465,176 @@
              ALLOCATE ( rad_lw_out_av(0:0,nysg:nyng,nxlg:nxrg) )
           ENDIF
-
-          rad_sw_in  = 0.0_wp
-          rad_sw_out = 0.0_wp
-          rad_lw_in  = 0.0_wp
-          rad_lw_out = 0.0_wp
-
-!
-!--       Overwrite albedo if manually set in parameter file
-          IF ( albedo_type /= 0  .AND.  albedo_type /= 9999999 .AND. albedo == 9999999.9_wp )  THEN
-             albedo = albedo_pars(2,albedo_type)
-          ENDIF
-!
-!--       Write albedo to 2d array alpha to allow surface heterogeneities    
-          alpha = albedo
-  
+!
+!--       Allocate arrays for broadband albedo, and level 1 initialization
+!--       via namelist paramter. 
+          IF ( .NOT. ALLOCATED(surf_def_h(0)%albedo) )                         &
+             ALLOCATE( surf_def_h(0)%albedo(0:0,1:surf_def_h(0)%ns) )
+          IF ( .NOT. ALLOCATED(surf_lsm_h%albedo) )                            &
+             ALLOCATE( surf_lsm_h%albedo(0:2,1:surf_lsm_h%ns)     )
+          IF ( .NOT. ALLOCATED(surf_usm_h%albedo) )                            &
+             ALLOCATE( surf_usm_h%albedo(0:2,1:surf_usm_h%ns)     )
+
+          surf_def_h(0)%albedo = albedo
+          surf_lsm_h%albedo    = albedo
+          surf_usm_h%albedo    = albedo
+          DO  l = 0, 3
+             IF ( .NOT. ALLOCATED( surf_def_v(l)%albedo ) )                    &
+                ALLOCATE( surf_def_v(l)%albedo(0:0,1:surf_def_v(l)%ns) )
+             IF ( .NOT. ALLOCATED( surf_lsm_v(l)%albedo ) )                    &
+                ALLOCATE( surf_lsm_v(l)%albedo(0:2,1:surf_lsm_v(l)%ns) )
+             IF ( .NOT. ALLOCATED( surf_usm_v(l)%albedo ) )                    &
+                ALLOCATE( surf_usm_v(l)%albedo(0:2,1:surf_usm_v(l)%ns) )
+
+             surf_def_v(l)%albedo = albedo
+             surf_lsm_v(l)%albedo = albedo
+             surf_usm_v(l)%albedo = albedo
+          ENDDO
+!
+!--       Level 2 initialization of broadband albedo via given albedo_type. 
+!--       Only if albedo_type is non-zero
+          DO  m = 1, surf_def_h(0)%ns
+             IF ( surf_def_h(0)%albedo_type(0,m) /= 0 )                        &
+                surf_def_h(0)%albedo(0,m) =                                    &
+                                albedo_pars(2,surf_def_h(0)%albedo_type(0,m))
+          ENDDO
+          DO  m = 1, surf_lsm_h%ns
+             IF ( surf_lsm_h%albedo_type(0,m) /= 0 )                           &
+                surf_lsm_h%albedo(0,m) =                                       &
+                                      albedo_pars(2,surf_lsm_h%albedo_type(0,m))
+             IF ( surf_lsm_h%albedo_type(1,m) /= 0 )                           &
+                surf_lsm_h%albedo(1,m) =                                       &
+                                      albedo_pars(2,surf_lsm_h%albedo_type(1,m))
+             IF ( surf_lsm_h%albedo_type(2,m) /= 0 )                           &
+                surf_lsm_h%albedo(2,m) =                                       &
+                                      albedo_pars(2,surf_lsm_h%albedo_type(2,m))
+          ENDDO
+          DO  m = 1, surf_usm_h%ns
+             IF ( surf_usm_h%albedo_type(0,m) /= 0 )                           &
+                surf_usm_h%albedo(0,m) =                                       &
+                                      albedo_pars(2,surf_usm_h%albedo_type(0,m))
+             IF ( surf_usm_h%albedo_type(1,m) /= 0 )                           &
+                surf_usm_h%albedo(1,m) =                                       &
+                                      albedo_pars(2,surf_usm_h%albedo_type(1,m))
+             IF ( surf_usm_h%albedo_type(2,m) /= 0 )                           &
+                surf_usm_h%albedo(2,m) =                                       &
+                                      albedo_pars(2,surf_usm_h%albedo_type(2,m))
+          ENDDO
+
+          DO  l = 0, 3
+             DO  m = 1, surf_def_v(l)%ns
+                IF ( surf_def_v(l)%albedo_type(0,m) /= 0 )                     &
+                   surf_def_v(l)%albedo(0,m) =                                 &
+                                albedo_pars(2,surf_def_v(l)%albedo_type(0,m))
+             ENDDO
+             DO  m = 1, surf_lsm_v(l)%ns
+                IF ( surf_lsm_v(l)%albedo_type(0,m) /= 0 )                     &
+                   surf_lsm_v(l)%albedo(0,m) =                                 &
+                                   albedo_pars(2,surf_lsm_v(l)%albedo_type(0,m))
+                IF ( surf_lsm_v(l)%albedo_type(1,m) /= 0 )                     &
+                   surf_lsm_v(l)%albedo(1,m) =                                 &
+                                   albedo_pars(2,surf_lsm_v(l)%albedo_type(1,m))
+                IF ( surf_lsm_v(l)%albedo_type(2,m) /= 0 )                     &
+                   surf_lsm_v(l)%albedo(2,m) =                                 &
+                                   albedo_pars(2,surf_lsm_v(l)%albedo_type(2,m))
+             ENDDO
+             DO  m = 1, surf_usm_v(l)%ns
+                IF ( surf_usm_v(l)%albedo_type(0,m) /= 0 )                     &
+                   surf_usm_v(l)%albedo(0,m) =                                 &
+                                   albedo_pars(2,surf_usm_v(l)%albedo_type(0,m))
+                IF ( surf_usm_v(l)%albedo_type(1,m) /= 0 )                     &
+                   surf_usm_v(l)%albedo(1,m) =                                 &
+                                   albedo_pars(2,surf_usm_v(l)%albedo_type(1,m))
+                IF ( surf_usm_v(l)%albedo_type(2,m) /= 0 )                     &
+                   surf_usm_v(l)%albedo(2,m) =                                 &
+                                   albedo_pars(2,surf_usm_v(l)%albedo_type(2,m))
+             ENDDO
+          ENDDO
+
+!
+!--       Level 3 initialization at grid points where albedo type is zero.
+!--       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  m = 1, surf_def_h(0)%ns
+                i = surf_def_h(0)%i(m)
+                j = surf_def_h(0)%j(m)
+                IF ( albedo_pars_f%pars_xy(0,j,i) /= albedo_pars_f%fill  .AND. &
+                     surf_def_h(0)%albedo_type(0,m) == 0 )  THEN
+                   surf_def_h(0)%albedo(0,m) = albedo_pars_f%pars_xy(0,j,i)
+                ENDIF
+             ENDDO
+             DO  m = 1, surf_lsm_h%ns
+                i = surf_lsm_h%i(m)
+                j = surf_lsm_h%j(m)
+                IF ( albedo_pars_f%pars_xy(0,j,i) /= albedo_pars_f%fill )  THEN
+                   IF ( surf_lsm_h%albedo_type(0,m) == 0 )                     &
+                      surf_lsm_h%albedo(0,m) = albedo_pars_f%pars_xy(0,j,i)
+                   IF ( surf_lsm_h%albedo_type(1,m) == 0 )                     &
+                      surf_lsm_h%albedo(1,m) = albedo_pars_f%pars_xy(0,j,i)
+                   IF ( surf_lsm_h%albedo_type(2,m) == 0 )                     &
+                      surf_lsm_h%albedo(2,m) = albedo_pars_f%pars_xy(0,j,i)
+                ENDIF
+             ENDDO
+             DO  m = 1, surf_usm_h%ns
+                i = surf_usm_h%i(m)
+                j = surf_usm_h%j(m)
+                IF ( albedo_pars_f%pars_xy(0,j,i) /= albedo_pars_f%fill )  THEN
+                   IF ( surf_usm_h%albedo_type(0,m) == 0 )                     &
+                      surf_usm_h%albedo(0,m) = albedo_pars_f%pars_xy(0,j,i)
+                   IF ( surf_usm_h%albedo_type(1,m) == 0 )                     &
+                      surf_usm_h%albedo(1,m) = albedo_pars_f%pars_xy(0,j,i)
+                   IF ( surf_usm_h%albedo_type(2,m) == 0 )                     &
+                      surf_usm_h%albedo(2,m) = albedo_pars_f%pars_xy(0,j,i)
+                ENDIF
+             ENDDO 
+!
+!--          Vertical surfaces            
+             DO  l = 0, 3
+
+                ioff = surf_def_v(l)%ioff
+                joff = surf_def_v(l)%joff
+                DO  m = 1, surf_def_v(l)%ns
+                   i = surf_def_v(l)%i(m) + ioff
+                   j = surf_def_v(l)%j(m) + joff
+                   IF ( albedo_pars_f%pars_xy(0,j,i) /= albedo_pars_f%fill  .AND. &
+                        surf_def_v(l)%albedo_type(0,m) == 0 )  THEN
+                      surf_def_v(l)%albedo(0,m) = albedo_pars_f%pars_xy(0,j,i)
+                   ENDIF
+                ENDDO
+
+                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
+                      IF ( surf_lsm_v(l)%albedo_type(0,m) == 0 )               &
+                         surf_lsm_v(l)%albedo(1,m) = albedo_pars_f%pars_xy(0,j,i)
+                      IF ( surf_lsm_v(l)%albedo_type(1,m) == 0 )               &
+                         surf_lsm_v(l)%albedo(1,m) = albedo_pars_f%pars_xy(0,j,i)
+                      IF ( surf_lsm_v(l)%albedo_type(2,m) == 0 )               &
+                         surf_lsm_v(l)%albedo(2,m) = 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_h%ns
+                   i = surf_usm_h%i(m) + joff
+                   j = surf_usm_h%j(m) + joff
+                   IF ( albedo_pars_f%pars_xy(0,j,i) /= albedo_pars_f%fill )  THEN
+                      IF ( surf_usm_v(l)%albedo_type(0,m) == 0 )               &
+                         surf_usm_v(l)%albedo(1,m) = albedo_pars_f%pars_xy(0,j,i)
+                      IF ( surf_usm_v(l)%albedo_type(1,m) == 0 )               &
+                         surf_usm_v(l)%albedo(1,m) = albedo_pars_f%pars_xy(0,j,i)
+                      IF ( surf_usm_v(l)%albedo_type(2,m) == 0 )               &
+                         surf_lsm_v(l)%albedo(2,m) = albedo_pars_f%pars_xy(0,j,i)
+                   ENDIF
+                ENDDO
+             ENDDO
+
+          ENDIF  
 !
 !--    Initialization actions for RRTMG
@@ -1036,29 +1642,417 @@
 #if defined ( __rrtmg )
 !
-!--       Allocate albedos
-          ALLOCATE ( rrtm_aldif(0:0,nysg:nyng,nxlg:nxrg) )
-          ALLOCATE ( rrtm_aldir(0:0,nysg:nyng,nxlg:nxrg) )
-          ALLOCATE ( rrtm_asdif(0:0,nysg:nyng,nxlg:nxrg) )
-          ALLOCATE ( rrtm_asdir(0:0,nysg:nyng,nxlg:nxrg) )
-          ALLOCATE ( aldif(nysg:nyng,nxlg:nxrg) )
-          ALLOCATE ( aldir(nysg:nyng,nxlg:nxrg) )
-          ALLOCATE ( asdif(nysg:nyng,nxlg:nxrg) )
-          ALLOCATE ( asdir(nysg:nyng,nxlg:nxrg) )
-
-          IF ( albedo_type /= 0 )  THEN
-             IF ( albedo_sw_dif == 9999999.9_wp )  THEN
-                albedo_sw_dif = albedo_pars(0,albedo_type)
-                albedo_sw_dir = albedo_sw_dif
+!--       Allocate albedos for short/longwave radiation, horizontal surfaces.
+          ALLOCATE ( surf_def_h(0)%aldif(1:surf_def_h(0)%ns) )
+          ALLOCATE ( surf_def_h(0)%aldir(1:surf_def_h(0)%ns) )
+          ALLOCATE ( surf_def_h(0)%asdif(1:surf_def_h(0)%ns) )
+          ALLOCATE ( surf_def_h(0)%asdir(1:surf_def_h(0)%ns) )
+          ALLOCATE ( surf_def_h(0)%rrtm_aldif(1:surf_def_h(0)%ns) )
+          ALLOCATE ( surf_def_h(0)%rrtm_aldir(1:surf_def_h(0)%ns) )
+          ALLOCATE ( surf_def_h(0)%rrtm_asdif(1:surf_def_h(0)%ns) )
+          ALLOCATE ( surf_def_h(0)%rrtm_asdir(1:surf_def_h(0)%ns) )
+
+          ALLOCATE ( surf_lsm_h%aldif(1:surf_lsm_h%ns)       )
+          ALLOCATE ( surf_lsm_h%aldir(1:surf_lsm_h%ns)       )
+          ALLOCATE ( surf_lsm_h%asdif(1:surf_lsm_h%ns)       )
+          ALLOCATE ( surf_lsm_h%asdir(1:surf_lsm_h%ns)       )
+          ALLOCATE ( surf_lsm_h%rrtm_aldif(1:surf_lsm_h%ns)  )
+          ALLOCATE ( surf_lsm_h%rrtm_aldir(1:surf_lsm_h%ns)  )
+          ALLOCATE ( surf_lsm_h%rrtm_asdif(1:surf_lsm_h%ns)  )
+          ALLOCATE ( surf_lsm_h%rrtm_asdir(1:surf_lsm_h%ns)  )
+
+          ALLOCATE ( surf_usm_h%aldif(1:surf_usm_h%ns)       )
+          ALLOCATE ( surf_usm_h%aldir(1:surf_usm_h%ns)       )
+          ALLOCATE ( surf_usm_h%asdif(1:surf_usm_h%ns)       )
+          ALLOCATE ( surf_usm_h%asdir(1:surf_usm_h%ns)       )
+          ALLOCATE ( surf_usm_h%rrtm_aldif(1:surf_usm_h%ns)  )
+          ALLOCATE ( surf_usm_h%rrtm_aldir(1:surf_usm_h%ns)  )
+          ALLOCATE ( surf_usm_h%rrtm_asdif(1:surf_usm_h%ns)  )
+          ALLOCATE ( surf_usm_h%rrtm_asdir(1:surf_usm_h%ns)  )
+
+!
+!--       Allocate broadband albedo (temporary for the current radiation 
+!--       implementations)
+          IF ( .NOT. ALLOCATED(surf_def_h(0)%albedo) )                         &
+             ALLOCATE( surf_def_h(0)%albedo(0:0,1:surf_def_h(0)%ns) )
+          IF ( .NOT. ALLOCATED(surf_lsm_h%albedo) )                            &
+             ALLOCATE( surf_lsm_h%albedo(0:2,1:surf_lsm_h%ns)     )
+          IF ( .NOT. ALLOCATED(surf_usm_h%albedo) )                            &
+             ALLOCATE( surf_usm_h%albedo(0:2,1:surf_usm_h%ns)     )
+
+!
+!--       Allocate albedos for short/longwave radiation, vertical surfaces 
+          DO  l = 0, 3
+             ALLOCATE ( surf_def_v(l)%aldif(1:surf_def_v(l)%ns)      )
+             ALLOCATE ( surf_def_v(l)%aldir(1:surf_def_v(l)%ns)      )
+             ALLOCATE ( surf_def_v(l)%asdif(1:surf_def_v(l)%ns)      )
+             ALLOCATE ( surf_def_v(l)%asdir(1:surf_def_v(l)%ns)      )
+
+             ALLOCATE ( surf_def_v(l)%rrtm_aldif(1:surf_def_v(l)%ns) )
+             ALLOCATE ( surf_def_v(l)%rrtm_aldir(1:surf_def_v(l)%ns) )
+             ALLOCATE ( surf_def_v(l)%rrtm_asdif(1:surf_def_v(l)%ns) )
+             ALLOCATE ( surf_def_v(l)%rrtm_asdir(1:surf_def_v(l)%ns) )
+
+             ALLOCATE ( surf_lsm_v(l)%aldif(1:surf_lsm_v(l)%ns)      )
+             ALLOCATE ( surf_lsm_v(l)%aldir(1:surf_lsm_v(l)%ns)      )
+             ALLOCATE ( surf_lsm_v(l)%asdif(1:surf_lsm_v(l)%ns)      )
+             ALLOCATE ( surf_lsm_v(l)%asdir(1:surf_lsm_v(l)%ns)      )
+
+             ALLOCATE ( surf_lsm_v(l)%rrtm_aldif(1:surf_lsm_v(l)%ns) )
+             ALLOCATE ( surf_lsm_v(l)%rrtm_aldir(1:surf_lsm_v(l)%ns) )
+             ALLOCATE ( surf_lsm_v(l)%rrtm_asdif(1:surf_lsm_v(l)%ns) )
+             ALLOCATE ( surf_lsm_v(l)%rrtm_asdir(1:surf_lsm_v(l)%ns) )
+
+             ALLOCATE ( surf_usm_v(l)%aldif(1:surf_usm_v(l)%ns)      )
+             ALLOCATE ( surf_usm_v(l)%aldir(1:surf_usm_v(l)%ns)      )
+             ALLOCATE ( surf_usm_v(l)%asdif(1:surf_usm_v(l)%ns)      )
+             ALLOCATE ( surf_usm_v(l)%asdir(1:surf_usm_v(l)%ns)      )
+
+             ALLOCATE ( surf_usm_v(l)%rrtm_aldif(1:surf_usm_v(l)%ns) )
+             ALLOCATE ( surf_usm_v(l)%rrtm_aldir(1:surf_usm_v(l)%ns) )
+             ALLOCATE ( surf_usm_v(l)%rrtm_asdif(1:surf_usm_v(l)%ns) )
+             ALLOCATE ( surf_usm_v(l)%rrtm_asdir(1:surf_usm_v(l)%ns) )
+!
+!--          Allocate broadband albedo (temporary for the current radiation
+!--          implementations)
+             IF ( .NOT. ALLOCATED( surf_def_v(l)%albedo ) )                    &
+                ALLOCATE( surf_def_v(l)%albedo(0,1:surf_def_v(l)%ns) )
+             IF ( .NOT. ALLOCATED( surf_lsm_v(l)%albedo ) )                    &
+                ALLOCATE( surf_lsm_v(l)%albedo(0:2,1:surf_lsm_v(l)%ns) )
+             IF ( .NOT. ALLOCATED( surf_usm_v(l)%albedo ) )                    &
+                ALLOCATE( surf_usm_v(l)%albedo(0:2,1:surf_usm_v(l)%ns) )
+
+          ENDDO
+!
+!--       Level 1 initialization of spectral albedos via namelist 
+!--       paramters
+          IF ( surf_def_h(0)%ns > 0 )  THEN
+             surf_def_h(0)%aldif  = albedo_lw_dif
+             surf_def_h(0)%aldir  = albedo_lw_dir
+             surf_def_h(0)%asdif  = albedo_sw_dif
+             surf_def_h(0)%asdir  = albedo_sw_dir
+             surf_def_h(0)%albedo = albedo_sw_dif
+          ENDIF
+          IF ( surf_lsm_h%ns > 0 )  THEN
+             surf_lsm_h%aldif  = albedo_lw_dif
+             surf_lsm_h%aldir  = albedo_lw_dir
+             surf_lsm_h%asdif  = albedo_sw_dif
+             surf_lsm_h%asdir  = albedo_sw_dir
+             surf_lsm_h%albedo = albedo_sw_dif
+          ENDIF
+          IF ( surf_usm_h%ns > 0 )  THEN
+             surf_usm_h%aldif  = albedo_lw_dif
+             surf_usm_h%aldir  = albedo_lw_dir
+             surf_usm_h%asdif  = albedo_sw_dif
+             surf_usm_h%asdir  = albedo_sw_dir
+             surf_usm_h%albedo = albedo_sw_dif
+          ENDIF
+
+          DO  l = 0, 3
+             IF ( surf_def_v(l)%ns > 0 )  THEN
+                surf_def_v(l)%aldif  = albedo_lw_dif
+                surf_def_v(l)%aldir  = albedo_lw_dir
+                surf_def_v(l)%asdif  = albedo_sw_dif
+                surf_def_v(l)%asdir  = albedo_sw_dir
+                surf_def_v(l)%albedo = albedo_sw_dif
              ENDIF
-             IF ( albedo_lw_dif == 9999999.9_wp )  THEN
-                albedo_lw_dif = albedo_pars(1,albedo_type)
-                albedo_lw_dir = albedo_lw_dif
+
+             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
+                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
+                surf_usm_v(l)%albedo = albedo_sw_dif
+             ENDIF
+          ENDDO
+
+!
+!--       Level 2 initialization of spectral albedos via albedo_type. 
+!--       Only diffusive albedos (why?)
+          DO  m = 1, surf_def_h(0)%ns
+             IF ( surf_def_h(0)%albedo_type(0,m) /= 0 )  THEN
+                surf_def_h(0)%aldif(m) =                                       &
+                                albedo_pars(0,surf_def_h(0)%albedo_type(0,m))
+                surf_def_h(0)%asdif(m) =                                       &
+                                albedo_pars(1,surf_def_h(0)%albedo_type(0,m))
+                surf_def_h(0)%aldir(m) =                                       &
+                                albedo_pars(0,surf_def_h(0)%albedo_type(0,m))
+                surf_def_h(0)%asdir(m) =                                       &
+                                albedo_pars(1,surf_def_h(0)%albedo_type(0,m))
+                surf_def_h(0)%albedo(0,m) =                                    &
+                                albedo_pars(2,surf_def_h(0)%albedo_type(0,m))
+             ENDIF
+          ENDDO
+          DO  m = 1, surf_lsm_h%ns
+!
+!--          Determine surface type
+             IF ( surf_lsm_h%vegetation_surface(m) )  ind_type = 0
+             IF ( surf_lsm_h%pavement_surface(m)   )  ind_type = 1
+             IF ( surf_lsm_h%water_surface(m)      )  ind_type = 2
+
+             IF ( surf_lsm_h%albedo_type(ind_type,m) /= 0 )  THEN
+                surf_lsm_h%aldif(m) =                                          &
+                               albedo_pars(0,surf_lsm_h%albedo_type(ind_type,m))
+                surf_lsm_h%asdif(m) =                                          &
+                               albedo_pars(1,surf_lsm_h%albedo_type(ind_type,m))
+                surf_lsm_h%aldir(m) =                                          &
+                               albedo_pars(0,surf_lsm_h%albedo_type(ind_type,m))
+                surf_lsm_h%asdir(m) =                                          &
+                               albedo_pars(1,surf_lsm_h%albedo_type(ind_type,m))
+                surf_lsm_h%albedo(:,m) =                                       &
+                               albedo_pars(2,surf_lsm_h%albedo_type(ind_type,m))
+             ENDIF
+
+          ENDDO
+
+          DO  m = 1, surf_usm_h%ns
+!
+!--          Initialize spectral albedos for urban-type surfaces. Please note,
+!--          for urban surfaces a tile approach is applied, so that the 
+!--          resulting albedo should be calculated via the weighted average of  
+!--          respective surface fractions. However, for the moment the albedo
+!--          is set to the wall-surface value. 
+             IF ( surf_usm_h%albedo_type(0,m) /= 0 )  THEN
+                surf_usm_h%aldif(m) =                                          &
+                                albedo_pars(0,surf_usm_h%albedo_type(0,m))
+                surf_usm_h%asdif(m) =                                          &
+                                albedo_pars(1,surf_usm_h%albedo_type(0,m))
+                surf_usm_h%aldir(m) =                                          &
+                               albedo_pars(0,surf_usm_h%albedo_type(0,m))
+                surf_usm_h%asdir(m) =                                          &
+                               albedo_pars(1,surf_usm_h%albedo_type(0,m))
+                surf_usm_h%albedo(:,m) =                                       &
+                                albedo_pars(2,surf_usm_h%albedo_type(0,m))
+             ENDIF
+          ENDDO
+
+          DO l = 0, 3
+             DO  m = 1, surf_def_v(l)%ns
+                IF ( surf_def_v(l)%albedo_type(0,m) /= 0 )  THEN
+                    surf_def_v(l)%aldif(m) =                                   &
+                               albedo_pars(0,surf_def_v(l)%albedo_type(0,m))
+                    surf_def_v(l)%asdif(m) =                                   &
+                               albedo_pars(1,surf_def_v(l)%albedo_type(0,m))
+                    surf_def_v(l)%aldir(m) =                                   &
+                               albedo_pars(0,surf_def_v(l)%albedo_type(0,m))
+                    surf_def_v(l)%asdir(m) =                                   &
+                               albedo_pars(1,surf_def_v(l)%albedo_type(0,m))
+                    surf_def_v(l)%albedo(:,m) =                                &
+                               albedo_pars(2,surf_def_v(l)%albedo_type(0,m))
+                ENDIF
+             ENDDO
+             DO  m = 1, surf_lsm_v(l)%ns
+                IF ( surf_lsm_v(l)%vegetation_surface(m) )  ind_type = 0
+                IF ( surf_lsm_v(l)%pavement_surface(m)   )  ind_type = 1
+                IF ( surf_lsm_v(l)%water_surface(m)      )  ind_type = 2
+
+                IF ( surf_lsm_v(l)%albedo_type(0,m) /= 0 )  THEN
+                   surf_lsm_v(l)%aldif(m) =                                    &
+                            albedo_pars(0,surf_lsm_v(l)%albedo_type(ind_type,m))
+                   surf_lsm_v(l)%asdif(m) =                                    &
+                            albedo_pars(1,surf_lsm_v(l)%albedo_type(ind_type,m))
+                   surf_lsm_v(l)%aldir(m) =                                    &
+                            albedo_pars(0,surf_lsm_v(l)%albedo_type(ind_type,m))
+                   surf_lsm_v(l)%asdir(m) =                                    &
+                            albedo_pars(1,surf_lsm_v(l)%albedo_type(ind_type,m))
+                   surf_lsm_v(l)%albedo(:,m) =                                 &
+                            albedo_pars(2,surf_lsm_v(l)%albedo_type(ind_type,m))
+                ENDIF
+            ENDDO
+
+            DO  m = 1, surf_usm_v(l)%ns
+!
+!--            Initialize spectral albedos for urban-type surfaces. Please note,
+!--            for urban surfaces a tile approach is applied, so that the 
+!--            resulting albedo should be calculated via the weighted average of  
+!--            respective surface fractions. However, for the moment the albedo
+!--            is set to the wall-surface value. 
+               IF ( surf_usm_v(l)%albedo_type(0,m) /= 0 )  THEN
+                  surf_usm_v(l)%aldif(m) =                                    &
+                               albedo_pars(0,surf_usm_v(l)%albedo_type(0,m))
+                  surf_usm_v(l)%asdif(m) =                                    &
+                               albedo_pars(1,surf_usm_v(l)%albedo_type(0,m))
+                  surf_usm_v(l)%aldir(m) =                                    &
+                               albedo_pars(0,surf_usm_v(l)%albedo_type(0,m))
+                  surf_usm_v(l)%asdir(m) =                                    &
+                               albedo_pars(1,surf_usm_v(l)%albedo_type(0,m))
+                  surf_usm_v(l)%albedo(:,m) =                                 &
+                               albedo_pars(2,surf_usm_v(l)%albedo_type(0,m))
+               ENDIF
+            ENDDO
+          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  m = 1, surf_def_h(0)%ns
+                i = surf_def_h(0)%i(m)
+                j = surf_def_h(0)%j(m)
+                IF ( surf_def_h(0)%albedo_type(0,m) == 0 )  THEN
+
+                   IF ( albedo_pars_f%pars_xy(1,j,i) /= albedo_pars_f%fill )   &
+                      surf_def_h(0)%albedo(0,m) = albedo_pars_f%pars_xy(1,j,i)
+                   IF ( albedo_pars_f%pars_xy(1,j,i) /= albedo_pars_f%fill )   &
+                      surf_def_h(0)%aldir(m) = albedo_pars_f%pars_xy(1,j,i)
+                   IF ( albedo_pars_f%pars_xy(2,j,i) /= albedo_pars_f%fill )   &
+                      surf_def_h(0)%aldif(m) = albedo_pars_f%pars_xy(2,j,i)
+                   IF ( albedo_pars_f%pars_xy(3,j,i) /= albedo_pars_f%fill )   &
+                      surf_def_h(0)%asdir(m) = albedo_pars_f%pars_xy(3,j,i)
+                   IF ( albedo_pars_f%pars_xy(4,j,i) /= albedo_pars_f%fill )   &
+                      surf_def_h(0)%asdif(m) = albedo_pars_f%pars_xy(4,j,i)
+                ENDIF
+             ENDDO
+
+             DO  m = 1, surf_lsm_h%ns
+                i = surf_lsm_h%i(m)
+                j = surf_lsm_h%j(m)
+
+                IF ( surf_lsm_h%vegetation_surface(m) )  ind_type = 0
+                IF ( surf_lsm_h%pavement_surface(m)   )  ind_type = 1
+                IF ( surf_lsm_h%water_surface(m)      )  ind_type = 2
+
+                IF ( surf_lsm_h%albedo_type(ind_type,m) == 0 )  THEN
+                   IF ( albedo_pars_f%pars_xy(1,j,i) /= albedo_pars_f%fill )   &
+                      surf_lsm_h%albedo(ind_type,m) = albedo_pars_f%pars_xy(1,j,i)
+                   IF ( albedo_pars_f%pars_xy(1,j,i) /= albedo_pars_f%fill )   &
+                      surf_lsm_h%aldir(m) = albedo_pars_f%pars_xy(1,j,i)
+                   IF ( albedo_pars_f%pars_xy(2,j,i) /= albedo_pars_f%fill )   &
+                      surf_lsm_h%aldif(m) = albedo_pars_f%pars_xy(2,j,i)
+                   IF ( albedo_pars_f%pars_xy(3,j,i) /= albedo_pars_f%fill )   &
+                      surf_lsm_h%asdir(m) = albedo_pars_f%pars_xy(3,j,i)
+                   IF ( albedo_pars_f%pars_xy(4,j,i) /= albedo_pars_f%fill )   &
+                      surf_lsm_h%asdif(m) = albedo_pars_f%pars_xy(4,j,i)
+                ENDIF
+             ENDDO
+
+             DO  m = 1, surf_usm_h%ns
+                i = surf_usm_h%i(m)
+                j = surf_usm_h%j(m)
+!
+!--             At the moment, consider only wall surfaces (index 0)
+                IF ( surf_usm_h%albedo_type(0,m) == 0 )  THEN
+                   IF ( albedo_pars_f%pars_xy(1,j,i) /= albedo_pars_f%fill )   &
+                      surf_usm_h%albedo(:,m) = albedo_pars_f%pars_xy(1,j,i)
+                   IF ( albedo_pars_f%pars_xy(1,j,i) /= albedo_pars_f%fill )   &
+                      surf_usm_h%aldir(m) = albedo_pars_f%pars_xy(1,j,i)
+                   IF ( albedo_pars_f%pars_xy(2,j,i) /= albedo_pars_f%fill )   &
+                      surf_usm_h%aldif(m) = albedo_pars_f%pars_xy(2,j,i)
+                   IF ( albedo_pars_f%pars_xy(3,j,i) /= albedo_pars_f%fill )   &
+                      surf_usm_h%asdir(m) = albedo_pars_f%pars_xy(3,j,i)
+                   IF ( albedo_pars_f%pars_xy(4,j,i) /= albedo_pars_f%fill )   &
+                      surf_usm_h%asdif(m) = albedo_pars_f%pars_xy(4,j,i)
+                ENDIF
+             ENDDO
+!
+!--          Vertical
+             DO  l = 0, 3
+                ioff = surf_def_v(l)%ioff
+                joff = surf_def_v(l)%joff
+
+                DO  m = 1, surf_def_v(l)%ns
+                   i = surf_def_v(l)%i(m)
+                   j = surf_def_v(l)%j(m)
+                   IF ( surf_def_v(l)%albedo_type(0,m) == 0 )  THEN
+
+                      IF ( albedo_pars_f%pars_xy(1,j+joff,i+ioff) /=           &
+                           albedo_pars_f%fill )                                &
+                         surf_def_v(l)%albedo(0,m) =                           &
+                                          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_def_v(l)%aldir(m) =                              &
+                                          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_def_v(l)%aldif(m) =                              &
+                                          albedo_pars_f%pars_xy(2,j+joff,i+ioff)
+                      IF ( albedo_pars_f%pars_xy(3,j+joff,i+ioff) /=           &
+                           albedo_pars_f%fill )                                &
+                         surf_def_v(l)%asdir(m) =                              &
+                                          albedo_pars_f%pars_xy(3,j+joff,i+ioff)
+                      IF ( albedo_pars_f%pars_xy(4,j+joff,i+ioff) /=           &
+                           albedo_pars_f%fill )                                &
+                         surf_def_v(l)%asdif(m) =                              &
+                                          albedo_pars_f%pars_xy(4,j+joff,i+ioff)
+                   ENDIF
+                ENDDO
+
+                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)
+
+                   IF ( surf_lsm_v(l)%vegetation_surface(m) )  ind_type = 0
+                   IF ( surf_lsm_v(l)%pavement_surface(m)   )  ind_type = 1
+                   IF ( surf_lsm_v(l)%water_surface(m)      )  ind_type = 2
+
+                   IF ( surf_lsm_v(l)%albedo_type(ind_type,m) == 0 )  THEN
+                      IF ( albedo_pars_f%pars_xy(1,j+joff,i+ioff) /=           &
+                           albedo_pars_f%fill )                                &
+                         surf_lsm_v(l)%albedo(:,m) =                           &
+                                          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)%aldir(m) =                              &
+                                          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)%aldif(m) =                              &
+                                          albedo_pars_f%pars_xy(2,j+joff,i+ioff)
+                      IF ( albedo_pars_f%pars_xy(3,j+joff,i+ioff) /=           &
+                           albedo_pars_f%fill )                                &
+                         surf_lsm_v(l)%asdir(m) =                              &
+                                          albedo_pars_f%pars_xy(3,j+joff,i+ioff)
+                      IF ( albedo_pars_f%pars_xy(4,j+joff,i+ioff) /=           &
+                           albedo_pars_f%fill )                                &
+                         surf_lsm_v(l)%asdif(m) =                              &
+                                          albedo_pars_f%pars_xy(4,j+joff,i+ioff)
+                   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)
+                   j = surf_usm_v(l)%j(m)
+
+!--                At the moment, consider only wall surfaces (index 0)
+                   IF ( surf_usm_v(l)%albedo_type(0,m) == 0 )  THEN
+                      IF ( albedo_pars_f%pars_xy(1,j+joff,i+ioff) /=           &
+                           albedo_pars_f%fill )                                &
+                         surf_usm_v(l)%albedo(:,m) =                           &
+                                          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_usm_v(l)%aldir(m) =                              &
+                                          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_usm_v(l)%aldif(m) =                              &
+                                          albedo_pars_f%pars_xy(2,j+joff,i+ioff)
+                      IF ( albedo_pars_f%pars_xy(3,j+joff,i+ioff) /=           &
+                           albedo_pars_f%fill )                                &
+                         surf_usm_v(l)%asdir(m) =                              &
+                                          albedo_pars_f%pars_xy(3,j+joff,i+ioff)
+                      IF ( albedo_pars_f%pars_xy(4,j+joff,i+ioff) /=           &
+                           albedo_pars_f%fill )                                &
+                         surf_usm_v(l)%asdif(m) =                              &
+                                          albedo_pars_f%pars_xy(4,j+joff,i+ioff)
+                   ENDIF
+                ENDDO
+             ENDDO
+
           ENDIF
 
-          aldif(:,:) = albedo_lw_dif
-          aldir(:,:) = albedo_lw_dir
-          asdif(:,:) = albedo_sw_dif
-          asdir(:,:) = albedo_sw_dir
 !
 !--       Calculate initial values of current (cosine of) the zenith angle and 
@@ -1066,18 +2060,64 @@
           CALL calc_zenith     
 !
-!--       Calculate initial surface albedo
+!--       Calculate initial surface albedo for different surfaces
           IF ( .NOT. constant_albedo )  THEN
-             CALL calc_albedo
+!
+!--          Horizontally aligned default, natural and urban surfaces
+             CALL calc_albedo( surf_def_h(0) )
+             CALL calc_albedo( surf_lsm_h    )
+             CALL calc_albedo( surf_usm_h    )
+!
+!--          Vertically aligned default, natural and urban surfaces
+             DO  l = 0, 3
+                CALL calc_albedo( surf_def_v(l) )
+                CALL calc_albedo( surf_lsm_v(l) )
+                CALL calc_albedo( surf_usm_v(l) )
+             ENDDO
           ELSE
-             rrtm_aldif(0,:,:) = aldif(:,:)
-             rrtm_aldir(0,:,:) = aldir(:,:)
-             rrtm_asdif(0,:,:) = asdif(:,:) 
-             rrtm_asdir(0,:,:) = asdir(:,:)   
+!
+!--          Initialize sun-inclination independent spectral albedos
+!--          Horizontal surfaces
+             IF ( surf_def_h(0)%ns > 0 )  THEN
+                surf_def_h(0)%rrtm_aldir = surf_def_h(0)%aldir
+                surf_def_h(0)%rrtm_asdir = surf_def_h(0)%asdir
+                surf_def_h(0)%rrtm_aldif = surf_def_h(0)%aldif
+                surf_def_h(0)%rrtm_asdif = surf_def_h(0)%asdif
+             ENDIF
+             IF ( surf_lsm_h%ns > 0 )  THEN
+                surf_lsm_h%rrtm_aldir = surf_lsm_h%aldir
+                surf_lsm_h%rrtm_asdir = surf_lsm_h%asdir
+                surf_lsm_h%rrtm_aldif = surf_lsm_h%aldif
+                surf_lsm_h%rrtm_asdif = surf_lsm_h%asdif
+             ENDIF
+             IF ( surf_usm_h%ns > 0 )  THEN
+                surf_usm_h%rrtm_aldir = surf_usm_h%aldir
+                surf_usm_h%rrtm_asdir = surf_usm_h%asdir
+                surf_usm_h%rrtm_aldif = surf_usm_h%aldif
+                surf_usm_h%rrtm_asdif = surf_usm_h%asdif
+             ENDIF
+!
+!--          Vertical surfaces
+             DO  l = 0, 3
+                IF ( surf_def_h(0)%ns > 0 )  THEN
+                   surf_def_v(l)%rrtm_aldir = surf_def_v(l)%aldir
+                   surf_def_v(l)%rrtm_asdir = surf_def_v(l)%asdir
+                   surf_def_v(l)%rrtm_aldif = surf_def_v(l)%aldif
+                   surf_def_v(l)%rrtm_asdif = surf_def_v(l)%asdif
+                ENDIF
+                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 surface emissivity
-          ALLOCATE ( rrtm_emis(0:0,1:nbndlw+1) )
-          rrtm_emis = emissivity
 
 !
@@ -1170,6 +2210,11 @@
 
 !
-!--       Allocate dummy array for storing surface temperature
+!--       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) )
 
 !
@@ -1234,8 +2279,14 @@
        IMPLICIT NONE
 
-       INTEGER(iwp) :: i, j, k   !< loop indices
-       REAL(wp)     :: exn,   &  !< Exner functions at surface
-                       exn1,  &  !< Exner functions at first grid level
-                       pt1       !< potential temperature at first grid level
+       INTEGER(iwp) ::  l         !< running index for surface orientation
+
+       REAL(wp)     ::  exn       !< Exner functions at surface
+       REAL(wp)     ::  exn1      !< Exner functions at first grid level or at urban layer top 
+       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   
 
 !
@@ -1246,39 +2297,169 @@
 !--    Calculate sky transmissivity
        sky_trans = 0.6_wp + 0.2_wp * zenith(0)
-
-!
-!--    Calculate value of the Exner function
+!
+!--    Calculate value of the Exner function at model surface
        exn = (surface_pressure / 1000.0_wp )**0.286_wp
 !
-!--    Calculate radiation fluxes and net radiation (rad_net) for each grid 
-!--    point
-       DO i = nxlg, nxrg
-          DO j = nysg, nyng
-!
-!--          Obtain vertical index of topography top 
-             k = get_topography_top_index( j, i, 's' )
-
-             exn1 = (hyp(k+1) / 100000.0_wp )**0.286_wp
-
-             rad_sw_in(0,j,i)  = solar_constant * sky_trans * zenith(0)
-             rad_sw_out(0,j,i) = alpha(j,i) * rad_sw_in(0,j,i)
-             rad_lw_out(0,j,i) = emis(j,i) * sigma_sb * (pt(k,j,i) * exn)**4
-
-             IF ( cloud_physics  .OR.  cloud_droplets )  THEN
-                pt1 = pt(k+1,j,i) + l_d_cp / exn1 * ql(k+1,j,i)
-                rad_lw_in(0,j,i)  = 0.8_wp * sigma_sb * (pt1 * exn1)**4
+!--    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 ( cloud_physics )  ql1   = 0.0_wp
+
+          pt1_l = SUM( pt(nzut,nys:nyn,nxl:nxr) )
+          IF ( cloud_physics )  ql1_l = SUM( ql(nzut,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 ( cloud_physics )                                                 &
+             CALL MPI_ALLREDUCE( ql1_l, ql1, 1, MPI_REAL, MPI_SUM, comm2d, ierr )
+#else
+          pt1 = pt1_l 
+          IF ( cloud_physics )  ql1 = ql1_l
+#endif
+          IF ( cloud_physics )  pt1 = pt1 + l_d_cp / exn1 * 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
+       surf => surf_def_h(0)
+       CALL radiation_clearsky_surf
+       surf => surf_lsm_h
+       CALL radiation_clearsky_surf
+       surf => surf_usm_h
+       CALL radiation_clearsky_surf
+!
+!--    Vertical surfaces
+       DO  l = 0, 3
+          surf => surf_def_v(l)
+          CALL radiation_clearsky_surf
+          surf => surf_lsm_v(l)
+          CALL radiation_clearsky_surf
+          surf => surf_usm_v(l)
+          CALL radiation_clearsky_surf
+       ENDDO
+
+       CONTAINS
+
+          SUBROUTINE radiation_clearsky_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 radiation fluxes and net radiation (rad_net) assuming 
+!--          homogeneous urban radiation conditions. 
+             IF ( average_radiation ) THEN       
+
+                k = nzut
+!
+!-- MS: Why k+1 ? 
+!-- MS: @Mohamed: emissivity belongs now to surface type with 3 different values for each 
+!--               surface element (due to tile approach).
+                exn1 = ( hyp(k+1) / 100000.0_wp )**0.286_wp
+
+                surf%rad_sw_in  = solar_constant * sky_trans * zenith(0)
+                surf%rad_sw_out = albedo_urb * surf%rad_sw_in
+                
+                surf%rad_lw_in  = 0.8_wp * sigma_sb * (pt1 * exn1)**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 = 3.0_wp * emissivity_urb * sigma_sb  &
+                                           * (t_rad_urb)**3
+
+!
+!--          Calculate radiation fluxes and net radiation (rad_net) for each surface 
+!--          element.
              ELSE
-                rad_lw_in(0,j,i)  = 0.8_wp * sigma_sb * (pt(k+1,j,i) * exn1)**4
+!
+!--             Determine index offset between surface element and adjacent 
+!--             atmospheric grid point (depends on surface orientation). 
+                ioff = surf%ioff
+                joff = surf%joff
+                koff = surf%koff
+
+                DO  m = 1, surf%ns
+                   i = surf%i(m)
+                   j = surf%j(m)
+                   k = surf%k(m)
+
+                   exn1 = (hyp(k) / 100000.0_wp )**0.286_wp
+
+                   surf%rad_sw_in(m)  = solar_constant * sky_trans * zenith(0)
+!
+!--                Weighted average according to surface fraction. 
+!--                In case no surface fraction is given ( default-type )
+!--                no weighted averaging is performed ( only one surface type per
+!--                surface element ). 
+                   IF ( ALLOCATED( surf%frac ) )  THEN
+
+                      surf%rad_sw_out(m) = ( surf%frac(0,m) * surf%albedo(0,m)    &
+                                           + surf%frac(1,m) * surf%albedo(1,m)    &
+                                           + surf%frac(2,m) * surf%albedo(2,m) )  &
+                                           * surf%rad_sw_in(m)
+
+                      surf%rad_lw_out(m) = ( surf%frac(0,m) * surf%emissivity(0,m)&
+                                           + surf%frac(1,m) * surf%emissivity(1,m)&
+                                           + surf%frac(2,m) * surf%emissivity(2,m)&
+                                           )                                      &
+                                           * sigma_sb                             &
+                                           * ( pt(k+koff,j+joff,i+ioff) * exn )**4
+
+
+                      surf%rad_lw_out_change_0(m) =                               &
+                                         ( surf%frac(0,m) * surf%emissivity(0,m)  &
+                                         + surf%frac(1,m) * surf%emissivity(1,m)  &
+                                         + surf%frac(2,m) * surf%emissivity(2,m)  &
+                                         ) * 3.0_wp * sigma_sb                    &
+                                         * ( pt(k+koff,j+joff,i+ioff) * exn )** 3
+
+                   ELSE
+
+                      surf%rad_sw_out(m) = surf%albedo(0,m) * surf%rad_sw_in(m)
+
+                      surf%rad_lw_out(m) = surf%emissivity(0,m)                   &
+                                           * sigma_sb                             &
+                                           * ( pt(k+koff,j+joff,i+ioff) * exn )**4
+
+
+                      surf%rad_lw_out_change_0(m) = surf%emissivity(0,m)          &
+                                           * 3.0_wp * sigma_sb                    &
+                                           * ( pt(k+koff,j+joff,i+ioff) * exn )** 3
+
+                   ENDIF
+
+                   IF ( cloud_physics )  THEN
+                      pt1 = pt(k,j,i) + l_d_cp / exn1 * ql(k,j,i)
+                      surf%rad_lw_in(m)  = 0.8_wp * sigma_sb * (pt1 * exn1)**4
+                   ELSE
+                      surf%rad_lw_in(m)  = 0.8_wp * sigma_sb * (pt(k,j,i) * exn1)**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
 
-             rad_net(j,i) = rad_sw_in(0,j,i) - rad_sw_out(0,j,i)               &
-                            + rad_lw_in(0,j,i) - rad_lw_out(0,j,i)
-
-
-             rad_lw_out_change_0(j,i) = 3.0_wp * sigma_sb * emis(j,i)         &
-                                        * (pt(k,j,i) * exn) ** 3
-
-          ENDDO
-       ENDDO
+          END SUBROUTINE radiation_clearsky_surf
 
     END SUBROUTINE radiation_clearsky
@@ -1295,8 +2476,14 @@
        IMPLICIT NONE
 
-       INTEGER(iwp) :: i, j, k   !< loop indices
-       REAL(wp)     :: exn,   &  !< Exner functions at surface
-                       exn1,  &  !< Exner functions at first grid level
-                       pt1       !< potential temperature at first grid level
+       INTEGER(iwp) ::  l         !< running index for surface orientation
+
+       REAL(wp)     ::  exn       !< Exner functions at surface
+       REAL(wp)     ::  exn1      !< Exner functions at first grid level
+       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   
 
 !
@@ -1304,33 +2491,165 @@
        exn = (surface_pressure / 1000.0_wp )**0.286_wp
 !
-!--    Prescribe net radiation and estimate the remaining radiative fluxes
-       DO i = nxlg, nxrg
-          DO j = nysg, nyng
-!
-!--          Obtain vertical index of topography top. So far it is identical to
-!--          nzb.
-             k = get_topography_top_index( j, i, 's' )
-
-             rad_net(j,i)      = net_radiation
-
-             exn1 = (hyp(k+1) / 100000.0_wp )**0.286_wp
-
-             IF ( cloud_physics  .OR.  cloud_droplets )  THEN
-                pt1 = pt(k+1,j,i) + l_d_cp / exn1 * ql(k+1,j,i)
-                rad_lw_in(0,j,i)  = 0.8_wp * sigma_sb * (pt1 * exn1)**4
+!--    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 ( cloud_physics )  ql1   = 0.0_wp
+
+          pt1_l = SUM( pt(nzut,nys:nyn,nxl:nxr) )
+          IF ( cloud_physics )  ql1_l = SUM( ql(nzut,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 ( cloud_physics )                                                 &
+             CALL MPI_ALLREDUCE( ql1_l, ql1, 1, MPI_REAL, MPI_SUM, comm2d, ierr )
+#else
+          pt1 = pt1_l
+          IF ( cloud_physics )  ql1 = ql1_l
+#endif
+          IF ( cloud_physics )  pt1 = pt1 + l_d_cp / exn1 * ql1
+!
+!--       Finally, divide by number of grid points
+          pt1 = pt1 / REAL( ( nx + 1 ) * ( ny + 1 ), KIND=wp )
+       ENDIF
+
+!
+!--    First, horizontal surfaces
+       surf => surf_def_h(0)
+       CALL radiation_constant_surf
+       surf => surf_lsm_h
+       CALL radiation_constant_surf
+       surf => surf_usm_h
+       CALL radiation_constant_surf
+!
+!--    Vertical surfaces
+       DO  l = 0, 3
+          surf => surf_def_v(l)
+          CALL radiation_constant_surf
+          surf => surf_lsm_v(l)
+          CALL radiation_constant_surf
+          surf => surf_usm_v(l)
+          CALL radiation_constant_surf
+       ENDDO
+
+       CONTAINS
+
+          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
+
+                ! set height above canopy
+                k = nzut
+
+                surf%rad_net = net_radiation
+! MS: Wyh k + 1 ?
+                exn1 = (hyp(k+1) / 100000.0_wp )**0.286_wp
+
+                surf%rad_lw_in  = 0.8_wp * sigma_sb * (pt1 * exn1)**4
+
+                surf%rad_lw_out = emissivity_urb * sigma_sb * (t_rad_urb)**4   &
+                                    + ( 10.0_wp - emissivity_urb )             & ! shouldn't be this a bulk value -- emissivity_urb?
+                                    * surf%rad_lw_in
+
+                surf%rad_lw_out_change_0 = 3.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
-                rad_lw_in(0,j,i)  = 0.8_wp * sigma_sb * (pt(k+1,j,i) * exn1)**4
+!
+!--             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
+
+                   exn1 = (hyp(k) / 100000.0_wp )**0.286_wp
+
+                   IF ( cloud_physics )  THEN
+                      pt1 = pt(k,j,i) + l_d_cp / exn1 * ql(k,j,i)
+                      surf%rad_lw_in(m)  = 0.8_wp * sigma_sb * (pt1 * exn1)**4
+                   ELSE
+                      surf%rad_lw_in(m)  = 0.8_wp * sigma_sb *                    &
+                                             ( pt(k,j,i) * exn1 )**4
+                   ENDIF
+
+!
+!--                Weighted average according to surface fraction. 
+!--                In case no surface fraction is given ( default-type )
+!--                no weighted averaging is performed ( only one surface type per
+!--                surface element ). 
+                   IF ( ALLOCATED( surf%frac ) )  THEN
+
+                      surf%rad_lw_out(m) = ( surf%frac(0,m) * surf%emissivity(0,m)&
+                                           + surf%frac(1,m) * surf%emissivity(1,m)&
+                                           + surf%frac(2,m) * surf%emissivity(2,m)&
+                                           )                                      &
+                                         * sigma_sb                               &
+                                         * ( pt(k+koff,j+joff,i+ioff) * exn )**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(0,m) * surf%albedo(0,m) +&
+                                               surf%frac(1,m) * surf%albedo(1,m) +&
+                                               surf%frac(1,m) * surf%albedo(1,m) )&
+                                            )
+
+                      surf%rad_sw_out(m) = ( surf%frac(0,m) * surf%albedo(0,m)    &
+                                           + surf%frac(1,m) * surf%albedo(1,m)    &
+                                           + surf%frac(2,m) * surf%albedo(2,m) )  &
+                                         * surf%rad_sw_in(m)
+
+                   ELSE
+                      surf%rad_lw_out(m) = surf%emissivity(0,m)                   &
+                                         * sigma_sb                               &
+                                         * ( pt(k+koff,j+joff,i+ioff) * exn )**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(0,m) * surf%albedo(0,m) )&
+                                            )
+
+                      surf%rad_sw_out(m) = ( surf%frac(0,m) * surf%albedo(0,m) )  &
+                                         * surf%rad_sw_in(m)
+                   ENDIF
+
+                ENDDO
+
              ENDIF
 
-             rad_lw_out(0,j,i) = emis(j,i) * sigma_sb * (pt(k,j,i) * exn)**4
-
-             rad_sw_in(0,j,i) = ( rad_net(j,i) - rad_lw_in(0,j,i)              &
-                                  + rad_lw_out(0,j,i) )                        &
-                                  / ( 1.0_wp - alpha(j,i) )
-
-             rad_sw_out(0,j,i) =  alpha(j,i) * rad_sw_in(0,j,i)
-
-          ENDDO
-       ENDDO
+          END SUBROUTINE radiation_constant_surf
+          
 
     END SUBROUTINE radiation_constant
@@ -1364,8 +2683,14 @@
        ENDIF 
 
-       IF ( albedo_type == 0 )  THEN
-          WRITE( io, 7 ) albedo
-       ELSE
-          WRITE( io, 8 ) TRIM( albedo_type_name(albedo_type) )
+       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
@@ -1389,4 +2714,6 @@
 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.')
 
 
@@ -1411,5 +2738,16 @@
                                   lw_radiation, net_radiation,                 &
                                   radiation_scheme, skip_time_do_radiation,    &
-                                  sw_radiation, unscheduled_radiation_calls
+                                  sw_radiation, unscheduled_radiation_calls,   &
+                                  split_diffusion_radiation,                   &
+                                  energy_balance_surf_h,                       &
+                                  energy_balance_surf_v,                       &
+                                  read_svf_on_init,                            &
+                                  nrefsteps,                                   &
+                                  write_svf_on_init,                           &
+                                  mrt_factors,                                 &
+                                  dist_max_svf,                                &
+                                  average_radiation,                           &
+                                  radiation_interactions, atm_surfaces,        &
+                                  surf_reflections
        
        line = ' '
@@ -1456,5 +2794,6 @@
 #if defined ( __rrtmg )
 
-       INTEGER(iwp) :: i, j, k, n !< loop indices
+       INTEGER(iwp) ::  i, j, k, l, m, n !< loop indices
+       INTEGER(iwp) ::  k_topo     !< topography top index
 
        REAL(wp)     ::  nc_rad, &    !< number concentration of cloud droplets
@@ -1462,11 +2801,37 @@
                         s_r3         !< weighted sum over all droplets with r^3
 
+       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
+
 !
 !--    Calculate current (cosine of) zenith angle and whether the sun is up
        CALL calc_zenith     
 !
-!--    Calculate surface albedo
+!--    Calculate surface albedo. In case average radiation is applied, 
+!--    this is not required.
        IF ( .NOT. constant_albedo )  THEN
-          CALL calc_albedo
+!
+!--       Horizontally aligned default, natural and urban surfaces
+          CALL calc_albedo( surf_def_h(0) )
+          CALL calc_albedo( surf_lsm_h    )
+          CALL calc_albedo( surf_usm_h    )
+!
+!--       Vertically aligned default, natural and urban surfaces
+          DO  l = 0, 3
+             CALL calc_albedo( surf_def_v(l) )
+             CALL calc_albedo( surf_lsm_v(l) )
+             CALL calc_albedo( surf_usm_v(l) )
+          ENDDO
        ENDIF
 
@@ -1482,211 +2847,742 @@
           CALL read_trace_gas_data
        ENDIF
-!
-!--    Loop over all grid points
-       DO i = nxl, nxr
-          DO j = nys, nyn
-
-!
-!--          Prepare profiles of temperature and H2O volume mixing ratio
-             rrtm_tlev(0,nzb+1) = pt(nzb,j,i) * ( surface_pressure             &
-                                                  / 1000.0_wp )**0.286_wp
-
-
-             IF ( cloud_physics )  THEN
-                DO k = nzb+1, nzt+1
-                   rrtm_tlay(0,k) = pt(k,j,i) * ( (hyp(k) ) / 100000.0_wp      &
-                                    )**0.286_wp + l_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) * ( (hyp(k) ) / 100000.0_wp      &
-                                    )**0.286_wp + l_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) * ( (hyp(k) ) / 100000.0_wp      &
-                                    )**0.286_wp
-                   rrtm_h2ovmr(0,k) = 0.0_wp
-                ENDDO
+
+
+       IF ( average_radiation ) THEN
+
+          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. Actually, only one height level is required.
+          CALL calc_mean_profile( pt, 4 )
+          pt_av = hom(:, 1, 4, 0)
+
+!
+!--       Prepare profiles of temperature and H2O volume mixing ratio
+          rrtm_tlev(0,nzb+1) = t_rad_urb
+
+          IF ( cloud_physics )  THEN
+             CALL calc_mean_profile( q, 41 )
+             ! average  q is now in hom(:, 1, 41, 0)
+             q_av = hom(:, 1, 41, 0)
+             CALL calc_mean_profile( ql, 54 )
+             ! 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 + l_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
+                rrtm_h2ovmr(0,k) = 0._wp
+              ENDDO
+          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 interpolate 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/mÂ² instead of kg/kg m.
+          rrtm_cldfr  = 0.0_wp
+          rrtm_reliq  = 0.0_wp
+          rrtm_cliqwp = 0.0_wp
+          rrtm_icld   = 0
+
+          IF ( cloud_physics )  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
+                   IF ( cloud_physics )  THEN
+                      rrtm_reliq(0,k) = 1.0E6_wp * ( 3._wp * ql_av(k)      &
+                                        * rho_surface                       &
+                                        / ( 4._wp * pi * nc_const * rho_l )&
+                                        )**.33333333333333_wp              &
+                                        * EXP( LOG( sigma_gc )**2 )
+
+                   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
+
+!
+!--       Set surface temperature
+          rrtm_tsfc = t_rad_urb
+
+          IF ( lw_radiation )  THEN
+             CALL rrtmg_lw( 1, nzt_rad      , rrtm_icld    , rrtm_idrv      ,&
+             rrtm_play       , rrtm_plev    , rrtm_tlay    , rrtm_tlev      ,&
+             rrtm_tsfc       , rrtm_h2ovmr  , rrtm_o3vmr   , rrtm_co2vmr    ,&
+             rrtm_ch4vmr     , rrtm_n2ovmr  , rrtm_o2vmr   , rrtm_cfc11vmr  ,&
+             rrtm_cfc12vmr   , rrtm_cfc22vmr, rrtm_ccl4vmr , rrtm_emis      ,&
+             rrtm_inflglw    , rrtm_iceflglw, rrtm_liqflglw, rrtm_cldfr     ,&
+             rrtm_lw_taucld  , rrtm_cicewp  , rrtm_cliqwp  , rrtm_reice     ,& 
+             rrtm_reliq      , rrtm_lw_tauaer,                               &
+             rrtm_lwuflx     , rrtm_lwdflx  , rrtm_lwhr  ,                   &
+             rrtm_lwuflxc    , rrtm_lwdflxc , rrtm_lwhrc ,                   &
+             rrtm_lwuflx_dt  ,  rrtm_lwuflxc_dt )
+
+!
+!--          Save fluxes
+             DO k = nzb, nzt+1
+                rad_lw_in(k,:,:)  = rrtm_lwdflx(0,k)
+                rad_lw_out(k,:,:) = rrtm_lwuflx(0,k)
+             ENDDO
+
+!
+!--          Save heating rates (convert from K/d to K/h)
+             DO k = nzb+1, nzt+1
+                rad_lw_hr(k,:,:)     = rrtm_lwhr(0,k)  * d_hours_day
+                rad_lw_cs_hr(k,:,:)  = rrtm_lwhrc(0,k) * d_hours_day
+             ENDDO
+
+!
+!--          Save surface radiative fluxes and change in LW heating rate 
+!--          onto respective surface elements
+!--          Horizontal surfaces
+             IF ( surf_def_h(0)%ns > 0 )  THEN
+                surf_def_h(0)%rad_lw_in           = rrtm_lwdflx(0,nzb)
+                surf_def_h(0)%rad_lw_out          = rrtm_lwuflx(0,nzb)
+                surf_def_h(0)%rad_lw_out_change_0 = rrtm_lwuflx_dt(0,nzb)
              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)                        &
+             IF ( surf_lsm_h%ns > 0 )  THEN
+                surf_lsm_h%rad_lw_in           = rrtm_lwdflx(0,nzb)
+                surf_lsm_h%rad_lw_out          = rrtm_lwuflx(0,nzb)
+                surf_lsm_h%rad_lw_out_change_0 = rrtm_lwuflx_dt(0,nzb)
+             ENDIF             
+             IF ( surf_usm_h%ns > 0 )  THEN
+                surf_usm_h%rad_lw_in           = rrtm_lwdflx(0,nzb)
+                surf_usm_h%rad_lw_out          = rrtm_lwuflx(0,nzb)
+                surf_usm_h%rad_lw_out_change_0 = rrtm_lwuflx_dt(0,nzb)
+             ENDIF
+!
+!--          Vertical surfaces. 
+             DO  l = 0, 3
+                IF ( surf_def_v(l)%ns > 0 )  THEN
+                   surf_def_v(l)%rad_lw_in           = rrtm_lwdflx(0,nzb)
+                   surf_def_v(l)%rad_lw_out          = rrtm_lwuflx(0,nzb)
+                   surf_def_v(l)%rad_lw_out_change_0 = rrtm_lwuflx_dt(0,nzb)
+                ENDIF
+                IF ( surf_lsm_v(l)%ns > 0 )  THEN
+                   surf_lsm_v(l)%rad_lw_in           = rrtm_lwdflx(0,nzb)
+                   surf_lsm_v(l)%rad_lw_out          = rrtm_lwuflx(0,nzb)
+                   surf_lsm_v(l)%rad_lw_out_change_0 = rrtm_lwuflx_dt(0,nzb)
+                ENDIF
+                IF ( surf_usm_v(l)%ns > 0 )  THEN
+                   surf_usm_v(l)%rad_lw_in           = rrtm_lwdflx(0,nzb)
+                   surf_usm_v(l)%rad_lw_out          = rrtm_lwuflx(0,nzb)
+                   surf_usm_v(l)%rad_lw_out_change_0 = rrtm_lwuflx_dt(0,nzb)
+                ENDIF
+             ENDDO
+
+          ENDIF
+
+          IF ( sw_radiation .AND. sun_up )  THEN
+             CALL rrtmg_sw( 1, nzt_rad      , rrtm_icld  , rrtm_iaer        ,&
+             rrtm_play       , rrtm_plev    , rrtm_tlay  , rrtm_tlev        ,&
+             rrtm_tsfc       , rrtm_h2ovmr  , rrtm_o3vmr , rrtm_co2vmr      ,&
+             rrtm_ch4vmr     , rrtm_n2ovmr  , rrtm_o2vmr , 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 , rrtm_sw_taucld   ,&
+             rrtm_sw_ssacld  , rrtm_sw_asmcld, rrtm_sw_fsfcld, rrtm_cicewp  ,&
+             rrtm_cliqwp     , rrtm_reice   , rrtm_reliq , rrtm_sw_tauaer   ,&
+             rrtm_sw_ssaaer  , rrtm_sw_asmaer  , rrtm_sw_ecaer ,             &
+             rrtm_swuflx     , rrtm_swdflx  , rrtm_swhr  ,                   &
+             rrtm_swuflxc    , rrtm_swdflxc , rrtm_swhrc )
+  
+!
+!--          Save fluxes
+             DO k = nzb, nzt+1
+                rad_sw_in(k,:,:)  = rrtm_swdflx(0,k)
+                rad_sw_out(k,:,:) = 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,:,:)     = rrtm_swhr(0,k)  * d_hours_day
+                rad_sw_cs_hr(k,:,:)  = rrtm_swhrc(0,k) * d_hours_day
+             ENDDO
+
+!
+!--          Save surface radiative fluxes onto respective surface elements
+!--          Horizontal surfaces
+             IF ( surf_def_h(0)%ns > 0 )  THEN
+                surf_def_h(0)%rad_lw_in           = rrtm_swdflx(0,nzb)
+                surf_def_h(0)%rad_lw_out          = rrtm_swuflx(0,nzb)
+             ENDIF
+             IF ( surf_lsm_h%ns > 0 )  THEN
+                   surf_lsm_h%rad_sw_in     = rrtm_swdflx(0,nzb)
+                   surf_lsm_h%rad_sw_out    = rrtm_swuflx(0,nzb)
+             ENDIF
+             IF ( surf_usm_h%ns > 0 )  THEN
+                   surf_usm_h%rad_sw_in     = rrtm_swdflx(0,nzb)
+                   surf_usm_h%rad_sw_out    = rrtm_swuflx(0,nzb)
+             ENDIF
+!
+!--          Vertical surfaces. Fluxes are obtain at respective vertical 
+!--          level of the surface element
+             DO  l = 0, 3
+                IF ( surf_def_v(l)%ns > 0 )  THEN
+                      surf_def_v(l)%rad_sw_in  = rrtm_swdflx(0,nzb)
+                      surf_def_v(l)%rad_sw_out = rrtm_swuflx(0,nzb)
+                ENDIF
+                IF ( surf_lsm_v(l)%ns > 0 )  THEN
+                      surf_lsm_v(l)%rad_sw_in  = rrtm_swdflx(0,nzb)
+                      surf_lsm_v(l)%rad_sw_out = rrtm_swuflx(0,nzb)
+                ENDIF             
+                IF ( surf_usm_v(l)%ns > 0 )  THEN
+                      surf_usm_v(l)%rad_sw_in  = rrtm_swdflx(0,nzb)
+                      surf_usm_v(l)%rad_sw_out = rrtm_swuflx(0,nzb)
+                ENDIF       
+             ENDDO
+
+          ENDIF
+!
+!--    RRTMG is called for each (j,i) grid point separately, starting at the 
+!--    highest topography level
+       ELSE
+!
+!--       Loop over all grid points
+          DO i = nxl, nxr
+             DO j = nys, nyn
+
+!
+!--             Prepare profiles of temperature and H2O volume mixing ratio
+                rrtm_tlev(0,nzb+1) = pt(nzb,j,i) * ( surface_pressure          &
+                                                     / 1000.0_wp )**0.286_wp
+
+
+                IF ( cloud_physics )  THEN
+                   DO k = nzb+1, nzt+1
+                      rrtm_tlay(0,k) = pt(k,j,i) * ( (hyp(k) ) / 100000.0_wp   &
+                                       )**0.286_wp + l_d_cp * ql(k,j,i)
+                      rrtm_h2ovmr(0,k) = mol_mass_air_d_wv * (q(k,j,i) - ql(k,j,i))
+                   ENDDO
+                ELSE
+                   DO k = nzb+1, nzt+1
+                      rrtm_tlay(0,k) = pt(k,j,i) * ( (hyp(k) ) / 100000.0_wp   &
+                                       )**0.286_wp
+                      rrtm_h2ovmr(0,k) = 0.0_wp
+                   ENDDO
+                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) )
+                              * ( rrtm_play(0,k)       - rrtm_play(0,nzt+1) )
+
+                ENDDO
+
+!--             Linear interpolate 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/mÂ² instead of kg/kg m.
+                rrtm_cldfr  = 0.0_wp
+                rrtm_reliq  = 0.0_wp
+                rrtm_cliqwp = 0.0_wp
+                rrtm_icld   = 0
+
+                IF ( cloud_physics  .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 ( cloud_physics )  THEN
+!
+!--                         Calculete 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 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_def_h(0)%start_index(j,i), surf_def_h(0)%end_index(j,i)
+                   rrtm_emis = surf_def_h(0)%emissivity(0,m)
+                   rrtm_tsfc = pt(surf_def_h(0)%k(m)+surf_def_h(0)%koff,j,i) * &
+                                       (surface_pressure / 1000.0_wp )**0.286_wp
+                ENDDO
+                DO  m = surf_lsm_h%start_index(j,i), surf_lsm_h%end_index(j,i)
+                   rrtm_emis = surf_lsm_h%frac(0,m) * surf_lsm_h%emissivity(0,m) +&
+                               surf_lsm_h%frac(1,m) * surf_lsm_h%emissivity(1,m) +& 
+                               surf_lsm_h%frac(2,m) * surf_lsm_h%emissivity(2,m)
+                   rrtm_tsfc = pt(surf_lsm_h%k(m)+surf_lsm_h%koff,j,i) *          &
+                                       (surface_pressure / 1000.0_wp )**0.286_wp
+                ENDDO             
+                DO  m = surf_usm_h%start_index(j,i), surf_usm_h%end_index(j,i)
+                   rrtm_emis = surf_usm_h%frac(0,m) * surf_usm_h%emissivity(0,m) +&
+                               surf_usm_h%frac(1,m) * surf_usm_h%emissivity(1,m) +& 
+                               surf_usm_h%frac(2,m) * surf_usm_h%emissivity(2,m)
+                   rrtm_tsfc = pt(surf_usm_h%k(m)+surf_usm_h%koff,j,i) *          &
+                                       (surface_pressure / 1000.0_wp )**0.286_wp
+                ENDDO
+!
+!--             Obtain topography top index (lower bound of RRTMG)
+                k_topo = get_topography_top_index( j, i, 's' )
+
+                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 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 give 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)  * d_hours_day
+                      rad_lw_cs_hr(k,j,i)  = rrtm_lwhrc(0,k) * d_hours_day
+                   ENDDO
+
+!
+!--                Save surface radiative fluxes and change in LW heating rate 
+!--                onto respective surface elements
+!--                Horizontal surfaces
+                   DO  m = surf_def_h(0)%start_index(j,i),                     &
+                           surf_def_h(0)%end_index(j,i)
+                      surf_def_h(0)%rad_lw_in(m)           = rrtm_lwdflx(0,k_topo)
+                      surf_def_h(0)%rad_lw_out(m)          = rrtm_lwuflx(0,k_topo)
+                      surf_def_h(0)%rad_lw_out_change_0(m) = rrtm_lwuflx_dt(0,k_topo)
+                   ENDDO
+                   DO  m = surf_lsm_h%start_index(j,i),                        &
+                           surf_lsm_h%end_index(j,i)
+                      surf_lsm_h%rad_lw_in(m)           = rrtm_lwdflx(0,k_topo)
+                      surf_lsm_h%rad_lw_out(m)          = rrtm_lwuflx(0,k_topo)
+                      surf_lsm_h%rad_lw_out_change_0(m) = rrtm_lwuflx_dt(0,k_topo)
+                   ENDDO             
+                   DO  m = surf_usm_h%start_index(j,i),                        &
+                           surf_usm_h%end_index(j,i)
+                      surf_usm_h%rad_lw_in(m)           = rrtm_lwdflx(0,k_topo)
+                      surf_usm_h%rad_lw_out(m)          = rrtm_lwuflx(0,k_topo)
+                      surf_usm_h%rad_lw_out_change_0(m) = rrtm_lwuflx_dt(0,k_topo)
+                   ENDDO 
+!
+!--                Vertical surfaces. Fluxes are obtain at vertical level of the 
+!--                respective surface element
+                   DO  l = 0, 3
+                      DO  m = surf_def_v(l)%start_index(j,i),                  &
+                              surf_def_v(l)%end_index(j,i)
+                         k                                    = surf_def_v(l)%k(m)
+                         surf_def_v(l)%rad_lw_in(m)           = rrtm_lwdflx(0,k)
+                         surf_def_v(l)%rad_lw_out(m)          = rrtm_lwuflx(0,k)
+                         surf_def_v(l)%rad_lw_out_change_0(m) = rrtm_lwuflx_dt(0,k)
+                      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)
+                         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 horizontal surfaces, as RRTMG is a single 
+!--                column model
+!--                (Please note, only one loop will entered, controlled by 
+!--                start-end index.)
+                   DO  m = surf_def_h(0)%start_index(j,i),                     &
+                           surf_def_h(0)%end_index(j,i)
+                      rrtm_asdir(1)  = surf_def_h(0)%rrtm_asdir(m)
+                      rrtm_asdif(1)  = surf_def_h(0)%rrtm_asdif(m)
+                      rrtm_aldir(1)  = surf_def_h(0)%rrtm_aldir(m)
+                      rrtm_aldif(1)  = surf_def_h(0)%rrtm_aldif(m)
+                   ENDDO
+                   DO  m = surf_lsm_h%start_index(j,i),                        &
+                           surf_lsm_h%end_index(j,i)
+                      rrtm_asdir(1)  = surf_lsm_h%rrtm_asdir(m)
+                      rrtm_asdif(1)  = surf_lsm_h%rrtm_asdif(m)
+                      rrtm_aldir(1)  = surf_lsm_h%rrtm_aldir(m)
+                      rrtm_aldif(1)  = surf_lsm_h%rrtm_aldif(m)
+                   ENDDO             
+                   DO  m = surf_usm_h%start_index(j,i),                        &
+                           surf_usm_h%end_index(j,i)
+                      rrtm_asdir(1)  = surf_usm_h%rrtm_asdir(m)
+                      rrtm_asdif(1)  = surf_usm_h%rrtm_asdif(m)
+                      rrtm_aldir(1)  = surf_usm_h%rrtm_aldir(m)
+                      rrtm_aldif(1)  = surf_usm_h%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 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 give 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) )
+
+                   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  m = surf_def_h(0)%start_index(j,i),                     &
+                           surf_def_h(0)%end_index(j,i)
+                      surf_def_h(0)%rad_sw_in(m)  = rrtm_swdflx(0,k_topo)
+                      surf_def_h(0)%rad_sw_out(m) = rrtm_swuflx(0,k_topo)
+                   ENDDO
+                   DO  m = surf_lsm_h%start_index(j,i),                        &
+                           surf_lsm_h%end_index(j,i)
+                      surf_lsm_h%rad_sw_in(m)     = rrtm_swdflx(0,k_topo)
+                      surf_lsm_h%rad_sw_out(m)    = rrtm_swuflx(0,k_topo)
+                   ENDDO             
+                   DO  m = surf_usm_h%start_index(j,i),                        &
+                           surf_usm_h%end_index(j,i)
+                      surf_usm_h%rad_sw_in(m)     = rrtm_swdflx(0,k_topo)
+                      surf_usm_h%rad_sw_out(m)    = rrtm_swuflx(0,k_topo)
+                   ENDDO 
+!
+!--                Vertical surfaces. Fluxes are obtain at respective vertical 
+!--                level of the surface element
+                   DO  l = 0, 3
+                      DO  m = surf_def_v(l)%start_index(j,i),                  &
+                              surf_def_v(l)%end_index(j,i)
+                         k                           = surf_def_v(l)%k(m)
+                         surf_def_v(l)%rad_sw_in(m)  = rrtm_swdflx(0,k)
+                         surf_def_v(l)%rad_sw_out(m) = rrtm_swuflx(0,k)
+                      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)
+                         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
+
+                ENDIF
 
              ENDDO
-
-!--          Linear interpolate 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/mÂ² instead of kg/kg m.
-             rrtm_cldfr  = 0.0_wp
-             rrtm_reliq  = 0.0_wp
-             rrtm_cliqwp = 0.0_wp
-             rrtm_icld   = 0
-
-             IF ( cloud_physics  .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 ( cloud_physics )  THEN
-!
-!--                      Calculete 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
-
-!
-!--          Set surface temperature
-             rrtm_tsfc = pt(nzb,j,i) * (surface_pressure / 1000.0_wp )**0.286_wp
-
-!
-!--          Set surface emissivity
-             rrtm_emis = emis(j,i)
-
-             IF ( lw_radiation )  THEN
-               CALL rrtmg_lw( 1, nzt_rad      , rrtm_icld    , rrtm_idrv      ,&
-               rrtm_play       , rrtm_plev    , rrtm_tlay    , rrtm_tlev      ,&
-               rrtm_tsfc       , rrtm_h2ovmr  , rrtm_o3vmr   , rrtm_co2vmr    ,&
-               rrtm_ch4vmr     , rrtm_n2ovmr  , rrtm_o2vmr   , rrtm_cfc11vmr  ,&
-               rrtm_cfc12vmr   , rrtm_cfc22vmr, rrtm_ccl4vmr , rrtm_emis      ,&
-               rrtm_inflglw    , rrtm_iceflglw, rrtm_liqflglw, rrtm_cldfr     ,&
-               rrtm_lw_taucld  , rrtm_cicewp  , rrtm_cliqwp  , rrtm_reice     ,& 
-               rrtm_reliq      , rrtm_lw_tauaer,                               &
-               rrtm_lwuflx     , rrtm_lwdflx  , rrtm_lwhr  ,                   &
-               rrtm_lwuflxc    , rrtm_lwdflxc , rrtm_lwhrc ,                   &
-               rrtm_lwuflx_dt  ,  rrtm_lwuflxc_dt )
-
-!
-!--             Save fluxes
-                DO k = nzb, 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 = nzb+1, nzt+1
-                   rad_lw_hr(k,j,i)     = rrtm_lwhr(0,k)  * d_hours_day
-                   rad_lw_cs_hr(k,j,i)  = rrtm_lwhrc(0,k) * d_hours_day
-                ENDDO
-
-!
-!--             Save change in LW heating rate
-                rad_lw_out_change_0(j,i) = rrtm_lwuflx_dt(0,nzb)
-
-             ENDIF
-
-             IF ( sw_radiation .AND. sun_up )  THEN
-                CALL rrtmg_sw( 1, nzt_rad      , rrtm_icld  , rrtm_iaer       ,&
-               rrtm_play       , rrtm_plev    , rrtm_tlay  , rrtm_tlev        ,&
-               rrtm_tsfc       , rrtm_h2ovmr  , rrtm_o3vmr , rrtm_co2vmr      ,&
-               rrtm_ch4vmr     , rrtm_n2ovmr  , rrtm_o2vmr , rrtm_asdir(:,j,i),&
-               rrtm_asdif(:,j,i), rrtm_aldir(:,j,i), rrtm_aldif(:,j,i), zenith,&
-               0.0_wp          , day_of_year  , solar_constant,   rrtm_inflgsw,&
-               rrtm_iceflgsw   , rrtm_liqflgsw, rrtm_cldfr , rrtm_sw_taucld   ,&
-               rrtm_sw_ssacld  , rrtm_sw_asmcld, rrtm_sw_fsfcld, rrtm_cicewp  ,&
-               rrtm_cliqwp     , rrtm_reice   , rrtm_reliq , rrtm_sw_tauaer   ,&
-               rrtm_sw_ssaaer     , rrtm_sw_asmaer  , rrtm_sw_ecaer ,          &
-               rrtm_swuflx     , rrtm_swdflx  , rrtm_swhr  ,                   &
-               rrtm_swuflxc    , rrtm_swdflxc , rrtm_swhrc )
-  
-!
-!--             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
-
-             ENDIF
-
-!
-!--          Calculate surface net radiation
-             rad_net(j,i) = rad_sw_in(nzb,j,i) - rad_sw_out(nzb,j,i)           &
-                            + rad_lw_in(nzb,j,i) - rad_lw_out(nzb,j,i)
-
+          ENDDO
+
+       ENDIF
+!
+!--    Finally, calculate surface net radiation for surface elements.
+!--    First, for horizontal surfaces
+       DO  m = 1, surf_def_h(0)%ns
+          surf_def_h(0)%rad_net(m) = surf_def_h(0)%rad_sw_in(m)                &
+                                   - surf_def_h(0)%rad_sw_out(m)               &
+                                   + surf_def_h(0)%rad_lw_in(m)                &
+                                   - surf_def_h(0)%rad_lw_out(m)
+       ENDDO       
+       DO  m = 1, surf_lsm_h%ns
+          surf_lsm_h%rad_net(m) = surf_lsm_h%rad_sw_in(m)                      &
+                                - surf_lsm_h%rad_sw_out(m)                     &
+                                + surf_lsm_h%rad_lw_in(m)                      &
+                                - surf_lsm_h%rad_lw_out(m)
+       ENDDO
+       DO  m = 1, surf_usm_h%ns
+          surf_usm_h%rad_net(m) = surf_usm_h%rad_sw_in(m)                      &
+                                - surf_usm_h%rad_sw_out(m)                     &
+                                + surf_usm_h%rad_lw_in(m)                      &
+                                - surf_usm_h%rad_lw_out(m)
+       ENDDO
+!
+!--    Vertical surfaces. 
+!--    Todo: weight with azimuth and zenith angle according to their orientation!
+       DO  l = 0, 3
+          DO  m = 1, surf_def_v(l)%ns
+             surf_def_v(l)%rad_net(m) = surf_def_v(l)%rad_sw_in(m)             &
+                                      - surf_def_v(l)%rad_sw_out(m)            &
+                                      + surf_def_v(l)%rad_lw_in(m)             &
+                                      - surf_def_v(l)%rad_lw_out(m)
+          ENDDO       
+          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
+
 
        CALL exchange_horiz( rad_lw_in,  nbgp )
@@ -1700,6 +3596,4 @@
        CALL exchange_horiz( rad_sw_cs_hr, nbgp )
 
-       CALL exchange_horiz_2d( rad_net )
-       CALL exchange_horiz_2d( rad_lw_out_change_0 )
 #endif
 
@@ -1765,87 +3659,105 @@
 !> Briegleb et al. (1986)
 !------------------------------------------------------------------------------!
-    SUBROUTINE calc_albedo
+    SUBROUTINE calc_albedo( surf )
 
         IMPLICIT NONE
 
-        IF ( sun_up )  THEN
-!
-!--        Ocean
-           IF ( albedo_type == 1 )  THEN
-              rrtm_aldir(0,:,:) = 0.026_wp / ( zenith(0)**1.7_wp + 0.065_wp )  &
+        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
+!
+!--           Ocean
+              IF ( surf%albedo_type(0,m) == 1 )  THEN
+                 surf%rrtm_aldir(m) = 0.026_wp /                               &
+                                             ( zenith(0)**1.7_wp + 0.065_wp )  &
                                   + 0.15_wp * ( zenith(0) - 0.1_wp )           &
                                             * ( zenith(0) - 0.5_wp )           &
                                             * ( zenith(0) - 1.0_wp )
-              rrtm_asdir(0,:,:) = rrtm_aldir(0,:,:)
-!
-!--        Snow
-           ELSEIF ( albedo_type == 16 )  THEN
-              IF ( zenith(0) < 0.5_wp )  THEN
-                 rrtm_aldir(0,:,:) = 0.5_wp * (1.0_wp - aldif)                 &
+                 surf%rrtm_asdir(m) = surf%rrtm_aldir(m)
+!
+!--           Snow
+              ELSEIF ( surf%albedo_type(0,m) == 16 )  THEN
+                 IF ( zenith(0) < 0.5_wp )  THEN
+                    surf%rrtm_aldir(m) = 0.5_wp * (1.0_wp - surf%aldif(m))     &
                                      * ( 3.0_wp / (1.0_wp + 4.0_wp             &
                                      * zenith(0))) - 1.0_wp
-                 rrtm_asdir(0,:,:) = 0.5_wp * (1.0_wp - asdif)                 &
+                    surf%rrtm_asdir(m) = 0.5_wp * (1.0_wp - surf%asdif(m))     &
                                      * ( 3.0_wp / (1.0_wp + 4.0_wp             &
                                      * zenith(0))) - 1.0_wp
 
-                 rrtm_aldir(0,:,:) = MIN(0.98_wp, rrtm_aldir(0,:,:))
-                 rrtm_asdir(0,:,:) = MIN(0.98_wp, rrtm_asdir(0,:,:))
+                    surf%rrtm_aldir(m) = MIN(0.98_wp, surf%rrtm_aldir(m))
+                    surf%rrtm_asdir(m) = MIN(0.98_wp, surf%rrtm_asdir(m))
+                 ELSE
+                    surf%rrtm_aldir(m) = surf%aldif(m)
+                    surf%rrtm_asdir(m) = surf%asdif(m)
+                 ENDIF
+!
+!--           Sea ice
+              ELSEIF ( surf%albedo_type(0,m) == 15 )  THEN
+                 surf%rrtm_aldir(m) = surf%aldif(m)
+                 surf%rrtm_asdir(m) = surf%asdif(m)
+
+!
+!--           Asphalt
+              ELSEIF ( surf%albedo_type(0,m) == 17 )  THEN
+                 surf%rrtm_aldir(m) = surf%aldif(m)
+                 surf%rrtm_asdir(m) = surf%asdif(m)
+
+
+!
+!--           Bare soil
+              ELSEIF ( surf%albedo_type(0,m) == 18 )  THEN
+                 surf%rrtm_aldir(m) = surf%aldif(m)
+                 surf%rrtm_asdir(m) = surf%asdif(m)
+
+!
+!--           Land surfaces
               ELSE
-                 rrtm_aldir(0,:,:) = aldif
-                 rrtm_asdir(0,:,:) = asdif
+                 SELECT CASE ( surf%albedo_type(0,m) )
+
+!
+!--                 Surface types with strong zenith dependence
+                    CASE ( 1, 2, 3, 4, 11, 12, 13 )
+                       surf%rrtm_aldir(m) = surf%aldif(m) * 1.4_wp /                       &
+                                        (1.0_wp + 0.8_wp * zenith(0))
+                       surf%rrtm_asdir(m) = surf%asdif(m) * 1.4_wp /                       &
+                                        (1.0_wp + 0.8_wp * zenith(0))
+!
+!--                 Surface types with weak zenith dependence
+                    CASE ( 5, 6, 7, 8, 9, 10, 14 )
+                       surf%rrtm_aldir(m) = surf%aldif(m) * 1.1_wp /                       &
+                                        (1.0_wp + 0.2_wp * zenith(0))
+                       surf%rrtm_asdir(m) = surf%asdif(m) * 1.1_wp /                       &
+                                        (1.0_wp + 0.2_wp * zenith(0))
+
+                    CASE DEFAULT
+
+                 END SELECT
               ENDIF
 !
-!--        Sea ice
-           ELSEIF ( albedo_type == 15 )  THEN
-                 rrtm_aldir(0,:,:) = aldif
-                 rrtm_asdir(0,:,:) = asdif
-
-!
-!--        Bare soil
-           ELSEIF ( albedo_type == 17 )  THEN
-                 rrtm_aldir(0,:,:) = aldif
-                 rrtm_asdir(0,:,:) = asdif
-
-!
-!--        For impermeable surfaces, use values from the lookup table
-           ELSEIF ( albedo_type > 17 )  THEN
-                 rrtm_aldir(0,:,:) = aldif
-                 rrtm_asdir(0,:,:) = asdif
-!
-!--        Land surfaces
-           ELSE
-               SELECT CASE ( albedo_type )
-
-!
-!--              Surface types with strong zenith dependence
-                 CASE ( 1, 2, 3, 4, 11, 12, 13 )
-                    rrtm_aldir(0,:,:) = aldif * 1.4_wp /                       &
-                                        (1.0_wp + 0.8_wp * zenith(0))
-                    rrtm_asdir(0,:,:) = asdif * 1.4_wp /                       &
-                                        (1.0_wp + 0.8_wp * zenith(0))
-!
-!--              Surface types with weak zenith dependence
-                 CASE ( 5, 6, 7, 8, 9, 10, 14 )
-                    rrtm_aldir(0,:,:) = aldif * 1.1_wp /                       &
-                                        (1.0_wp + 0.2_wp * zenith(0))
-                    rrtm_asdir(0,:,:) = asdif * 1.1_wp /                       &
-                                        (1.0_wp + 0.2_wp * zenith(0))
-
-                 CASE DEFAULT
-
-              END SELECT
-           ENDIF
-!
-!--        Diffusive albedo is taken from Table 2
-           rrtm_aldif(0,:,:) = aldif
-           rrtm_asdif(0,:,:) = asdif
-
+!--           Diffusive albedo is taken from Table 2
+              surf%rrtm_aldif(m) = surf%aldif(m)
+              surf%rrtm_asdif(m) = surf%asdif(m)
+           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
-
-           rrtm_aldir(0,:,:) = 0.0_wp
-           rrtm_asdir(0,:,:) = 0.0_wp
-           rrtm_aldif(0,:,:) = 0.0_wp
-           rrtm_asdif(0,:,:) = 0.0_wp
+           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
 
@@ -2478,4 +4390,2587 @@
  END SUBROUTINE radiation_tendency
 
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> This subroutine calculates interaction of the solar radiation
+!> with urban and land surfaces and updates all surface heatfluxes, including
+!> the vertual atmospheric cell faces. It calculates also the required parameters
+!> for RRTMG lower BC.
+!>  
+!> For more info. see Resler et al. 2017
+!>  
+!------------------------------------------------------------------------------!
+    SUBROUTINE radiation_interaction_init
+    
+       USE netcdf_data_input_mod,                                              &
+           ONLY:  leaf_area_density_f
+
+       USE plant_canopy_model_mod,                                             &      
+           ONLY:  plant_canopy, pch_index,                                     &
+                  pc_heating_rate, lad_s, prototype_lad, usm_lad_rma       
+       
+       USE surface_mod,                                                        &
+           ONLY:  get_topography_top_index, surf_lsm_h, surf_lsm_v, surf_usm_h,&
+                  surf_usm_v
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) :: i, j, k, d, l, ir, jr, ids, m
+       INTEGER(iwp) :: k_topo     !< vertical index indicating topography top for given (j,i)
+       INTEGER(iwp) :: k_topo2    !< vertical index indicating topography top for given (j,i)
+       INTEGER(iwp) :: nzubl, nzutl, isurf, ipcgb
+       INTEGER(iwp) :: procid
+
+       INTEGER(iwp), DIMENSION(1:4,inorth_b:iwest_b)  ::  ijdb                               !< start and end of the local domain border coordinates (set in code)
+       LOGICAL, DIMENSION(inorth_b:iwest_b)           ::  isborder                           !< is PE on the border of the domain in four corresponding directions
+
+!
+!--    Find nzub, nzut, nzu 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( get_topography_top_index( 's' ) )
+       nzutl = MAXVAL( get_topography_top_index( 's' ) )
+
+       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 = get_topography_top_index( j, i, 's' )
+
+                   DO k = nzt+1, 0, -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 + pch(j,i)
+                           EXIT
+                       ENDIF
+                   ENDDO
+               ENDDO
+           ENDDO
+           
+           nzutl = MAX( nzutl, MAXVAL( pct ) )
+!--        code of plant canopy model uses parameter pch_index
+!--        we need to setup it here to right value
+!--        (pch_index, lad_s and other arrays in PCM are defined flat)
+           pch_index = MERGE( leaf_area_density_f%nz - 1, MAXVAL( pch ),       &
+                              leaf_area_density_f%from_file ) 
+
+           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('usm_init_urban_surface', 'PA0520', 0, 0, -1, 6, 0)
+       ENDIF
+       
+       nzutl = MIN( nzutl + nzut_free, nzt )
+
+#if defined( __parallel )
+       CALL MPI_AllReduce(nzubl, nzub, 1, MPI_INTEGER, MPI_MIN, comm2d, ierr )
+       CALL MPI_AllReduce(nzutl, nzut, 1, MPI_INTEGER, MPI_MAX, comm2d, ierr )
+#else
+       nzub = nzubl
+       nzut = nzutl
+#endif
+!
+!--    global number of urban layers
+       nzu = nzut - nzub + 1
+!
+!--    allocate urban surfaces grid
+!--    calc number of surfaces in local proc
+       CALL location_message( '    calculation of indices for surfaces', .TRUE. )
+       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.
+       startland = 1
+       nsurfl    = surf_usm_h%ns + surf_lsm_h%ns
+       endland   = nsurfl
+       nlands    = endland - startland + 1
+
+!
+!--    Number of vertical surfaces in both USM and LSM. Note that all vertical surface elements are 
+!--    already counted in surface_mod.
+       startwall = nsurfl+1
+       DO  i = 0,3
+          nsurfl = nsurfl + surf_usm_v(i)%ns + surf_lsm_v(i)%ns
+       ENDDO
+       endwall = nsurfl
+       nwalls  = endwall - startwall + 1
+       
+!--    range of energy balance surfaces  ! will be treated separately by surf_usm_h and surf_usm_v
+!--    Do we really need usm_energy_balance_land??!!
+!--    !!! Attention: if usm_energy_balance_land = false then only vertical surfaces will be considered here
+       nenergy = 0
+       IF ( energy_balance_surf_h )  THEN
+           startenergy = startland
+           nenergy = nenergy + nlands
+       ELSE
+           startenergy = startwall
+       ENDIF
+       IF ( energy_balance_surf_v )  THEN
+           endenergy = endwall
+           nenergy = nenergy + nwalls
+       ELSE
+           endenergy = endland
+       ENDIF
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!--    block of virtual surfaces
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!--    calculate sky surfaces  ! not used so far!
+       startsky = nsurfl+1
+       nsurfl = nsurfl+(nxr-nxl+1)*(nyn-nys+1)
+       endsky = nsurfl
+       nskys = endsky-startsky+1
+       
+!--    border flags
+#if defined( __parallel )
+       isborder = (/ north_border_pe, south_border_pe, right_border_pe, left_border_pe /)
+#else
+       isborder = (/.TRUE.,.TRUE.,.TRUE.,.TRUE./)
+#endif
+!--    fill array of the limits of the local domain borders
+       ijdb = RESHAPE( (/ nxl,nxr,nyn,nyn,nxl,nxr,nys,nys,nxr,nxr,nys,nyn,nxl,nxl,nys,nyn /), (/4, 4/) )
+!--    calulation of the free borders of the domain
+       startborder = nsurfl + 1
+       DO  ids = inorth_b,iwest_b
+          IF ( isborder(ids) )  THEN
+!--          free border of the domain in direction ids
+             DO  i = ijdb(1,ids), ijdb(2,ids)
+                DO  j = ijdb(3,ids), ijdb(4,ids)
+
+                   k_topo  = get_topography_top_index( j, i, 's' )
+                   k_topo2 = get_topography_top_index( j-jdir(ids), i-idir(ids), 's' )
+
+
+                   k = nzut - MAX( k_topo, k_topo2 )
+                   nsurfl = nsurfl + k
+                ENDDO
+             ENDDO
+          ENDIF
+       ENDDO
+       endborder = nsurfl
+       nborder = endborder - startborder + 1
+
+!--    calulation of the atmospheric virtual surfaces
+!--    each atmospheric cell has 6 faces
+       IF ( atm_surfaces ) THEN
+          DO i = nxl, nxr
+             DO j = nys, nyn
+!--              Find topography top index
+                 k_topo = get_topography_top_index( j, i, 's' )
+                 k = nzut - k_topo
+                 nsurfl = nsurfl + 6 * k
+             ENDDO
+          ENDDO
+!--       exclude the local physical surfaces
+          nsurfl = nsurfl - nlands - nwalls
+!--       exclude the local virtual surfaces
+          nsurfl = nsurfl - nskys - nborder
+       ENDIF
+
+!--    fill gridpcbl and pcbl
+       IF ( plant_canopy )  THEN
+           ALLOCATE( pcbl(iz:ix, 1:npcbl) )
+           ALLOCATE( gridpcbl(nzub:nzut,nys:nyn,nxl:nxr) )
+           gridpcbl(:,:,:) = 0
+           ipcgb = 0
+           DO i = nxl, nxr
+               DO j = nys, nyn
+!
+!--                Find topography top index
+                   k_topo = get_topography_top_index( j, i, 's' )
+
+                   DO k = k_topo + 1, pct(j,i)
+                       ipcgb = ipcgb + 1
+                       gridpcbl(k,j,i) = ipcgb
+                       pcbl(:,ipcgb) = (/ k, j, i /)
+                   ENDDO
+               ENDDO
+           ENDDO
+
+           ALLOCATE( pcbinsw( 1:npcbl ) )
+           ALLOCATE( pcbinlw( 1:npcbl ) )
+       ENDIF
+
+!--    fill surfl
+       ALLOCATE(surfl(5,nsurfl))  ! is it mecessary to allocate it with (5,nsurfl)?        
+       isurf = 0
+       
+!--    add horizontal surface elements (land and urban surfaces)
+!--    TODO: add urban overhanging surfaces (idown_u)
+       DO i = nxl, nxr
+           DO j = nys, nyn
+              DO  m = surf_usm_h%start_index(j,i), surf_usm_h%end_index(j,i)
+                 k = surf_usm_h%k(m)
+
+                 isurf = isurf + 1
+                 surfl(:,isurf) = (/iup_u,k,j,i,m/)
+              ENDDO
+
+              DO  m = surf_lsm_h%start_index(j,i), surf_lsm_h%end_index(j,i)
+                 k = surf_lsm_h%k(m)
+
+                 isurf = isurf + 1
+                 surfl(:,isurf) = (/iup_l,k,j,i,m/)
+              ENDDO
+              
+           ENDDO
+       ENDDO
+
+!--    add vertical surface elements (land and urban surfaces)
+!--    TODO: remove the hard coding of l = 0 to l = idirection        
+       DO i = nxl, nxr
+           DO j = nys, nyn
+              l = 0
+              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) = (/inorth_u,k,j,i,m/)
+              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) = (/inorth_l,k,j,i,m/)
+              ENDDO
+
+              l = 1
+              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) = (/isouth_u,k,j,i,m/)
+              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) = (/isouth_l,k,j,i,m/)
+              ENDDO
+
+              l = 2
+              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) = (/ieast_u,k,j,i,m/)
+              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) = (/ieast_l,k,j,i,m/)
+              ENDDO
+
+              l = 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) = (/iwest_u,k,j,i,m/)
+              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) = (/iwest_l,k,j,i,m/)
+              ENDDO
+           ENDDO
+       ENDDO
+
+!--    add sky
+       DO i = nxl, nxr
+           DO j = nys, nyn
+               isurf = isurf + 1
+               k = nzut
+               surfl(:,isurf) = (/isky,k,j,i,-1/)
+           ENDDO
+       ENDDO
+       
+!--    calulation of the free borders of the domain
+       DO ids = inorth_b,iwest_b
+           IF ( isborder(ids) )  THEN
+!--            free border of the domain in direction ids
+               DO i = ijdb(1,ids), ijdb(2,ids)
+                   DO j = ijdb(3,ids), ijdb(4,ids)
+                       k_topo  = get_topography_top_index( j, i, 's' )
+                       k_topo2 = get_topography_top_index( j-jdir(ids), i-idir(ids), 's' )
+
+                       DO k = MAX(k_topo,k_topo2)+1, nzut
+                           isurf = isurf + 1
+                           surfl(:,isurf) = (/ids,k,j,i,-1/)
+                       ENDDO
+                   ENDDO
+               ENDDO
+           ENDIF
+       ENDDO
+
+!--    adding the atmospheric virtual surfaces 
+       IF ( atm_surfaces ) THEN
+!-- TODO: use flags to identfy atmospheric cells and its coresponding surfaces           
+!--    add horizontal surface
+          DO i = nxl, nxr
+             DO j = nys, nyn
+                k_topo = get_topography_top_index( j, i, 's' )
+
+!--             add upward surface
+                DO k = (k_topo+1), nzut-1
+                   isurf = isurf + 1
+                   surfl(:,isurf) = (/iup_a,k+1,j,i,-1/)
+                ENDDO
+
+!--             add downward surface
+                DO k = (k_topo+1), nzut-1
+                   isurf = isurf + 1
+                   surfl(:,isurf) = (/idown_a,k,j,i,-1/)
+                ENDDO
+             ENDDO
+          ENDDO
+
+!--       add vertical surfaces
+          DO i = nxl, nxr
+             DO j = nys, nyn
+                k_topo = get_topography_top_index( j, i, 's' )
+!--             north
+                IF ( j /= ny ) THEN
+                   ids = inorth_a
+                   jr = min(max(j-jdir(ids),0),ny)
+                   ir = min(max(i-idir(ids),0),nx)
+                   k_topo2 = get_topography_top_index( jr, ir, 's' )
+                   DO k = MAX(k_topo,k_topo2)+1, nzut
+                      isurf = isurf + 1
+                      surfl(:,isurf) = (/inorth_a,k,j,i,-1/)
+                   ENDDO
+                END IF
+!--             south
+                IF ( j /= 0 ) THEN
+                   ids = isouth_a
+                   jr = min(max(j-jdir(ids),0),ny)
+                   ir = min(max(i-idir(ids),0),nx)
+                   k_topo2 = get_topography_top_index( jr, ir, 's' )
+
+                   DO k = MAX(k_topo,k_topo2)+1, nzut
+                      isurf = isurf + 1
+                      surfl(:,isurf) = (/isouth_a,k,j,i,-1/)
+                   ENDDO
+                END IF
+!--             east
+                IF ( i /= nx ) THEN
+                   ids = ieast_a
+                   jr = min(max(j-jdir(ids),0),ny)
+                   ir = min(max(i-idir(ids),0),nx)
+                   k_topo2 = get_topography_top_index( jr, ir, 's' )
+
+                   DO k = MAX(k_topo,k_topo2)+1, nzut
+                      isurf = isurf + 1
+                      surfl(:,isurf) = (/ieast_a,k,j,i,-1/)
+                   ENDDO
+                END IF
+!--             west
+                IF ( i /= 0 ) THEN
+                   ids = iwest_a
+                   jr = min(max(j-jdir(ids),0),ny)
+                   ir = min(max(i-idir(ids),0),nx)
+                   k_topo2 = get_topography_top_index( jr, ir, 's' )
+
+                   DO k = MAX(k_topo,k_topo2)+1, nzut
+                      isurf = isurf + 1
+                      surfl(:,isurf) = (/iwest_a,k,j,i,-1/)
+                   ENDDO
+                END IF
+             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. 
+!--     MS: Why startenergy:endenergy and albedo surf from 1:nsurfl ?  
+        ALLOCATE ( emiss_surf(startenergy:endenergy)  )
+
+
+!
+!--    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)
+#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
+       ALLOCATE(surf(5,nsurf))
+       
+#if defined( __parallel )
+       CALL MPI_AllGatherv(surfl, nsurfl*5, MPI_INTEGER, surf, nsurfs*5, surfstart*5, MPI_INTEGER, comm2d, ierr)
+#else
+       surf = surfl
+#endif
+
+!--
+!--    allocation of the arrays for direct and diffusion radiation
+       CALL location_message( '    allocation of radiation arrays', .TRUE. )
+!--    rad_sw_in, rad_lw_in are computed in radiation model,
+!--    splitting of direct and diffusion part is done
+!--    in usm_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(startenergy:endenergy) )
+       ALLOCATE( surfoutll(startenergy:endenergy) )
+       ALLOCATE( surfoutsw(startenergy:endenergy) )
+       ALLOCATE( surfoutlw(startenergy:endenergy) )
+       ALLOCATE( surfouts(nsurf) ) !TODO: global surfaces without virtual
+       ALLOCATE( surfoutl(nsurf) ) !TODO: global surfaces without virtual
+
+!
+!--    @Mohamed
+!--    In case of average_radiation, aggregated surface albedo and emissivity,
+!--    also set initial value of t_rad_urb.
+!--    For the moment set an arbitrary initial value. 
+       IF ( average_radiation )  THEN
+          albedo_urb = 0.5_wp
+          emissivity_urb = 0.5_wp
+          t_rad_urb = pt_surface    
+       ENDIF 
+
+    END SUBROUTINE radiation_interaction_init
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> This subroutine calculates interaction of the solar radiation
+!> with urban and land surfaces and updates all surface heatfluxes, including
+!> the vertual atmospheric cell faces. It calculates also the required parameters
+!> for RRTMG lower BC.
+!>  
+!> For more info. see Resler et al. 2017
+!>  
+!------------------------------------------------------------------------------!
+    SUBROUTINE radiation_interaction
+    
+      
+      USE control_parameters
+
+      USE plant_canopy_model_mod,                                                &
+           ONLY: prototype_lad
+    
+        IMPLICIT NONE
+       
+        INTEGER(iwp)               :: i, j, k, kk, is, js, d, ku, refstep, m, mm, l, ll
+        INTEGER(iwp)               :: ii, jj !< running indices
+        INTEGER(iwp)               :: nzubl, nzutl, isurf, isurfsrc, isurf1, isvf, icsf, ipcgb
+        INTEGER(iwp), DIMENSION(4) :: bdycross
+        REAL(wp), DIMENSION(3,3)   :: mrot            !< grid rotation matrix (xyz)
+        REAL(wp), DIMENSION(3,0:nsurf_type) :: vnorm  !< face direction normal vectors (xyz)
+        REAL(wp), DIMENSION(3)     :: sunorig         !< grid rotated solar direction unit vector (xyz)
+        REAL(wp), DIMENSION(3)     :: sunorig_grid    !< grid squashed solar direction unit vector (zyx)
+        REAL(wp), DIMENSION(0:nsurf_type)  :: costheta        !< direct irradiance factor of solar angle
+        REAL(wp), DIMENSION(nzub:nzut) :: pchf_prep   !< precalculated factor for canopy temp tendency
+        REAL(wp), PARAMETER        :: alpha = 0._wp   !< grid rotation (TODO: add to namelist or remove)
+        REAL(wp)                   :: rx, ry, rz
+        REAL(wp)                   :: pc_box_area, pc_abs_frac, pc_abs_eff
+        INTEGER(iwp)               :: pc_box_dimshift !< transform for best accuracy
+        INTEGER(iwp), DIMENSION(0:3) :: reorder = (/ 1, 0, 3, 2 /)
+        REAL(wp),     DIMENSION(0:nsurf_type)       :: facearea
+        REAL(wp)                   :: pabsswl  = 0.0_wp  !< total absorbed SW radiation energy in local processor (W)
+        REAL(wp)                   :: pabssw   = 0.0_wp  !< total absorbed SW radiation energy in all processors (W)
+        REAL(wp)                   :: pabslwl  = 0.0_wp  !< total absorbed LW radiation energy in local processor (W)
+        REAL(wp)                   :: pabslw   = 0.0_wp  !< total absorbed LW radiation energy in all processors (W)
+        REAL(wp)                   :: pemitlwl = 0.0_wp  !< total emitted LW radiation energy in all processors (W)
+        REAL(wp)                   :: pemitlw  = 0.0_wp  !< total emitted LW radiation energy in all processors (W)
+        REAL(wp)                   :: pinswl   = 0.0_wp  !< total received SW radiation energy in local processor (W)
+        REAL(wp)                   :: pinsw    = 0.0_wp  !< total received SW radiation energy in all processor (W)
+        REAL(wp)                   :: pinlwl   = 0.0_wp  !< total received LW radiation energy in local processor (W)
+        REAL(wp)                   :: pinlw    = 0.0_wp  !< total received LW radiation energy in all processor (W)
+        REAL(wp)                   :: emiss_sum_surfl    !< sum of emissisivity of surfaces in local processor
+        REAL(wp)                   :: emiss_sum_surf     !< sum of emissisivity of surfaces in all processor
+        REAL(wp)                   :: area_surfl         !< total area of surfaces in local processor
+        REAL(wp)                   :: area_surf          !< total area of surfaces in all processor
+        
+        IF ( plant_canopy )  THEN
+            pchf_prep(:) = r_d * (hyp(nzub:nzut) / 100000.0_wp)**0.286_wp &
+                        / (cp * hyp(nzub:nzut) * dx*dy*dz) !< equals to 1 / (rho * c_p * Vbox * T)
+        ENDIF
+
+        sun_direction = .TRUE.
+        CALL calc_zenith  !< required also for diffusion radiation
+
+!--     prepare rotated normal vectors and irradiance factor
+        vnorm(1,:) = idir(:)
+        vnorm(2,:) = jdir(:)
+        vnorm(3,:) = kdir(:)
+        mrot(1, :) = (/ cos(alpha), -sin(alpha), 0._wp /)
+        mrot(2, :) = (/ sin(alpha),  cos(alpha), 0._wp /)
+        mrot(3, :) = (/ 0._wp,       0._wp,      1._wp /)
+        sunorig = (/ sun_dir_lon, sun_dir_lat, zenith(0) /)
+        sunorig = matmul(mrot, sunorig)
+        DO d = 0, nsurf_type
+            costheta(d) = dot_product(sunorig, vnorm(:,d))
+        ENDDO
+        
+        IF ( zenith(0) > 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(3)/dz, sunorig(2)/dy, sunorig(1)/dx /)
+!--         sunorig_grid = sunorig_grid / norm2(sunorig_grid)
+            sunorig_grid = sunorig_grid / SQRT(SUM(sunorig_grid**2))
+
+            IF ( plant_canopy )  THEN
+!--            precompute effective box depth with prototype Leaf Area Density
+               pc_box_dimshift = maxloc(sunorig, 1) - 1
+               CALL box_absorb(cshift((/dx,dy,dz/), pc_box_dimshift),          &
+                                   60, prototype_lad,                          &
+                                   cshift(sunorig, pc_box_dimshift),           &
+                                   pc_box_area, pc_abs_frac)
+               pc_box_area = pc_box_area * sunorig(pc_box_dimshift+1) / sunorig(3)
+               pc_abs_eff = log(1._wp - pc_abs_frac) / prototype_lad
+            ENDIF
+        ENDIF
+        
+!--     split diffusion and direct part of the solar downward radiation
+!--     comming from radiation model and store it in 2D arrays
+!--     rad_sw_in_diff, rad_sw_in_dir and rad_lw_in_diff
+        IF ( split_diffusion_radiation )  THEN
+            CALL calc_diffusion_radiation
+        ELSE
+           DO  i = nxl, nxr
+              DO  j = nys, nyn
+                 DO  m = surf_def_h(0)%start_index(j,i),                       &
+                         surf_def_h(0)%end_index(j,i)
+                    rad_sw_in_diff(j,i) = 0.0_wp
+                    rad_sw_in_dir(j,i)  = surf_def_h(0)%rad_sw_in(m)
+                    rad_lw_in_diff(j,i) = surf_def_h(0)%rad_lw_in(m)
+                 ENDDO
+                 DO  m = surf_lsm_h%start_index(j,i),                          &
+                         surf_lsm_h%end_index(j,i)
+                    rad_sw_in_diff(j,i) = 0.0_wp
+                    rad_sw_in_dir(j,i)  = surf_lsm_h%rad_sw_in(m)
+                    rad_lw_in_diff(j,i) = surf_lsm_h%rad_lw_in(m)
+                 ENDDO
+                 DO  m = surf_usm_h%start_index(j,i),                          &
+                         surf_usm_h%end_index(j,i)
+                    rad_sw_in_diff(j,i) = 0.0_wp
+                    rad_sw_in_dir(j,i)  = surf_usm_h%rad_sw_in(m)
+                    rad_lw_in_diff(j,i) = surf_usm_h%rad_lw_in(m)
+                 ENDDO
+              ENDDO
+           ENDDO
+        ENDIF
+
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!--     First pass: direct + diffuse irradiance
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+        surfinswdir   = 0._wp !nsurfl
+        surfinswdif   = 0._wp !nsurfl
+        surfinlwdif   = 0._wp !nsurfl
+        surfins       = 0._wp !nsurfl
+        surfinl       = 0._wp !nsurfl
+        surfoutsl(:)  = 0.0_wp !start-end
+        surfoutll(:)  = 0.0_wp !start-end
+        
+!--     Set up thermal radiation from surfaces
+!--     emiss_surf is defined only for surfaces for which energy balance is calculated
+!--     Workaround: reorder surface data type back on 1D array including all surfaces, 
+!--     which implies to reorder horizontal and vertical surfaces
+!
+!--     Horizontal walls
+        mm = 1
+        DO  i = nxl, nxr
+           DO  j = nys, nyn
+!--           urban
+              DO  m = surf_usm_h%start_index(j,i), surf_usm_h%end_index(j,i)
+                 surfoutll(mm) = SUM ( surf_usm_h%frac(:,m) *                  &
+                                       surf_usm_h%emissivity(:,m) )            &
+                                     * sigma_sb                                &
+                                     * surf_usm_h%pt_surface(m)**4
+                 albedo_surf(mm) = SUM ( surf_usm_h%frac(:,m) *                &
+                                         surf_usm_h%albedo(:,m) )       
+                 emiss_surf(mm)  = SUM ( surf_usm_h%frac(:,m) *                &
+                                         surf_usm_h%emissivity(:,m) )  
+                 mm = mm + 1
+              ENDDO
+!--           land
+              DO  m = surf_lsm_h%start_index(j,i), surf_lsm_h%end_index(j,i)
+                 surfoutll(mm) = SUM ( surf_lsm_h%frac(:,m) *                  &
+                                       surf_lsm_h%emissivity(:,m) )            &
+                                     * sigma_sb                                &
+                                     * surf_lsm_h%pt_surface(m)**4
+                 albedo_surf(mm) = SUM ( surf_lsm_h%frac(:,m) *                &
+                                         surf_lsm_h%albedo(:,m) )       
+                 emiss_surf(mm)  = SUM ( surf_lsm_h%frac(:,m) *                &
+                                         surf_lsm_h%emissivity(:,m) )   
+                 mm = mm + 1
+              ENDDO
+           ENDDO
+        ENDDO
+!
+!--     Vertical walls
+        DO  i = nxl, nxr
+           DO  j = nys, nyn
+              DO  ll = 0, 3
+                 l = reorder(ll)
+!--              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 defined( __parallel )
+!--     might be optimized and gather only values relevant for current processor
+        
+        CALL MPI_AllGatherv(surfoutll, nenergy, MPI_REAL, &
+                            surfoutl, nsurfs, surfstart, MPI_REAL, comm2d, ierr) !nsurf global
+#else
+        surfoutl(:) = surfoutll(:) !nsurf global
+#endif
+        
+        isurf1 = -1   !< previous processed surface
+        DO isvf = 1, nsvfl
+            isurf = svfsurf(1, isvf)
+            k = surfl(iz, isurf)
+            j = surfl(iy, isurf)
+            i = surfl(ix, isurf)
+            isurfsrc = svfsurf(2, isvf)
+            IF ( zenith(0) > 0  .AND.  isurf /= isurf1 )  THEN
+!--             locate the virtual surface where the direct solar ray crosses domain boundary
+!--             (once per target surface)
+                d = surfl(id, isurf)
+                rz = REAL(k, wp) - 0.5_wp * kdir(d)
+                ry = REAL(j, wp) - 0.5_wp * jdir(d)
+                rx = REAL(i, wp) - 0.5_wp * idir(d)
+                
+                CALL find_boundary_face( (/ rz, ry, rx /), sunorig_grid, bdycross)
+                
+                isurf1 = isurf
+            ENDIF
+
+            IF ( surf(id, isurfsrc) >= isky )  THEN
+!--             diffuse rad from boundary surfaces. Since it is a simply
+!--             calculated value, it is not assigned to surfref(s/l),
+!--             instead it is used directly here
+!--             we consider the radiation from the radiation model falling on surface
+!--             as the radiation falling on the top of urban layer into the place of the source surface
+!--             we consider it as a very reasonable simplification which allow as avoid
+!--             necessity of other global range arrays and some all to all mpi communication
+                surfinswdif(isurf) = surfinswdif(isurf) + rad_sw_in_diff(j,i) * svf(1,isvf) * svf(2,isvf)
+                                                                !< canopy shading is applied only to shortwave
+                surfinlwdif(isurf) = surfinlwdif(isurf) + rad_lw_in_diff(j,i) * svf(1,isvf)
+            ELSE
+!--             for surface-to-surface factors we calculate thermal radiation in 1st pass
+                surfinl(isurf) = surfinl(isurf) + svf(1,isvf) * surfoutl(isurfsrc)
+            ENDIF
+
+            IF ( zenith(0) > 0  .AND.  all( surf(1:4,isurfsrc) == bdycross ) )  THEN
+!--             found svf between model boundary and the face => face isn't shaded
+                surfinswdir(isurf) = rad_sw_in_dir(j,i) &
+                    * costheta(surfl(id, isurf)) * svf(2,isvf) / zenith(0)
+
+            ENDIF
+        ENDDO
+
+        IF ( plant_canopy )  THEN
+        
+            pcbinsw(:) = 0._wp
+            pcbinlw(:) = 0._wp  !< will stay always 0 since we don't absorb lw anymore
+            !
+!--         pcsf first pass
+            isurf1 = -1  !< previous processed pcgb
+            DO icsf = 1, ncsfl
+                ipcgb = csfsurf(1, icsf)
+                i = pcbl(ix,ipcgb)
+                j = pcbl(iy,ipcgb)
+                k = pcbl(iz,ipcgb)
+                isurfsrc = csfsurf(2, icsf)
+
+                IF ( zenith(0) > 0  .AND.  ipcgb /= isurf1 )  THEN
+!--                 locate the virtual surface where the direct solar ray crosses domain boundary
+!--                 (once per target PC gridbox)
+                    rz = REAL(k, wp)
+                    ry = REAL(j, wp)
+                    rx = REAL(i, wp)
+                    CALL find_boundary_face( (/ rz, ry, rx /), &
+                        sunorig_grid, bdycross)
+
+                    isurf1 = ipcgb
+                ENDIF
+
+                IF ( surf(id, isurfsrc) >= isky )  THEN
+!--                 Diffuse rad from boundary surfaces. See comments for svf above.
+                    pcbinsw(ipcgb) = pcbinsw(ipcgb) + csf(1,icsf) * csf(2,icsf) * rad_sw_in_diff(j,i)
+!--                 canopy shading is applied only to shortwave, therefore no absorbtion for lw
+!--                 pcbinlw(ipcgb) = pcbinlw(ipcgb) + svf(1,isvf) * rad_lw_in_diff(j,i)
+                !ELSE
+!--                 Thermal radiation in 1st pass
+!--                 pcbinlw(ipcgb) = pcbinlw(ipcgb) + svf(1,isvf) * surfoutl(isurfsrc)
+                ENDIF
+
+                IF ( zenith(0) > 0  .AND.  ALL( surf(1:4,isurfsrc) == bdycross ) )  THEN
+!--                 found svf between model boundary and the pcgb => pcgb isn't shaded
+                    pc_abs_frac = 1._wp - EXP(pc_abs_eff * lad_s(k,j,i))
+                    pcbinsw(ipcgb) = pcbinsw(ipcgb) &
+                        + rad_sw_in_dir(j, i) * pc_box_area * csf(2,icsf) * pc_abs_frac
+                ENDIF
+            ENDDO
+        ENDIF
+
+        surfins(startenergy:endenergy) = surfinswdir(startenergy:endenergy) + surfinswdif(startenergy:endenergy)
+        surfinl(startenergy:endenergy) = surfinl(startenergy:endenergy) + surfinlwdif(startenergy:endenergy)
+        surfinsw(:) = surfins(:)
+        surfinlw(:) = surfinl(:)
+        surfoutsw(:) = 0.0_wp
+        surfoutlw(:) = surfoutll(:)
+!         surfhf(startenergy:endenergy) = surfinsw(startenergy:endenergy) + surfinlw(startenergy:endenergy) &
+!                                       - surfoutsw(startenergy:endenergy) - surfoutlw(startenergy:endenergy)
+        
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+!--     Next passes - reflections
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+        DO refstep = 1, nrefsteps
+        
+            surfoutsl(startenergy:endenergy) = albedo_surf(startenergy:endenergy) * surfins(startenergy:endenergy)
+!--         for non-transparent surfaces, longwave albedo is 1 - emissivity
+            surfoutll(startenergy:endenergy) = (1._wp - emiss_surf(startenergy:endenergy)) * surfinl(startenergy:endenergy)
+
+#if defined( __parallel )
+            CALL MPI_AllGatherv(surfoutsl, nsurfl, MPI_REAL, &
+                surfouts, nsurfs, surfstart, MPI_REAL, comm2d, ierr)
+            CALL MPI_AllGatherv(surfoutll, nsurfl, MPI_REAL, &
+                surfoutl, nsurfs, surfstart, MPI_REAL, comm2d, ierr)
+#else
+            surfouts(:) = surfoutsl(:)
+            surfoutl(:) = surfoutll(:)
+#endif
+
+!--         reset for next pass input
+            surfins(:) = 0._wp
+            surfinl(:) = 0._wp
+            
+!--         reflected radiation
+            DO isvf = 1, nsvfl
+                isurf = svfsurf(1, isvf)
+                isurfsrc = svfsurf(2, isvf)
+
+!--             TODO: to remove if, use start+end for isvf
+                IF ( surf(id, isurfsrc) < isky )  THEN
+                    surfins(isurf) = surfins(isurf) + svf(1,isvf) * svf(2,isvf) * surfouts(isurfsrc)
+                    surfinl(isurf) = surfinl(isurf) + svf(1,isvf) * surfoutl(isurfsrc)
+                ENDIF
+            ENDDO
+
+!--         radiation absorbed by plant canopy
+            DO icsf = 1, ncsfl
+                ipcgb = csfsurf(1, icsf)
+                isurfsrc = csfsurf(2, icsf)
+
+                IF ( surf(id, isurfsrc) < isky )  THEN
+                    pcbinsw(ipcgb) = pcbinsw(ipcgb) + csf(1,icsf) * csf(2,icsf) * surfouts(isurfsrc)
+!--                 pcbinlw(ipcgb) = pcbinlw(ipcgb) + csf(1,icsf) * surfoutl(isurfsrc)
+                ENDIF
+            ENDDO
+            
+            surfinsw(:) = surfinsw(:)  + surfins(:)
+            surfinlw(:) = surfinlw(:)  + surfinl(:)
+            surfoutsw(startenergy:endenergy) = surfoutsw(startenergy:endenergy) + surfoutsl(startenergy:endenergy)
+            surfoutlw(startenergy:endenergy) = surfoutlw(startenergy:endenergy) + surfoutll(startenergy:endenergy)
+!             surfhf(startenergy:endenergy) = surfinsw(startenergy:endenergy) + surfinlw(startenergy:endenergy) &
+!                                           - surfoutsw(startenergy:endenergy) - surfoutlw(startenergy:endenergy)
+        
+        ENDDO
+
+!--     push heat flux absorbed by plant canopy to respective 3D arrays
+        IF ( plant_canopy )  THEN
+            pc_heating_rate(:,:,:) = 0._wp
+            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 - get_topography_top_index( j, i, 's' )  !- lad arrays are defined flat
+                pc_heating_rate(kk, j, i) = (pcbinsw(ipcgb) + pcbinlw(ipcgb)) &
+                    * pchf_prep(k) * pt(k, j, i) !-- = dT/dt
+            ENDDO
+        ENDIF
+!
+!--     Transfer radiation arrays required for energy balance to the respective data types
+        DO  i = startenergy, endenergy
+           m  = surfl(5,i)          
+!
+!--        (1) Urban surfaces
+!--        upward-facing
+           IF ( surfl(1,i) == iup_u )  THEN
+              surf_usm_h%rad_sw_in(m)  = surfinsw(i)
+              surf_usm_h%rad_sw_out(m) = surfoutsw(i)
+              surf_usm_h%rad_lw_in(m)  = surfinlw(i)
+              surf_usm_h%rad_lw_out(m) = surfoutlw(i)
+              surf_usm_h%rad_net(m)    = surfinsw(i) - surfoutsw(i) +          &
+                                         surfinlw(i) - surfoutlw(i)
+!
+!--        northward-facding
+           ELSEIF ( surfl(1,i) == inorth_u )  THEN
+              surf_usm_v(0)%rad_sw_in(m)  = surfinsw(i) 
+              surf_usm_v(0)%rad_sw_out(m) = surfoutsw(i) 
+              surf_usm_v(0)%rad_lw_in(m)  = surfinlw(i)
+              surf_usm_v(0)%rad_lw_out(m) = surfoutlw(i)
+              surf_usm_v(0)%rad_net(m)    = surfinsw(i) - surfoutsw(i) +       &
+                                            surfinlw(i) - surfoutlw(i)
+!
+!--        southward-facding
+           ELSEIF ( surfl(1,i) == isouth_u )  THEN
+              surf_usm_v(1)%rad_sw_in(m)  = surfinsw(i) 
+              surf_usm_v(1)%rad_sw_out(m) = surfoutsw(i) 
+              surf_usm_v(1)%rad_lw_in(m)  = surfinlw(i)
+              surf_usm_v(1)%rad_lw_out(m) = surfoutlw(i)
+              surf_usm_v(1)%rad_net(m)    = surfinsw(i) - surfoutsw(i) +       &
+                                            surfinlw(i) - surfoutlw(i)
+!
+!--        eastward-facing
+           ELSEIF ( surfl(1,i) == ieast_u )  THEN
+              surf_usm_v(2)%rad_sw_in(m)  = surfinsw(i) 
+              surf_usm_v(2)%rad_sw_out(m) = surfoutsw(i) 
+              surf_usm_v(2)%rad_lw_in(m)  = surfinlw(i)
+              surf_usm_v(2)%rad_lw_out(m) = surfoutlw(i)
+              surf_usm_v(2)%rad_net(m)    = surfinsw(i) - surfoutsw(i) +       &
+                                            surfinlw(i) - surfoutlw(i)
+!
+!--        westward-facding
+           ELSEIF ( surfl(1,i) == iwest_u )  THEN
+              surf_usm_v(3)%rad_sw_in(m)  = surfinsw(i) 
+              surf_usm_v(3)%rad_sw_out(m) = surfoutsw(i) 
+              surf_usm_v(3)%rad_lw_in(m)  = surfinlw(i)
+              surf_usm_v(3)%rad_lw_out(m) = surfoutlw(i)
+              surf_usm_v(3)%rad_net(m)    = surfinsw(i) - surfoutsw(i) +       &
+                                            surfinlw(i) - surfoutlw(i)
+!
+!--        (2) land surfaces
+!--        upward-facing
+           ELSEIF ( surfl(1,i) == iup_l )  THEN
+              surf_lsm_h%rad_sw_in(m)  = surfinsw(i) 
+              surf_lsm_h%rad_sw_out(m) = surfoutsw(i) 
+              surf_lsm_h%rad_lw_in(m)  = surfinlw(i)
+              surf_lsm_h%rad_lw_out(m) = surfoutlw(i)
+              surf_lsm_h%rad_net(m)    = surfinsw(i) - surfoutsw(i) +          &
+                                         surfinlw(i) - surfoutlw(i)
+!
+!--        northward-facding
+           ELSEIF ( surfl(1,i) == inorth_l )  THEN
+              surf_lsm_v(0)%rad_sw_in(m)  = surfinsw(i) 
+              surf_lsm_v(0)%rad_sw_out(m) = surfoutsw(i) 
+              surf_lsm_v(0)%rad_lw_in(m)  = surfinlw(i)
+              surf_lsm_v(0)%rad_lw_out(m) = surfoutlw(i)
+              surf_lsm_v(0)%rad_net(m)    = surfinsw(i) - surfoutsw(i) +       &
+                                            surfinlw(i) - surfoutlw(i)
+!
+!--        southward-facding
+           ELSEIF ( surfl(1,i) == isouth_l )  THEN
+              surf_lsm_v(1)%rad_sw_in(m)  = surfinsw(i) 
+              surf_lsm_v(1)%rad_sw_out(m) = surfoutsw(i) 
+              surf_lsm_v(1)%rad_lw_in(m)  = surfinlw(i)
+              surf_lsm_v(1)%rad_lw_out(m) = surfoutlw(i)
+              surf_lsm_v(1)%rad_net(m)    = surfinsw(i) - surfoutsw(i) +       &
+                                            surfinlw(i) - surfoutlw(i)
+!
+!--        eastward-facing
+           ELSEIF ( surfl(1,i) == ieast_l )  THEN
+              surf_lsm_v(2)%rad_sw_in(m)  = surfinsw(i) 
+              surf_lsm_v(2)%rad_sw_out(m) = surfoutsw(i) 
+              surf_lsm_v(2)%rad_lw_in(m)  = surfinlw(i)
+              surf_lsm_v(2)%rad_lw_out(m) = surfoutlw(i)
+              surf_lsm_v(2)%rad_net(m)    = surfinsw(i) - surfoutsw(i) +       &
+                                            surfinlw(i) - surfoutlw(i)
+!
+!--        westward-facding
+           ELSEIF ( surfl(1,i) == iwest_l )  THEN
+              surf_lsm_v(3)%rad_sw_in(m)  = surfinsw(i) 
+              surf_lsm_v(3)%rad_sw_out(m) = surfoutsw(i) 
+              surf_lsm_v(3)%rad_lw_in(m)  = surfinlw(i)
+              surf_lsm_v(3)%rad_lw_out(m) = surfoutlw(i)
+              surf_lsm_v(3)%rad_net(m)    = surfinsw(i) - surfoutsw(i) +       &
+                                            surfinlw(i) - surfoutlw(i)
+           ENDIF
+
+        ENDDO
+
+        DO  m = 1, surf_usm_h%ns
+           surf_usm_h%surfhf(m) = surf_usm_h%rad_sw_in(m)  +                   &
+                                  surf_usm_h%rad_lw_in(m)  -                   &
+                                  surf_usm_h%rad_sw_out(m) -                   &
+                                  surf_usm_h%rad_lw_out(m)
+        ENDDO
+        DO  m = 1, surf_lsm_h%ns
+           surf_lsm_h%surfhf(m) = surf_lsm_h%rad_sw_in(m)  +                   &
+                                  surf_lsm_h%rad_lw_in(m)  -                   &
+                                  surf_lsm_h%rad_sw_out(m) -                   &
+                                  surf_lsm_h%rad_lw_out(m)
+        ENDDO
+
+        DO  l = 0, 3
+!--        urban
+           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
+           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
+!
+!--     Calculate the average temperature, albedo, and emissivity for urban/land domain
+!--     in case of using average_radiation in the respective radiation model
+        IF ( average_radiation )  THEN
+
+!--
+!--        precalculate face areas for different face directions using normal vector
+!--        TODO: make facearea a globale variable because it is used in more than one subroutine
+           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
+           ENDDO
+!
+!--        total absorbed SW & LW and emitted LW energy by all physical surfaces (land and urban) in local processor
+           pabsswl = 0._wp
+           pabslwl = 0._wp
+           pemitlwl = 0._wp
+           emiss_sum_surfl = 0._wp
+           area_surfl = 0._wp
+           DO  i = startenergy, endenergy
+              d = surfl(id, i)
+              pabsswl = pabsswl + (1._wp - albedo_surf(i)) * surfinsw(i) * facearea(d)
+              pabslwl = pabslwl + emiss_surf(i) * surfinlw(i) * facearea(d)
+              pemitlwl = pemitlwl + surfoutlw(i) * facearea(d)
+              emiss_sum_surfl = emiss_sum_surfl + emiss_surf(i) * facearea(d)
+              area_surfl = area_surfl + facearea(d)
+           END DO
+!
+!--        add the absorbed SW energy by plant canopy
+           IF ( plant_canopy )  THEN
+              pabsswl = pabsswl + SUM(pcbinsw)
+              pabslwl = pabslwl + SUM(pcbinlw)
+           ENDIF
+!
+!--        gather all absorbed SW energy in all processors
+#if defined( __parallel )
+           CALL MPI_ALLREDUCE( pabsswl, pabssw, 1, MPI_REAL, MPI_SUM, comm2d, ierr )
+           CALL MPI_ALLREDUCE( pabslwl, pabslw, 1, MPI_REAL, MPI_SUM, comm2d, ierr )
+           CALL MPI_ALLREDUCE( pemitlwl, pemitlw, 1, MPI_REAL, MPI_SUM, comm2d, ierr )
+           CALL MPI_ALLREDUCE( emiss_sum_surfl, emiss_sum_surf, 1, MPI_REAL, MPI_SUM, comm2d, ierr )
+           CALL MPI_ALLREDUCE( area_surfl, area_surf, 1, MPI_REAL, MPI_SUM, comm2d, ierr )
+#else
+           pabssw = pabsswl
+           pabslwl = pabslw
+           pemitlwl = pemitlw
+           emiss_sum_surf = emiss_sum_surfl
+           area_surf = area_surfl
+#endif
+!
+!--        total received SW energy in local processor !!!!!! cos??!!!!
+           pinswl = 0._wp
+           pinlwl = 0._wp
+!-- sky 
+           DO  i = startsky, endsky
+              d = surfl(id, i)
+              ii = surfl(ix, i)
+              jj = surfl(iy, i)
+              pinswl = pinswl + (rad_sw_in_dir(jj,ii) + rad_sw_in_diff(jj,ii)) * facearea(d)
+              pinlwl = pinlwl + rad_lw_in_diff(jj,ii) * facearea(d)
+           ENDDO
+!-- boundary
+           DO  i = startborder, endborder
+              d = surfl(id, i)
+              ii = surfl(ix, i)
+              jj = surfl(iy, i)
+              pinswl = pinswl + (rad_sw_in_dir(jj,ii) + rad_sw_in_diff(jj,ii)) * facearea(d)
+              pinlwl = pinlwl + rad_lw_in_diff(jj,ii) * facearea(d)
+           ENDDO
+!--        gather all received SW energy in all processors
+#if defined( __parallel )
+           CALL MPI_ALLREDUCE( pinswl, pinsw, 1, MPI_REAL, MPI_SUM, comm2d, ierr)
+           CALL MPI_ALLREDUCE( pinlwl, pinlw, 1, MPI_REAL, MPI_SUM, comm2d, ierr)
+#else
+           pinsw = pinswl
+           pinlw = pinlwl
+#endif
+!--        (1) albedo
+           IF ( pinsw /= 0.0_wp )  albedo_urb = 1._wp - pabssw / pinsw
+        
+!--        (2) average emmsivity
+           emissivity_urb = emiss_sum_surf / area_surf
+
+!--        (3) temerature
+           t_rad_urb = ((pemitlw - pabslw + emissivity_urb*pinlw)/(emissivity_urb*sigma_sb*area_surf))**0.25_wp
+
+        ENDIF
+        
+!--     return surface radiation to horizontal surfaces 
+!--     to rad_sw_in, rad_lw_in and rad_net for outputs
+        !!!!!!!!!!
+!--     we need the original radiation on urban top layer
+!--     for calculation of MRT so we can't do adjustment here for now
+        !!!!!!!!!!
+        !!!DO isurf = 1, nsurfl
+        !!!    i = surfl(ix,isurf)
+        !!!    j = surfl(iy,isurf)
+        !!!    k = surfl(iz,isurf)
+        !!!    d = surfl(id,isurf)
+        !!!    IF ( d==iroof )  THEN
+        !!!        rad_sw_in(:,j,i) = surfinsw(isurf)
+        !!!        rad_lw_in(:,j,i) = surfinlw(isurf)
+        !!!        rad_net(j,i) = rad_sw_in(k,j,i) - rad_sw_out(k,j,i) + rad_lw_in(k,j,i) - rad_lw_out(k,j,i)
+        !!!    ENDIF
+        !!!ENDDO
+
+      CONTAINS
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> This subroutine splits direct and diffusion dw radiation
+!> It sould not be called in case the radiation model already does it
+!> It follows <CITATION>
+!------------------------------------------------------------------------------!
+        SUBROUTINE calc_diffusion_radiation 
+
+          USE date_and_time_mod,                                               &
+              ONLY:  day_of_year_init, time_utc_init
+          
+          REAL(wp), PARAMETER                          ::  sol_const = 1367.0_wp   !< solar conbstant
+          REAL(wp), PARAMETER                          ::  lowest_solarUp = 0.1_wp  !< limit the sun elevation to protect stability of the calculation
+          INTEGER(iwp)                                 ::  i, j
+          REAL(wp), PARAMETER                          ::  year_seconds = 86400._wp * 365._wp
+          REAL(wp)                                     ::  year_angle              !< angle
+          REAL(wp)                                     ::  etr                     !< extraterestrial radiation
+          REAL(wp)                                     ::  corrected_solarUp       !< corrected solar up radiation
+          REAL(wp)                                     ::  horizontalETR           !< horizontal extraterestrial radiation
+          REAL(wp)                                     ::  clearnessIndex          !< clearness index
+          REAL(wp)                                     ::  diff_frac               !< diffusion fraction of the radiation
+          
+        
+!--     Calculate current day and time based on the initial values and simulation time
+          year_angle = ((day_of_year_init*86400)                               &
+                                  +  time_utc_init+time_since_reference_point) &
+                                  /  year_seconds * 2.0_wp * pi
+          
+          etr = sol_const * (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 ( zenith(0) <= lowest_solarUp )  THEN
+             corrected_solarUp = lowest_solarUp
+          ELSE
+             corrected_solarUp = zenith(0)
+          ENDIF
+          
+          horizontalETR = etr * corrected_solarUp
+          
+          DO i = nxl, nxr
+             DO j = nys, nyn
+
+                DO  m = surf_def_h(0)%start_index(j,i),                        &
+                        surf_def_h(0)%end_index(j,i)
+                   clearnessIndex = surf_def_h(0)%rad_sw_in(m) / horizontalETR
+                   diff_frac      = 1.0_wp /                                   &
+                        (1.0_wp + exp(-5.0033_wp + 8.6025_wp * clearnessIndex))
+                   rad_sw_in_diff(j,i) = surf_def_h(0)%rad_sw_in(m) * diff_frac
+                   rad_sw_in_dir(j,i)  = surf_def_h(0)%rad_sw_in(m) *          &
+                                            (1.0_wp - diff_frac)
+                   rad_lw_in_diff(j,i) = surf_def_h(0)%rad_lw_in(m)
+                ENDDO
+                DO  m = surf_lsm_h%start_index(j,i),                           &
+                        surf_lsm_h%end_index(j,i)
+                   clearnessIndex = surf_lsm_h%rad_sw_in(m) / horizontalETR
+                   diff_frac      = 1.0_wp /                                   &
+                        (1.0_wp + exp(-5.0033_wp + 8.6025_wp * clearnessIndex))
+                   rad_sw_in_diff(j,i) = surf_lsm_h%rad_sw_in(m) * diff_frac
+                   rad_sw_in_dir(j,i)  = surf_lsm_h%rad_sw_in(m) *             & 
+                                            (1.0_wp - diff_frac)
+                   rad_lw_in_diff(j,i) = surf_lsm_h%rad_lw_in(m)
+                ENDDO
+                DO  m = surf_usm_h%start_index(j,i),                           &
+                        surf_usm_h%end_index(j,i)
+                   clearnessIndex = surf_usm_h%rad_sw_in(m) / horizontalETR
+                   diff_frac      = 1.0_wp /                                   &
+                        (1.0_wp + exp(-5.0033_wp + 8.6025_wp * clearnessIndex))
+                   rad_sw_in_diff(j,i) = surf_usm_h%rad_sw_in(m) * diff_frac
+                   rad_sw_in_dir(j,i)  = surf_usm_h%rad_sw_in(m) *             & 
+                                            (1.0_wp - diff_frac)
+                   rad_lw_in_diff(j,i) = surf_usm_h%rad_lw_in(m)
+                ENDDO
+             ENDDO
+          ENDDO
+          
+        END SUBROUTINE calc_diffusion_radiation
+
+!------------------------------------------------------------------------------!
+!> Finds first model boundary crossed by a ray
+!------------------------------------------------------------------------------!
+        PURE SUBROUTINE find_boundary_face(origin, uvect, bdycross)
+          
+          IMPLICIT NONE
+          
+          INTEGER(iwp) ::  d       !<
+          INTEGER(iwp) ::  seldim  !< found fist crossing index
+          
+          INTEGER(iwp), DIMENSION(3)              ::  bdyd      !< boundary direction       
+          INTEGER(iwp), DIMENSION(4), INTENT(out) ::  bdycross  !< found boundary crossing (d, z, y, x)
+          
+          REAL(wp)                                ::  bdydim  !< 
+          REAL(wp)                                ::  dist    !<
+          
+          REAL(wp), DIMENSION(3)             ::  crossdist  !< crossing distance
+          REAL(wp), DIMENSION(3), INTENT(in) ::  origin     !< ray origin
+          REAL(wp), DIMENSION(3), INTENT(in) ::  uvect      !< ray unit vector
+          
+          
+          bdydim       = nzut + .5_wp  !< top boundary
+          bdyd(1)      = isky
+          crossdist(1) = ( bdydim - origin(1) ) / uvect(1)  !< subroutine called only when uvect(1)>0
+          
+          IF ( uvect(2) == 0._wp )  THEN
+             crossdist(2) = huge(1._wp)
+          ELSE
+             IF ( uvect(2) >= 0._wp )  THEN
+                bdydim  = ny + .5_wp  !< north global boundary
+                bdyd(2) = inorth_b
+             ELSE
+                bdydim  = -.5_wp  !< south global boundary
+                bdyd(2) = isouth_b
+             ENDIF
+             crossdist(2) = ( bdydim - origin(2) ) / uvect(2)
+          ENDIF
+          
+          IF ( uvect(3) == 0._wp )  THEN
+             crossdist(3) = huge(1._wp)
+          ELSE
+             IF ( uvect(3) >= 0._wp )  THEN
+                bdydim  = nx + .5_wp  !< east global boundary
+                bdyd(3) = ieast_b
+             ELSE
+                bdydim  = -.5_wp  !< west global boundary
+                bdyd(3) = iwest_b
+             ENDIF
+             crossdist(3) = ( bdydim - origin(3) ) / uvect(3)
+          ENDIF
+          
+          seldim = minloc(crossdist, 1)
+          dist   = crossdist(seldim)
+          d      = bdyd(seldim)
+          
+          bdycross(1)   = d
+          bdycross(2:4) = NINT( origin(:) + uvect(:) * dist &
+               + .5_wp * (/ kdir(d), jdir(d), idir(d) /) )
+          
+        END SUBROUTINE find_boundary_face
+!------------------------------------------------------------------------------!
+!> 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
+          
+          REAL(wp), DIMENSION(3), INTENT(in) :: &
+               boxsize, &      !< z, y, x size of box in m
+               uvec            !< z, y, x unit vector of incoming flux
+          INTEGER(iwp), INTENT(in) :: &
+               resol           !< No. of rays in x and y dimensions
+          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) :: &
+               xshift, yshift, &
+               xmin, xmax, ymin, ymax, &
+               xorig, yorig, &
+               dx1, dy1, dz1, dx2, dy2, dz2, &
+               crdist, &
+               transp
+          INTEGER(iwp) :: &
+               i, j
+          
+          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 IF ( uvec(2) < 0._wp )  THEN
+                   dy1 = (boxsize(2)-yorig) / uvec(2) !< crossing with y=boxsize(2)
+                   dy2 = -yorig             / uvec(2) !< crossing with y=0
+                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 IF ( uvec(3) < 0._wp )  THEN
+                   dx1 = (boxsize(3)-xorig) / uvec(3) !< crossing with x=boxsize(3)
+                   dx2 = -xorig             / uvec(3) !< crossing with x=0
+                ELSE !uvec(1)==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
+
+        
+    END SUBROUTINE radiation_interaction
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Calculates shape view factors SVF and plant sink canopy factors PSCF
+!> !!!!!DESCRIPTION!!!!!!!!!!
+!------------------------------------------------------------------------------!
+    SUBROUTINE radiation_calc_svf
+
+        IMPLICIT NONE
+        
+        INTEGER(iwp)                                :: i, j, k, l, d, ip, jp
+        INTEGER(iwp)                                :: isvf, ksvf, icsf, kcsf, npcsfl, isvf_surflt, imrtt, imrtf
+        INTEGER(iwp)                                :: sd, td, ioln, iproc
+        REAL(wp),     DIMENSION(0:nsurf_type)       :: facearea
+        INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE   :: nzterrl, planthl
+        REAL(wp),     DIMENSION(:,:), ALLOCATABLE   :: csflt, pcsflt
+        INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE   :: kcsflt,kpcsflt
+        INTEGER(iwp), DIMENSION(:), ALLOCATABLE     :: icsflt,dcsflt,ipcsflt,dpcsflt
+        REAL(wp), DIMENSION(3)                      :: uv
+        LOGICAL                                     :: visible
+        REAL(wp), DIMENSION(3)                      :: sa, ta          !< real coordinates z,y,x of source and target
+        REAL(wp)                                    :: transparency, rirrf, sqdist, svfsum
+        INTEGER(iwp)                                :: isurflt, isurfs, isurflt_prev
+        INTEGER(iwp)                                :: itx, ity, itz
+        CHARACTER(len=7)                            :: pid_char = ''
+        INTEGER(iwp)                                :: win_lad, minfo
+        REAL(wp), DIMENSION(:,:,:), POINTER         :: lad_s_rma       !< fortran pointer, but lower bounds are 1
+        TYPE(c_ptr)                                 :: lad_s_rma_p     !< allocated c pointer
+#if defined( __parallel )
+        INTEGER(kind=MPI_ADDRESS_KIND)              :: size_lad_rma
+#endif
+        REAL(wp), DIMENSION(0:nsurf_type)           :: svf_threshold   !< threshold to ignore very small svf between far surfaces
+        
+!    
+!--     calculation of the SVF
+        CALL location_message( '    calculation of SVF and CSF', .TRUE. )
+        CALL cpu_log( log_point_s(79), 'radiation_calc_svf', 'start' )
+!
+!--     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
+        ENDDO
+
+!--     calculate the svf threshold
+        svf_threshold = 0._wp
+        IF ( dist_max_svf > 0._wp ) THEN
+            DO d = 0, nsurf_type
+               sqdist = dist_max_svf * dist_max_svf
+               svf_threshold(d) = 1._wp / (pi * sqdist) * facearea(d)
+            ENDDO
+         ENDIF
+         
+!--     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
+        
+!--     initialize temporary terrain and plant canopy height arrays (global 2D array!)
+        ALLOCATE( nzterr(0:(nx+1)*(ny+1)-1) )
+#if defined( __parallel )
+        ALLOCATE( nzterrl(nys:nyn,nxl:nxr) )
+        nzterrl = get_topography_top_index( 's' )
+        CALL MPI_AllGather( nzterrl, nnx*nny, MPI_INTEGER, &
+                            nzterr, nnx*nny, MPI_INTEGER, comm2d, ierr )
+        DEALLOCATE(nzterrl)
+#else
+        nzterr = RESHAPE( get_topography_top_index( 's' ), (/(nx+1)*(ny+1)/) )
+#endif
+        IF ( plant_canopy )  THEN
+            ALLOCATE( plantt(0:(nx+1)*(ny+1)-1) )
+            maxboxesg = nx + ny + nzu + 1
+!--         temporary arrays storing values for csf calculation during raytracing
+            ALLOCATE( boxes(3, maxboxesg) )
+            ALLOCATE( crlens(maxboxesg) )
+
+#if defined( __parallel )
+            ALLOCATE( planthl(nys:nyn,nxl:nxr) )
+            planthl = pch(nys:nyn,nxl:nxr)
+        
+            CALL MPI_AllGather( planthl, nnx*nny, MPI_INTEGER, &
+                                plantt, nnx*nny, MPI_INTEGER, comm2d, ierr )
+            DEALLOCATE( planthl )
+            
+!--         temporary arrays storing values for csf calculation during raytracing
+            ALLOCATE( lad_ip(maxboxesg) )
+            ALLOCATE( lad_disp(maxboxesg) )
+
+            IF ( usm_lad_rma )  THEN
+                ALLOCATE( lad_s_ray(maxboxesg) )
+                
+                ! set conditions for RMA communication
+                CALL MPI_Info_create(minfo, ierr)
+                CALL MPI_Info_set(minfo, 'accumulate_ordering', '', ierr)
+                CALL MPI_Info_set(minfo, 'accumulate_ops', 'same_op', ierr)
+                CALL MPI_Info_set(minfo, 'same_size', 'true', ierr)
+                CALL MPI_Info_set(minfo, 'same_disp_unit', 'true', ierr)
+
+!--             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 c_sizeof(X) needs arbitrary REAL(wp) value, set to 1.0_wp for now
+                size_lad_rma = c_sizeof(1.0_wp)*nnx*nny*nzu
+                CALL MPI_Win_allocate(size_lad_rma, c_sizeof(1.0_wp), minfo, comm2d, &
+                                        lad_s_rma_p, win_lad, ierr)
+                CALL c_f_pointer(lad_s_rma_p, lad_s_rma, (/ nzu, nny, nnx /))
+                usm_lad(nzub:, nys:, nxl:) => lad_s_rma(:,:,:)
+            ELSE
+                ALLOCATE(usm_lad(nzub:nzut, nys:nyn, nxl:nxr))
+            ENDIF
+#else
+            plantt = RESHAPE( pct(nys:nyn,nxl:nxr), (/(nx+1)*(ny+1)/) )
+            ALLOCATE(usm_lad(nzub:nzut, nys:nyn, nxl:nxr))
+#endif
+            usm_lad(:,:,:) = 0._wp
+            DO i = nxl, nxr
+                DO j = nys, nyn
+                    k = get_topography_top_index( j, i, 's' )
+
+                    usm_lad(k:nzut, j, i) = lad_s(0:nzut-k, j, i)
+                ENDDO
+            ENDDO
+
+#if defined( __parallel )
+            IF ( usm_lad_rma )  THEN
+                CALL MPI_Info_free(minfo, ierr)
+                CALL MPI_Win_lock_all(0, win_lad, ierr)
+            ELSE
+                ALLOCATE( usm_lad_g(0:(nx+1)*(ny+1)*nzu-1) )
+                CALL MPI_AllGather( usm_lad, nnx*nny*nzu, MPI_REAL, &
+                                    usm_lad_g, nnx*nny*nzu, MPI_REAL, comm2d, ierr )
+            ENDIF
+#endif
+        ENDIF
+
+        IF ( mrt_factors )  THEN
+            OPEN(153, file='MRT_TARGETS', access='SEQUENTIAL', &
+                    action='READ', status='OLD', form='FORMATTED', err=524)
+            OPEN(154, file='MRT_FACTORS'//myid_char, access='DIRECT', recl=(5*4+2*8), &
+                    action='WRITE', status='REPLACE', form='UNFORMATTED', err=525)
+            imrtf = 1
+            DO
+                READ(153, *, end=526, err=524) imrtt, i, j, k
+                IF ( i < nxl  .OR.  i > nxr &
+                     .OR.  j < nys  .OR.  j > nyn ) CYCLE
+                ta = (/ REAL(k), REAL(j), REAL(i) /)
+
+                DO isurfs = 1, nsurf
+                    IF ( .NOT.  surface_facing(i, j, k, -1, &
+                        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, (ta(2)-sa(2))*dy, (ta(3)-sa(3))*dx /)
+                    sqdist = SUM(uv(:)**2)
+                    uv = uv / SQRT(sqdist)
+
+!--                 irradiance factor - see svf. Here we consider that target face is always normal,
+!--                 i.e. the second dot product equals 1
+                    rirrf = dot_product((/ kdir(sd), jdir(sd), idir(sd) /), uv) &
+                        / (pi * sqdist) * facearea(sd)
+
+!--                 raytrace while not creating any canopy sink factors
+                    CALL raytrace(sa, ta, isurfs, rirrf, 1._wp, .FALSE., &
+                            visible, transparency, win_lad)
+                    IF ( .NOT.  visible ) CYCLE
+
+                    !rsvf = rirrf * transparency
+                    WRITE(154, rec=imrtf, err=525) INT(imrtt, kind=4), &
+                        INT(surf(id, isurfs), kind=4), &
+                        INT(surf(iz, isurfs), kind=4), &
+                        INT(surf(iy, isurfs), kind=4), &
+                        INT(surf(ix, isurfs), kind=4), &
+                        REAL(rirrf, kind=8), REAL(transparency, kind=8)
+                    imrtf = imrtf + 1
+
+                ENDDO !< isurfs
+            ENDDO !< MRT_TARGETS record
+
+524         message_string = 'error reading file MRT_TARGETS'
+            CALL message( 'radiation_calc_svf', 'PA0524', 1, 2, 0, 6, 0 )
+
+525         message_string = 'error writing file MRT_FACTORS'//myid_char
+            CALL message( 'radiation_calc_svf', 'PA0525', 1, 2, 0, 6, 0 )
+
+526         CLOSE(153)
+            CLOSE(154)
+        ENDIF  !< mrt_factors
+
+        
+        DO isurflt = 1, nsurfl
+!--         determine face centers
+            td = surfl(id, isurflt)
+            IF ( td >= isky  .AND.  .NOT.  plant_canopy ) CYCLE
+            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)  /)
+            DO isurfs = 1, nsurf
+!--             cycle for atmospheric surfaces since they are not source surfaces
+                sd = surf(id, isurfs)
+                IF ( sd > iwest_l  .AND.  sd < isky ) CYCLE
+!--             if reflections between target surfaces (urban and land) are neglected (surf_reflection set to
+!--             FALSE) cycle. This will reduce the number of SVFs and keep SVFs between only ertual surfaces to
+!--             physical surfaces
+                IF ( .NOT.  surf_reflections  .AND. sd < isky ) CYCLE
+!--             cycle if the target and the source surfaces are not facing each other
+                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
+                  
+                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, (ta(2)-sa(2))*dy, (ta(3)-sa(3))*dx /)
+                sqdist = SUM(uv(:)**2)
+                uv = uv / SQRT(sqdist)
+                
+!--             irradiance factor (our unshaded shape view factor) = view factor per differential target area * source area
+                rirrf = 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
+                    * facearea(sd)
+
+!--             skip svf less than svf_threshold
+                IF ( rirrf < svf_threshold(sd) .AND.  sd < isky ) CYCLE
+
+!--             raytrace + process plant canopy sinks within
+                CALL raytrace(sa, ta, isurfs, rirrf, facearea(td), .TRUE., &
+                        visible, transparency, win_lad)
+                
+                IF ( .NOT.  visible ) CYCLE
+                IF ( td >= isky ) CYCLE !< we calculated these only for raytracing
+                                        !< to find plant canopy sinks, we don't need svf for them
+
+!--             write to the svf array
+                nsvfl = nsvfl + 1
+!--             check dimmension of asvf array and enlarge it if needed
+                IF ( nsvfla < nsvfl )  THEN
+                    k = nsvfla * 2
+                    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
+                    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
+        ENDDO
+
+        CALL location_message( '    waiting for completion of SVF and CSF calculation in all processes', .TRUE. )
+!--     deallocate temporary global arrays
+        DEALLOCATE(nzterr)
+        
+        IF ( plant_canopy )  THEN
+!--         finalize mpi_rma communication and deallocate temporary arrays
+#if defined( __parallel )
+            IF ( usm_lad_rma )  THEN
+                CALL MPI_Win_flush_all(win_lad, ierr)
+!--             unlock MPI window
+                CALL MPI_Win_unlock_all(win_lad, ierr)
+!--             free MPI window
+                CALL MPI_Win_free(win_lad, ierr)
+                
+!--             deallocate temporary arrays storing values for csf calculation during raytracing
+                DEALLOCATE( lad_s_ray )
+!--             usm_lad is the pointer to lad_s_rma in case of usm_lad_rma
+!--             and must not be deallocated here
+            ELSE
+                DEALLOCATE(usm_lad)
+                DEALLOCATE(usm_lad_g)
+            ENDIF
+#else
+            DEALLOCATE(usm_lad)
+#endif
+            DEALLOCATE( boxes )
+            DEALLOCATE( crlens )
+            DEALLOCATE( plantt )
+        ENDIF
+
+        CALL location_message( '    calculation of the complete SVF array', .TRUE. )
+
+!--     sort svf ( a version of quicksort )
+        CALL quicksort_svf(asvf,1,nsvfl)
+
+        ALLOCATE( svf(ndsvf,nsvfl) )
+        ALLOCATE( svfsurf(idsvf,nsvfl) )
+
+        !< load svf from the structure array to plain arrays
+        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
+!--                 TODO detect and log when normalization differs too much from 1
+                    svf(1, isvf_surflt:isvf-1) = svf(1, isvf_surflt:isvf-1) / svfsum
+                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
+!--         TODO detect and log when normalization differs too much from 1
+            svf(1, isvf_surflt:nsvfl) = svf(1, isvf_surflt:nsvfl) / svfsum
+        ENDIF
+
+!--     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
+
+            CALL location_message( '    calculation of the complete CSF array', .TRUE. )
+
+!--         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
+            ALLOCATE( csflt(ndcsf,max(ncsfl,ndcsf)) )
+            ALLOCATE( kcsflt(kdcsf,max(ncsfl,kdcsf)) )
+            ALLOCATE( icsflt(0:numprocs-1) )
+            ALLOCATE( dcsflt(0:numprocs-1) )
+            ALLOCATE( ipcsflt(0:numprocs-1) )
+            ALLOCATE( dpcsflt(0:numprocs-1) )
+            
+!--         fill out arrays of csf values and 
+!--         arrays of number of elements and displacements
+!--         for particular precessors
+            icsflt = 0
+            dcsflt = 0
+            ip = -1
+            j = -1
+            d = 0
+            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
+                    d = d+j
+!--                 blank blocks
+                    DO jp = ip+1, acsf(kcsf)%ip-1
+!--                     number of elements is zero, displacement is equal to previous
+                        icsflt(jp) = 0
+                        dcsflt(jp) = d
+                    ENDDO
+!--                 the actual block
+                    ip = acsf(kcsf)%ip
+                    dcsflt(ip) = d
+                    j = 0
+                ENDIF
+!--             fill out real values of rsvf, rtransp
+                csflt(1,kcsf) = acsf(kcsf)%rsvf
+                csflt(2,kcsf) = acsf(kcsf)%rtransp
+!--             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
+            d = d+j
+            DO jp = ip+1, numprocs-1
+!--             number of elements is zero, displacement is equal to previous
+                icsflt(jp) = 0
+                dcsflt(jp) = d
+            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 )
+!--         scatter and gather the number of elements to and from all processor
+!--         and calculate displacements
+            CALL MPI_AlltoAll(icsflt,1,MPI_INTEGER,ipcsflt,1,MPI_INTEGER,comm2d, ierr)
+            
+            npcsfl = SUM(ipcsflt)
+            d = 0
+            DO i = 0, numprocs-1
+                dpcsflt(i) = d
+                d = d + ipcsflt(i)
+            ENDDO
+        
+!--         exchange csf fields between processors
+            ALLOCATE( pcsflt(ndcsf,max(npcsfl,ndcsf)) )
+            ALLOCATE( kpcsflt(kdcsf,max(npcsfl,kdcsf)) )
+            CALL MPI_AlltoAllv(csflt, ndcsf*icsflt, ndcsf*dcsflt, MPI_REAL, &
+                pcsflt, ndcsf*ipcsflt, ndcsf*dpcsflt, MPI_REAL, comm2d, ierr)
+            CALL MPI_AlltoAllv(kcsflt, kdcsf*icsflt, kdcsf*dcsflt, MPI_INTEGER, &
+                kpcsflt, kdcsf*ipcsflt, kdcsf*dpcsflt, MPI_INTEGER, comm2d, ierr)
+            
+#else
+            npcsfl = ncsfl
+            ALLOCATE( pcsflt(ndcsf,max(npcsfl,ndcsf)) )
+            ALLOCATE( kpcsflt(kdcsf,max(npcsfl,kdcsf)) )
+            pcsflt = csflt
+            kpcsflt = kcsflt
+#endif
+
+!--         deallocate temporary arrays
+            DEALLOCATE( csflt )
+            DEALLOCATE( kcsflt )
+            DEALLOCATE( icsflt )
+            DEALLOCATE( dcsflt )
+            DEALLOCATE( ipcsflt )
+            DEALLOCATE( dpcsflt )
+
+!--         sort csf ( a version of quicksort )
+            CALL quicksort_csf2(kpcsflt, pcsflt, 1, npcsfl)
+
+!--         aggregate canopy sink factor records with identical box & source
+!--         againg across all values from all processors
+            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
+!--                     We could simply take either first or second rtransp, both are valid. As a very simple heuristic about which ray
+!--                     probably passes nearer the center of the target box, we choose DIF from the entry with greater CSF, since that
+!--                     might mean that the traced beam passes longer through the canopy box.
+                        IF ( pcsflt(1,kcsf) < pcsflt(1,icsf+1) )  THEN
+                            pcsflt(2,kcsf) = pcsflt(2,icsf+1)
+                        ENDIF
+                        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
+            DEALLOCATE( pcsflt )
+            DEALLOCATE( kpcsflt )
+            IF ( ALLOCATED( gridpcbl ) )  DEALLOCATE( gridpcbl )
+            
+        ENDIF
+        
+        RETURN
+        
+301     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 )
+
+        CALL cpu_log( log_point_s(79), 'radiation_calc_svf', 'stop' )
+
+
+    END SUBROUTINE radiation_calc_svf
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Raytracing for detecting obstacles and calculating compound canopy sink
+!> factors. (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, rirrf, atarg, create_csf, visible, transparency, win_lad)
+        IMPLICIT NONE
+
+        REAL(wp), DIMENSION(3), INTENT(in)     :: src, targ    !< real coordinates z,y,x
+        INTEGER(iwp), INTENT(in)               :: isrc         !< index of source face for csf
+        REAL(wp), INTENT(in)                   :: rirrf        !< irradiance factor for csf
+        REAL(wp), INTENT(in)                   :: atarg        !< target surface area for csf
+        LOGICAL, INTENT(in)                    :: create_csf   !< whether to generate new CSFs during raytracing
+        LOGICAL, INTENT(out)                   :: visible
+        REAL(wp), INTENT(out)                  :: transparency !< along whole path
+        INTEGER(iwp), INTENT(in)               :: win_lad
+        INTEGER(iwp)                           :: i, j, k, d
+        INTEGER(iwp)                           :: seldim       !< dimension to be incremented
+        INTEGER(iwp)                           :: ncsb         !< no of written plant canopy sinkboxes
+        INTEGER(iwp)                           :: maxboxes     !< max no of gridboxes visited
+        REAL(wp)                               :: distance     !< euclidean along path
+        REAL(wp)                               :: crlen        !< length of gridbox crossing
+        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)                               :: crmid        !< midpoint of crossing
+        REAL(wp)                               :: cursink      !< sink factor for current canopy box
+        REAL(wp), DIMENSION(3)                 :: delta        !< path vector
+        REAL(wp), DIMENSION(3)                 :: uvect        !< unit vector
+        REAL(wp), DIMENSION(3)                 :: dimnextdist  !< distance for each dimension increments
+        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
+        INTEGER(iwp)                           :: px, py       !< number of processors in x and y dir before 
+                                                               !< the processor in the question
+        INTEGER(iwp)                           :: ip           !< number of processor where gridbox reside
+        INTEGER(iwp)                           :: ig           !< 1D index of gridbox in global 2D array
+        REAL(wp)                               :: lad_s_target !< recieved lad_s of particular grid box
+        REAL(wp), PARAMETER                    :: grow_factor = 1.5_wp !< factor of expansion of grow arrays
+
+!
+!--     Maximum number of gridboxes visited equals to 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) - NINT(src))) + 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,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)
+
+!--             calculate index of the grid with global indices (box(2),box(3))
+!--             in the array nzterr and plantt and id of the coresponding processor
+                px = box(3)/nnx
+                py = box(2)/nny
+                ip = px*pdims(2)+py
+                ig = ip*nnx*nny + (box(3)-px*nnx)*nny + box(2)-py*nny
+                IF ( box(1) <= nzterr(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 )
+                        lad_ip(ncsb) = ip
+                        lad_disp(ncsb) = (box(3)-px*nnx)*(nny*nzu) + (box(2)-py*nny)*nzu + box(1)-nzub
+#endif
+                    ENDIF
+                ENDIF
+            ENDIF
+
+            IF ( nextdist >= distance ) 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 ( usm_lad_rma )  THEN
+!--             send requests for lad_s to appropriate processor
+                CALL cpu_log( log_point_s(77), 'usm_init_rma', '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(message_string, *) 'MPI error ', ierr, ' at MPI_Get'
+                        CALL message( 'raytrace', 'PA0519', 1, 2, 0, 6, 0 )
+                    ENDIF
+                ENDDO
+                
+!--             wait for all pending local requests complete
+                CALL MPI_Win_flush_local_all(win_lad, ierr)
+                IF ( ierr /= 0 )  THEN
+                    WRITE(message_string, *) 'MPI error ', ierr, ' at MPI_Win_flush_local_all'
+                    CALL message( 'raytrace', 'PA0519', 1, 2, 0, 6, 0 )
+                ENDIF
+                CALL cpu_log( log_point_s(77), 'usm_init_rma', 'stop' )
+                
+            ENDIF
+#endif
+
+!--         calculate csf and transparency
+            DO i = 1, ncsb
+#if defined( __parallel )
+                IF ( usm_lad_rma )  THEN
+                    lad_s_target = lad_s_ray(i)
+                ELSE
+                    lad_s_target = usm_lad_g(lad_ip(i)*nnx*nny*nzu + lad_disp(i))
+                ENDIF
+#else
+                lad_s_target = usm_lad(boxes(1,i),boxes(2,i),boxes(3,i))
+#endif
+                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)%rsvf = REAL(cursink*rirrf*atarg, wp) !-- we postpone multiplication by transparency
+                    acsf(ncsfl)%rtransp = REAL(transparency, wp)
+                ENDIF  !< create_csf
+
+                transparency = transparency * (1._wp - cursink)
+                
+            ENDDO
+        ENDIF
+        
+        visible = .TRUE.
+
+    END SUBROUTINE raytrace
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Determines whether two faces are oriented towards each other. 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_u  .OR.  d==iup_l  .OR.  d==iup_a )                             &
+             .AND. (d2==iup_u  .OR. d2==iup_l) ) RETURN
+        IF ( (d==isky  .OR.  d==idown_a)  .AND.  d2==isky ) RETURN
+        IF ( (d==isouth_u  .OR.  d==isouth_l  .OR.  d==isouth_a  .OR.  d==inorth_b ) &
+             .AND.  (d2==isouth_u  .OR.  d2==isouth_l  .OR.  d2==inorth_b) ) RETURN
+        IF ( (d==inorth_u  .OR.  d==inorth_l  .OR.  d==inorth_a  .OR.  d==isouth_b ) &
+             .AND.  (d2==inorth_u  .OR.  d2==inorth_l  .OR.  d2==isouth_b) ) RETURN
+        IF ( (d==iwest_u  .OR.  d==iwest_l  .OR.  d==iwest_a  .OR.  d==ieast_b )     &
+             .AND.  (d2==iwest_u  .OR.  d2==iwest_l  .OR.  d2==ieast_b ) ) RETURN
+        IF ( (d==ieast_u  .OR.  d==ieast_l  .OR.  d==ieast_a  .OR.  d==iwest_b )     &
+             .AND.  (d2==ieast_u  .OR.  d2==ieast_l  .OR.  d2==iwest_b ) ) RETURN
+
+!-- second check: are surfaces facing away from each other
+        SELECT CASE (d)
+            CASE (iup_u, iup_l, iup_a)                    !< upward facing surfaces
+                IF ( z2 < z ) RETURN
+            CASE (isky, idown_a)                          !< downward facing surfaces
+                IF ( z2 > z ) RETURN
+            CASE (isouth_u, isouth_l, isouth_a, inorth_b) !< southward facing surfaces
+                IF ( y2 > y ) RETURN
+            CASE (inorth_u, inorth_l, inorth_a, isouth_b) !< northward facing surfaces
+                IF ( y2 < y ) RETURN
+            CASE (iwest_u, iwest_l, iwest_a, ieast_b)     !< westward facing surfaces
+                IF ( x2 > x ) RETURN
+            CASE (ieast_u, ieast_l, ieast_a, iwest_b)     !< eastward facing surfaces
+                IF ( x2 < x ) RETURN
+        END SELECT
+
+        SELECT CASE (d2)
+            CASE (iup_u)                        !< ground, roof
+                IF ( z < z2 ) RETURN
+            CASE (isky)                         !< sky
+                IF ( z > z2 ) RETURN
+            CASE (isouth_u, isouth_l, inorth_b) !< south facing
+                IF ( y > y2 ) RETURN
+            CASE (inorth_u, inorth_l, isouth_b) !< north facing
+                IF ( y < y2 ) RETURN
+            CASE (iwest_u, iwest_l, ieast_b)    !< west facing
+                IF ( x > x2 ) RETURN
+            CASE (ieast_u, ieast_l, iwest_b)    !< east facing
+                IF ( x < x2 ) RETURN
+            CASE (-1)
+                CONTINUE
+        END SELECT
+
+        surface_facing = .TRUE.
+        
+    END FUNCTION surface_facing
+
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+!> Soubroutine reads svf and svfsurf data from saved file
+!------------------------------------------------------------------------------!
+    SUBROUTINE radiation_read_svf
+
+        IMPLICIT NONE
+        INTEGER(iwp)                 :: fsvf = 89
+        INTEGER(iwp)                 :: i
+        CHARACTER(usm_version_len)   :: usm_version_field
+        CHARACTER(svf_code_len)      :: svf_code_field
+
+        DO  i = 0, io_blocks-1
+            IF ( i == io_group )  THEN
+                OPEN ( fsvf, FILE='SVFIN'//TRIM(coupling_char)//'/'//myid_char,&
+                    form='unformatted', status='old' )
+
+!--             read and check version
+                READ ( fsvf ) usm_version_field
+                IF ( TRIM(usm_version_field) /= TRIM(usm_version) )  THEN
+                    WRITE( message_string, * ) 'Version of binary SVF file "',           &
+                                            TRIM(usm_version_field), '" does not match ',            &
+                                            'the version of model "', TRIM(usm_version), '"'
+                    CALL message( 'radiation_read_svf', 'UI0012', 1, 2, 0, 6, 0 )
+                ENDIF
+                
+!--             read nsvfl, ncsfl
+                READ ( fsvf ) nsvfl, ncsfl
+                IF ( nsvfl <= 0  .OR.  ncsfl < 0 )  THEN
+                    WRITE( message_string, * ) 'Wrong number of SVF or CSF'
+                    CALL message( 'radiation_read_svf', 'UI0012', 1, 2, 0, 6, 0 )
+                ELSE
+                    WRITE(message_string,*) '    Number of SVF and CSF to read', nsvfl, ncsfl
+                    CALL location_message( message_string, .TRUE. )
+                ENDIF
+                
+                ALLOCATE(svf(ndsvf,nsvfl))
+                ALLOCATE(svfsurf(idsvf,nsvfl))
+                READ(fsvf) svf
+                READ(fsvf) svfsurf
+                IF ( plant_canopy )  THEN
+                    ALLOCATE(csf(ndcsf,ncsfl))
+                    ALLOCATE(csfsurf(idcsf,ncsfl))
+                    READ(fsvf) csf
+                    READ(fsvf) csfsurf
+                ENDIF
+                READ ( fsvf ) svf_code_field
+                
+                IF ( TRIM(svf_code_field) /= TRIM(svf_code) )  THEN
+                    WRITE( message_string, * ) 'Wrong structure of binary svf file'
+                    CALL message( 'radiation_read_svf', 'UI0012', 1, 2, 0, 6, 0 )
+                ENDIF
+                
+                CLOSE (fsvf)
+                
+            ENDIF
+#if defined( __parallel )
+            CALL MPI_BARRIER( comm2d, ierr )
+#endif
+        ENDDO
+
+    END SUBROUTINE radiation_read_svf
+
+
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+!> Subroutine stores svf, svfsurf, csf and csfsurf data to a file.
+!------------------------------------------------------------------------------!
+    SUBROUTINE radiation_write_svf
+
+        IMPLICIT NONE
+        INTEGER(iwp)        :: fsvf = 89
+        INTEGER(iwp)        :: i
+
+        DO  i = 0, io_blocks-1
+            IF ( i == io_group )  THEN
+                OPEN ( fsvf, FILE='SVFOUT'//TRIM( coupling_char )//'/'//myid_char,   &
+                    form='unformatted', status='new' )
+
+                WRITE ( fsvf )  usm_version
+                WRITE ( fsvf )  nsvfl, ncsfl
+                WRITE ( fsvf )  svf
+                WRITE ( fsvf )  svfsurf
+                IF ( plant_canopy )  THEN
+                    WRITE ( fsvf )  csf
+                    WRITE ( fsvf )  csfsurf
+                ENDIF
+                WRITE ( fsvf )  TRIM(svf_code)
+                
+                CLOSE (fsvf)
+#if defined( __parallel )
+                CALL MPI_BARRIER( comm2d, ierr )
+#endif
+            ENDIF
+        ENDDO
+
+    END SUBROUTINE radiation_write_svf
+
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!
+!> radiation_radflux_gridbox subroutine gives the sw and lw radiation fluxes at the 
+!> faces of a gridbox defined at i,j,k and located in the urban layer.
+!> The total sw and the diffuse sw radiation as well as the lw radiation fluxes at
+!> the gridbox 6 faces are stored in sw_gridbox, swd_gridbox, and lw_gridbox arrays, 
+!> respectively, in the following order:
+!>  up_face, down_face, north_face, south_face, east_face, west_face
+!> 
+!> The subroutine reports also how successful was the search process via the parameter
+!> i_feedback as follow:
+!> - i_feedback =  1 : successful
+!> - i_feedback = -1 : unsuccessful; the requisted point is outside the urban domain
+!> - i_feedback =  0 : uncomplete; some gridbox faces fluxes are missing
+!> 
+!> 
+!> It is called outside from usm_urban_surface_mod whenever the radiation fluxes
+!> are needed.
+!>
+!> TODO:
+!>    - Compare performance when using some combination of the Fortran intrinsic 
+!>      functions, e.g. MINLOC, MAXLOC, ALL, ANY and COUNT functions, which search
+!>      surfl array for elements meeting user-specified criterion, i.e. i,j,k
+!>    - Report non-found or incomplete radiation fluxes arrays , if any, at the 
+!>      gridbox faces in an error message form
+!>
+!------------------------------------------------------------------------------!
+    SUBROUTINE radiation_radflux_gridbox(i,j,k,sw_gridbox,swd_gridbox,lw_gridbox,i_feedback)
+        
+        IMPLICIT NONE
+
+        INTEGER(iwp),                 INTENT(in)  :: i,j,k                 !< gridbox indices at which fluxes are required
+        INTEGER(iwp)                              :: ii,jj,kk,d            !< surface indices and type
+        INTEGER(iwp)                              :: l                     !< surface id
+        REAL(wp)    , DIMENSION(1:6), INTENT(out) :: sw_gridbox,lw_gridbox !< total sw and lw radiation fluxes of 6 faces of a gridbox, w/m2 
+        REAL(wp)    , DIMENSION(1:6), INTENT(out) :: swd_gridbox           !< diffuse sw radiation from sky and model boundary of 6 faces of a gridbox, w/m2
+        INTEGER(iwp),                 INTENT(out) :: i_feedback            !< feedback to report how the search was successful 
+
+
+!-- initialize variables
+        i_feedback  = -999999
+        sw_gridbox  = -999999.9_wp
+        lw_gridbox  = -999999.9_wp
+        swd_gridbox = -999999.9_wp
+        
+!-- check the requisted grid indices
+        IF ( k < nzb   .OR.  k > nzut  .OR.   &
+             j < nysg  .OR.  j > nyng  .OR.   &
+             i < nxlg  .OR.  i > nxrg         &
+             ) THEN
+           i_feedback = -1
+           RETURN
+        ENDIF
+
+!-- search for the required grid and formulate the fluxes at the 6 gridbox faces
+        DO l = 1, nsurfl
+            ii = surfl(ix,l)
+            jj = surfl(iy,l)
+            kk = surfl(iz,l)
+
+            IF ( ii == i  .AND.  jj == j  .AND.  kk == k ) THEN
+               d = surfl(id,l)
+
+               SELECT CASE ( d )
+
+               CASE (iup_u,iup_l,iup_a)                    !- gridbox up_facing face
+                  sw_gridbox(1) = surfinsw(l)
+                  lw_gridbox(1) = surfinlw(l)
+                  swd_gridbox(1) = surfinswdif(l)
+
+               CASE (isky,idown_a)                         !- gridbox down_facing face
+                  sw_gridbox(2) = surfinsw(l)
+                  lw_gridbox(2) = surfinlw(l)
+                  swd_gridbox(2) = surfinswdif(l)
+
+               CASE (inorth_u,inorth_l,inorth_a,isouth_b)  !- gridbox north_facing face
+                  sw_gridbox(3) = surfinsw(l)
+                  lw_gridbox(3) = surfinlw(l)
+                  swd_gridbox(3) = surfinswdif(l)
+
+               CASE (isouth_u,isouth_l,isouth_a,inorth_b)  !- gridbox south_facing face
+                  sw_gridbox(4) = surfinsw(l)
+                  lw_gridbox(4) = surfinlw(l)
+                  swd_gridbox(4) = surfinswdif(l)
+
+               CASE (ieast_u,ieast_l,ieast_a,iwest_b)      !- gridbox east_facing face
+                  sw_gridbox(5) = surfinsw(l)
+                  lw_gridbox(5) = surfinlw(l)
+                  swd_gridbox(5) = surfinswdif(l)
+
+               CASE (iwest_u,iwest_l,iwest_a,ieast_b)      !- gridbox west_facing face
+                  sw_gridbox(6) = surfinsw(l)
+                  lw_gridbox(6) = surfinlw(l)
+                  swd_gridbox(6) = surfinswdif(l)
+
+               END SELECT
+
+            ENDIF
+
+        IF ( ALL( sw_gridbox(:)  /= -999999.9_wp )  ) EXIT
+        ENDDO
+
+!-- check the completeness of the fluxes at all gidbox faces        
+!-- TODO: report non-found or incomplete rad fluxes arrays in an error message form
+        IF ( ANY( sw_gridbox(:)  <= -999999.9_wp )  .OR.   &
+             ANY( swd_gridbox(:) <= -999999.9_wp )  .OR.   &
+             ANY( lw_gridbox(:)  <= -999999.9_wp ) ) THEN
+           i_feedback = 0
+        ELSE
+           i_feedback = 1
+        ENDIF
+        
+        RETURN
+        
+    END SUBROUTINE radiation_radflux_gridbox
+
+
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+!> Block of auxiliary subroutines:
+!> 1. quicksort and corresponding comparison
+!> 2. merge_and_grow_csf for implementation of "dynamical growing"
+!>    array for csf
+!------------------------------------------------------------------------------!    
+    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
+    
+ 
+!-- 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
+        TYPE(t_svf), DIMENSION(:), INTENT(INOUT)  :: svfl
+        INTEGER(iwp), INTENT(IN)                  :: first, last
+        TYPE(t_svf)                               :: x, t
+        INTEGER(iwp)                              :: i, j
+
+        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)
+      TYPE (t_csf), INTENT(in) :: csf1,csf2
+      LOGICAL                  :: res
+      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
+
+
+!-- 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
+        TYPE(t_csf), DIMENSION(:), INTENT(INOUT)  :: csfl
+        INTEGER(iwp), INTENT(IN)                  :: first, last
+        TYPE(t_csf)                               :: x, t
+        INTEGER(iwp)                              :: i, j
+
+        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
+
+    
+    SUBROUTINE merge_and_grow_csf(newsize)
+        INTEGER(iwp), INTENT(in)                :: newsize  !< new array size after grow, must be >= ncsfl
+                                                            !< or -1 to shrink to minimum
+        INTEGER(iwp)                            :: iread, iwrite
+        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
+!--                 We could simply take either first or second rtransp, both are valid. As a very simple heuristic about which ray
+!--                 probably passes nearer the center of the target box, we choose DIF from the entry with greater CSF, since that
+!--                 might mean that the traced beam passes longer through the canopy box.
+                    IF ( acsfnew(iwrite)%rsvf < acsf(iread)%rsvf )  THEN
+                        acsfnew(iwrite)%rtransp = acsf(iread)%rtransp
+                    ENDIF
+                    acsfnew(iwrite)%rsvf = acsfnew(iwrite)%rsvf + acsf(iread)%rsvf
+!--                 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
+    END SUBROUTINE merge_and_grow_csf
+
+    
+!-- 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), DIMENSION(:,:), INTENT(INOUT)  :: kpcsflt
+        REAL(wp), DIMENSION(:,:), INTENT(INOUT)      :: pcsflt
+        INTEGER(iwp), INTENT(IN)                     :: first, last
+        REAL(wp), DIMENSION(ndcsf)                   :: t2
+        INTEGER(iwp), DIMENSION(kdcsf)               :: x, t1
+        INTEGER(iwp)                                 :: i, j
+
+        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
+
 !------------------------------------------------------------------------------!
 !
@@ -2501,4 +6996,5 @@
     INTEGER(iwp) ::  j !< 
     INTEGER(iwp) ::  k !< 
+    INTEGER(iwp) ::  m !< index of current surface element 
 
     IF ( mode == 'allocate' )  THEN
@@ -2570,7 +7066,16 @@
 
           CASE ( 'rad_net*' )
-             DO  i = nxlg, nxrg
-                DO  j = nysg, nyng
-                   rad_net_av(j,i) = rad_net_av(j,i) + rad_net(j,i)
+             DO  i = nxl, nxr
+                DO  j = nys, nyn
+                   DO m = surf_def_h(0)%start_index(j,i),                      &
+                          surf_def_h(0)%end_index(j,i)
+                      rad_net_av(j,i) = rad_net_av(j,i) + surf_def_h(0)%rad_net(m)
+                   ENDDO
+                   DO m = surf_lsm_h%start_index(j,i), surf_lsm_h%end_index(j,i)
+                      rad_net_av(j,i) = rad_net_av(j,i) + surf_lsm_h%rad_net(m)
+                   ENDDO
+                   DO m = surf_usm_h%start_index(j,i), surf_usm_h%end_index(j,i)
+                      rad_net_av(j,i) = rad_net_av(j,i) + surf_usm_h%rad_net(m)
+                   ENDDO
                 ENDDO
              ENDDO
@@ -2835,4 +7340,5 @@
     INTEGER(iwp) ::  j  !< 
     INTEGER(iwp) ::  k  !< 
+    INTEGER(iwp) ::  m  !< index of surface element at grid point (j,i)
 
     LOGICAL      ::  found !< 
@@ -2849,5 +7355,23 @@
              DO  i = nxl, nxr
                 DO  j = nys, nyn
-                   local_pf(i,j,nzb+1) = rad_net(j,i)
+!
+!--                Obtain rad_net from its respective surface type
+!--                Default-type surfaces
+                   DO  m = surf_def_h(0)%start_index(j,i),                     &
+                           surf_def_h(0)%end_index(j,i) 
+                      local_pf(i,j,nzb+1) = surf_def_h(0)%rad_net(m)
+                   ENDDO
+!
+!--                Natural-type surfaces
+                   DO  m = surf_lsm_h%start_index(j,i),                        &
+                           surf_lsm_h%end_index(j,i)  
+                      local_pf(i,j,nzb+1) = surf_lsm_h%rad_net(m)
+                   ENDDO
+!
+!--                Urban-type surfaces
+                   DO  m = surf_usm_h%start_index(j,i),                        &
+                           surf_usm_h%end_index(j,i)  
+                      local_pf(i,j,nzb+1) = surf_usm_h%rad_net(m)
+                   ENDDO
                 ENDDO
              ENDDO
@@ -3454,7 +7978,4 @@
 
     IF ( write_binary )  THEN
-       IF ( ALLOCATED( rad_net ) )  THEN
-          WRITE ( 14 )  'rad_net             ';  WRITE ( 14 )  rad_net  
-       ENDIF
        IF ( ALLOCATED( rad_net_av ) )  THEN
           WRITE ( 14 )  'rad_net_av          ';  WRITE ( 14 )  rad_net_av  
@@ -3472,8 +7993,4 @@
           WRITE ( 14 )  'rad_lw_out_av       ';  WRITE ( 14 )  rad_lw_out_av  
        ENDIF 
-       IF ( ALLOCATED( rad_lw_out_change_0 ) )  THEN
-          WRITE ( 14 )  'rad_lw_out_change_0 '
-          WRITE ( 14 )  rad_lw_out_change_0
-       ENDIF
        IF ( ALLOCATED( rad_lw_cs_hr ) )  THEN
           WRITE ( 14 )  'rad_lw_cs_hr        ';  WRITE ( 14 )  rad_lw_cs_hr
@@ -3594,12 +8111,4 @@
             SELECT CASE ( TRIM( field_char ) )
 
-                CASE ( 'rad_net' )
-                   IF ( .NOT. ALLOCATED( rad_net ) )  THEN
-                      ALLOCATE( rad_net(nysg:nyng,nxlg:nxrg) )
-                   ENDIF  
-                   IF ( k == 1 )  READ ( 13 )  tmp_2d
-                   rad_net(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp)  =         &
-                                 tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
                 CASE ( 'rad_net_av' )
                    IF ( .NOT. ALLOCATED( rad_net_av ) )  THEN
@@ -3697,12 +8206,4 @@
                    ENDIF
 
-                CASE ( 'rad_lw_out_change_0' )
-                   IF ( .NOT. ALLOCATED( rad_lw_out_change_0 ) )  THEN
-                      ALLOCATE( rad_lw_out_change_0(nysg:nyng,nxlg:nxrg) )
-                   ENDIF
-                   IF ( k == 1 )  READ ( 13 )  tmp_2d
-                   rad_lw_out_change_0(nysc-nbgp:nync+nbgp,nxlc-nbgp:nxrc+nbgp)&
-                              = tmp_2d(nysf-nbgp:nynf+nbgp,nxlf-nbgp:nxrf+nbgp)
-
                 CASE ( 'rad_lw_cs_hr' )
                    IF ( .NOT. ALLOCATED( rad_lw_cs_hr ) )  THEN
Index: palm/trunk/SOURCE/random_function_mod.f90
===================================================================
--- palm/trunk/SOURCE/random_function_mod.f90	(revision 2689)
+++ palm/trunk/SOURCE/random_function_mod.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file random_function_mod.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/random_gauss.f90
===================================================================
--- palm/trunk/SOURCE/random_gauss.f90	(revision 2689)
+++ palm/trunk/SOURCE/random_gauss.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file random_gauss.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/random_generator_parallel_mod.f90
===================================================================
--- palm/trunk/SOURCE/random_generator_parallel_mod.f90	(revision 2689)
+++ palm/trunk/SOURCE/random_generator_parallel_mod.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file random_generator_parallel_mod.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
@@ -25,4 +25,7 @@
 ! -----------------
 ! $Id$
+! Formatting (MS)
+! 
+! 2255 2017-06-07 11:58:09Z knoop
 ! Implemented PALM specific error message handling
 ! 
@@ -158,22 +161,22 @@
       id_random_array  = 0
 
-!--       Asigning an ID to every vertical gridpoint column 
-!--       dependig on the ensemble run number.
-          DO i=nxl, nxr
-             DO j=nys, nyn
-                id_random_array(j,i) = j*(nx+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, 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(:, j, i))
-             ENDDO
-          ENDDO
+!--   Asigning an ID to every vertical gridpoint column 
+!--   dependig on the ensemble run number.
+      DO i=nxl, nxr
+         DO j=nys, nyn
+            id_random_array(j,i) = j*(nx+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, 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(:, j, i))
+         ENDDO
+      ENDDO
 
    END SUBROUTINE init_parallel_random_generator
Index: palm/trunk/SOURCE/read_3d_binary.f90
===================================================================
--- palm/trunk/SOURCE/read_3d_binary.f90	(revision 2689)
+++ palm/trunk/SOURCE/read_3d_binary.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file read_3d_binary.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
@@ -21,8 +21,13 @@
 ! -----------------
 ! 
-!
+! 
 ! Former revisions:
 ! -----------------
 ! $Id$
+! - kh_av, km_av (TG)
+! - Implementation of chemistry module (FK)
+! - Changes from trunk concerning random generator added (MS)
+! 
+! 2644 2017-11-27 09:27:09Z raasch
 ! further bugfix for r2636 (wrong datatype used for allocation)
 !
@@ -144,7 +149,12 @@
     USE averaging
 
+#if defined( __chem )
+    USE chemistry_model_mod,                                                   &
+        ONLY:  chem_read_restart_data, chem_species, nspec                                
+#endif
+
     USE control_parameters,                                                    &
-        ONLY:  iran, land_surface, message_string, outflow_l, outflow_n,       &
-               outflow_r, outflow_s, urban_surface
+        ONLY:  air_chemistry, iran, land_surface, message_string, outflow_l,   &
+               outflow_n, outflow_r, outflow_s, urban_surface
 
     USE cpulog,                                                                &
@@ -234,5 +244,5 @@
     REAL(wp) ::  rdummy
 
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE     ::  tmp_2d      !< temporary array for storing 2D data
+    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_3dwul   !<
@@ -360,5 +370,5 @@
 !--    First compare the version numbers
        READ ( 13 )  version_on_file
-       binary_version = '4.5'
+       binary_version = '4.6'
        IF ( TRIM( version_on_file ) /= TRIM( binary_version ) )  THEN
           WRITE( message_string, * ) 'version mismatch concerning data ',      &
@@ -460,7 +470,4 @@
              nync = nynfa(i,k) + offset_ya(i,k)
 
-             write(9,*) "f", nxlf, nxrf, nysf, nynf
-             write(9,*) "c", nxlc, nxrc, nysc, nync
-
 
 
@@ -489,8 +496,24 @@
                              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' )
@@ -703,5 +726,5 @@
                    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,         &
@@ -722,4 +745,5 @@
                                        tmp_2d_seq_random(:,nysf:nynf,nxlf:nxrf)
                    DEALLOCATE( tmp_2d_id_random, tmp_2d_seq_random )
+
                 CASE ( 'rho_ocean_av' )
                    IF ( .NOT. ALLOCATED( rho_ocean_av ) )  THEN
@@ -1054,4 +1078,13 @@
 
 !
+!--    Read urban surface restart data
+       IF ( urban_surface )  THEN
+          CALL usm_read_restart_data( i, nxlfa, nxl_on_file, nxrfa,            &
+                                      nxr_on_file, nynfa, nyn_on_file, nysfa,  &
+                                      nys_on_file, offset_xa, offset_ya,       &
+                                      overlap_count(i) )
+       ENDIF
+
+!
 !--    Read land surface restart data
        IF ( land_surface )  THEN
@@ -1061,13 +1094,4 @@
                                       overlap_count(i), tmp_2d )
 
-       ENDIF
-       
-!
-!--    Read land surface restart data
-       IF ( urban_surface )  THEN
-          CALL usm_read_restart_data( i, nxlfa, nxl_on_file, nxrfa,            &
-                                      nxr_on_file, nynfa, nyn_on_file, nysfa,  &
-                                      nys_on_file, offset_xa, offset_ya,       &
-                                      overlap_count(i) )
        ENDIF
 
@@ -1083,4 +1107,16 @@
 
 !
+!--    Read chemistry restart data
+#if defined( __chem )
+       IF ( air_chemistry )  THEN
+          CALL chem_read_restart_data( i, nxlfa, nxl_on_file, nxrfa,           &
+                                       nxr_on_file, nynfa, nyn_on_file,        &
+                                       nysfa, nys_on_file, offset_xa,          &
+                                       offset_ya, overlap_count(i),            &
+                                       tmp_2d, tmp_3d )
+       ENDIF
+#endif
+
+!
 !--    Read user-defined restart data
        CALL user_read_restart_data( i, nxlfa, nxl_on_file, nxrfa, nxr_on_file, &
Index: palm/trunk/SOURCE/read_var_list.f90
===================================================================
--- palm/trunk/SOURCE/read_var_list.f90	(revision 2689)
+++ palm/trunk/SOURCE/read_var_list.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file read_var_list.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
@@ -25,4 +25,7 @@
 ! -----------------
 ! $Id$
+! + rans_mode, turbulence_closure (TG)
+! 
+! 2576 2017-10-24 13:49:46Z Giersch
 ! *** end *** marks the end of the standard parameter list of restart files
 ! like it was before revision 2563. To skip also the variables of the modules  
@@ -283,5 +286,5 @@
 !-- Make version number check first
     READ ( 13 )  version_on_file
-    binary_version = '4.4'
+    binary_version = '4.5'
     IF ( TRIM( version_on_file ) /= TRIM( binary_version ) )  THEN
        WRITE( message_string, * ) 'version mismatch concerning control ', &
@@ -636,4 +639,6 @@
           CASE ( 'random_heatflux' )
              READ ( 13 )  random_heatflux
+          CASE ( 'rans_mode' )
+             READ ( 13 )  rans_mode
           CASE ( 'rayleigh_damping_factor' )
              READ ( 13 )  rayleigh_damping_factor
@@ -758,4 +763,6 @@
           CASE ( 'tunnel_wall_depth' )
              READ ( 13 )  tunnel_wall_depth
+          CASE ( 'turbulence_closure' )
+             READ ( 13 )  turbulence_closure
           CASE ( 'turbulent_inflow' )
              READ ( 13 )  turbulent_inflow
Index: palm/trunk/SOURCE/run_control.f90
===================================================================
--- palm/trunk/SOURCE/run_control.f90	(revision 2689)
+++ palm/trunk/SOURCE/run_control.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file run_control.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/set_slicer_attributes_dvrp.f90
===================================================================
--- palm/trunk/SOURCE/set_slicer_attributes_dvrp.f90	(revision 2689)
+++ palm/trunk/SOURCE/set_slicer_attributes_dvrp.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file set_slicer_attributes_dvrp.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/sor.f90
===================================================================
--- palm/trunk/SOURCE/sor.f90	(revision 2689)
+++ palm/trunk/SOURCE/sor.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file sor.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
@@ -25,4 +25,7 @@
 ! -----------------
 ! $Id$
+! - Large-scale forcing implemented (MS)
+! 
+! 2101 2017-01-05 16:42:31Z suehring
 !
 ! 2037 2016-10-26 11:15:40Z knoop
@@ -75,8 +78,9 @@
 
     USE control_parameters,                                                    &
-        ONLY:  bc_lr_cyc, bc_ns_cyc, ibc_p_b, ibc_p_t, inflow_l, inflow_n,     &
-               inflow_r, inflow_s, nest_bound_l, nest_bound_n, nest_bound_r,   &
-               nest_bound_s, n_sor, omega_sor, outflow_l, outflow_n,           &
-               outflow_r, outflow_s
+        ONLY:  bc_lr_cyc, bc_ns_cyc, force_bound_l, force_bound_n,             &
+               force_bound_r, force_bound_s, ibc_p_b, ibc_p_t, inflow_l,       &
+               inflow_n, inflow_r, inflow_s, nest_bound_l, nest_bound_n,       &
+               nest_bound_r, nest_bound_s, n_sor, omega_sor, outflow_l,        &
+               outflow_n, outflow_r, outflow_s
 
     IMPLICIT NONE
@@ -167,10 +171,14 @@
 !--    Horizontal (Neumann) boundary conditions in case of non-cyclic boundaries
        IF ( .NOT. bc_lr_cyc )  THEN
-          IF ( inflow_l .OR. outflow_l .OR. nest_bound_l )  p(:,:,nxl-1) = p(:,:,nxl)
-          IF ( inflow_r .OR. outflow_r .OR. nest_bound_r )  p(:,:,nxr+1) = p(:,:,nxr)
+          IF ( inflow_l      .OR.  outflow_l  .OR.                                 &
+               nest_bound_l  .OR.  force_bound_l )  p(:,:,nxl-1) = p(:,:,nxl)
+          IF ( inflow_r      .OR.  outflow_r  .OR.                                 &
+               nest_bound_r  .OR.  force_bound_r )  p(:,:,nxr+1) = p(:,:,nxr)
        ENDIF
        IF ( .NOT. bc_ns_cyc )  THEN
-          IF ( inflow_n .OR. outflow_n .OR. nest_bound_n )  p(:,nyn+1,:) = p(:,nyn,:)
-          IF ( inflow_s .OR. outflow_s .OR. nest_bound_s )  p(:,nys-1,:) = p(:,nys,:)
+          IF ( inflow_n      .OR.  outflow_n  .OR.                                 &
+               nest_bound_n  .OR.  force_bound_n )  p(:,nyn+1,:) = p(:,nyn,:)
+          IF ( inflow_s      .OR.  outflow_s  .OR.                                 &
+               nest_bound_s  .OR.  force_bound_s )  p(:,nys-1,:) = p(:,nys,:)
        ENDIF
 
@@ -229,10 +237,14 @@
 !--    Horizontal (Neumann) boundary conditions in case of non-cyclic boundaries
        IF ( .NOT. bc_lr_cyc )  THEN
-          IF ( inflow_l .OR. outflow_l .OR. nest_bound_l )  p(:,:,nxl-1) = p(:,:,nxl)
-          IF ( inflow_r .OR. outflow_r .OR. nest_bound_r )  p(:,:,nxr+1) = p(:,:,nxr)
+          IF ( inflow_l      .OR.  outflow_l  .OR.                             &
+               nest_bound_l  .OR.  force_bound_l )  p(:,:,nxl-1) = p(:,:,nxl)
+          IF ( inflow_r      .OR.  outflow_r  .OR.                             &
+               nest_bound_r  .OR.  force_bound_r )  p(:,:,nxr+1) = p(:,:,nxr)
        ENDIF
        IF ( .NOT. bc_ns_cyc )  THEN
-          IF ( inflow_n .OR. outflow_n .OR. nest_bound_n )  p(:,nyn+1,:) = p(:,nyn,:)
-          IF ( inflow_s .OR. outflow_s .OR. nest_bound_s )  p(:,nys-1,:) = p(:,nys,:)
+          IF ( inflow_n      .OR.  outflow_n  .OR.                             &
+               nest_bound_n  .OR.  force_bound_n )  p(:,nyn+1,:) = p(:,nyn,:)
+          IF ( inflow_s      .OR.  outflow_s  .OR.                             &
+               nest_bound_s  .OR.  force_bound_s )  p(:,nys-1,:) = p(:,nys,:)
        ENDIF
 
Index: palm/trunk/SOURCE/spectra_mod.f90
===================================================================
--- palm/trunk/SOURCE/spectra_mod.f90	(revision 2689)
+++ palm/trunk/SOURCE/spectra_mod.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file spectra_mod.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/subsidence_mod.f90
===================================================================
--- palm/trunk/SOURCE/subsidence_mod.f90	(revision 2689)
+++ palm/trunk/SOURCE/subsidence_mod.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file subsidence_mod.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/sum_up_3d_data.f90
===================================================================
--- palm/trunk/SOURCE/sum_up_3d_data.f90	(revision 2689)
+++ palm/trunk/SOURCE/sum_up_3d_data.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file sum_up_3d_data.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
@@ -25,4 +25,11 @@
 ! -----------------
 ! $Id$
+! - Implementation of uv exposure model (FK)
+! - output of diss_av, kh_av, km_av (turbulence_closure_mod) (TG)
+! - Implementation of chemistry module (FK)
+! - Workaround for sum-up usm arrays in case of restart runs, to avoid program 
+!   crash (MS)
+! 
+! 2292 2017-06-20 09:51:42Z schwenkel
 ! Implementation of new microphysic scheme: cloud_scheme = 'morrison' 
 ! includes two more prognostic equations for cloud drop concentration (nc)  
@@ -144,9 +151,13 @@
 
     USE averaging,                                                             &
-        ONLY:  e_av, lpt_av, lwp_av, nc_av, nr_av, ol_av, p_av, pc_av, pr_av,  &
-               prr_av, precipitation_rate_av, pt_av, q_av, qc_av, ql_av,       &
-               ql_c_av, ql_v_av, ql_vp_av, qr_av, qsws_av, qv_av, rho_ocean_av,&
-               s_av, sa_av, shf_av, ssws_av, ts_av, u_av, us_av, v_av, vpt_av, &
-               w_av, z0_av, z0h_av, z0q_av
+        ONLY:  diss_av, e_av, kh_av, km_av, lpt_av, lwp_av, nc_av, nr_av,      &
+               ol_av, p_av, pc_av, pr_av, prr_av, precipitation_rate_av, pt_av,&
+               q_av, qc_av, ql_av, ql_c_av, ql_v_av, ql_vp_av, qr_av, qsws_av, &
+               qv_av, rho_ocean_av, s_av, sa_av, shf_av, ssws_av, ts_av, u_av, &
+               us_av, v_av, vpt_av, w_av, z0_av, z0h_av, z0q_av
+#if defined( __chem )
+    USE chemistry_model_mod,                                                   &
+        ONLY:  chem_3d_data_averaging, chem_integrate, chem_species, nspec                                   
+#endif
 
     USE cloud_parameters,                                                      &
@@ -154,6 +165,7 @@
 
     USE control_parameters,                                                    &
-        ONLY:  average_count_3d, cloud_physics, doav, doav_n, land_surface,    &
-               rho_surface, urban_surface, varnamelength
+        ONLY:  air_chemistry, average_count_3d, cloud_physics, doav, doav_n,   &
+               land_surface, rho_surface, urban_surface, uv_exposure,          &
+               varnamelength
 
     USE cpulog,                                                                &
@@ -177,6 +189,12 @@
         ONLY:  surf_def_h, surf_lsm_h, surf_usm_h
 
+    USE turbulence_closure_mod,                                                &
+        ONLY:  tcm_3d_data_averaging
+
     USE urban_surface_mod,                                                     &
         ONLY:  usm_average_3d_data
+
+    USE uv_exposure_model_mod,                                                &
+        ONLY:  uvem_3d_data_averaging
 
 
@@ -436,4 +454,8 @@
 
 !
+!--             Turbulence closure module
+                CALL tcm_3d_data_averaging( 'allocate', doav(ii) )
+
+!
 !--             Land surface quantity
                 IF ( land_surface )  THEN
@@ -445,4 +467,18 @@
                 IF ( radiation )  THEN
                    CALL radiation_3d_data_averaging( 'allocate', doav(ii) )
+                ENDIF
+
+!
+!--             Chemical quantity                                           
+#if defined( __chem )                
+                IF ( air_chemistry  .AND.  trimvar(1:3) == 'kc_')  THEN
+                   CALL chem_3d_data_averaging( 'allocate', doav(ii) )
+                ENDIF
+#endif
+
+!
+!--             UV exposure quantity
+                IF ( uv_exposure  .AND.  trimvar(1:5) == 'uvem_')  THEN
+                   CALL uvem_3d_data_averaging( 'allocate', doav(ii) )
                 ENDIF
 
@@ -889,9 +925,17 @@
              ENDDO
 !             
-!--       Block of urban surface model outputs 
+!--       Block of urban surface model outputs. 
+!--       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 usm arrays are not read from file at the moment. 
           CASE ( 'usm_output' )
+             CALL usm_average_3d_data( 'allocate', doav(ii) )
              CALL usm_average_3d_data( 'sum', doav(ii) )
 
           CASE DEFAULT
+!
+!--          Turbulence closure module
+             CALL tcm_3d_data_averaging( 'sum', doav(ii) )
+
 !
 !--          Land surface quantity
@@ -907,4 +951,18 @@
 
 !
+!--          Chemical quantity
+#if defined( __chem )                
+             IF ( air_chemistry  .AND.  trimvar(1:3) == 'kc_')  THEN
+                CALL chem_3d_data_averaging( 'sum',doav(ii) )
+             ENDIF
+#endif
+
+!
+!--          UV exposure quantity
+             IF ( uv_exposure )  THEN
+                CALL uvem_3d_data_averaging( 'sum', doav(ii) )
+             ENDIF
+
+!
 !--          User-defined quantity
              CALL user_3d_data_averaging( 'sum', doav(ii) )
Index: palm/trunk/SOURCE/surface_coupler.f90
===================================================================
--- palm/trunk/SOURCE/surface_coupler.f90	(revision 2689)
+++ palm/trunk/SOURCE/surface_coupler.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file surface_coupler.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/surface_layer_fluxes_mod.f90
===================================================================
--- palm/trunk/SOURCE/surface_layer_fluxes_mod.f90	(revision 2689)
+++ palm/trunk/SOURCE/surface_layer_fluxes_mod.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file surface_layer_fluxes_mod.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
@@ -18,4 +18,5 @@
 !
 !------------------------------------------------------------------------------!
+!
 ! Current revisions:
 ! ------------------
@@ -25,4 +26,10 @@
 ! -----------------
 ! $Id$
+! - Implementation of chemistry module (FK)
+! - Added calculation of pt1 and qv1 for all surface types. Added calculation of
+!   pt_surface for default-type surfaces (BM)
+! - Add flag to disable computation of qsws in case of urban surface (MS)
+! 
+! 2547 2017-10-16 12:41:56Z schwenkel
 ! extended by cloud_droplets option
 ! 
@@ -188,4 +195,5 @@
 !> @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
@@ -195,4 +203,9 @@
                drho_air_zw, rho_air_zw
 
+#if defined( __chem )
+    USE chem_modules,                                                          &
+        ONLY:  constant_csflux, nvar
+#endif
+
     USE cloud_parameters,                                                      &
         ONLY:  l_d_cp, pt_d_t
@@ -204,7 +217,8 @@
 
     USE control_parameters,                                                    &
-        ONLY:  cloud_droplets, cloud_physics, constant_heatflux,               &
-               constant_scalarflux, constant_waterflux, coupling_mode, g,      &
-               humidity, ibc_e_b, ibc_pt_b, initializing_actions, kappa,       &
+        ONLY:  air_chemistry, cloud_droplets, cloud_physics,                   &
+               constant_heatflux, constant_scalarflux,                         &     
+               constant_waterflux, coupling_mode, g, humidity, ibc_e_b,        &
+               ibc_pt_b, initializing_actions, kappa,                          &
                intermediate_timestep_count, intermediate_timestep_count_max,   &
                land_surface, large_scale_forcing, lsf_surf,                    &
@@ -291,30 +305,45 @@
        downward      = .FALSE.
 !
-!--    In case cloud physics is used, it is required to derive potential
-!--    temperature and specific humidity at first grid level from the fields pt 
-!--    and q
-       IF ( cloud_physics  .OR.  cloud_droplets )  THEN
-!
-!--       First call for horizontal default-type surfaces (l=0 - upward facing, 
-!--       l=1 - downward facing)
-          DO  l = 0, 1
-             IF ( surf_def_h(l)%ns >= 1  )  THEN
-                surf => surf_def_h(l)
-                CALL calc_pt_q
-             ENDIF
-          ENDDO
-!
-!--       Call for natural-type surfaces
-          IF ( surf_lsm_h%ns >= 1  )  THEN
-             surf => surf_lsm_h
+!--    Derive potential temperature and specific humidity at first grid level 
+!--    from the fields pt and q
+!
+!--    First call for horizontal default-type surfaces (l=0 - upward facing, 
+!--    l=1 - downward facing)
+       DO  l = 0, 1
+          IF ( surf_def_h(l)%ns >= 1  )  THEN
+             surf => surf_def_h(l)
              CALL calc_pt_q
-          ENDIF
-!
-!--       Call for urban-type surfaces
-          IF ( surf_usm_h%ns >= 1  )  THEN
-             surf => surf_usm_h
+             IF ( .NOT. neutral )  CALL calc_pt_surface
+          ENDIF
+       ENDDO
+!
+!--    Call for natural-type horizontal surfaces
+       IF ( surf_lsm_h%ns >= 1  )  THEN
+          surf => surf_lsm_h
+          CALL calc_pt_q
+       ENDIF
+
+!
+!--    Call for urban-type horizontal surfaces
+       IF ( surf_usm_h%ns >= 1  )  THEN
+          surf => surf_usm_h
+          CALL calc_pt_q
+       ENDIF
+
+!
+!--    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
-       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
 
 !
@@ -923,5 +952,4 @@
 !--       However, this do 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)           &
@@ -1538,4 +1566,11 @@
              surf%pt1(m) = pt(k,j,i) + l_d_cp * pt_d_t(k) * ql(k,j,i)
              surf%qv1(m) = q(k,j,i) 
+          ELSE
+             surf%pt1(m) = pt(k,j,i)
+             IF ( humidity )  THEN
+                surf%qv1(m) = q(k,j,i)
+             ELSE
+                surf%qv1(m) = 0.0_wp
+             ENDIF
           ENDIF 
 
@@ -1543,4 +1578,29 @@
 
     END SUBROUTINE calc_pt_q
+
+
+!
+!-- Calculate potential temperature and specific humidity at first grid level
+!-- ( only for upward-facing surfs )
+    SUBROUTINE calc_pt_surface
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  koff    !< 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 
+       
+       koff = 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%pt_surface(m) = pt(k+koff,j,i)
+
+       ENDDO
+
+    END SUBROUTINE calc_pt_surface
 
 !
@@ -1552,5 +1612,5 @@
 
        INTEGER(iwp)  ::  m       !< loop variable over all horizontal surf elements 
-
+       INTEGER(iwp)  ::  lsp     !< running index for chemical species
 ! 
 !--    Compute theta* at horizontal surfaces
@@ -1592,36 +1652,16 @@
           ENDIF
 
-          IF ( cloud_physics  .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%ts(m) = kappa * ( surf%pt1(m) - pt(k-1,j,i) )             &
-                                     / ( LOG( z_mo / surf%z0h(m) )             &
-                                         - psi_h( z_mo / surf%ol(m) )          &
-                                         + psi_h( surf%z0h(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%ts(m) = kappa * ( pt(k,j,i) - pt(k-1,j,i) )               &
-                                     / ( LOG( z_mo / surf%z0h(m) )             &
-                                         - psi_h( z_mo / surf%ol(m) )          &
-                                         + psi_h( surf%z0h(m) / surf%ol(m) ) )
-             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) )      &
+                                  / ( LOG( z_mo / surf%z0h(m) )             &
+                                      - psi_h( z_mo / surf%ol(m) )          &
+                                      + psi_h( surf%z0h(m) / surf%ol(m) ) )
+
+          ENDDO
+
        ENDIF
 ! 
@@ -1769,4 +1809,36 @@
 
 !
+!--    If required compute cs* (chemical species)
+#if defined( __chem )
+       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
+#endif
+
+!
 !--    If required compute qc* and nc*
        IF ( cloud_physics  .AND.  microphysics_morrison  .AND.                 &
@@ -1830,5 +1902,6 @@
        IMPLICIT NONE
 
-       INTEGER(iwp)  ::  m       !< loop variable over all horizontal surf elements 
+       INTEGER(iwp)  ::  m       !< loop variable over all horizontal surf elements
+       INTEGER(iwp)  ::  lsp     !< running index for chemical species
 
        REAL(wp)                            ::  dum     !< dummy to precalculate logarithm
@@ -1883,6 +1956,4 @@
 
                 surf%usws(m) = kappa * u(k,j,i) / LOG( z_mo / surf%z0(m) )
-!
-!--        To Do: Is the sign correct???
                 surf%usws(m) = surf%usws(m) * surf%us(m) * rho_air_zw(k)
 
@@ -1929,5 +2000,4 @@
 
                 surf%vsws(m) = kappa * v(k,j,i) / LOG( z_mo / surf%z0(m) )
- 
                 surf%vsws(m) = surf%vsws(m) * surf%us(m) * rho_air_zw(k)
              ENDDO
@@ -1937,5 +2007,5 @@
           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.  land_surface )  .AND.  .NOT. urban_surface  .AND.        &
                .NOT. downward )  THEN
              !$OMP PARALLEL DO PRIVATE( i, j, k )
@@ -1951,6 +2021,6 @@
           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. downward )  THEN
+               simulated_time > 0.0_wp ) .OR.  .NOT.  land_surface  )  .AND.   &
+               .NOT.  urban_surface  .AND.  .NOT. downward )  THEN
              !$OMP PARALLEL DO PRIVATE( i, j, k )
              DO  m = 1, surf%ns 
@@ -1974,4 +2044,20 @@
              ENDDO
           ENDIF   
+!
+!--       Compute the vertical chemical species' flux
+#if defined( __chem )
+          DO  lsp = 1, nvar
+             IF (  .NOT.  constant_csflux(lsp)  .AND.  air_chemistry  .AND.    &
+                   .NOT.  downward )  THEN
+                !$OMP PARALLEL DO PRIVATE( i, j )
+                DO  m = 1, surf%ns   
+                   i     = surf%i(m)            
+                   j     = surf%j(m)
+                   surf%cssws(lsp,m) = -surf%css(lsp,m) * surf%us(m)
+                ENDDO
+             ENDIF   
+          ENDDO
+#endif
+
 !
 !--       Compute (turbulent) fluxes of cloud water content and cloud drop conc.
Index: palm/trunk/SOURCE/surface_mod.f90
===================================================================
--- palm/trunk/SOURCE/surface_mod.f90	(revision 2689)
+++ palm/trunk/SOURCE/surface_mod.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file surface_mod.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
@@ -26,4 +26,16 @@
 ! -----------------
 ! $Id$
+! - Missing code for css added to surf_*, handling of surface_csflux updated (FK)
+! - Bugfixes in reading/writing restart data in case several surface types are 
+!   present at the same time (MS)
+! - Implementation of chemistry module (FK)
+! - Allocation of pt1 and qv1 now done for all surface types (MS)
+! - Revised classification of surface types
+! - Introduce offset values to simplify index determination of surface elements
+! - Dimensions of function get_topo_top_index (MS)
+! - added variables for USM 
+! - adapted to changes in USM (RvT)
+! 
+! 2688 2017-12-12 17:27:04Z Giersch
 ! Allocation and initialization of the latent heat flux (qsws) at the top of 
 ! the ocean domain in case of coupled runs. In addtion, a double if-query has 
@@ -84,4 +96,8 @@
 !> 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 chemistry surface flux part (reduce loops?!) 
 !------------------------------------------------------------------------------!
  MODULE surface_mod
@@ -91,4 +107,8 @@
                momentumflux_input_conversion
 
+#if defined( __chem )
+    USE chem_modules
+#endif
+
     USE control_parameters               
 
@@ -126,5 +146,9 @@
     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), DIMENSION(:), ALLOCATABLE ::  i       !< x-index linking to the PALM 3D-grid  
        INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  j       !< y-index linking to the PALM 3D-grid    
@@ -154,6 +178,7 @@
        REAL(wp), DIMENSION(:), ALLOCATABLE ::  z0q       !< roughness length for humidity
 
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  pt1       !< Specific humidity at first grid level (required for cloud_physics = .T. or cloud_droplets = .T.)
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  qv1       !< Potential temperature at first grid level (required for cloud_physics = .T. or cloud_droplets = .T.)
+       REAL(wp), DIMENSION(:), ALLOCATABLE ::  pt1       !< Potential temperature at first grid level
+       REAL(wp), DIMENSION(:), ALLOCATABLE ::  qv1       !< Specific humidity at first grid level
+       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  css     !< scaling parameter chemical species
 !
 !--    Define arrays for surface fluxes
@@ -169,4 +194,6 @@
        REAL(wp), DIMENSION(:), ALLOCATABLE ::  nrsws     !< surface flux nr
        REAL(wp), DIMENSION(:), ALLOCATABLE ::  sasws     !< surface flux salinity
+       
+       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  cssws   !< surface flux chemical species
 !
 !--    Required for horizontal walls in production_e
@@ -179,25 +206,52 @@
 !
 !--    Variables required for LSM as well as for USM
-       REAL(wp), DIMENSION(:), ALLOCATABLE   ::  pt_surface        !< skin-surface temperature
-       REAL(wp), DIMENSION(:), ALLOCATABLE   ::  rad_net_l         !< net radiation 
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  lambda_h          !< heat conductivity of soil (W/m/K) 
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  lambda_h_def      !< default heat conductivity of soil (W/m/K)   
-       
+       INTEGER(iwp), DIMENSION(:), ALLOCATABLE   ::  nzt_pavement  !< top index for pavement in soil
+       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
+       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Â°
+       REAL(wp), DIMENSION(:), ALLOCATABLE   ::  aldir             !< albedo for longwave direct radiation, solar angle of 60Â°
+       REAL(wp), DIMENSION(:), ALLOCATABLE   ::  asdif             !< albedo for shortwave diffusive radiation, solar angle of 60Â°
+       REAL(wp), DIMENSION(:), ALLOCATABLE   ::  asdir             !< albedo for shortwave direct radiation, solar angle of 60Â°
+       REAL(wp), DIMENSION(:), ALLOCATABLE   ::  rrtm_aldif        !< albedo for longwave diffusive radiation, solar angle of 60Â°
+       REAL(wp), DIMENSION(:), ALLOCATABLE   ::  rrtm_aldir        !< albedo for longwave direct radiation, solar angle of 60Â°
+       REAL(wp), DIMENSION(:), ALLOCATABLE   ::  rrtm_asdif        !< albedo for shortwave diffusive radiation, solar angle of 60Â°
+       REAL(wp), DIMENSION(:), ALLOCATABLE   ::  rrtm_asdir        !< albedo for shortwave direct radiation, solar angle of 60Â°
+
+       REAL(wp), DIMENSION(:), ALLOCATABLE   ::  pt_surface        !< skin-surface 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_sw_in           !< incoming shortwave radiation
+       REAL(wp), DIMENSION(:), ALLOCATABLE ::  rad_sw_out          !< emitted shortwave radiation
+       
+
 
        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 ::  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 ::  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_canopy            !< canopy resistance
@@ -224,12 +278,20 @@
        INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  surface_types   !< array of types of wall parameters
 
-       LOGICAL, DIMENSION(:), ALLOCATABLE  ::  isroof_surf         !< flag indication roof surfaces
-
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  albedo_surf         !< albedo of the surface
+       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 ::  emiss_surf          !< emissivity of the wall surface
+       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 ::  lambda_surf         !< heat conductivity between air and surface (W/m2/K)
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  roughness_wall      !< roughness relative to concrete
+       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
@@ -238,14 +300,16 @@
 
        REAL(wp), DIMENSION(:), ALLOCATABLE ::  tt_surface_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 ::  rad_in_sw           !< incoming shortwave radiation
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  rad_out_sw          !< emitted shortwave radiation
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  rad_in_lw           !< incoming longwave radiation
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  rad_out_lw          !< emitted longwave radiation
+       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
@@ -262,4 +326,18 @@
        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 ::  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)
 
 
@@ -279,8 +357,18 @@
        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 ::  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 ::  t_surf_whole_av  !< average of whole wall surface temperature (K)
+       REAL(wp), DIMENSION(:), ALLOCATABLE ::  t_surf_10cm_av   !< average of the near surface temperature (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
 
     END TYPE surf_type
@@ -305,4 +393,5 @@
     INTERFACE get_topography_top_index
        MODULE PROCEDURE get_topography_top_index
+       MODULE PROCEDURE get_topography_top_index_ji
     END  INTERFACE get_topography_top_index
 
@@ -331,4 +420,9 @@
     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
+
 !
 !-- Public variables
@@ -338,6 +432,7 @@
 !-- Public subroutines and functions
     PUBLIC get_topography_top_index, init_bc, init_surfaces,                   &
-           init_surface_arrays, surface_read_restart_data,                     &
-           surface_write_restart_data, surface_last_actions
+           init_surface_arrays, surface_read_restart_data,                     & 
+           surface_restore_elements, surface_write_restart_data,               &
+           surface_last_actions
 
 
@@ -473,4 +568,6 @@
        INTEGER(iwp), DIMENSION(0:3) ::  num_usm_v !< number of vertically-aligned urban surfaces 
 
+       LOGICAL ::  building                       !< flag indicating building grid point
+       LOGICAL ::  terrain                        !< flag indicating natural terrain grid point
 
        num_def_h = 0
@@ -481,4 +578,10 @@
        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
@@ -491,17 +594,34 @@
 !--                Check if grid point adjoins to any upward-facing horizontal
 !--                surface, e.g. the Earth surface, plane roofs, or ceilings.
+
                    IF ( .NOT. BTEST( wall_flags_0(k-1,j,i), 0 ) )  THEN
 !
+!--                   Determine flags indicating terrain or building. 
+                      terrain  = BTEST( wall_flags_0(k-1,j,i), 5 )  .OR.       &
+                                 topo_no_distinct
+                      building = BTEST( wall_flags_0(k-1,j,i), 6 )  .OR.       &
+                                 topo_no_distinct
+!
 !--                   Land-surface type
-                      IF ( land_surface )  THEN
+                      IF ( land_surface  .AND.  terrain )  THEN
                          num_lsm_h    = num_lsm_h    + 1 
 !
 !--                   Urban surface tpye
-                      ELSEIF ( urban_surface )  THEN 
+                      ELSEIF ( urban_surface  .AND.  building )  THEN
                          num_usm_h    = num_usm_h    + 1 
 !
 !--                   Default-surface type
-                      ELSE
-                         num_def_h(0) = num_def_h(0) + 1 
+                      ELSEIF ( .NOT. land_surface    .AND.                     &
+                               .NOT. urban_surface )  THEN
+                               
+                         num_def_h(0) = num_def_h(0) + 1
+!
+!--                   Unclassifified surface-grid point. Give error message.
+                      ELSE 
+                         WRITE( message_string, * )                           &
+                                          'Unclassified upward-facing ' //    &
+                                          'surface element at '//             &
+                                          'grid point (k,j,i) = ', k, j, i
+                         CALL message( 'surface_mod', 'PA0999', 1, 2, 0, 6, 0 )
                       ENDIF
 
@@ -531,10 +651,29 @@
 !--                Northward-facing
                    IF ( .NOT. BTEST( wall_flags_0(k,j-1,i), 0 ) )  THEN
-                      IF ( urban_surface )  THEN
+!
+!--                   Determine flags indicating terrain or building
+
+                      terrain  = BTEST( wall_flags_0(k,j-1,i), 5 )  .OR.       &
+                                 topo_no_distinct
+                      building = BTEST( wall_flags_0(k,j-1,i), 6 )   .OR.       &
+                                 topo_no_distinct
+                      IF (  land_surface  .AND.  terrain )  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 
-                      ELSEIF ( land_surface )  THEN
-                         num_lsm_v(0) = num_lsm_v(0) + 1 
-                      ELSE
+!
+!--                   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', 'PA0999', 1, 2, 0, 6, 0 ) 
+
                       ENDIF
                    ENDIF
@@ -542,10 +681,28 @@
 !--                Southward-facing
                    IF ( .NOT. BTEST( wall_flags_0(k,j+1,i), 0 ) )  THEN
-                      IF ( urban_surface )  THEN
+!
+!--                   Determine flags indicating terrain or building
+                      terrain  = BTEST( wall_flags_0(k,j+1,i), 5 )  .OR.       &
+                                 topo_no_distinct
+                      building = BTEST( wall_flags_0(k,j+1,i), 6 )  .OR.       &
+                                 topo_no_distinct
+                      IF (  land_surface  .AND.  terrain )  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 
-                      ELSEIF ( land_surface )  THEN
-                         num_lsm_v(1) = num_lsm_v(1) + 1 
-                      ELSE
+!
+!--                   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', 'PA0999', 1, 2, 0, 6, 0 ) 
+
                       ENDIF
                    ENDIF
@@ -553,10 +710,28 @@
 !--                Eastward-facing
                    IF ( .NOT. BTEST( wall_flags_0(k,j,i-1), 0 ) )  THEN
-                      IF ( urban_surface )  THEN
+!
+!--                   Determine flags indicating terrain or building
+                      terrain  = BTEST( wall_flags_0(k,j,i-1), 5 )  .OR.       &
+                                 topo_no_distinct
+                      building = BTEST( wall_flags_0(k,j,i-1), 6 )  .OR.       &
+                                 topo_no_distinct
+                      IF (  land_surface  .AND.  terrain )  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 
-                      ELSEIF ( land_surface )  THEN
-                         num_lsm_v(2) = num_lsm_v(2) + 1 
-                      ELSE
+!
+!--                   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', 'PA0999', 1, 2, 0, 6, 0 ) 
+
                       ENDIF
                    ENDIF
@@ -564,10 +739,28 @@
 !--                Westward-facing
                    IF ( .NOT. BTEST( wall_flags_0(k,j,i+1), 0 ) )  THEN
-                      IF ( urban_surface )  THEN
-                         num_usm_v(3) = num_usm_v(3) + 1
-                      ELSEIF ( land_surface )  THEN
-                         num_lsm_v(3) = num_lsm_v(3) + 1  
-                      ELSE
+!
+!--                   Determine flags indicating terrain or building
+                      terrain  = BTEST( wall_flags_0(k,j,i+1), 5 )  .OR.       &
+                                 topo_no_distinct
+                      building = BTEST( wall_flags_0(k,j,i+1), 6 )  .OR.       &
+                                 topo_no_distinct
+                      IF (  land_surface  .AND.  terrain )  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', 'PA0999', 1, 2, 0, 6, 0 ) 
+
                       ENDIF
                    ENDIF
@@ -651,5 +844,5 @@
 !--    Default type.
        DO  l = 0, 3
-          CALL allocate_surface_attributes_v ( surf_def_v(l), .FALSE.,         &
+          CALL allocate_surface_attributes_v ( surf_def_v(l),                  &
                                                nys, nyn, nxl, nxr )
        ENDDO
@@ -657,5 +850,5 @@
 !--    Natural type
        DO  l = 0, 3
-          CALL allocate_surface_attributes_v ( surf_lsm_v(l), .TRUE.,          &
+          CALL allocate_surface_attributes_v ( surf_lsm_v(l),                  &
                                                nys, nyn, nxl, nxr )
        ENDDO
@@ -663,5 +856,5 @@
 !--    Urban type
        DO  l = 0, 3
-          CALL allocate_surface_attributes_v ( surf_usm_v(l), .FALSE.,         &
+          CALL allocate_surface_attributes_v ( surf_usm_v(l),                  &
                                                nys, nyn, nxl, nxr )
        ENDDO
@@ -716,5 +909,4 @@
 !--    Surface-parallel wind velocity
        ALLOCATE ( surfaces%uvw_abs(1:surfaces%ns) )
-!      ALLOCATE ( surfaces%pt_surface(1:surfaces%ns) )
 !
 !--    Roughness
@@ -746,4 +938,7 @@
        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
@@ -758,10 +953,16 @@
        ENDIF 
 !
-!--    When cloud physics is used, arrays for storing potential temperature and
-!--    specific humidity at first grid level are required. 
-       IF ( cloud_physics  .OR.  cloud_droplets )  THEN
-          ALLOCATE ( surfaces%pt1(1:surfaces%ns) )
-          ALLOCATE ( surfaces%qv1(1:surfaces%ns) )
-       ENDIF
+!--    Scaling parameter (cs*) and surface flux of chemical species
+#if defined ( __chem )
+       IF ( air_chemistry )  THEN
+          ALLOCATE ( surfaces%css(1:nvar,1:surfaces%ns)   )   
+          ALLOCATE ( surfaces%cssws(1:nvar,1:surfaces%ns) ) 
+       ENDIF 
+#endif 
+!
+!--    Arrays for storing potential temperature and
+!--    specific humidity at first grid level
+       ALLOCATE ( surfaces%pt1(1:surfaces%ns) )
+       ALLOCATE ( surfaces%qv1(1:surfaces%ns) )
 !
 !--       
@@ -836,4 +1037,11 @@
        ENDIF 
 !
+!--    Chemical species flux
+#if defined( __chem )
+       IF ( air_chemistry )  THEN
+          ALLOCATE ( surfaces%cssws(1:nvar,1:surfaces%ns) ) 
+       ENDIF 
+#endif 
+!
 !--       
        IF ( cloud_physics .AND. microphysics_morrison)  THEN
@@ -858,5 +1066,5 @@
 !> Allocating memory for vertical surface types. 
 !------------------------------------------------------------------------------!
-    SUBROUTINE allocate_surface_attributes_v( surfaces, lsm,                   &
+    SUBROUTINE allocate_surface_attributes_v( surfaces,                        &
                                               nys_l, nyn_l, nxl_l, nxr_l )
 
@@ -867,6 +1075,4 @@
        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         ::  lsm      !< flag indicating data type of natural land surface
 
        TYPE(surf_type) ::  surfaces !< respective surface type
@@ -909,10 +1115,9 @@
        ALLOCATE ( surfaces%us(1:surfaces%ns) )
 !
-!--    Allocate Obukhov length and bulk Richardson number. Only required 
+!--    Allocate Obukhov length and bulk Richardson number. Actually, at
+!--    vertical surfaces these are only required for natural surfaces.  
 !--    for natural land surfaces
-       IF ( lsm )  THEN
-          ALLOCATE( surfaces%ol(1:surfaces%ns)  ) 
-          ALLOCATE( surfaces%rib(1:surfaces%ns) ) 
-       ENDIF
+       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- 
@@ -930,5 +1135,8 @@
 !--    Characteristic temperature and surface flux of sensible heat
        ALLOCATE ( surfaces%ts(1:surfaces%ns)  )    
-       ALLOCATE ( surfaces%shf(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
@@ -942,5 +1150,18 @@
           ALLOCATE ( surfaces%ss(1:surfaces%ns)   )   
           ALLOCATE ( surfaces%ssws(1:surfaces%ns) ) 
+       ENDIF
+!
+!--    Scaling parameter (cs*) and surface flux of chemical species
+#if defined( __chem )
+       IF ( air_chemistry )  THEN
+             ALLOCATE ( surfaces%css(1:nvar,1:surfaces%ns)   )   
+             ALLOCATE ( surfaces%cssws(1:nvar,1:surfaces%ns) ) 
        ENDIF 
+#endif
+!
+!--    Arrays for storing potential temperature and
+!--    specific humidity at first grid level
+       ALLOCATE ( surfaces%pt1(1:surfaces%ns) )
+       ALLOCATE ( surfaces%qv1(1:surfaces%ns) )
 
        IF ( cloud_physics .AND. microphysics_seifert)  THEN
@@ -966,5 +1187,10 @@
 ! Description:
 ! ------------
-!> Initialize surface elements. 
+!> 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
@@ -1001,4 +1227,63 @@
        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
+
+!
+!--    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%ioff = 0
+       surf_lsm_h%joff = 0
+
+       surf_usm_h%ioff = 0
+       surf_usm_h%joff = 0
+!
+!--    Upward facing vertical offsets
+       surf_def_h(0)%koff   = -1
+       surf_lsm_h%koff      = -1
+       surf_usm_h%koff      = -1
+!
+!--    Downward facing vertical offset
+       surf_def_h(1:2)%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
 
 !
@@ -1039,10 +1324,15 @@
 !--                Upward-facing surface. Distinguish between differet surface types.
 !--                To do, think about method to flag natural and non-natural 
-!--                surfaces. Only to ask for land_surface or urban surface 
-!--                is just a work-around. 
+!--                surfaces. 
                    IF ( .NOT. BTEST( wall_flags_0(k-1,j,i), 0 ) )  THEN 
 !
+!--                   Determine flags indicating terrain or building
+                      terrain  = BTEST( wall_flags_0(k-1,j,i), 5 )  .OR.       &
+                                 topo_no_distinct
+                      building = BTEST( wall_flags_0(k-1,j,i), 6 )  .OR.       &
+                                 topo_no_distinct
+!
 !--                   Natural surface type          
-                      IF ( land_surface )  THEN
+                      IF ( land_surface  .AND.  terrain )  THEN
                          CALL initialize_horizontal_surfaces( k, j, i,         &
                                                               surf_lsm_h,      &
@@ -1052,5 +1342,5 @@
 !
 !--                   Urban surface tpye
-                      ELSEIF ( urban_surface )  THEN
+                      ELSEIF ( urban_surface  .AND.  building )  THEN
                          CALL initialize_horizontal_surfaces( k, j, i,         &
                                                               surf_usm_h,      &
@@ -1069,5 +1359,7 @@
                    ENDIF  
 !
-!--                downward-facing surface, first, model top
+!--                downward-facing surface, first, model top. Please note, 
+!--                for the moment, downward-facing surfaces are always of 
+!--                default type
                    IF ( k == nzt  .AND.  use_top_fluxes )  THEN
                       CALL initialize_top( k, j, i, surf_def_h(2),             &
@@ -1087,5 +1379,11 @@
 !                  Start with northward-facing surface.
                    IF ( .NOT. BTEST( wall_flags_0(k,j-1,i), 0 ) )  THEN
-                      IF ( urban_surface )  THEN
+!
+!--                   Determine flags indicating terrain or building
+                      terrain  = BTEST( wall_flags_0(k,j-1,i), 5 )  .OR.       &
+                                 topo_no_distinct
+                      building = BTEST( wall_flags_0(k,j-1,i), 6 )  .OR.       &
+                                 topo_no_distinct
+                      IF ( urban_surface  .AND.  building )  THEN
                          CALL initialize_vertical_surfaces( 0, k, j, i,        &
                                                             surf_usm_v(0),     &
@@ -1094,5 +1392,5 @@
                                                             .FALSE., .FALSE.,  &             
                                                             .FALSE., .TRUE. ) 
-                      ELSEIF ( land_surface )  THEN
+                      ELSEIF ( land_surface  .AND.  terrain )  THEN
                          CALL initialize_vertical_surfaces( 0, k, j, i,        &
                                                             surf_lsm_v(0),     &
@@ -1113,5 +1411,11 @@
 !--                southward-facing surface
                    IF ( .NOT. BTEST( wall_flags_0(k,j+1,i), 0 ) )  THEN
-                      IF ( urban_surface )  THEN
+!
+!--                   Determine flags indicating terrain or building
+                      terrain  = BTEST( wall_flags_0(k,j+1,i), 5 )  .OR.       &
+                                 topo_no_distinct
+                      building = BTEST( wall_flags_0(k,j+1,i), 6 )  .OR.       &
+                                 topo_no_distinct
+                      IF ( urban_surface  .AND.  building )  THEN
                          CALL initialize_vertical_surfaces( 1, k, j, i,        &
                                                             surf_usm_v(1),     &
@@ -1120,5 +1424,5 @@
                                                             .FALSE., .FALSE.,  &
                                                             .TRUE., .FALSE. )
-                      ELSEIF ( land_surface )  THEN
+                      ELSEIF ( land_surface  .AND.  terrain )  THEN
                          CALL initialize_vertical_surfaces( 1, k, j, i,        &
                                                             surf_lsm_v(1),     &
@@ -1139,5 +1443,11 @@
 !--                eastward-facing surface
                    IF ( .NOT. BTEST( wall_flags_0(k,j,i-1), 0 ) )  THEN
-                      IF ( urban_surface )  THEN
+!
+!--                   Determine flags indicating terrain or building
+                      terrain  = BTEST( wall_flags_0(k,j,i-1), 5 )  .OR.       &
+                                 topo_no_distinct
+                      building = BTEST( wall_flags_0(k,j,i-1), 6 )  .OR.       &
+                                 topo_no_distinct
+                      IF ( urban_surface  .AND.  building )  THEN
                          CALL initialize_vertical_surfaces( 2, k, j, i,        &
                                                             surf_usm_v(2),     &
@@ -1146,5 +1456,5 @@
                                                             .TRUE., .FALSE.,   &
                                                             .FALSE., .FALSE. ) 
-                      ELSEIF ( land_surface )  THEN
+                      ELSEIF ( land_surface  .AND.  terrain )  THEN
                          CALL initialize_vertical_surfaces( 2, k, j, i,        &
                                                             surf_lsm_v(2),     &
@@ -1165,5 +1475,11 @@
 !--                westward-facing surface
                    IF ( .NOT. BTEST( wall_flags_0(k,j,i+1), 0 ) )  THEN
-                      IF ( urban_surface )  THEN
+!
+!--                   Determine flags indicating terrain or building
+                      terrain  = BTEST( wall_flags_0(k,j,i+1), 5 )  .OR.       &
+                                 topo_no_distinct
+                      building = BTEST( wall_flags_0(k,j,i+1), 6 )  .OR.       &
+                                 topo_no_distinct
+                      IF ( urban_surface  .AND.  building )  THEN
                          CALL initialize_vertical_surfaces( 3, k, j, i,        &
                                                             surf_usm_v(3),     &
@@ -1172,5 +1488,5 @@
                                                            .FALSE., .TRUE.,    &
                                                            .FALSE., .FALSE. ) 
-                      ELSEIF ( land_surface )  THEN
+                      ELSEIF ( land_surface  .AND.  terrain )  THEN
                          CALL initialize_vertical_surfaces( 3, k, j, i,        &
                                                             surf_lsm_v(3),     &
@@ -1285,4 +1601,5 @@
        ENDDO
 
+
        CONTAINS
 
@@ -1305,4 +1622,6 @@
              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
@@ -1356,6 +1675,6 @@
 !
 !--          Initialization in case of constant profiles
-             ELSEIF ( INDEX(initializing_actions, 'set_constant_profiles') /= 0 )&
-             THEN
+             ELSEIF ( INDEX(initializing_actions, 'set_constant_profiles') /= 0&
+                .OR.  INDEX(initializing_actions, 'inifor' ) /= 0 )  THEN
 
                 surf%ol(num_h)   = surf%z_mo(num_h) / zeta_min
@@ -1403,4 +1722,13 @@
 
              IF ( passive_scalar )  surf%ss(num_h) = 0.0_wp
+
+#if defined( __chem )
+             DO  lsp = 1, nvar
+                IF ( air_chemistry )  surf%css(lsp,num_h) = 0.0_wp
+             ENDDO
+#endif
+!
+!--          Set initial value for surface temperature
+             surf%pt_surface(num_h) = pt_surface
 !
 !--          Inititalize surface fluxes of sensible and latent heat, as well as
@@ -1414,5 +1742,5 @@
 !--                   if random_heatflux is set. This case, shf is initialized later.
                       IF ( .NOT. random_heatflux )  THEN
-                         surf%shf(num_h) = surface_heatflux *               &
+                         surf%shf(num_h) = surface_heatflux *                  &
                                                  heatflux_input_conversion(nzb)
 !
@@ -1420,5 +1748,5 @@
 !--                      prescribed wall heatflux
                          IF ( k-1 /= 0 )  THEN
-                            surf%shf(num_h) = wall_heatflux(0) *            &
+                            surf%shf(num_h) = wall_heatflux(0) *               &
                                                  heatflux_input_conversion(k-1)
                          ENDIF
@@ -1476,4 +1804,31 @@
                 ENDIF
 
+#if defined( __chem )
+                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)
+
+                                  IF ( k-1 /= 0 )                                    &
+                                     surf%cssws(lsp,num_h) = wall_csflux(lsp,0)
+                               ELSE
+                                  surf%cssws(lsp,num_h) = 0.0_wp
+                               ENDIF
+                            ELSE
+                               surf%cssws(lsp,num_h) = wall_csflux(lsp,5)
+                            ENDIF
+                         ENDIF
+                      ENDDO
+                      lsp_pr = lsp_pr + 1
+                   ENDDO
+                ENDIF
+#endif
+
                 IF ( ocean )  THEN
                    IF ( upward_facing )  THEN 
@@ -1508,4 +1863,5 @@
              INTEGER(iwp)  ::  num_h            !< current number of surface element
              INTEGER(iwp)  ::  num_h_kji        !< dummy increment
+             INTEGER(iwp)  ::  lsp              !< running index for chemical species
 
              TYPE( surf_type ) :: surf          !< respective surface type
@@ -1543,4 +1899,13 @@
                 surf%ssws(num_h) = top_scalarflux
 !
+!--          Prescribe top chemical species' flux
+#if defined( __chem )
+             DO  lsp = 1, nvar
+                IF ( air_chemistry  .AND.  constant_top_csflux(lsp) )  THEN 
+                   surf%cssws(lsp,num_h) = top_csflux(lsp)
+                ENDIF
+             ENDDO
+#endif
+!
 !--          Prescribe top salinity flux
              IF ( ocean .AND. constant_top_salinityflux)                       &
@@ -1575,5 +1940,5 @@
              IMPLICIT NONE 
 
-             INTEGER(iwp)  ::  component !<
+             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
@@ -1582,4 +1947,5 @@
              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
 
 
@@ -1609,20 +1975,20 @@
 !--          etc., on surface type (further below)
              IF ( north_facing )  THEN
-                surf%facing(num_v) = IBSET( surf%facing(num_v), 0 )  
+                surf%facing(num_v) = 5 !IBSET( surf%facing(num_v), 0 )  
                 component          = 4
              ENDIF
 
              IF ( south_facing )  THEN
-                surf%facing(num_v) = IBSET( surf%facing(num_v), 1 ) 
+                surf%facing(num_v) = 6 !IBSET( surf%facing(num_v), 1 ) 
                 component          = 3
              ENDIF
 
              IF ( east_facing )  THEN
-                surf%facing(num_v) = IBSET( surf%facing(num_v), 2 )
+                surf%facing(num_v) = 7 !IBSET( surf%facing(num_v), 2 )
                 component          = 2
              ENDIF
 
              IF ( west_facing )  THEN
-                surf%facing(num_v) = IBSET( surf%facing(num_v), 3 ) 
+                surf%facing(num_v) = 8 !IBSET( surf%facing(num_v), 3 ) 
                 component          = 1
              ENDIF
@@ -1647,4 +2013,7 @@
              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
@@ -1673,4 +2042,14 @@
                 surf%ssws(num_v) = wall_scalarflux(component)
              ENDIF
+
+#if defined( __chem )
+             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
+#endif
+
 !
 !--          So far, salinityflux at vertical surfaces is simply zero 
@@ -1692,15 +2071,13 @@
 !> Determines topography-top index at given (j,i)-position.  
 !------------------------------------------------------------------------------!
-    FUNCTION get_topography_top_index( j, i, grid )
-
-       USE kinds
+    FUNCTION get_topography_top_index_ji( j, i, grid )
 
        IMPLICIT NONE 
 
-       CHARACTER(LEN=*) ::  grid                      !< flag to distinquish between staggered grids
-       INTEGER(iwp)     ::  i                         !< grid index in x-dimension
-       INTEGER(iwp)     ::  ibit                      !< bit position where topography information is stored on respective grid
-       INTEGER(iwp)     ::  j                         !< grid index in y-dimension
-       INTEGER(iwp)     ::  get_topography_top_index  !< topography top index
+       CHARACTER(LEN=*) ::  grid                         !< flag to distinquish between staggered grids
+       INTEGER(iwp)     ::  i                            !< grid index in x-dimension
+       INTEGER(iwp)     ::  ibit                         !< bit position where topography information is stored on respective grid
+       INTEGER(iwp)     ::  j                            !< grid index in y-dimension
+       INTEGER(iwp)     ::  get_topography_top_index_ji  !< topography top index
 
        SELECT CASE ( TRIM( grid ) )
@@ -1729,9 +2106,57 @@
        END SELECT
 
-       get_topography_top_index = MAXLOC(                                      &
+       get_topography_top_index_ji = MAXLOC(                                   &
                                      MERGE( 1, 0,                              &
                                             BTEST( wall_flags_0(:,j,i), ibit ) &
                                           ), DIM = 1                           &
-                                        ) - 1
+                                           ) - 1
+
+       RETURN
+
+    END FUNCTION get_topography_top_index_ji
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Determines topography-top index at each (j,i)-position.  
+!------------------------------------------------------------------------------!
+    FUNCTION get_topography_top_index( grid )
+
+       IMPLICIT NONE 
+
+       CHARACTER(LEN=*) ::  grid                      !< flag to distinquish between staggered grids
+       INTEGER(iwp)     ::  ibit                      !< bit position where topography information is stored on respective grid
+       INTEGER(iwp), DIMENSION(nys:nyn,nxl:nxr) ::  get_topography_top_index  !< topography top index
+
+       SELECT CASE ( TRIM( grid ) )
+
+          CASE ( 's'     )
+             ibit = 12
+          CASE ( 'u'     )
+             ibit = 14
+          CASE ( 'v'     )
+             ibit = 16
+          CASE ( 'w'     )
+             ibit = 18
+          CASE ( 's_out' )
+             ibit = 24
+          CASE ( 'u_out' )
+             ibit = 26
+          CASE ( 'v_out' )
+             ibit = 27
+          CASE ( 'w_out' )
+             ibit = 28
+          CASE DEFAULT
+!
+!--          Set default to scalar grid
+             ibit = 12 
+
+       END SELECT
+
+       get_topography_top_index(nys:nyn,nxl:nxr) = MAXLOC(                     &
+                         MERGE( 1, 0,                                          &
+                                 BTEST( wall_flags_0(:,nys:nyn,nxl:nxr), ibit )&
+                              ), DIM = 1                                       &
+                                                         ) - 1
 
        RETURN
@@ -1754,4 +2179,5 @@
        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:3) ::  mm   !< running index for surface elements on gathered surface array
@@ -1781,5 +2207,5 @@
        DO  l = 0, 3
           surf_v(l)%ns = ns_v_on_file(l)
-          CALL allocate_surface_attributes_v( surf_v(l), .FALSE.,              &
+          CALL allocate_surface_attributes_v( surf_v(l),                       &
                                               nys, nyn, nxl, nxr )
        ENDDO
@@ -1823,4 +2249,16 @@
                    IF ( ALLOCATED( surf_def_h(l)%ssws ) )                      &
                       surf_h(l)%ssws(mm(l))    = surf_def_h(l)%ssws(m)
+#if defined( __chem )
+                   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
+#endif
                    IF ( ALLOCATED( surf_def_h(l)%ncsws ) )                     &
                       surf_h(l)%ncsws(mm(l))   = surf_def_h(l)%ncsws(m)
@@ -1866,4 +2304,16 @@
                       IF ( ALLOCATED( surf_lsm_h%ssws ) )                      &
                          surf_h(0)%ssws(mm(0))    = surf_lsm_h%ssws(m)
+#if defined( __chem )
+                      IF ( ALLOCATED( surf_lsm_h%css ) )  THEN                  
+                         DO  lsp = 1, nvar
+                            surf_h(0)%css(lsp,mm(0)) = surf_lsm_h%css(lsp,m)
+                         ENDDO
+                      ENDIF
+                      IF ( ALLOCATED( surf_lsm_h%cssws ) )  THEN
+                         DO  lsp = 1, nvar
+                            surf_h(0)%cssws(lsp,mm(0)) = surf_lsm_h%cssws(lsp,m)
+                         ENDDO 
+                      ENDIF
+#endif
                       IF ( ALLOCATED( surf_lsm_h%ncsws ) )                     &
                          surf_h(0)%ncsws(mm(0))   = surf_lsm_h%ncsws(m)
@@ -1909,4 +2359,16 @@
                       IF ( ALLOCATED( surf_usm_h%ssws ) )                      &
                          surf_h(0)%ssws(mm(0))    = surf_usm_h%ssws(m)
+#if defined( __chem )
+                      IF ( ALLOCATED( surf_usm_h%css ) )  THEN             
+                         DO lsp = 1, nvar
+                            surf_h(0)%css(lsp,mm(0)) = surf_usm_h%css(lsp,m)
+                         ENDDO
+                      ENDIF
+                      IF ( ALLOCATED( surf_usm_h%cssws ) )  THEN             
+                         DO lsp = 1, nvar
+                            surf_h(0)%cssws(lsp,mm(0)) = surf_usm_h%cssws(lsp,m)
+                         ENDDO
+                      ENDIF
+#endif
                       IF ( ALLOCATED( surf_usm_h%ncsws ) )                     &
                          surf_h(0)%ncsws(mm(0))   = surf_usm_h%ncsws(m)
@@ -1926,15 +2388,27 @@
 
           ENDDO
-          IF ( l == 0 )  THEN
-             surf_h(l)%start_index = MAX( surf_def_h(l)%start_index,           &
-                                          surf_lsm_h%start_index,              &
-                                          surf_usm_h%start_index )
-             surf_h(l)%end_index   = MAX( surf_def_h(l)%end_index,             &
-                                          surf_lsm_h%end_index,                &
-                                          surf_usm_h%end_index )
-          ELSE
-             surf_h(l)%start_index = surf_def_h(l)%start_index
-             surf_h(l)%end_index   = surf_def_h(l)%end_index
-          ENDIF
+!
+!--       Gather start- and end indices                                        
+          DO  i = nxl, nxr
+             DO  j = nys, nyn
+                IF ( surf_def_h(l)%start_index(j,i) <=                         &
+                     surf_def_h(l)%end_index(j,i) )  THEN
+                   surf_h(l)%start_index(j,i) = surf_def_h(l)%start_index(j,i)
+                   surf_h(l)%end_index(j,i)   = surf_def_h(l)%end_index(j,i)
+                ENDIF
+                IF ( l == 0 )  THEN
+                   IF ( surf_lsm_h%start_index(j,i) <=                         &
+                        surf_lsm_h%end_index(j,i) )  THEN
+                      surf_h(l)%start_index(j,i) = surf_lsm_h%start_index(j,i)
+                      surf_h(l)%end_index(j,i)   = surf_lsm_h%end_index(j,i)
+                   ENDIF
+                   IF ( surf_usm_h%start_index(j,i) <=                         &
+                        surf_usm_h%end_index(j,i) )  THEN
+                      surf_h(l)%start_index(j,i) = surf_usm_h%start_index(j,i)
+                      surf_h(l)%end_index(j,i)   = surf_usm_h%end_index(j,i)
+                   ENDIF
+                ENDIF
+             ENDDO
+          ENDDO
        ENDDO
 
@@ -1972,4 +2446,16 @@
                    IF ( ALLOCATED( surf_def_v(l)%ssws ) )                      &
                       surf_v(l)%ssws(mm(l))    = surf_def_v(l)%ssws(m)
+#if defined( __chem )
+                   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
+#endif
                    IF ( ALLOCATED( surf_def_v(l)%ncsws ) )                     &
                       surf_v(l)%ncsws(mm(l))   = surf_def_v(l)%ncsws(m)
@@ -2020,4 +2506,16 @@
                    IF ( ALLOCATED( surf_lsm_v(l)%ssws ) )                      &
                       surf_v(l)%ssws(mm(l))    = surf_lsm_v(l)%ssws(m)
+#if defined( __chem )
+                   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
+#endif
                    IF ( ALLOCATED( surf_lsm_v(l)%ncsws ) )                     &
                       surf_v(l)%ncsws(mm(l))   = surf_lsm_v(l)%ncsws(m)
@@ -2068,4 +2566,16 @@
                    IF ( ALLOCATED( surf_usm_v(l)%ssws ) )                      &
                       surf_v(l)%ssws(mm(l))    = surf_usm_v(l)%ssws(m)
+#if defined( __chem )
+                   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
+#endif
                    IF ( ALLOCATED( surf_usm_v(l)%ncsws ) )                     &
                       surf_v(l)%ncsws(mm(l))   = surf_usm_v(l)%ncsws(m)
@@ -2171,4 +2681,14 @@
              WRITE ( 14 )  surf_h(l)%ssws
           ENDIF
+#if defined ( __chem )
+          WRITE ( 14 )  'surf_h(' // dum // ')%css                 '
+          IF ( ALLOCATED ( surf_h(l)%css ) )  THEN 
+             WRITE ( 14 )  surf_h(l)%css
+          ENDIF
+          WRITE ( 14 )  'surf_h(' // dum // ')%cssws               '
+          IF ( ALLOCATED ( surf_h(l)%cssws ) )  THEN 
+             WRITE ( 14 )  surf_h(l)%cssws
+          ENDIF
+#endif
           WRITE ( 14 )  'surf_h(' // dum // ')%qcsws               '  
           IF ( ALLOCATED ( surf_h(l)%qcsws ) )  THEN
@@ -2254,4 +2774,14 @@
              WRITE ( 14 )  surf_v(l)%ssws
           ENDIF
+#if defined( __chem )
+          WRITE ( 14 )  'surf_v(' // dum // ')%css                 '  
+          IF ( ALLOCATED ( surf_v(l)%css ) )  THEN
+             WRITE ( 14 )  surf_v(l)%css
+          ENDIF
+          WRITE ( 14 )  'surf_v(' // dum // ')%cssws               '  
+          IF ( ALLOCATED ( surf_v(l)%cssws ) )  THEN
+             WRITE ( 14 )  surf_v(l)%cssws
+          ENDIF
+#endif
           WRITE ( 14 )  'surf_v(' // dum // ')%qcsws               '  
           IF ( ALLOCATED ( surf_v(l)%qcsws ) )  THEN
@@ -2399,5 +2929,5 @@
        DO  l = 0, 3
           surf_v(l)%ns = ns_v_on_file(l)
-          CALL allocate_surface_attributes_v( surf_v(l), .FALSE.,              &
+          CALL allocate_surface_attributes_v( surf_v(l),                       &
                                               nys_on_file, nyn_on_file,        &
                                               nxl_on_file, nxr_on_file )
@@ -2486,4 +3016,12 @@
                       IF ( ALLOCATED( surf_h(0)%ssws )  .AND.  kk == 1 )       &
                          READ ( 13 )  surf_h(0)%ssws
+#if defined( __chem )
+                   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
+#endif
                    CASE ( 'surf_h(0)%qcsws' )         
                       IF ( ALLOCATED( surf_h(0)%qcsws )  .AND.  kk == 1 )      &
@@ -2554,4 +3092,12 @@
                       IF ( ALLOCATED( surf_h(1)%ssws )  .AND.  kk == 1 )       &
                          READ ( 13 )  surf_h(1)%ssws
+#if defined( __chem )
+                   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
+#endif
                    CASE ( 'surf_h(1)%qcsws' )         
                       IF ( ALLOCATED( surf_h(1)%qcsws )  .AND.  kk == 1 )      &
@@ -2622,4 +3168,12 @@
                       IF ( ALLOCATED( surf_h(2)%ssws )  .AND.  kk == 1 )       &
                          READ ( 13 )  surf_h(2)%ssws
+#if defined( __chem )
+                   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
+#endif
                    CASE ( 'surf_h(2)%qcsws' )         
                       IF ( ALLOCATED( surf_h(2)%qcsws )  .AND.  kk == 1 )      &
@@ -2686,4 +3240,12 @@
                       IF ( ALLOCATED( surf_v(0)%ssws )  .AND.  kk == 1 )       &
                          READ ( 13 )  surf_v(0)%ssws
+#if defined( __chem )
+                   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
+#endif
                    CASE ( 'surf_v(0)%qcsws' )         
                       IF ( ALLOCATED( surf_v(0)%qcsws )  .AND.  kk == 1 )      &
@@ -2757,4 +3319,12 @@
                       IF ( ALLOCATED( surf_v(1)%ssws )  .AND.  kk == 1 )       &
                          READ ( 13 )  surf_v(1)%ssws
+#if defined( __chem )
+                   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
+#endif
                    CASE ( 'surf_v(1)%qcsws' )         
                       IF ( ALLOCATED( surf_v(1)%qcsws )  .AND.  kk == 1 )      &
@@ -2828,4 +3398,12 @@
                       IF ( ALLOCATED( surf_v(2)%ssws )  .AND.  kk == 1 )       &
                          READ ( 13 )  surf_v(2)%ssws
+#if defined( __chem )
+                   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
+#endif
                    CASE ( 'surf_v(2)%qcsws' )         
                       IF ( ALLOCATED( surf_v(2)%qcsws )  .AND.  kk == 1 )      &
@@ -2899,4 +3477,12 @@
                       IF ( ALLOCATED( surf_v(3)%ssws )  .AND.  kk == 1 )       &
                          READ ( 13 )  surf_v(3)%ssws
+#if defined( __chem )
+                   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
+#endif
                    CASE ( 'surf_v(3)%qcsws' )         
                       IF ( ALLOCATED( surf_v(3)%qcsws )  .AND.  kk == 1 )      &
@@ -3047,9 +3633,10 @@
              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 ( SCAN( TRIM( field_chr ), '%us' ) /= 0 )  THEN 
+             IF ( INDEX( TRIM( field_chr ), '%us' ) /= 0 )  THEN 
                 IF ( ALLOCATED( surf_target%us )  .AND.                        &
                      ALLOCATED( surf_file%us   ) )                             & 
@@ -3057,5 +3644,5 @@
              ENDIF
 
-             IF ( SCAN( TRIM( field_chr ), '%ol' ) /= 0 )  THEN 
+             IF ( INDEX( TRIM( field_chr ), '%ol' ) /= 0 )  THEN 
                 IF ( ALLOCATED( surf_target%ol )  .AND.                        &
                      ALLOCATED( surf_file%ol   ) )                             & 
@@ -3063,5 +3650,5 @@
              ENDIF
 
-             IF ( SCAN( TRIM( field_chr ), '%usws' ) /= 0 )  THEN 
+             IF ( INDEX( TRIM( field_chr ), '%usws' ) /= 0 )  THEN 
                 IF ( ALLOCATED( surf_target%usws )  .AND.                      &
                      ALLOCATED( surf_file%usws   ) )                           & 
@@ -3069,5 +3656,5 @@
              ENDIF
 
-             IF ( SCAN( TRIM( field_chr ), '%vsws' ) /= 0 )  THEN 
+             IF ( INDEX( TRIM( field_chr ), '%vsws' ) /= 0 )  THEN 
                 IF ( ALLOCATED( surf_target%vsws )  .AND.                      &
                      ALLOCATED( surf_file%vsws   ) )                           & 
@@ -3075,5 +3662,5 @@
              ENDIF
 
-             IF ( SCAN( TRIM( field_chr ), '%ts' ) /= 0 )  THEN 
+             IF ( INDEX( TRIM( field_chr ), '%ts' ) /= 0 )  THEN 
                 IF ( ALLOCATED( surf_target%ts )  .AND.                        &
                      ALLOCATED( surf_file%ts   ) )                             & 
@@ -3081,5 +3668,5 @@
              ENDIF
 
-             IF ( SCAN( TRIM( field_chr ), '%shf' ) /= 0 )  THEN 
+             IF ( INDEX( TRIM( field_chr ), '%shf' ) /= 0 )  THEN 
                 IF ( ALLOCATED( surf_target%shf )  .AND.                       &
                      ALLOCATED( surf_file%shf   ) )                            & 
@@ -3087,5 +3674,5 @@
              ENDIF
 
-             IF ( SCAN( TRIM( field_chr ), '%qs' ) /= 0 )  THEN 
+             IF ( INDEX( TRIM( field_chr ), '%qs' ) /= 0 )  THEN 
                 IF ( ALLOCATED( surf_target%qs )  .AND.                        &
                      ALLOCATED( surf_file%qs   ) )                             & 
@@ -3093,5 +3680,5 @@
              ENDIF
 
-             IF ( SCAN( TRIM( field_chr ), '%qsws' ) /= 0 )  THEN 
+             IF ( INDEX( TRIM( field_chr ), '%qsws' ) /= 0 )  THEN 
                 IF ( ALLOCATED( surf_target%qsws )  .AND.                      &
                      ALLOCATED( surf_file%qsws   ) )                           & 
@@ -3099,5 +3686,5 @@
              ENDIF
 
-             IF ( SCAN( TRIM( field_chr ), '%ss' ) /= 0 )  THEN 
+             IF ( INDEX( TRIM( field_chr ), '%ss' ) /= 0 )  THEN 
                 IF ( ALLOCATED( surf_target%ss )  .AND.                        &
                      ALLOCATED( surf_file%ss   ) )                             & 
@@ -3105,5 +3692,5 @@
              ENDIF
 
-             IF ( SCAN( TRIM( field_chr ), '%ssws' ) /= 0 )  THEN 
+             IF ( INDEX( TRIM( field_chr ), '%ssws' ) /= 0 )  THEN 
                 IF ( ALLOCATED( surf_target%ssws )  .AND.                      &
                      ALLOCATED( surf_file%ssws   ) )                           & 
@@ -3111,5 +3698,24 @@
              ENDIF
 
-             IF ( SCAN( TRIM( field_chr ), '%qcs' ) /= 0 )  THEN 
+#if defined( __chem )
+             IF ( INDEX( TRIM( field_chr ), '%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( TRIM( field_chr ), '%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
+#endif
+
+             IF ( INDEX( TRIM( field_chr ), '%qcs' ) /= 0 )  THEN 
                 IF ( ALLOCATED( surf_target%qcs )  .AND.                       &
                      ALLOCATED( surf_file%qcs   ) )                            & 
@@ -3117,5 +3723,5 @@
              ENDIF
 
-             IF ( SCAN( TRIM( field_chr ), '%qcsws' ) /= 0 )  THEN 
+             IF ( INDEX( TRIM( field_chr ), '%qcsws' ) /= 0 )  THEN 
                 IF ( ALLOCATED( surf_target%qcsws )  .AND.                     &
                      ALLOCATED( surf_file%qcsws   ) )                          & 
@@ -3123,5 +3729,5 @@
              ENDIF
 
-             IF ( SCAN( TRIM( field_chr ), '%ncs' ) /= 0 )  THEN 
+             IF ( INDEX( TRIM( field_chr ), '%ncs' ) /= 0 )  THEN 
                 IF ( ALLOCATED( surf_target%ncs )  .AND.                       &
                      ALLOCATED( surf_file%ncs   ) )                            & 
@@ -3129,5 +3735,5 @@
              ENDIF
 
-             IF ( SCAN( TRIM( field_chr ), '%ncsws' ) /= 0 )  THEN 
+             IF ( INDEX( TRIM( field_chr ), '%ncsws' ) /= 0 )  THEN 
                 IF ( ALLOCATED( surf_target%ncsws )  .AND.                     &
                      ALLOCATED( surf_file%ncsws   ) )                          & 
@@ -3135,5 +3741,5 @@
              ENDIF
 
-             IF ( SCAN( TRIM( field_chr ), '%qrs' ) /= 0 )  THEN 
+             IF ( INDEX( TRIM( field_chr ), '%qrs' ) /= 0 )  THEN 
                 IF ( ALLOCATED( surf_target%qrs )  .AND.                       &
                      ALLOCATED( surf_file%qrs   ) )                            & 
@@ -3141,5 +3747,5 @@
              ENDIF
 
-             IF ( SCAN( TRIM( field_chr ), '%qrsws' ) /= 0 )  THEN 
+             IF ( INDEX( TRIM( field_chr ), '%qrsws' ) /= 0 )  THEN 
                 IF ( ALLOCATED( surf_target%qrsws )  .AND.                     &
                      ALLOCATED( surf_file%qrsws   ) )                          & 
@@ -3147,5 +3753,5 @@
              ENDIF
 
-             IF ( SCAN( TRIM( field_chr ), '%nrs' ) /= 0 )  THEN 
+             IF ( INDEX( TRIM( field_chr ), '%nrs' ) /= 0 )  THEN 
                 IF ( ALLOCATED( surf_target%nrs )  .AND.                       &
                      ALLOCATED( surf_file%nrs   ) )                            & 
@@ -3153,5 +3759,5 @@
              ENDIF
 
-             IF ( SCAN( TRIM( field_chr ), '%nrsws' ) /= 0 )  THEN 
+             IF ( INDEX( TRIM( field_chr ), '%nrsws' ) /= 0 )  THEN 
                 IF ( ALLOCATED( surf_target%nrsws )  .AND.                     &
                      ALLOCATED( surf_file%nrsws   ) )                          & 
@@ -3159,5 +3765,5 @@
              ENDIF
 
-             IF ( SCAN( TRIM( field_chr ), '%sasws' ) /= 0 )  THEN 
+             IF ( INDEX( TRIM( field_chr ), '%sasws' ) /= 0 )  THEN 
                 IF ( ALLOCATED( surf_target%sasws )  .AND.                     &
                      ALLOCATED( surf_file%sasws   ) )                          & 
@@ -3165,5 +3771,5 @@
              ENDIF
 
-             IF ( SCAN( TRIM( field_chr ), '%mom_uv' ) /= 0 )  THEN 
+             IF ( INDEX( TRIM( field_chr ), '%mom_uv' ) /= 0 )  THEN 
                 IF ( ALLOCATED( surf_target%mom_flux_uv )  .AND.               &
                      ALLOCATED( surf_file%mom_flux_uv   ) )                    & 
@@ -3172,5 +3778,5 @@
              ENDIF
 
-             IF ( SCAN( TRIM( field_chr ), '%mom_w' ) /= 0 )  THEN 
+             IF ( INDEX( TRIM( field_chr ), '%mom_w' ) /= 0 )  THEN 
                 IF ( ALLOCATED( surf_target%mom_flux_w )  .AND.                &
                      ALLOCATED( surf_file%mom_flux_w   ) )                     & 
@@ -3179,5 +3785,5 @@
              ENDIF
 
-             IF ( SCAN( TRIM( field_chr ), '%mom_tke' ) /= 0 )  THEN 
+             IF ( INDEX( TRIM( field_chr ), '%mom_tke' ) /= 0 )  THEN 
                 IF ( ALLOCATED( surf_target%mom_flux_tke )  .AND.              &
                      ALLOCATED( surf_file%mom_flux_tke   ) )                   & 
@@ -3214,4 +3820,124 @@
     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 2689)
+++ palm/trunk/SOURCE/swap_timelevel.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file swap_timelevel.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
@@ -25,4 +25,8 @@
 ! -----------------
 ! $Id$
+! Moved TKE to turbulence_closure_mod (TG)
+! Implementation of chemistry module (FK)
+! 
+! 2350 2017-08-15 11:48:26Z kanani
 ! Bugfix in nopointer version
 ! 
@@ -122,4 +126,9 @@
 #endif
 
+#if defined( __chem )
+    USE chemistry_model_mod,                                                   &
+        ONLY:  chem_swap_timelevel 
+#endif
+
     USE land_surface_model_mod,                                                &
         ONLY: lsm_swap_timelevel
@@ -129,5 +138,6 @@
 
     USE control_parameters,                                                    &
-        ONLY:  cloud_physics, constant_diffusion, humidity, land_surface,      &
+        ONLY:  air_chemistry, cloud_physics, constant_diffusion,               &
+               humidity, land_surface,                                         &
                microphysics_morrison, microphysics_seifert, neutral, ocean,    &
                passive_scalar, timestep_count, urban_surface
@@ -138,4 +148,7 @@
     USE pmc_interface,                                                         &
         ONLY: nested_run, pmci_set_swaplevel
+
+    USE turbulence_closure_mod,                                                &
+        ONLY:  tcm_swap_timelevel
 
     USE urban_surface_mod,                                                     &
@@ -168,13 +181,5 @@
     ENDDO
 
-    IF ( .NOT. constant_diffusion )  THEN
-       DO  i = nxlg, nxrg
-          DO  j = nysg, nyng
-             DO  k = nzb, nzt+1
-                e(k,j,i) = e_p(k,j,i)
-             ENDDO
-          ENDDO
-       ENDDO
-    ENDIF
+    CALL tcm_swap_timelevel ( 0 )
 
     IF ( ocean )  THEN
@@ -219,7 +224,4 @@
              pt => pt_1;  pt_p => pt_2
           ENDIF
-          IF ( .NOT. constant_diffusion )  THEN
-             e => e_1;    e_p => e_2
-          ENDIF
           IF ( ocean )  THEN
              sa => sa_1;  sa_p => sa_2
@@ -240,4 +242,8 @@
           ENDIF
 
+#if defined( __chem )
+          IF ( air_chemistry )  CALL chem_swap_timelevel(0)
+#endif
+
           swap_level = 1
 
@@ -249,7 +255,4 @@
           IF ( .NOT. neutral )  THEN
              pt => pt_2;  pt_p => pt_1
-          ENDIF
-          IF ( .NOT. constant_diffusion )  THEN
-             e => e_2;    e_p => e_1
           ENDIF
           IF ( ocean )  THEN
@@ -271,7 +274,13 @@
           ENDIF
 
+#if defined( __chem )
+          IF ( air_chemistry )  CALL chem_swap_timelevel(1)
+#endif
+
           swap_level = 2
 
     END SELECT
+
+    CALL tcm_swap_timelevel ( MOD( timestep_count, 2) )
 
     IF ( land_surface )  THEN
Index: palm/trunk/SOURCE/synthetic_turbulence_generator_mod.f90
===================================================================
--- palm/trunk/SOURCE/synthetic_turbulence_generator_mod.f90	(revision 2689)
+++ palm/trunk/SOURCE/synthetic_turbulence_generator_mod.f90	(revision 2696)
@@ -1,12 +1,12 @@
 !> @synthetic_turbulence_generator_mod.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM-4U.
-!
-! PALM-4U is free software: you can redistribute it and/or modify it under the
+! 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-4U is distributed in the hope that it will be useful, but WITHOUT ANY
+! 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.
Index: palm/trunk/SOURCE/time_integration.f90
===================================================================
--- palm/trunk/SOURCE/time_integration.f90	(revision 2689)
+++ palm/trunk/SOURCE/time_integration.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file time_integration.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
@@ -25,4 +25,19 @@
 ! -----------------
 ! $Id$
+! - Implementation of uv exposure model (FK)
+! - Moved vnest_boundary_conds_khkm from tcm_diffusivities to here (TG)
+! - renamed diffusivities to tcm_diffusivities (TG)
+! - implement prognostic equation for diss (TG)
+! - Moved/commented CALL to chem_emissions (FK)
+! - Added CALL to chem_emissions (FK)
+! - Implementation of chemistry module (FK)
+! - Calls for setting boundary conditions in USM and LSM (MS)
+! - Large-scale forcing with larger-scale models implemented (MS)
+! - Rename usm_radiation into radiation_interactions; merge with branch 
+!   radiation (MS)
+! - added call for usm_green_heat_model for green building surfaces (RvT)
+! - added call for usm_temperature_near_surface for use in indoor model (RvT)
+! 
+! 2617 2017-11-16 12:47:24Z suehring
 ! Bugfix, assure that the reference state does not become zero.
 ! 
@@ -287,5 +302,5 @@
 
     USE arrays_3d,                                                             &
-        ONLY:  diss, dzu, e, e_p, nc, nc_p, nr, nr_p, prho, pt, pt_p, pt_init, &
+        ONLY:  diss, diss_p, dzu, e, e_p, nc, nc_p, nr, nr_p, prho, pt, pt_p, pt_init, &
                q_init, q, qc, qc_p, ql, ql_c, ql_v, ql_vp, qr, qr_p, q_p,      &
                ref_state, rho_ocean, s, s_p, sa_p, tend, u, u_p, v, vpt,       &
@@ -295,7 +310,15 @@
         ONLY:  calc_mean_profile
 
+#if defined( __chem )
+    USE chemistry_model_mod,                                                   &
+        ONLY:  chem_emissions, chem_species
+
+    USE chem_modules,                                                          &
+        ONLY:  nspec 
+#endif
+
     USE control_parameters,                                                    &
-        ONLY:  advected_distance_x, advected_distance_y, average_count_3d,     &
-               averaging_interval, averaging_interval_pr,                      &
+        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, call_psolver_at_all_substeps, cloud_droplets,       &
@@ -307,6 +330,6 @@
                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_dvrp, dt_run_control,              &
-               end_time, first_call_lpm, galilei_transformation, humidity,     &
+               dt_dopr_listing, dt_dots, dt_dvrp, dt_run_control, end_time,    &
+               first_call_lpm, forcing, galilei_transformation, humidity,      &
                intermediate_timestep_count, intermediate_timestep_count_max,   &
                land_surface, large_scale_forcing,                              &
@@ -316,5 +339,5 @@
                ocean, passive_scalar,                                          &
                prho_reference, pt_reference, pt_slope_offset, random_heatflux, &
-               run_coupled, simulated_time, simulated_time_chr,                &
+               rans_tke_e, run_coupled, 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,               &
@@ -328,6 +351,6 @@
                turbulent_inflow, turbulent_outflow, urban_surface,             &
                use_initial_profile_as_reference,                               &
-               use_single_reference_value, u_gtrans, v_gtrans, virtual_flight, &
-               wind_turbine, ws_scheme_mom, ws_scheme_sca
+               use_single_reference_value, uv_exposure, u_gtrans, v_gtrans,    &
+               virtual_flight, wind_turbine, ws_scheme_mom, ws_scheme_sca
 
     USE cpulog,                                                                &
@@ -349,9 +372,13 @@
 
     USE land_surface_model_mod,                                                &
-        ONLY:  lsm_energy_balance, lsm_soil_model,                             &
+        ONLY:  lsm_boundary_condition, lsm_energy_balance, lsm_soil_model,     &
                skip_time_do_lsm
 
     USE lsf_nudging_mod,                                                       &
-        ONLY:  calc_tnudge, ls_forcing_surf, ls_forcing_vert, nudge_ref
+        ONLY:  calc_tnudge, ls_forcing_surf, ls_forcing_vert, nudge_ref,       &
+               forcing_bc, forcing_bc_mass_conservation
+
+    USE netcdf_data_input_mod,                                                 &
+        ONLY:  force, netcdf_data_input_lsf
 
     USE microphysics_mod,                                                      &
@@ -368,7 +395,4 @@
                pmci_ensure_nest_mass_conservation, pmci_synchronize
 
-    USE production_e_mod,                                                      &
-        ONLY:  production_e_init
-
     USE progress_bar,                                                          &
         ONLY:  finish_progress_bar, output_progress_bar
@@ -379,4 +403,5 @@
     USE radiation_model_mod,                                                   &
         ONLY: dt_radiation, force_radiation_call, radiation, radiation_control,&
+              radiation_interaction, radiation_interactions,                   &
               skip_time_do_radiation, time_radiation
 
@@ -395,7 +420,12 @@
         ONLY:  surf_def_h, surf_lsm_h, surf_usm_h
 
+    USE turbulence_closure_mod,                                                &
+        ONLY:  tcm_diffusivities, production_e_init
+
     USE urban_surface_mod,                                                     &
-        ONLY:  usm_material_heat_model, usm_material_model,                    &
-               usm_radiation, usm_surface_energy_balance
+        ONLY:  usm_boundary_condition, usm_material_heat_model,                &
+               usm_material_model,                                             &
+               usm_surface_energy_balance, usm_green_heat_model,               &
+               usm_temperature_near_surface
 
     USE synthetic_turbulence_generator_mod,                                    &
@@ -404,4 +434,7 @@
     USE user_actions_mod,                                                      &
         ONLY:  user_actions
+
+    USE uv_exposure_model_mod,                                                 &
+        ONLY:  uvem_calc_exposure
 
     USE wind_turbine_model_mod,                                                &
@@ -417,8 +450,9 @@
 
     CHARACTER (LEN=9) ::  time_to_string          !< 
+    INTEGER           ::  n
+    INTEGER           ::  lsp
 
     REAL(wp) ::  dt_3d_old  !< temporary storage of timestep to be used for
                             !< steering of run control output interval
-
 !
 !-- At beginning determine the first time step
@@ -501,4 +535,11 @@
            bc_q_t_val  = ( q_init(nzt+1) - q_init(nzt) ) / dzu(nzt+1)
        ENDIF
+!
+!--    If forcing by larger-scale models is applied, check if new data
+!--    at domain boundaries need to be read.
+       IF ( forcing )  THEN
+          IF ( force%time(force%tind_p) <= simulated_time )                    &
+             CALL netcdf_data_input_lsf
+       ENDIF
 
 !
@@ -617,4 +658,12 @@
           CALL exchange_horiz( pt_p, nbgp )
           IF ( .NOT. constant_diffusion )  CALL exchange_horiz( e_p, nbgp )
+          IF ( rans_tke_e  .OR.  wang_kernel  .OR.  collision_turbulence       &
+               .OR.  use_sgs_for_particles )  THEN
+             IF ( rans_tke_e )  THEN
+                CALL exchange_horiz( diss_p, nbgp )
+             ELSE
+                CALL exchange_horiz( diss, nbgp )
+             ENDIF
+          ENDIF
           IF ( ocean )  THEN
              CALL exchange_horiz( sa_p, nbgp )
@@ -639,10 +688,12 @@
              CALL exchange_horiz( ql_vp, nbgp )
           ENDIF
-          IF ( wang_kernel  .OR.  collision_turbulence  .OR.                &
-               use_sgs_for_particles )  THEN
-             CALL exchange_horiz( diss, nbgp )
-          ENDIF
           IF ( passive_scalar )  CALL exchange_horiz( s_p, nbgp )
-
+#if defined( __chem )
+          IF ( air_chemistry )  THEN
+             DO  n = 1, nspec     
+                CALL exchange_horiz( chem_species(n)%conc_p, nbgp ) 
+             ENDDO
+          ENDIF
+#endif
           CALL cpu_log( log_point(26), 'exchange-horiz-progn', 'stop' )
 
@@ -756,5 +807,5 @@
                    CALL disturb_field( 'v', tend, v )
                 ELSEIF ( ( .NOT. bc_lr_cyc  .OR.  .NOT. bc_ns_cyc )            &
-                     .AND. .NOT. nest_domain )  THEN
+                     .AND. .NOT. nest_domain  .AND.  .NOT.  forcing )  THEN
 !
 !--                Runs with a non-cyclic lateral wall need perturbations
@@ -770,4 +821,15 @@
 
 !
+!--       Map forcing data derived from larger scale model onto domain 
+!--       boundaries. 
+          IF ( forcing  .AND.  intermediate_timestep_count ==                  &
+                               intermediate_timestep_count_max  )  THEN
+             CALL forcing_bc
+          ENDIF
+!
+!--       Moreover, ensure mass conservation at each RK substep.
+          IF ( forcing )  CALL forcing_bc_mass_conservation
+
+!
 !--       Reduce the velocity divergence via the equation for perturbation
 !--       pressure.
@@ -833,9 +895,8 @@
                 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
+             IF ( land_surface .AND. time_since_reference_point >= skip_time_do_lsm)  THEN
 
                 CALL cpu_log( log_point(54), 'land_surface', 'start' )
@@ -860,8 +921,12 @@
                 CALL lsm_energy_balance( .FALSE., 3 )
                 CALL lsm_soil_model( .FALSE., 3, .TRUE. )
+!
+!--             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 
@@ -871,9 +936,17 @@
                 CALL usm_surface_energy_balance
                 IF ( usm_material_model )  THEN
+                   CALL usm_green_heat_model
                    CALL usm_material_heat_model
                 ENDIF
+
+                CALL usm_temperature_near_surface
+!
+!--             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
@@ -881,13 +954,15 @@
              IF ( .NOT. humidity ) THEN
                 IF ( ocean )  THEN
-                   CALL diffusivities( prho, prho_reference )
+                   CALL tcm_diffusivities( prho, prho_reference )
                 ELSE
-                   CALL diffusivities( pt, pt_reference )
+                   CALL tcm_diffusivities( pt, pt_reference )
                 ENDIF
              ELSE
-                CALL diffusivities( vpt, pt_reference )
-             ENDIF
-
+                CALL tcm_diffusivities( vpt, pt_reference )
+             ENDIF
              CALL cpu_log( log_point(17), 'diffusivities', 'stop' )
+!
+!--          Vertical nesting: set fine grid eddy viscosity top boundary condition
+             IF ( vnest_init )  CALL vnest_boundary_conds_khkm
 
           ENDIF
@@ -914,8 +989,9 @@
                 CALL cpu_log( log_point(50), 'radiation', 'stop' )
 
-                IF (urban_surface)  THEN
-                   CALL cpu_log( log_point(75), 'usm_radiation', 'start' )
-                   CALL usm_radiation
-                   CALL cpu_log( log_point(75), 'usm_radiation', 'stop' )
+                IF ( urban_surface  .OR.  land_surface  .AND.                  &
+                     radiation_interactions )  THEN
+                   CALL cpu_log( log_point(75), 'radiation_interaction', 'start' )
+                   CALL radiation_interaction
+                   CALL cpu_log( log_point(75), 'radiation_interaction', 'stop' )
                 ENDIF
 
@@ -924,5 +1000,19 @@
 
        ENDDO   ! Intermediate step loop
-
+!
+!--          If required, consider chemical emissions
+!--          (todo (FK): Implement hourly call of emissions, using time_utc from
+!--                      data_and_time_mod.f90;
+!--                      move the CALL to appropriate location)
+! #if defined( __chem )
+!              IF ( air_chemistry ) THEN
+!                 CALL chem_emissions
+!              ENDIF
+! #endif
+!
+!--    If required, do UV exposure calculations
+       IF ( uv_exposure )  THEN
+          CALL uvem_calc_exposure
+       ENDIF
 !
 !--    Increase simulation time and output times
Index: palm/trunk/SOURCE/time_integration_spinup.f90
===================================================================
--- palm/trunk/SOURCE/time_integration_spinup.f90	(revision 2689)
+++ palm/trunk/SOURCE/time_integration_spinup.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file time_integration_spinup.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
@@ -25,4 +25,7 @@
 ! -----------------
 ! $Id$
+! Added radiation interactions (moved from USM) (MS)
+! 
+! 2544 2017-10-13 18:09:32Z maronga
 ! Date and time quantities are now read from date_and_time_mod 
 ! 
@@ -87,5 +90,6 @@
     USE radiation_model_mod,                                                   &
         ONLY:  dt_radiation, force_radiation_call, radiation,                  &
-               radiation_control, rad_sw_in, time_radiation 
+               radiation_control, rad_sw_in, time_radiation,                   &
+               radiation_interaction, radiation_interactions
 
     USE statistics,                                                            &
@@ -101,5 +105,6 @@
     USE urban_surface_mod,                                                     &
         ONLY:  usm_material_heat_model, usm_material_model,                    &
-               usm_radiation, usm_surface_energy_balance, usm_swap_timelevel
+               usm_surface_energy_balance, usm_swap_timelevel,                 &
+               usm_green_heat_model, usm_temperature_near_surface
 
 
@@ -274,5 +279,9 @@
                 CALL usm_surface_energy_balance
                 IF ( usm_material_model )  THEN
+                   CALL usm_green_heat_model
                    CALL usm_material_heat_model
+                ENDIF
+                IF ( urban_surface ) THEN
+                   CALL usm_temperature_near_surface
                 ENDIF
                 CALL cpu_log( log_point(74), 'urban_surface', 'stop' )
@@ -301,8 +310,8 @@
                 CALL cpu_log( log_point(50), 'radiation', 'stop' )
 
-                IF (urban_surface)  THEN
-                   CALL cpu_log( log_point(75), 'usm_radiation', 'start' )
-                   CALL usm_radiation
-                   CALL cpu_log( log_point(75), 'usm_radiation', 'stop' )
+                IF ( radiation_interactions )  THEN
+                   CALL cpu_log( log_point(75), 'radiation_interaction', 'start' )
+                   CALL radiation_interaction
+                   CALL cpu_log( log_point(75), 'radiation_interaction', 'stop' )
                 ENDIF
              ENDIF
Index: palm/trunk/SOURCE/time_to_string.f90
===================================================================
--- palm/trunk/SOURCE/time_to_string.f90	(revision 2689)
+++ palm/trunk/SOURCE/time_to_string.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file time_to_string.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/timestep.f90
===================================================================
--- palm/trunk/SOURCE/timestep.f90	(revision 2689)
+++ palm/trunk/SOURCE/timestep.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file timestep.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/timestep_scheme_steering.f90
===================================================================
--- palm/trunk/SOURCE/timestep_scheme_steering.f90	(revision 2689)
+++ palm/trunk/SOURCE/timestep_scheme_steering.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file timestep_scheme_steering.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/transpose.f90
===================================================================
--- palm/trunk/SOURCE/transpose.f90	(revision 2689)
+++ palm/trunk/SOURCE/transpose.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file transpose.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/tridia_solver_mod.f90
===================================================================
--- palm/trunk/SOURCE/tridia_solver_mod.f90	(revision 2689)
+++ palm/trunk/SOURCE/tridia_solver_mod.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file tridia_solver_mod.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/turbulence_closure_mod.f90
===================================================================
--- palm/trunk/SOURCE/turbulence_closure_mod.f90	(revision 2696)
+++ palm/trunk/SOURCE/turbulence_closure_mod.f90	(revision 2696)
@@ -0,0 +1,3917 @@
+!> @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 2017-2017 Leibniz Universitaet Hannover
+!--------------------------------------------------------------------------------!
+!
+! Current revisions:
+! -----------------
+! 
+! 
+! Former revisions:
+! -----------------
+! $Id$
+! Initial revision
+!
+! 
+! 
+!
+! Authors:
+! --------
+! @author Tobias Gronemeier
+!
+!
+! Description:
+! ------------
+!> This module contains the available turbulence closures for PALM.
+!>
+!>
+!> @todo test initialization for all possibilities
+!>       add OpenMP directives whereever possible
+!>       remove debug output variables (dummy1, dummy2, dummy3)
+!> @note <Enter notes on the module>
+!> @bug  TKE-e closure still crashes due to too small dt
+!------------------------------------------------------------------------------!
+ MODULE turbulence_closure_mod
+ 
+
+#if defined( __nopointer )
+    USE arrays_3d,                                                             &
+        ONLY:  diss, diss_p, dzu, e, e_p, kh, km, l_grid,                      &
+               mean_inflow_profiles, prho, pt, tdiss_m, te_m, tend, u, v, vpt, w
+#else
+    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, l_grid, mean_inflow_profiles, prho, pt, tdiss_m,   &
+               te_m, tend, u, v, vpt, w
+#endif
+
+    USE control_parameters,                                                    &
+        ONLY:  constant_diffusion, dt_3d, e_init, humidity, inflow_l,          &
+               initializing_actions, intermediate_timestep_count,              &
+               intermediate_timestep_count_max, kappa, km_constant, les_mw,    &
+               ocean, prandtl_number, prho_reference, pt_reference, rans_mode, &
+               rans_tke_e, rans_tke_l, simulated_time, 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, log_point_s
+
+    USE indices,                                                               &
+        ONLY:  nbgp, nxl, nxlg, nxr, nxrg, nyn, nyng, nys, nysg,               &
+               nzb, nzb_s_inner, nzb_u_inner, nzb_v_inner, nzb_w_inner, nzt,   &
+               wall_flags_0
+
+    USE kinds
+
+    USE pegrid
+
+    USE plant_canopy_model_mod,                                                &
+        ONLY:  pcm_tendency, plant_canopy
+
+    USE statistics,                                                            &
+        ONLY:  hom, hom_sum, statistic_regions
+
+    USE user_actions_mod,                                                      &
+        ONLY:  user_actions
+
+
+    IMPLICIT NONE
+
+
+    REAL(wp) ::  c_1  = 1.44_wp    !< model constant for RANS mode
+    REAL(wp) ::  c_2  = 1.92_wp    !< model constant for RANS mode
+    REAL(wp) ::  c_3  = 1.44_wp    !< model constant for RANS mode
+    REAL(wp) ::  c_h  = 0.0015_wp  !< model constant for RANS mode
+    REAL(wp) ::  c_m               !< constant used for diffusion coefficient and dissipation (dependent on mode RANS/LES)
+    REAL(wp) ::  c_mu = 0.09_wp    !< model constant for RANS mode
+    REAL(wp) ::  l_max             !< maximum length scale for Blackadar mixing length
+    REAL(wp) ::  sig_e = 1.0_wp    !< factor to calculate Ke from Km
+    REAL(wp) ::  sig_diss = 1.3_wp !< factor to calculate K_diss from Km
+    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), DIMENSION(:), ALLOCATABLE ::  l_black      !< mixing length according to Blackadar
+
+    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: dummy1 !< debug output variable
+    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: dummy2 !< debug output variable
+    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE, SAVE :: dummy3 !< debug output variable
+
+
+    PUBLIC c_m, dummy1, dummy2, dummy3
+
+!
+!-- PALM interfaces:
+!-- 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
+
+!
+!-- 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
+
+!
+!-- Initialization actions  
+    INTERFACE tcm_init
+       MODULE PROCEDURE tcm_init
+    END INTERFACE tcm_init
+
+!
+!-- Initialization of arrays
+    INTERFACE tcm_init_arrays
+       MODULE PROCEDURE tcm_init_arrays
+    END INTERFACE tcm_init_arrays
+
+!
+!-- Initialization of TKE production term
+    INTERFACE production_e_init
+       MODULE PROCEDURE production_e_init
+    END INTERFACE production_e_init
+
+!
+!-- Prognostic equations for TKE and TKE dissipation rate
+    INTERFACE tcm_prognostic
+       MODULE PROCEDURE tcm_prognostic
+       MODULE PROCEDURE tcm_prognostic_ij
+    END INTERFACE tcm_prognostic
+
+!
+!-- Production term for TKE
+    INTERFACE production_e
+       MODULE PROCEDURE production_e
+       MODULE PROCEDURE production_e_ij
+    END INTERFACE production_e
+
+!
+!-- Diffusion term for TKE
+    INTERFACE diffusion_e
+       MODULE PROCEDURE diffusion_e
+       MODULE PROCEDURE diffusion_e_ij
+    END INTERFACE diffusion_e
+
+!
+!-- Diffusion term for TKE dissipation rate
+    INTERFACE diffusion_diss
+       MODULE PROCEDURE diffusion_diss
+       MODULE PROCEDURE diffusion_diss_ij
+    END INTERFACE diffusion_diss
+
+!
+!-- Mixing length for LES case
+    INTERFACE mixing_length_les
+       MODULE PROCEDURE mixing_length_les
+    END INTERFACE mixing_length_les
+
+!
+!-- Mixing length for RANS case
+    INTERFACE mixing_length_rans
+       MODULE PROCEDURE mixing_length_rans
+    END INTERFACE mixing_length_rans
+
+!
+!-- Calculate diffusivities
+    INTERFACE tcm_diffusivities
+       MODULE PROCEDURE tcm_diffusivities
+    END INTERFACE tcm_diffusivities
+
+!
+!-- Swapping of time levels (required for prognostic variables)
+    INTERFACE tcm_swap_timelevel
+       MODULE PROCEDURE tcm_swap_timelevel
+    END INTERFACE tcm_swap_timelevel
+
+    SAVE
+
+    PRIVATE
+!
+!-- Add INTERFACES that must be available to other modules (alphabetical order)
+    PUBLIC production_e_init, tcm_3d_data_averaging, tcm_check_data_output,    &
+           tcm_check_parameters, tcm_data_output_2d, tcm_data_output_3d,       &
+           tcm_define_netcdf_grid, tcm_diffusivities, tcm_init,                &
+           tcm_init_arrays, tcm_prognostic, tcm_swap_timelevel
+
+
+ CONTAINS
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Check parameters routine for turbulence closure module.
+!------------------------------------------------------------------------------!
+ SUBROUTINE tcm_check_parameters
+
+    USE control_parameters,                                                    &
+        ONLY:  message_string, neutral, turbulent_inflow, turbulent_outflow
+
+    IMPLICIT NONE
+
+!
+!-- Define which turbulence closure is going to be used
+    IF ( rans_mode )  THEN
+
+       c_m = 0.4_wp  !according to Detering and Etling (1985)
+
+       SELECT CASE ( TRIM( turbulence_closure ) )
+
+          CASE ( 'TKE-l' )
+             rans_tke_l = .TRUE.
+
+          CASE ( 'TKE-e' )
+             rans_tke_e = .TRUE.
+
+             IF ( INDEX( initializing_actions, 'set_1d-model_profiles' )       &
+                  == 0 )  THEN
+                message_string = 'Initializing without 1D model while ' //     &
+                                 'using TKE-e closure&' //                     &
+                                 'is not possible at the moment!'
+                CALL message( 'tcm_check_parameters', 'TG0005', 1, 2, 0, 6, 0 )
+             ENDIF
+
+          CASE DEFAULT
+             message_string = 'Unknown turbulence closure: ' //                &
+                              TRIM( turbulence_closure )
+             CALL message( 'tcm_check_parameters', 'TG0001', 1, 2, 0, 6, 0 )
+
+       END SELECT
+
+       message_string = 'RANS mode is still in development! ' //               &
+                        '&Not all features of PALM are yet compatible '//      &
+                        'with RANS mode. &Use at own risk!'
+       CALL message( 'tcm_check_parameters', 'TG0003', 0, 1, 0, 6, 0 )
+
+    ELSE
+
+       c_m = 0.1_wp !according to Lilly (1967) and Deardorff (1980)
+
+       SELECT CASE ( TRIM( turbulence_closure ) )
+
+          CASE ( 'Moeng_Wyngaard' )
+             les_mw = .TRUE.
+
+          CASE DEFAULT
+             message_string = 'Unknown turbulence closure: ' //                &
+                              TRIM( turbulence_closure )
+             CALL message( 'tcm_check_parameters', 'TG0001', 1, 2, 0, 6, 0 )
+
+       END SELECT
+
+    ENDIF
+
+    IF ( rans_tke_e )  THEN
+
+       IF ( turbulent_inflow .OR. turbulent_outflow )  THEN
+          message_string = 'turbulent inflow/outflow is not yet '//            &
+                           'implemented for TKE-e closure'
+          CALL message( 'tcm_check_parameters', 'TG0002', 1, 2, 0, 6, 0 )
+       ENDIF
+
+    ENDIF
+
+ END SUBROUTINE tcm_check_parameters
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Check data output.
+!------------------------------------------------------------------------------!
+ SUBROUTINE tcm_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 ( 'diss' )
+          IF ( .NOT.  rans_tke_e )  THEN
+             message_string = 'output of "' // TRIM( var ) // '" requi' //  &
+                      'res TKE-e closure for RANS mode.'
+             CALL message( 'tcm_check_data_output', 'TG0101', 1, 2, 0, 6, 0 )
+          ENDIF
+          unit = 'm2/s3'
+
+       CASE ( 'dummy2', 'dummy3', 'dummy1' )
+          unit = '?'
+
+       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   !< 
+    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 ( 'diss', 'diss_xy', 'diss_xz', 'diss_yz' )
+          grid_x = 'x'
+          grid_y = 'y'
+          grid_z = 'zu'
+
+       CASE ( 'dummy2', 'dummy3', 'dummy1' )                                    !### remove later
+          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       !< 
+    CHARACTER (LEN=*) ::  variable   !< 
+
+    INTEGER(iwp) ::  i   !< 
+    INTEGER(iwp) ::  j   !< 
+    INTEGER(iwp) ::  k   !< 
+
+    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' )
+             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
+
+          CASE ( 'kh' )
+             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
+
+          CASE ( 'km' )
+             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
+
+          CASE DEFAULT
+             CONTINUE
+
+       END SELECT
+
+    ELSEIF ( mode == 'average' )  THEN
+
+       SELECT CASE ( TRIM( variable ) )
+
+          CASE ( 'diss' )
+             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
+
+          CASE ( 'kh' )
+             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
+
+          CASE ( 'km' )
+             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
+
+       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,     &
+                                two_d, nzb_do, nzt_do )
+ 
+    USE averaging,                                                             &
+        ONLY:  diss_av, kh_av, km_av
+
+    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) ::  nzb_do   !< 
+    INTEGER(iwp) ::  nzt_do   !< 
+
+    LOGICAL ::  found   !< 
+    LOGICAL ::  two_d   !< flag parameter that indicates 2D variables (horizontal cross sections)
+
+    REAL(wp), DIMENSION(nxl:nxr,nys:nyn,nzb:nzt+1) ::  local_pf !< local
+       !< array to which output data is resorted to
+
+    found = .TRUE.
+
+    SELECT CASE ( TRIM( variable ) )
+
+
+       CASE ( 'diss_xy', 'diss_xz', 'diss_yz' )
+          IF ( av == 0 )  THEN
+             DO  i = nxl, nxr
+                DO  j = nys, nyn
+                   DO k = nzb_do, nzt_do
+                      local_pf(i,j,k) = diss(k,j,i)
+                   ENDDO
+                ENDDO
+             ENDDO
+          ELSE
+             DO  i = nxl, nxr
+                DO  j = nys, nyn
+                   DO k = nzb_do, nzt_do
+                      local_pf(i,j,k) = diss_av(k,j,i)
+                   ENDDO
+                ENDDO
+             ENDDO
+          ENDIF
+
+          IF ( mode == 'xy' ) grid = 'zu'
+
+       CASE ( 'kh_xy', 'kh_xz', 'kh_yz' )
+          IF ( av == 0 )  THEN
+             DO  i = nxl, nxr
+                DO  j = nys, nyn
+                   DO k = nzb_do, nzt_do
+                      local_pf(i,j,k) = kh(k,j,i)
+                   ENDDO
+                ENDDO
+             ENDDO
+          ELSE
+             DO  i = nxl, nxr
+                DO  j = nys, nyn
+                   DO k = nzb_do, nzt_do
+                      local_pf(i,j,k) = kh_av(k,j,i)
+                   ENDDO
+                ENDDO
+             ENDDO
+          ENDIF
+
+          IF ( mode == 'xy' ) grid = 'zu'
+
+       CASE ( 'km_xy', 'km_xz', 'km_yz' )
+          IF ( av == 0 )  THEN
+             DO  i = nxl, nxr
+                DO  j = nys, nyn
+                   DO k = nzb_do, nzt_do
+                      local_pf(i,j,k) = km(k,j,i)
+                   ENDDO
+                ENDDO
+             ENDDO
+          ELSE
+             DO  i = nxl, nxr
+                DO  j = nys, nyn
+                   DO k = nzb_do, nzt_do
+                      local_pf(i,j,k) = km_av(k,j,i)
+                   ENDDO
+                ENDDO
+             ENDDO
+          ENDIF
+
+          IF ( mode == 'xy' ) grid = 'zu'
+
+       CASE DEFAULT
+          found = .FALSE.
+          grid  = 'none'
+
+    END SELECT
+ 
+ END SUBROUTINE tcm_data_output_2d
+
+ 
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Define 3D output variables.
+!------------------------------------------------------------------------------!
+ SUBROUTINE tcm_data_output_3d( av, variable, found, local_pf )
+ 
+
+    USE averaging,                                                             &
+        ONLY:  diss_av, kh_av, km_av
+
+    IMPLICIT NONE
+
+    CHARACTER (LEN=*) ::  variable   !< 
+
+    INTEGER(iwp) ::  av   !< 
+    INTEGER(iwp) ::  i    !< 
+    INTEGER(iwp) ::  j    !< 
+    INTEGER(iwp) ::  k    !< 
+
+    LOGICAL ::  found   !< 
+
+    REAL(sp), DIMENSION(nxl:nxr,nys:nyn,nzb:nzt+1) ::  local_pf   !< local
+       !< array to which output data is resorted to
+
+
+    found = .TRUE.
+
+
+    SELECT CASE ( TRIM( variable ) )
+
+
+       CASE ( 'diss' )
+          IF ( av == 0 )  THEN
+             DO  i = nxl, nxr
+                DO  j = nys, nyn
+                   DO  k = nzb, nzt+1
+                      local_pf(i,j,k) = diss(k,j,i)
+                   ENDDO
+                ENDDO
+             ENDDO
+          ELSE
+             DO  i = nxl, nxr
+                DO  j = nys, nyn
+                   DO  k = nzb, nzt+1
+                      local_pf(i,j,k) = diss_av(k,j,i)
+                   ENDDO
+                ENDDO
+             ENDDO
+          ENDIF
+
+       CASE ( 'kh' )
+          IF ( av == 0 )  THEN
+             DO  i = nxl, nxr
+                DO  j = nys, nyn
+                   DO  k = nzb, nzt+1
+                      local_pf(i,j,k) = kh(k,j,i)
+                   ENDDO
+                ENDDO
+             ENDDO
+          ELSE
+             DO  i = nxl, nxr
+                DO  j = nys, nyn
+                   DO  k = nzb, nzt+1
+                      local_pf(i,j,k) = kh_av(k,j,i)
+                   ENDDO
+                ENDDO
+             ENDDO
+          ENDIF
+
+       CASE ( 'km' )
+          IF ( av == 0 )  THEN
+             DO  i = nxl, nxr
+                DO  j = nys, nyn
+                   DO  k = nzb, nzt+1
+                      local_pf(i,j,k) = km(k,j,i)
+                   ENDDO
+                ENDDO
+             ENDDO
+          ELSE
+             DO  i = nxl, nxr
+                DO  j = nys, nyn
+                   DO  k = nzb, nzt+1
+                      local_pf(i,j,k) = km_av(k,j,i)
+                   ENDDO
+                ENDDO
+             ENDDO
+          ENDIF
+
+       CASE ( 'dummy1' )                                                        !### remove later
+          IF ( av == 0 )  THEN
+             DO  i = nxl, nxr
+                DO  j = nys, nyn
+                   DO  k = nzb, nzt+1
+                      local_pf(i,j,k) = dummy1(k,j,i)
+                   ENDDO
+                ENDDO
+             ENDDO
+          ENDIF
+
+       CASE ( 'dummy2' )                                                        !### remove later
+          IF ( av == 0 )  THEN
+             DO  i = nxl, nxr
+                DO  j = nys, nyn
+                   DO  k = nzb, nzt+1
+                      local_pf(i,j,k) = dummy2(k,j,i)
+                   ENDDO
+                ENDDO
+             ENDDO
+          ENDIF
+
+       CASE ( 'dummy3' )                                                        !### remove later
+          IF ( av == 0 )  THEN
+             DO  i = nxl, nxr
+                DO  j = nys, nyn
+                   DO  k = nzb, nzt+1
+                      local_pf(i,j,k) = dummy3(k,j,i)
+                   ENDDO
+                ENDDO
+             ENDDO
+          ENDIF
+
+       CASE DEFAULT
+          found = .FALSE.
+
+    END SELECT
+
+ END SUBROUTINE tcm_data_output_3d
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Allocate arrays and assign pointers.
+!------------------------------------------------------------------------------!
+ SUBROUTINE tcm_init_arrays
+
+    USE microphysics_mod,                                                      &
+        ONLY:  collision_turbulence
+
+    USE particle_attributes,                                                   &
+        ONLY:  use_sgs_for_particles, wang_kernel
+
+    IMPLICIT NONE
+
+    ALLOCATE( kh(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
+    ALLOCATE( km(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
+
+    ALLOCATE( dummy1(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )                           !### remove later
+    ALLOCATE( dummy2(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
+    ALLOCATE( dummy3(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
+
+    IF ( rans_mode )  ALLOCATE( l_black(nzb:nzt+1) )
+
+#if defined( __nopointer )
+    ALLOCATE( e(nzb:nzt+1,nysg:nyng,nxlg:nxrg)    )
+    ALLOCATE( e_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg)  )
+    ALLOCATE( te_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
+
+#else
+    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) )
+#endif
+
+    IF ( rans_tke_e  .OR.  use_sgs_for_particles  .OR.  wang_kernel  .OR.      &
+         collision_turbulence )  THEN
+#if defined( __nopointer )
+       ALLOCATE( diss(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
+       IF ( rans_tke_e )  THEN
+          ALLOCATE( diss_p(nzb:nzt+1,nysg:nyng,nxlg:nxrg)  )
+          ALLOCATE( tdiss_m(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
+       ENDIF
+#else
+       ALLOCATE( diss_1(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
+       IF ( rans_tke_e )  THEN
+          ALLOCATE( diss_2(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
+          ALLOCATE( diss_3(nzb:nzt+1,nysg:nyng,nxlg:nxrg) )
+       ENDIF
+#endif
+    ENDIF
+
+#if ! defined( __nopointer )
+!
+!-- Initial assignment of pointers
+    e  => e_1;   e_p  => e_2;   te_m  => e_3
+
+    IF ( rans_tke_e  .OR.  use_sgs_for_particles  .OR.     &
+         wang_kernel  .OR.  collision_turbulence )  THEN
+       diss => diss_1
+       IF ( rans_tke_e )  THEN
+       diss_p => diss_2; tdiss_m => diss_3
+       ENDIF
+    ENDIF
+#endif
+
+ END SUBROUTINE tcm_init_arrays
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Initialization of turbulence closure module.
+!------------------------------------------------------------------------------!
+ SUBROUTINE tcm_init
+
+    USE arrays_3d,                                                             &
+        ONLY:  ug, vg, zu
+
+    USE control_parameters,                                                    &
+        ONLY:  complex_terrain, f, kappa, dissipation_1d, topography
+
+    USE model_1d_mod,                                                          &
+        ONLY:  diss1d, e1d, kh1d, km1d, l1d
+
+    USE surface_mod,                                                           &
+        ONLY:  get_topography_top_index
+
+    IMPLICIT NONE
+
+    INTEGER(iwp) :: i            !< loop index
+    INTEGER(iwp) :: j            !< loop index
+    INTEGER(iwp) :: k            !< loop index
+    INTEGER(iwp) :: nz_s_shift   !<
+    INTEGER(iwp) :: nz_s_shift_l !< 
+
+!
+!-- 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
+!
+!--       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
+
+          IF ( rans_tke_e )  THEN
+             IF ( dissipation_1d == 'prognostic' )  THEN    !### Why must this be checked?
+                DO  i = nxlg, nxrg                          !### Should 'diss' not always
+                   DO  j = nysg, nyng                       !### be prognostic in case rans_tke_e?
+                      diss(:,j,i) = diss1d
+                   ENDDO
+                ENDDO
+             ELSE
+                DO  i = nxlg, nxrg
+                   DO  j = nysg, nyng
+                      DO  k = nzb+1, nzt
+                         diss(k,j,i) = e(k,j,i) * SQRT( e(k,j,i) ) / l1d(k)
+                      ENDDO
+                   ENDDO
+                ENDDO
+             ENDIF
+          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  k = nzb+1, nzt
+                km(k,:,:) = c_m * l_grid(k) * SQRT( e_init )
+             ENDDO
+             km(nzb,:,:)   = km(nzb+1,:,:)
+             km(nzt+1,:,:) = km(nzt,:,:)
+             kh   = km / prandtl_number
+             e    = e_init
+          ELSE
+             IF ( .NOT. ocean )  THEN
+                kh   = 0.01_wp   ! there must exist an initial diffusion, because 
+                km   = 0.01_wp   ! otherwise no 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
+
+       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 = get_topography_top_index( j, i, 's' )
+
+                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
+       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 = get_topography_top_index( 0, 0, 's' )
+             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 ( inflow_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, diss, ...) 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_0(k,j,i), 0 ) )
+                   te_m(k,j,i)  = MERGE( te_m(k,j,i), 0.0_wp,                  &
+                                         BTEST( wall_flags_0(k,j,i), 0 ) )
+                ENDDO
+             ENDDO
+          ENDDO
+
+       ENDIF
+!
+!--    Initialize new time levels (only done in order to set boundary values
+!--    including ghost points)
+       e_p = e
+!
+!--    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. 
+       te_m = 0.0_wp
+
+    ENDIF
+
+!
+!-- Calculate mixing length according to Blackadar (1962)
+    IF ( rans_mode )  THEN
+
+       IF ( f /= 0.0_wp )  THEN
+          l_max = 2.7E-4 * SQRT( ug(nzt+1)**2 + vg(nzt+1)**2 ) /        &
+                  ABS( f ) + 1E-10_wp
+       ELSE
+          l_max = 30.0_wp
+       ENDIF
+
+       DO  k = nzb, nzt
+          l_black(k) = kappa * zu(k) / ( 1.0_wp + kappa * zu(k) / l_max )
+       ENDDO
+
+       l_black(nzt+1) = l_black(nzt)
+
+    ENDIF
+
+ END SUBROUTINE tcm_init
+
+
+!------------------------------------------------------------------------------!
+! 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_mod,                                                           &
+        ONLY :  surf_def_h, surf_def_v, surf_lsm_h, surf_usm_h 
+
+    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
+
+    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.
+!--    WARNING: the exact analytical solution would require the determination
+!--             of the eddy diffusivity by km = u* * kappa * zp / phi_m.
+!--    Default surfaces, upward-facing
+       !$OMP PARALLEL DO PRIVATE(i,j,k,m)
+       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, calculatione 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(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(k,j,i)  + 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(k,j,i)  + 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)
+       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)
+
+          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-facing
+       !$OMP PARALLEL DO PRIVATE(i,j,k,m)
+       DO  m = 1, surf_lsm_h%ns
+
+          i = surf_lsm_h%i(m)            
+          j = surf_lsm_h%j(m)
+          k = surf_lsm_h%k(m)
+!
+!--       Note, calculatione 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%u_0(m) = u(k+1,j,i) + surf_lsm_h%usws(m)      *           &
+                                        drho_air_zw(k-1) *                     &
+                                        ( zu(k+1)   - zu(k-1)    )  /          &
+                                        ( km(k,j,i) + 1.0E-20_wp )  
+          surf_lsm_h%v_0(m) = v(k+1,j,i) + surf_lsm_h%vsws(m)      *           &
+                                        drho_air_zw(k-1) *                     &
+                                        ( zu(k+1)   - zu(k-1)    )  /          &
+                                        ( km(k,j,i) + 1.0E-20_wp )
+
+          IF ( ABS( u(k+1,j,i) - surf_lsm_h%u_0(m) )  >                        &
+               ABS( u(k+1,j,i) - u(k-1,j,i)   )                                &
+             )  surf_lsm_h%u_0(m) = u(k-1,j,i)
+
+          IF ( ABS( v(k+1,j,i) - surf_lsm_h%v_0(m) )  >                        &
+               ABS( v(k+1,j,i) - v(k-1,j,i)   )                                &
+             )  surf_lsm_h%v_0(m) = v(k-1,j,i)
+
+       ENDDO
+!
+!--    Urban surfaces, upward-facing
+       !$OMP PARALLEL DO PRIVATE(i,j,k,m)
+       DO  m = 1, surf_usm_h%ns
+
+          i = surf_usm_h%i(m)            
+          j = surf_usm_h%j(m)
+          k = surf_usm_h%k(m)
+!
+!--       Note, calculatione 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%u_0(m) = u(k+1,j,i) + surf_usm_h%usws(m)      *           &
+                                        drho_air_zw(k-1) *                     &
+                                        ( zu(k+1)   - zu(k-1)    )  /          &
+                                        ( km(k,j,i) + 1.0E-20_wp )  
+          surf_usm_h%v_0(m) = v(k+1,j,i) + surf_usm_h%vsws(m)      *           &
+                                        drho_air_zw(k-1) *                     &
+                                        ( zu(k+1)   - zu(k-1)    )  /          &
+                                        ( km(k,j,i) + 1.0E-20_wp )
+
+          IF ( ABS( u(k+1,j,i) - surf_usm_h%u_0(m) )  >                        &
+               ABS( u(k+1,j,i) - u(k-1,j,i)   )                                &
+             )  surf_usm_h%u_0(m) = u(k-1,j,i)
+
+          IF ( ABS( v(k+1,j,i) - surf_usm_h%v_0(m) )  >                        &
+               ABS( v(k+1,j,i) - v(k-1,j,i)   )                                &
+             )  surf_usm_h%v_0(m) = v(k-1,j,i)
+
+       ENDDO
+
+    ENDIF
+
+ END SUBROUTINE production_e_init
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Prognostic equation for subgrid-scale TKE and TKE dissipation rate.
+!> Vector-optimized version
+!------------------------------------------------------------------------------!
+ SUBROUTINE tcm_prognostic
+
+    USE arrays_3d,                                                             &
+        ONLY:  ddzu
+
+    USE control_parameters,                                                    &
+        ONLY:  f, scalar_advec, tsc
+
+    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) ::  i       !< loop index
+    INTEGER(iwp) ::  j       !< loop index
+    INTEGER(iwp) ::  k       !< loop index
+    INTEGER(iwp) ::  m       !< loop index
+    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)     ::  sbt     !< wheighting factor for sub-time step
+
+    REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: advec  !< advection term of TKE tendency
+    REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) :: produc !< production term of TKE tendency
+
+!
+!-- If required, compute prognostic equation for turbulent kinetic
+!-- energy (TKE)
+    IF ( .NOT. constant_diffusion )  THEN
+
+       CALL cpu_log( log_point(16), 'tke-equation', 'start' )
+
+       sbt = tsc(2)
+       IF ( .NOT. use_upstream_for_tke )  THEN
+          IF ( scalar_advec == 'bc-scheme' )  THEN
+
+             IF ( timestep_scheme(1:5) /= 'runge' )  THEN
+!
+!--             Bott-Chlond scheme always uses Euler time step. Thus:
+                sbt = 1.0_wp
+             ENDIF
+             tend = 0.0_wp
+             CALL advec_s_bc( e, 'e' )
+
+          ENDIF
+       ENDIF
+
+!
+!--    TKE-tendency terms with no communication
+       IF ( scalar_advec /= 'bc-scheme'  .OR.  use_upstream_for_tke )  THEN
+          IF ( use_upstream_for_tke )  THEN
+             tend = 0.0_wp
+             CALL advec_s_up( e )
+          ELSE
+             tend = 0.0_wp
+             IF ( timestep_scheme(1:5) == 'runge' )  THEN
+                IF ( ws_scheme_sca )  THEN
+                   CALL advec_s_ws( e, 'e' )
+                ELSE
+                   CALL advec_s_pw( e )
+                ENDIF
+             ELSE
+                CALL advec_s_up( e )
+             ENDIF
+          ENDIF
+       ENDIF
+
+       IF ( rans_tke_e )  advec = tend
+
+       CALL production_e
+
+!
+!--    Save production term for prognostic equation of TKE dissipation rate
+       IF ( rans_tke_e )  produc = tend - advec
+
+       IF ( .NOT. humidity )  THEN
+          IF ( ocean )  THEN
+             CALL diffusion_e( prho, prho_reference )
+          ELSE
+             CALL diffusion_e( pt, pt_reference )
+          ENDIF
+       ELSE
+          CALL diffusion_e( vpt, pt_reference )
+       ENDIF
+
+!
+!--    Additional sink term for flows through plant canopies
+       IF ( plant_canopy )  CALL pcm_tendency( 6 )
+
+       CALL user_actions( 'e-tendency' )
+
+!
+!--    Prognostic equation for TKE.
+!--    Eliminate negative TKE values, which can occur due to numerical
+!--    reasons in the course of the integration. In such cases the old TKE
+!--    value is reduced by 90%.
+       DO  i = nxl, nxr
+          DO  j = nys, nyn
+             DO  k = nzb+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_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
+
+!
+!--    Use special boundary condition in case of TKE-e closure
+       IF ( rans_tke_e )  THEN
+          DO  i = nxl, nxr
+             DO  j = nys, nyn
+                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)
+                   e_p(k,j,i) = surf_def_h(0)%us(m)**2 / c_m**2
+                ENDDO
+             ENDDO
+          ENDDO
+       ENDIF
+
+!
+!--    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
+                      te_m(k,j,i) = tend(k,j,i)
+                   ENDDO
+                ENDDO
+             ENDDO
+          ELSEIF ( intermediate_timestep_count < &
+                   intermediate_timestep_count_max )  THEN
+             DO  i = nxl, nxr
+                DO  j = nys, nyn
+                   DO  k = nzb+1, nzt
+                      te_m(k,j,i) =   -9.5625_wp * tend(k,j,i)                 &
+                                     + 5.3125_wp * te_m(k,j,i)
+                   ENDDO
+                ENDDO
+             ENDDO
+          ENDIF
+       ENDIF
+
+       CALL cpu_log( log_point(16), 'tke-equation', 'stop' )
+
+    ENDIF   ! TKE equation
+
+!
+!-- If required, compute prognostic equation for TKE dissipation rate
+    IF ( rans_tke_e )  THEN
+
+       CALL cpu_log( log_point(33), '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( diss, 'diss' )
+                ELSE
+                   CALL advec_s_pw( diss )
+                ENDIF
+             ELSE
+                CALL advec_s_up( diss )
+             ENDIF
+          ENDIF
+       ENDIF
+
+!
+!--    Production of TKE dissipation rate
+       DO  i = nxl, nxr
+          DO  j = nys, nyn
+             DO  k = nzb+1, nzt
+!                tend(k,j,i) = tend(k,j,i) + c_1 * diss(k,j,i) / ( e(k,j,i) + 1.0E-20_wp ) * produc(k)
+                tend(k,j,i) = tend(k,j,i) + c_1 * c_mu * f / c_h               &  !### needs revision
+                      / surf_def_h(0)%us(surf_def_h(0)%start_index(j,i))       &
+                      * SQRT(e(k,j,i)) * produc(k,j,i)
+             ENDDO
+          ENDDO
+       ENDDO
+
+       CALL diffusion_diss
+
+!
+!--    Additional sink term for flows through plant canopies
+!        IF ( plant_canopy )  CALL pcm_tendency( ? )                            !### what to do with this?
+
+!        CALL user_actions( 'diss-tendency' )                                   !### not yet implemented
+
+!
+!--    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_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
+
+!
+!--    Use special boundary condition in case of TKE-e closure
+       DO  i = nxl, nxr
+          DO  j = nys, nyn
+             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)
+                diss_p(k,j,i) = surf_def_h(0)%us(m)**3 / kappa * ddzu(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+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(33), 'diss-equation', 'stop' )
+
+    ENDIF
+
+ END SUBROUTINE tcm_prognostic
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Prognostic equation for subgrid-scale TKE and TKE dissipation rate.
+!> Cache-optimized version
+!------------------------------------------------------------------------------!
+ SUBROUTINE tcm_prognostic_ij( i, j, i_omp, tn )
+
+    USE arrays_3d,                                                             &
+        ONLY:  ddzu, 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:  f, tsc
+
+    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) ::  i       !< loop index x direction
+    INTEGER(iwp) ::  i_omp   !< 
+    INTEGER(iwp) ::  j       !< loop index y direction
+    INTEGER(iwp) ::  k       !< loop index z direction
+    INTEGER(iwp) ::  m       !< loop index
+    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
+    INTEGER(iwp) ::  tn      !<
+
+    REAL(wp), DIMENSION(nzb:nzt+1) :: advec  !< advection term of TKE tendency
+    REAL(wp), DIMENSION(nzb:nzt+1) :: produc !< production term of TKE tendency
+
+!
+!-- If required, compute prognostic equation for turbulent kinetic
+!-- energy (TKE)
+    IF ( .NOT. constant_diffusion )  THEN
+
+!
+!--    Tendency-terms for TKE
+       tend(:,j,i) = 0.0_wp
+       IF ( timestep_scheme(1:5) == 'runge'  &
+           .AND.  .NOT. use_upstream_for_tke )  THEN
+           IF ( ws_scheme_sca )  THEN
+               CALL advec_s_ws( i, j, e, 'e', flux_s_e, diss_s_e, &
+                                flux_l_e, diss_l_e , i_omp, tn )
+           ELSE
+               CALL advec_s_pw( i, j, e )
+           ENDIF
+       ELSE
+          CALL advec_s_up( i, j, e )
+       ENDIF
+
+       advec(:) = tend(:,j,i)
+
+       CALL production_e( i, j )
+
+       produc(:) = tend(:,j,i) - advec(:)
+
+       IF ( .NOT. humidity )  THEN
+          IF ( ocean )  THEN
+             CALL diffusion_e( i, j, prho, prho_reference )
+          ELSE
+             CALL diffusion_e( i, j, pt, pt_reference )
+          ENDIF
+       ELSE
+          CALL diffusion_e( i, j, vpt, pt_reference )
+       ENDIF
+
+!
+!--    Additional sink term for flows through plant canopies
+       IF ( plant_canopy )  CALL pcm_tendency( i, j, 6 )
+
+       CALL user_actions( i, j, 'e-tendency' )
+
+!
+!--    Prognostic equation for TKE.
+!--    Eliminate negative TKE values, which can occur due to numerical
+!--    reasons in the course of the integration. In such cases the old
+!--    TKE value is reduced by 90%.
+       DO  k = nzb+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_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
+
+!
+!--    Use special boundary condition in case of TKE-e closure
+       IF ( rans_tke_e )  THEN
+          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)
+             e_p(k,j,i) = surf_def_h(0)%us(m)**2 / c_m**2
+          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
+                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( i, j, diss, 'diss', flux_s_diss, diss_s_diss,  &
+                                flux_l_diss, diss_l_diss, i_omp, tn )
+           ELSE
+               CALL advec_s_pw( i, j, diss )
+           ENDIF
+       ELSE
+          CALL advec_s_up( i, j, diss )
+       ENDIF
+
+!
+!--    Production of TKE dissipation rate
+       DO  k = nzb+1, nzt
+!              tend(k,j,i) = tend(k,j,i) + c_1 * diss(k,j,i) / ( e(k,j,i) + 1.0E-20_wp ) * produc(k)
+          tend(k,j,i) = tend(k,j,i) + c_1 * c_mu * f / c_h                     &  !### needs revision
+                      / surf_def_h(0)%us(surf_def_h(0)%start_index(j,i))       &
+                      * SQRT(e(k,j,i)) * produc(k)
+       ENDDO
+
+       CALL diffusion_diss( i, j )
+
+!
+!--    Additional sink term for flows through plant canopies
+!        IF ( plant_canopy )  CALL pcm_tendency( i, j, ? )                      !### not yet implemented
+
+!        CALL user_actions( i, j, 'diss-tendency' )                             !### not yet implemented
+
+!
+!--    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_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
+
+!
+!--    Use special boundary condition in case of TKE-e closure
+       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)
+          diss_p(k,j,i) = surf_def_h(0)%us(m)**3 / kappa * ddzu(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+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
+
+!        IF ( intermediate_timestep_count == 1 )  dummy1(:,j,i) = e_p(:,j,i)
+!        IF ( intermediate_timestep_count == 2 )  dummy2(:,j,i) = e_p(:,j,i)
+!        IF ( intermediate_timestep_count == 3 )  dummy3(:,j,i) = e_p(:,j,i)
+
+    ENDIF   ! dissipation equation
+
+ END SUBROUTINE tcm_prognostic_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
+
+    USE arrays_3d,                                                             &
+        ONLY:  ddzw, dd2zu, drho_air_zw, q, ql
+
+    USE cloud_parameters,                                                      &
+        ONLY:  l_d_cp, l_d_r, pt_d_t, t_d_pt
+
+    USE control_parameters,                                                    &
+        ONLY:  cloud_droplets, cloud_physics, constant_flux_layer, g, neutral, &
+               rho_reference, use_single_reference_value, use_surface_fluxes,  &
+               use_top_fluxes
+
+    USE grid_variables,                                                        &
+        ONLY:  ddx, dx, ddy, dy
+
+    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) ::  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         !< 
+    REAL(wp)     ::  flag        !< flag to mask topography
+    REAL(wp)     ::  k1          !<
+    REAL(wp)     ::  k2          !<
+    REAL(wp)     ::  km_neutral  !< diffusion coefficient assuming neutral conditions - used to compute shear production at surfaces
+    REAL(wp)     ::  theta       !<
+    REAL(wp)     ::  temp        !<
+    REAL(wp)     ::  sign_dir    !< sign of wall-tke flux, depending on wall orientation 
+    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,nys:nyn) ::  dudx  !< Gradient of u-component in x-direction
+    REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  dudy  !< Gradient of u-component in y-direction
+    REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  dudz  !< Gradient of u-component in z-direction
+    REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  dvdx  !< Gradient of v-component in x-direction
+    REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  dvdy  !< Gradient of v-component in y-direction
+    REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  dvdz  !< Gradient of v-component in z-direction
+    REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  dwdx  !< Gradient of w-component in x-direction
+    REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  dwdy  !< Gradient of w-component in y-direction
+    REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  dwdz  !< Gradient of w-component in z-direction
+
+    DO  i = nxl, nxr
+
+       IF ( constant_flux_layer )  THEN
+
+!
+!--       Calculate TKE production by shear. Calculate gradients at all grid 
+!--       points first, gradients at surface-bounded grid points will be 
+!--       overwritten further below. 
+          DO  j = nys, nyn
+             DO  k = nzb+1, nzt
+
+                dudx(k,j) =           ( u(k,j,i+1) - u(k,j,i)     ) * ddx
+                dudy(k,j) = 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,j) = 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,j) = 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,j) =           ( v(k,j+1,i) - v(k,j,i)     ) * ddy
+                dvdz(k,j) = 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,j) = 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,j) = 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,j) =           ( w(k,j,i)   - w(k-1,j,i)   ) * ddzw(k)
+
+             ENDDO
+          ENDDO
+
+!
+!--       Position beneath wall
+!--       (2) - Will allways be executed.
+!--       'bottom and wall: use u_0,v_0 and wall functions'
+          DO  j = nys, nyn
+!
+!--          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_0(k,j-1,i), 0 ) ) 
+                   dudy(k,j) = sign_dir * usvs / ( km_neutral + 1E-10_wp )
+                   dwdy(k,j) = 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_0(k,j-1,i), 0 ) ) 
+                   dudy(k,j) = sign_dir * usvs / ( km_neutral + 1E-10_wp )
+                   dwdy(k,j) = 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_0(k,j-1,i), 0 ) ) 
+                   dudy(k,j) = sign_dir * usvs / ( km_neutral + 1E-10_wp )
+                   dwdy(k,j) = 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_0(k,j,i-1), 0 ) ) 
+                   dvdx(k,j) = sign_dir * vsus / ( km_neutral + 1E-10_wp )
+                   dwdx(k,j) = 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_0(k,j,i-1), 0 ) ) 
+                   dvdx(k,j) = sign_dir * vsus / ( km_neutral + 1E-10_wp )
+                   dwdx(k,j) = 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_0(k,j,i-1), 0 ) ) 
+                   dvdx(k,j) = sign_dir * vsus / ( km_neutral + 1E-10_wp )
+                   dwdx(k,j) = 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,j) = ( u(k+1,j,i) - surf_def_h(0)%u_0(m) ) * dd2zu(k)   
+                dvdz(k,j) = ( v(k+1,j,i) - surf_def_h(0)%v_0(m) ) * dd2zu(k)
+         
+             ENDDO
+!
+!--          Natural surfaces
+             surf_s = surf_lsm_h%start_index(j,i)
+             surf_e = surf_lsm_h%end_index(j,i)
+             DO  m = surf_s, surf_e
+                k = surf_lsm_h%k(m)
+
+                dudz(k,j) = ( u(k+1,j,i) - surf_lsm_h%u_0(m) ) * dd2zu(k)   
+                dvdz(k,j) = ( v(k+1,j,i) - surf_lsm_h%v_0(m) ) * dd2zu(k)
+         
+             ENDDO
+!
+!--          Urban surfaces
+             surf_s = surf_usm_h%start_index(j,i)
+             surf_e = surf_usm_h%end_index(j,i)
+             DO  m = surf_s, surf_e
+                k = surf_usm_h%k(m)
+
+                dudz(k,j) = ( u(k+1,j,i) - surf_usm_h%u_0(m) ) * dd2zu(k)   
+                dvdz(k,j) = ( v(k+1,j,i) - surf_usm_h%v_0(m) ) * dd2zu(k)
+         
+             ENDDO
+!
+!--          Compute gradients at downward-facing walls, only for 
+!--          non-natural 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,j) = ( surf_def_h(1)%u_0(m) - u(k-1,j,i) ) * dd2zu(k)   
+                dvdz(k,j) = ( surf_def_h(1)%v_0(m) - v(k-1,j,i) ) * dd2zu(k)
+
+             ENDDO
+          ENDDO
+
+          DO  j = nys, nyn
+             DO  k = nzb+1, nzt
+
+                def = 2.0_wp * ( dudx(k,j)**2 + dvdy(k,j)**2 + dwdz(k,j)**2 ) + &
+                                 dudy(k,j)**2 + dvdx(k,j)**2 + dwdx(k,j)**2 +   &
+                                 dwdy(k,j)**2 + dudz(k,j)**2 + dvdz(k,j)**2 +   &
+                      2.0_wp * ( dvdx(k,j)*dudy(k,j) + dwdx(k,j)*dudz(k,j)  +   &
+                                 dwdy(k,j)*dvdz(k,j) )
+
+                IF ( def < 0.0_wp )  def = 0.0_wp
+
+                flag  = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) ) 
+
+                tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def * flag
+
+             ENDDO
+          ENDDO
+
+       ELSE
+
+          DO  j = nys, nyn
+!
+!--          Calculate TKE production by shear. Here, no additional
+!--          wall-bounded code is considered. 
+!--          Why?
+             DO  k = nzb+1, nzt
+
+                dudx(k,j)  =           ( u(k,j,i+1) - u(k,j,i)     ) * ddx
+                dudy(k,j)  = 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,j)  = 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,j)  = 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,j)  =           ( v(k,j+1,i) - v(k,j,i)     ) * ddy
+                dvdz(k,j)  = 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,j)  = 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,j)  = 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,j)  =           ( w(k,j,i)   - w(k-1,j,i)   ) *         &
+                                                                     ddzw(k)
+   
+                def = 2.0_wp * (                                               &
+                             dudx(k,j)**2 + dvdy(k,j)**2 + dwdz(k,j)**2        &
+                               ) +                                             &
+                             dudy(k,j)**2 + dvdx(k,j)**2 + dwdx(k,j)**2 +      &
+                             dwdy(k,j)**2 + dudz(k,j)**2 + dvdz(k,j)**2 +      &
+                      2.0_wp * (                                               &
+                             dvdx(k,j)*dudy(k,j) + dwdx(k,j)*dudz(k,j)  +      &
+                             dwdy(k,j)*dvdz(k,j)                               &
+                               )
+
+                IF ( def < 0.0_wp )  def = 0.0_wp
+
+                flag  = MERGE( 1.0_wp, 0.0_wp,                                 &
+                               BTEST( wall_flags_0(k,j,i), 29 ) ) 
+                tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def * flag
+   
+             ENDDO
+          ENDDO
+
+       ENDIF
+
+!
+!--    If required, calculate TKE production by buoyancy
+       IF ( .NOT. neutral )  THEN
+
+          IF ( .NOT. humidity )  THEN
+
+             IF ( ocean )  THEN
+!
+!--             So far in the ocean no special treatment of density flux
+!--             in the bottom and top surface layer
+                DO  j = nys, nyn
+                   DO  k = nzb+1, nzt
+                      tend(k,j,i) = tend(k,j,i) +                              &
+                                    kh(k,j,i) * g /                            &
+                           MERGE( rho_reference, prho(k,j,i),                  &
+                                  use_single_reference_value ) *               &
+                                    ( prho(k+1,j,i) - prho(k-1,j,i) ) *        &
+                                    dd2zu(k) *                                 &
+                                MERGE( 1.0_wp, 0.0_wp,                         &
+                                       BTEST( wall_flags_0(k,j,i), 30 )        &
+                                     )                            *            &
+                                MERGE( 1.0_wp, 0.0_wp,                         &
+                                       BTEST( wall_flags_0(k,j,i), 9 )         &
+                                     )  
+                   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)
+                            tend(k,j,i) = tend(k,j,i) + g /                    &
+                                      MERGE( rho_reference, prho(k,j,i),       &
+                                             use_single_reference_value ) *    &
+                                      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)
+                         tend(k,j,i) = tend(k,j,i) + g /                       &
+                                      MERGE( rho_reference, prho(k,j,i),       &
+                                             use_single_reference_value ) *    &
+                                      drho_air_zw(k) *                         &
+                                      surf_def_h(2)%shf(m) 
+                      ENDDO
+                   ENDIF
+
+                ENDDO
+
+             ELSE
+
+                DO  j = nys, nyn
+                   DO  k = nzb+1, nzt
+!
+!--                   Flag 9 is used to mask top fluxes, flag 30 to mask
+!--                   surface fluxes
+                      tend(k,j,i) = tend(k,j,i) -                              &
+                                    kh(k,j,i) * g /                            &
+                                MERGE( pt_reference, pt(k,j,i),                &
+                                        use_single_reference_value ) *         &
+                                    ( pt(k+1,j,i) - pt(k-1,j,i) ) *            &
+                                    dd2zu(k)                      *            &
+                                MERGE( 1.0_wp, 0.0_wp,                         &
+                                       BTEST( wall_flags_0(k,j,i), 30 )        &
+                                     )                            *            &
+                                MERGE( 1.0_wp, 0.0_wp,                         &
+                                       BTEST( wall_flags_0(k,j,i), 9 )         &
+                                     )  
+                   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)
+                            tend(k,j,i) = tend(k,j,i) + g /                    &
+                                 MERGE( pt_reference, pt(k,j,i),               &
+                                        use_single_reference_value )           &
+                                                   * drho_air_zw(k-1)          &
+                                                   * surf_def_h(l)%shf(m)       
+                         ENDDO      
+                      ENDDO
+!
+!--                   Natural surfaces
+                      surf_s = surf_lsm_h%start_index(j,i)
+                      surf_e = surf_lsm_h%end_index(j,i)
+                      DO  m = surf_s, surf_e
+                         k = surf_lsm_h%k(m)
+                         tend(k,j,i) = tend(k,j,i) + g /                       &
+                                 MERGE( pt_reference, pt(k,j,i),               &
+                                        use_single_reference_value )           &
+                                                   * drho_air_zw(k-1)          &
+                                                   * surf_lsm_h%shf(m)   
+                      ENDDO
+!
+!--                   Urban surfaces
+                      surf_s = surf_usm_h%start_index(j,i)
+                      surf_e = surf_usm_h%end_index(j,i)
+                      DO  m = surf_s, surf_e
+                         k = surf_usm_h%k(m)
+                         tend(k,j,i) = tend(k,j,i) + g /                       &
+                                 MERGE( pt_reference, pt(k,j,i),               &
+                                        use_single_reference_value )           &
+                                                   * drho_air_zw(k-1)          &
+                                                   * surf_usm_h%shf(m)   
+                      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)
+                         tend(k,j,i) = tend(k,j,i) + g /                       &
+                                 MERGE( pt_reference, pt(k,j,i),               &
+                                        use_single_reference_value )           &
+                                                   * drho_air_zw(k)            &
+                                                   * surf_def_h(2)%shf(m) 
+                      ENDDO
+                   ENDIF
+                ENDDO
+
+             ENDIF
+
+          ELSE
+
+             DO  j = nys, nyn
+
+                DO  k = nzb+1, nzt
+!
+!--                Flag 9 is used to mask top fluxes, flag 30 to mask
+!--                surface fluxes
+                   IF ( .NOT. cloud_physics .AND. .NOT. cloud_droplets ) THEN
+                      k1 = 1.0_wp + 0.61_wp * q(k,j,i)
+                      k2 = 0.61_wp * pt(k,j,i)
+                      tend(k,j,i) = tend(k,j,i) - kh(k,j,i) *                  &
+                                      g /                                      &
+                                 MERGE( vpt_reference, vpt(k,j,i),             &
+                                        use_single_reference_value ) *         &
+                                      ( k1 * ( pt(k+1,j,i)-pt(k-1,j,i) ) +     &
+                                        k2 * ( q(k+1,j,i) - q(k-1,j,i) )       &
+                                      ) * dd2zu(k) *                           &
+                                   MERGE( 1.0_wp, 0.0_wp,                      &
+                                          BTEST( wall_flags_0(k,j,i), 30 )     &
+                                        )          *                           &
+                                   MERGE( 1.0_wp, 0.0_wp,                      &
+                                          BTEST( wall_flags_0(k,j,i), 9 )      &
+                                        )
+                   ELSE IF ( cloud_physics )  THEN
+                      IF ( ql(k,j,i) == 0.0_wp )  THEN
+                         k1 = 1.0_wp + 0.61_wp * q(k,j,i)
+                         k2 = 0.61_wp * pt(k,j,i)
+                      ELSE
+                         theta = pt(k,j,i) + pt_d_t(k) * l_d_cp * ql(k,j,i)
+                         temp  = theta * t_d_pt(k)
+                         k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp *                  &
+                                       ( q(k,j,i) - ql(k,j,i) ) *              &
+                              ( 1.0_wp + 0.622_wp * l_d_r / temp ) ) /         &
+                              ( 1.0_wp + 0.622_wp * l_d_r * l_d_cp *           &
+                              ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
+                         k2 = theta * ( l_d_cp / temp * k1 - 1.0_wp )
+                      ENDIF
+                      tend(k,j,i) = tend(k,j,i) - kh(k,j,i) *                  &
+                                      g /                                      &
+                                 MERGE( vpt_reference, vpt(k,j,i),             &
+                                        use_single_reference_value ) *         &
+                                      ( k1 * ( pt(k+1,j,i)-pt(k-1,j,i) ) +     &
+                                        k2 * ( q(k+1,j,i) - q(k-1,j,i) )       &
+                                      ) * dd2zu(k) *                           &
+                                   MERGE( 1.0_wp, 0.0_wp,                      &
+                                          BTEST( wall_flags_0(k,j,i), 30 )     &
+                                        )          *                           &
+                                   MERGE( 1.0_wp, 0.0_wp,                      &
+                                          BTEST( wall_flags_0(k,j,i), 9 )      &
+                                        )
+                   ELSE IF ( cloud_droplets )  THEN
+                      k1 = 1.0_wp + 0.61_wp * q(k,j,i) - ql(k,j,i)
+                      k2 = 0.61_wp * pt(k,j,i)
+                      tend(k,j,i) = tend(k,j,i) -                              & 
+                                    kh(k,j,i) * g /                            &
+                                 MERGE( vpt_reference, vpt(k,j,i),             &
+                                        use_single_reference_value ) *         &
+                                    ( 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) *             &
+                                   MERGE( 1.0_wp, 0.0_wp,                      &
+                                          BTEST( wall_flags_0(k,j,i), 30 )     &
+                                        )                        *             &
+                                   MERGE( 1.0_wp, 0.0_wp,                      &
+                                          BTEST( wall_flags_0(k,j,i), 9 )      &
+                                        )
+                   ENDIF
+
+                ENDDO
+
+             ENDDO
+
+             IF ( use_surface_fluxes )  THEN
+
+                DO  j = nys, nyn
+!
+!--                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. cloud_physics .AND. .NOT. cloud_droplets ) THEN
+                            k1 = 1.0_wp + 0.61_wp * q(k,j,i)
+                            k2 = 0.61_wp * pt(k,j,i)
+                         ELSE IF ( cloud_physics )  THEN
+                            IF ( ql(k,j,i) == 0.0_wp )  THEN
+                               k1 = 1.0_wp + 0.61_wp * q(k,j,i)
+                               k2 = 0.61_wp * pt(k,j,i)
+                            ELSE
+                               theta = pt(k,j,i) + pt_d_t(k) * l_d_cp * ql(k,j,i)
+                               temp  = theta * t_d_pt(k)
+                               k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp *            &
+                                          ( q(k,j,i) - ql(k,j,i) ) *           &
+                                 ( 1.0_wp + 0.622_wp * l_d_r / temp ) ) /      &
+                                 ( 1.0_wp + 0.622_wp * l_d_r * l_d_cp *        &
+                                 ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
+                               k2 = theta * ( l_d_cp / temp * k1 - 1.0_wp )
+                            ENDIF
+                         ELSE IF ( cloud_droplets )  THEN
+                            k1 = 1.0_wp + 0.61_wp * q(k,j,i) - ql(k,j,i)
+                            k2 = 0.61_wp * pt(k,j,i)
+                         ENDIF
+
+                         tend(k,j,i) = tend(k,j,i) + g /                       &
+                                 MERGE( vpt_reference, vpt(k,j,i),             &
+                                        use_single_reference_value ) *         &
+                                            ( 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
+                   surf_s = surf_lsm_h%start_index(j,i)
+                   surf_e = surf_lsm_h%end_index(j,i)
+                   DO  m = surf_s, surf_e
+                      k = surf_lsm_h%k(m)
+
+                      IF ( .NOT. cloud_physics .AND. .NOT. cloud_droplets ) THEN
+                         k1 = 1.0_wp + 0.61_wp * q(k,j,i)
+                         k2 = 0.61_wp * pt(k,j,i)
+                      ELSE IF ( cloud_physics )  THEN
+                         IF ( ql(k,j,i) == 0.0_wp )  THEN
+                            k1 = 1.0_wp + 0.61_wp * q(k,j,i)
+                            k2 = 0.61_wp * pt(k,j,i)
+                         ELSE
+                            theta = pt(k,j,i) + pt_d_t(k) * l_d_cp * ql(k,j,i)
+                            temp  = theta * t_d_pt(k)
+                            k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp *               &
+                                          ( q(k,j,i) - ql(k,j,i) ) *           &
+                                 ( 1.0_wp + 0.622_wp * l_d_r / temp ) ) /      &
+                                 ( 1.0_wp + 0.622_wp * l_d_r * l_d_cp *        &
+                                 ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
+                            k2 = theta * ( l_d_cp / temp * k1 - 1.0_wp )
+                         ENDIF
+                      ELSE IF ( cloud_droplets )  THEN
+                         k1 = 1.0_wp + 0.61_wp * q(k,j,i) - ql(k,j,i)
+                         k2 = 0.61_wp * pt(k,j,i)
+                      ENDIF
+
+                      tend(k,j,i) = tend(k,j,i) + g /                          &
+                                 MERGE( vpt_reference, vpt(k,j,i),             &
+                                        use_single_reference_value ) *         &
+                                            ( k1 * surf_lsm_h%shf(m) +         &
+                                              k2 * surf_lsm_h%qsws(m)          &
+                                            ) * drho_air_zw(k-1)
+                   ENDDO
+!
+!--                Treat horizontal urban surfaces
+                   surf_s = surf_usm_h%start_index(j,i)
+                   surf_e = surf_usm_h%end_index(j,i)
+                   DO  m = surf_s, surf_e
+                      k = surf_lsm_h%k(m)
+
+                      IF ( .NOT. cloud_physics .AND. .NOT. cloud_droplets ) THEN
+                         k1 = 1.0_wp + 0.61_wp * q(k,j,i)
+                         k2 = 0.61_wp * pt(k,j,i)
+                      ELSE IF ( cloud_physics )  THEN
+                         IF ( ql(k,j,i) == 0.0_wp )  THEN
+                            k1 = 1.0_wp + 0.61_wp * q(k,j,i)
+                            k2 = 0.61_wp * pt(k,j,i)
+                         ELSE
+                            theta = pt(k,j,i) + pt_d_t(k) * l_d_cp * ql(k,j,i)
+                            temp  = theta * t_d_pt(k)
+                            k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp *               &
+                                          ( q(k,j,i) - ql(k,j,i) ) *           &
+                                 ( 1.0_wp + 0.622_wp * l_d_r / temp ) ) /      &
+                                 ( 1.0_wp + 0.622_wp * l_d_r * l_d_cp *        &
+                                 ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
+                            k2 = theta * ( l_d_cp / temp * k1 - 1.0_wp )
+                         ENDIF
+                      ELSE IF ( cloud_droplets )  THEN
+                         k1 = 1.0_wp + 0.61_wp * q(k,j,i) - ql(k,j,i)
+                         k2 = 0.61_wp * pt(k,j,i)
+                      ENDIF
+
+                      tend(k,j,i) = tend(k,j,i) + g /                          &
+                                 MERGE( vpt_reference, vpt(k,j,i),             &
+                                        use_single_reference_value ) *         &
+                                            ( k1 * surf_usm_h%shf(m) +         &
+                                              k2 * surf_usm_h%qsws(m)          &
+                                            ) * drho_air_zw(k-1)
+                   ENDDO
+
+                ENDDO
+
+             ENDIF
+
+             IF ( use_top_fluxes )  THEN
+
+                DO  j = nys, nyn
+
+                   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. cloud_physics .AND. .NOT. cloud_droplets ) THEN
+                         k1 = 1.0_wp + 0.61_wp * q(k,j,i)
+                         k2 = 0.61_wp * pt(k,j,i)
+                      ELSE IF ( cloud_physics )  THEN
+                         IF ( ql(k,j,i) == 0.0_wp )  THEN
+                            k1 = 1.0_wp + 0.61_wp * q(k,j,i)
+                            k2 = 0.61_wp * pt(k,j,i)
+                         ELSE
+                            theta = pt(k,j,i) + pt_d_t(k) * l_d_cp * ql(k,j,i)
+                            temp  = theta * t_d_pt(k)
+                            k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp *               &
+                                       ( q(k,j,i) - ql(k,j,i) ) *              &
+                              ( 1.0_wp + 0.622_wp * l_d_r / temp ) ) /         &
+                              ( 1.0_wp + 0.622_wp * l_d_r * l_d_cp *           &
+                              ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
+                            k2 = theta * ( l_d_cp / temp * k1 - 1.0_wp )
+                         ENDIF
+                      ELSE IF ( cloud_droplets )  THEN
+                         k1 = 1.0_wp + 0.61_wp * q(k,j,i) - ql(k,j,i)
+                         k2 = 0.61_wp * pt(k,j,i)
+                      ENDIF
+
+                      tend(k,j,i) = tend(k,j,i) + g /                          &
+                                 MERGE( vpt_reference, vpt(k,j,i),             &
+                                        use_single_reference_value ) *         &
+                                            ( k1 * surf_def_h(2)%shf(m) +      &
+                                              k2 * surf_def_h(2)%qsws(m)       &
+                                            ) * drho_air_zw(k)
+
+                   ENDDO
+
+                ENDDO
+
+             ENDIF
+
+          ENDIF
+
+       ENDIF
+
+    ENDDO
+
+ 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 )
+
+    USE arrays_3d,                                                             &
+        ONLY:  ddzw, dd2zu, drho_air_zw, q, ql
+
+    USE cloud_parameters,                                                      &
+        ONLY:  l_d_cp, l_d_r, pt_d_t, t_d_pt
+
+    USE control_parameters,                                                    &
+        ONLY:  cloud_droplets, cloud_physics, constant_flux_layer, g, neutral, &
+               rho_reference, use_single_reference_value, use_surface_fluxes,  &
+               use_top_fluxes
+
+    USE grid_variables,                                                        &
+        ONLY:  ddx, dx, ddy, dy
+
+    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) ::  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         !<
+    REAL(wp)     ::  flag        !< flag to mask topography
+    REAL(wp)     ::  k1          !<
+    REAL(wp)     ::  k2          !<
+    REAL(wp)     ::  km_neutral  !< diffusion coefficient assuming neutral conditions - used to compute shear production at surfaces
+    REAL(wp)     ::  theta       !<
+    REAL(wp)     ::  temp        !<
+    REAL(wp)     ::  sign_dir    !< sign of wall-tke flux, depending on wall orientation 
+    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
+
+
+    IF ( constant_flux_layer )  THEN
+!
+!--    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
+!
+!--    Compute gradients at north- and south-facing surfaces.
+!--    Note, no vertical natural surfaces so far.
+       DO  l = 0, 1
+!
+!--       Default surfaces
+          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_0(k,j-1,i), 0 ) ) 
+             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_0(k,j-1,i), 0 ) ) 
+             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_0(k,j-1,i), 0 ) ) 
+             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
+!
+!--       Default surfaces
+          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_0(k,j,i-1), 0 ) )
+             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_0(k,j,i-1), 0 ) ) 
+             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_0(k,j,i-1), 0 ) ) 
+             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 walls, first for 
+!--    non-natural default 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%start_index(j,i)
+       surf_e = surf_lsm_h%end_index(j,i)
+       DO  m = surf_s, surf_e
+          k = surf_lsm_h%k(m)
+
+          dudz(k)     = ( u(k+1,j,i) - surf_lsm_h%u_0(m) ) * dd2zu(k)   
+          dvdz(k)     = ( v(k+1,j,i) - surf_lsm_h%v_0(m) ) * dd2zu(k)
+       ENDDO
+!
+!--    Urban surfaces
+       surf_s = surf_usm_h%start_index(j,i)
+       surf_e = surf_usm_h%end_index(j,i)
+       DO  m = surf_s, surf_e
+          k = surf_usm_h%k(m)
+
+          dudz(k)     = ( u(k+1,j,i) - surf_usm_h%u_0(m) ) * dd2zu(k)   
+          dvdz(k)     = ( v(k+1,j,i) - surf_usm_h%v_0(m) ) * dd2zu(k)
+       ENDDO
+!
+!--    Compute gradients at downward-facing walls, only for 
+!--    non-natural 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
+
+       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) )
+
+!
+!--       Production term according to Kato and Launder (1993)
+!           def = SQRT( ( dudx(k) + dudy(k) + dudz(k) +                       &
+!                         dvdx(k) + dvdy(k) + dvdz(k) +                       &
+!                         dwdx(k) + dwdy(k) + dwdz(k)                         &
+!                       )**4 -                                                &
+!                       ( dudx(k)**2 + dvdy(k)**2 + dwdz(k)**2 +              &
+!                         2.0_wp * ( dudy(k) * dvdx(k) +                      &
+!                                    dudz(k) * dwdx(k) +                      &
+!                                    dvdz(k) * dwdy(k) )                      &
+!                       )**2                                                  &
+!                     )
+
+          IF ( def < 0.0_wp )  def = 0.0_wp
+
+          flag  = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) ) 
+
+          tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def * flag
+
+       ENDDO
+
+    ELSE
+!
+!--    Calculate TKE production by shear. Here, no additional
+!--    wall-bounded code is considered. 
+!--    Why?
+       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)
+
+          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) )
+
+!
+!--       Production term according to Kato and Launder (1993)
+!           def = SQRT( ( dudx(k) + dudy(k) + dudz(k) +                        &
+!                         dvdx(k) + dvdy(k) + dvdz(k) +                        &
+!                         dwdx(k) + dwdy(k) + dwdz(k)                          &
+!                       )**4 -                                                 &
+!                       ( dudx(k)**2 + dvdy(k)**2 + dwdz(k)**2 +               &
+!                         2.0_wp * ( dudy(k) * dvdx(k) +                       &
+!                                    dudz(k) * dwdx(k) +                       &
+!                                    dvdz(k) * dwdy(k) )                       &
+!                       )**2                                                   &
+!                     )
+
+          IF ( def < 0.0_wp )  def = 0.0_wp
+
+          flag        = MERGE( 1.0_wp, 0.0_wp,                                 &
+                               BTEST( wall_flags_0(k,j,i), 29 ) ) 
+          tend(k,j,i) = tend(k,j,i) + km(k,j,i) * def * flag
+
+       ENDDO
+
+    ENDIF
+
+!
+!-- If required, calculate TKE production by buoyancy
+    IF ( .NOT. neutral )  THEN
+
+       IF ( .NOT. humidity )  THEN
+
+          IF ( ocean )  THEN
+!
+!--          So far in the ocean no special treatment of density flux in
+!--          the bottom and top surface layer
+             DO  k = nzb+1, nzt
+ 
+                tend(k,j,i) = tend(k,j,i) +                                    &
+                              kh(k,j,i) * g /                                  &
+                              MERGE( rho_reference, prho(k,j,i),               &
+                                     use_single_reference_value ) *            &
+                              ( prho(k+1,j,i) - prho(k-1,j,i) ) *              &
+                              dd2zu(k) *                                       &
+                                MERGE( 1.0_wp, 0.0_wp,                         &
+                                       BTEST( wall_flags_0(k,j,i), 30 )        &
+                                     ) *                                       &
+                                MERGE( 1.0_wp, 0.0_wp,                         &
+                                       BTEST( wall_flags_0(k,j,i), 9 )         &
+                                     )           
+             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)
+                      tend(k,j,i) = tend(k,j,i) + g /                          &
+                                MERGE( rho_reference, prho(k,j,i),             &
+                                       use_single_reference_value ) *          &
+                                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)
+                   tend(k,j,i) = tend(k,j,i) + g /                             &
+                                MERGE( rho_reference, prho(k,j,i),             &
+                                       use_single_reference_value ) *          &
+                                drho_air_zw(k) *                               &
+                                surf_def_h(2)%shf(m) 
+                ENDDO
+             ENDIF
+
+          ELSE
+
+             DO  k = nzb+1, nzt
+!
+!--             Flag 9 is used to mask top fluxes, flag 30 to mask
+!--             surface fluxes
+                tend(k,j,i) = tend(k,j,i) -                                    &
+                              kh(k,j,i) * g /                                  &
+                                MERGE( pt_reference, pt(k,j,i),                &
+                                       use_single_reference_value ) *          &
+                              ( pt(k+1,j,i) - pt(k-1,j,i) ) * dd2zu(k) *       &
+                                MERGE( 1.0_wp, 0.0_wp,                         &
+                                       BTEST( wall_flags_0(k,j,i), 30 )        &
+                                     ) *                                       &
+                                MERGE( 1.0_wp, 0.0_wp,                         &
+                                       BTEST( wall_flags_0(k,j,i), 9 )         &
+                                     )
+
+             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)
+                      tend(k,j,i) = tend(k,j,i) + g /                          &
+                                MERGE( pt_reference, pt(k,j,i),                &
+                                       use_single_reference_value ) *          &
+                                drho_air_zw(k-1) *                             &
+                                surf_def_h(l)%shf(m)
+                   ENDDO
+                ENDDO
+!
+!--             Natural surfaces
+                surf_s = surf_lsm_h%start_index(j,i)
+                surf_e = surf_lsm_h%end_index(j,i)
+                DO  m = surf_s, surf_e
+                   k = surf_lsm_h%k(m)
+                   tend(k,j,i) = tend(k,j,i) + g /                             &
+                                MERGE( pt_reference, pt(k,j,i),                &
+                                       use_single_reference_value ) *          &
+                                drho_air_zw(k-1) *                             &
+                                surf_lsm_h%shf(m) 
+                ENDDO
+!
+!--             Urban surfaces
+                surf_s = surf_usm_h%start_index(j,i)
+                surf_e = surf_usm_h%end_index(j,i)
+                DO  m = surf_s, surf_e
+                   k = surf_usm_h%k(m)
+                   tend(k,j,i) = tend(k,j,i) + g /                             &
+                                MERGE( pt_reference, pt(k,j,i),                &
+                                       use_single_reference_value ) *          &
+                                drho_air_zw(k-1) *                             &
+                                surf_usm_h%shf(m) 
+                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)
+                   tend(k,j,i) = tend(k,j,i) + g /                             &
+                                MERGE( pt_reference, pt(k,j,i),                &
+                                       use_single_reference_value ) *          &
+                                drho_air_zw(k) *                               &
+                                surf_def_h(2)%shf(m) 
+                ENDDO
+             ENDIF
+
+          ENDIF
+
+       ELSE
+
+          DO  k = nzb+1, nzt
+!
+!--          Flag 9 is used to mask top fluxes, flag 30 to mask surface fluxes
+             IF ( .NOT. cloud_physics .AND. .NOT. cloud_droplets )  THEN
+                k1 = 1.0_wp + 0.61_wp * q(k,j,i)
+                k2 = 0.61_wp * pt(k,j,i)
+                tend(k,j,i) = tend(k,j,i) - kh(k,j,i) * g /                    &
+                                MERGE( vpt_reference, vpt(k,j,i),              &
+                                       use_single_reference_value ) *          &
+                                      ( k1 * ( pt(k+1,j,i)-pt(k-1,j,i) ) +     &
+                                        k2 * ( q(k+1,j,i) - q(k-1,j,i) )       &
+                                      ) * dd2zu(k) *                           &
+                                   MERGE( 1.0_wp, 0.0_wp,                      &
+                                          BTEST( wall_flags_0(k,j,i), 30 )     &
+                                        )          *                           &
+                                   MERGE( 1.0_wp, 0.0_wp,                      &
+                                          BTEST( wall_flags_0(k,j,i), 9 )      &
+                                        )
+
+             ELSE IF ( cloud_physics )  THEN
+                IF ( ql(k,j,i) == 0.0_wp )  THEN
+                   k1 = 1.0_wp + 0.61_wp * q(k,j,i)
+                   k2 = 0.61_wp * pt(k,j,i)
+                ELSE
+                   theta = pt(k,j,i) + pt_d_t(k) * l_d_cp * ql(k,j,i)
+                   temp  = theta * t_d_pt(k)
+                   k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp *                        &
+                                 ( q(k,j,i) - ql(k,j,i) ) *                    &
+                        ( 1.0_wp + 0.622_wp * l_d_r / temp ) ) /               &
+                        ( 1.0_wp + 0.622_wp * l_d_r * l_d_cp *                 &
+                        ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
+                   k2 = theta * ( l_d_cp / temp * k1 - 1.0_wp )
+                ENDIF
+                tend(k,j,i) = tend(k,j,i) - kh(k,j,i) * g /                    &
+                                MERGE( vpt_reference, vpt(k,j,i),              &
+                                       use_single_reference_value ) *          &
+                                      ( k1 * ( pt(k+1,j,i)-pt(k-1,j,i) ) +     &
+                                        k2 * ( q(k+1,j,i) - q(k-1,j,i) )       &
+                                      ) * dd2zu(k) *                           &
+                                   MERGE( 1.0_wp, 0.0_wp,                      &
+                                          BTEST( wall_flags_0(k,j,i), 30 )     &
+                                        )          *                           &
+                                   MERGE( 1.0_wp, 0.0_wp,                      &
+                                          BTEST( wall_flags_0(k,j,i), 9 )      &
+                                        )
+             ELSE IF ( cloud_droplets )  THEN
+                k1 = 1.0_wp + 0.61_wp * q(k,j,i) - ql(k,j,i)
+                k2 = 0.61_wp * pt(k,j,i)
+                tend(k,j,i) = tend(k,j,i) - kh(k,j,i) * g /                    &
+                                MERGE( vpt_reference, vpt(k,j,i),              &
+                                       use_single_reference_value ) *          &
+                                  ( 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)   &
+                                 * MERGE( 1.0_wp, 0.0_wp,                      &
+                                          BTEST( wall_flags_0(k,j,i), 30 )     &
+                                        )                                      &
+                                 * MERGE( 1.0_wp, 0.0_wp,                      &
+                                          BTEST( wall_flags_0(k,j,i), 9 )      &
+                                        )    
+             ENDIF
+          ENDDO
+
+          IF ( use_surface_fluxes )  THEN
+!
+!--          Treat horizontal 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)
+
+                   IF ( .NOT. cloud_physics .AND. .NOT. cloud_droplets ) THEN
+                      k1 = 1.0_wp + 0.61_wp * q(k,j,i)
+                      k2 = 0.61_wp * pt(k,j,i)
+                   ELSE IF ( cloud_physics )  THEN
+                      IF ( ql(k,j,i) == 0.0_wp )  THEN
+                         k1 = 1.0_wp + 0.61_wp * q(k,j,i)
+                         k2 = 0.61_wp * pt(k,j,i)
+                      ELSE
+                        theta = pt(k,j,i) + pt_d_t(k) * l_d_cp * ql(k,j,i)
+                        temp  = theta * t_d_pt(k)
+                        k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp *                   &
+                                   ( q(k,j,i) - ql(k,j,i) ) *                  &
+                          ( 1.0_wp + 0.622_wp * l_d_r / temp ) ) /             &
+                          ( 1.0_wp + 0.622_wp * l_d_r * l_d_cp *               & 
+                          ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
+                        k2 = theta * ( l_d_cp / temp * k1 - 1.0_wp )
+                      ENDIF
+                   ELSE IF ( cloud_droplets )  THEN
+                      k1 = 1.0_wp + 0.61_wp * q(k,j,i) - ql(k,j,i)
+                      k2 = 0.61_wp * pt(k,j,i)
+                   ENDIF
+
+                   tend(k,j,i) = tend(k,j,i) + g /                             &
+                                MERGE( vpt_reference, vpt(k,j,i),              &
+                                       use_single_reference_value ) *          &
+                                      ( 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
+             surf_s = surf_lsm_h%start_index(j,i)
+             surf_e = surf_lsm_h%end_index(j,i)
+             DO  m = surf_s, surf_e
+                k = surf_lsm_h%k(m)
+
+                IF ( .NOT. cloud_physics .AND. .NOT. cloud_droplets ) THEN
+                    k1 = 1.0_wp + 0.61_wp * q(k,j,i)
+                    k2 = 0.61_wp * pt(k,j,i)
+                ELSE IF ( cloud_physics )  THEN
+                    IF ( ql(k,j,i) == 0.0_wp )  THEN
+                       k1 = 1.0_wp + 0.61_wp * q(k,j,i)
+                       k2 = 0.61_wp * pt(k,j,i)
+                    ELSE
+                       theta = pt(k,j,i) + pt_d_t(k) * l_d_cp * ql(k,j,i)
+                       temp  = theta * t_d_pt(k)
+                       k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp *                    &
+                                     ( q(k,j,i) - ql(k,j,i) ) *                &
+                            ( 1.0_wp + 0.622_wp * l_d_r / temp ) ) /           &
+                            ( 1.0_wp + 0.622_wp * l_d_r * l_d_cp *             &
+                            ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
+                       k2 = theta * ( l_d_cp / temp * k1 - 1.0_wp )
+                   ENDIF
+                ELSE IF ( cloud_droplets )  THEN
+                   k1 = 1.0_wp + 0.61_wp * q(k,j,i) - ql(k,j,i)
+                   k2 = 0.61_wp * pt(k,j,i)
+                ENDIF
+
+                tend(k,j,i) = tend(k,j,i) + g /                                &
+                                MERGE( vpt_reference, vpt(k,j,i),              &
+                                       use_single_reference_value ) *          &
+                                         ( k1 * surf_lsm_h%shf(m) +            &
+                                           k2 * surf_lsm_h%qsws(m)             &
+                                         ) * drho_air_zw(k-1)
+             ENDDO
+!
+!--          Treat horizontal urban surfaces
+             surf_s = surf_usm_h%start_index(j,i)
+             surf_e = surf_usm_h%end_index(j,i)
+             DO  m = surf_s, surf_e
+                k = surf_usm_h%k(m)
+
+                IF ( .NOT. cloud_physics .AND. .NOT. cloud_droplets ) THEN
+                    k1 = 1.0_wp + 0.61_wp * q(k,j,i)
+                    k2 = 0.61_wp * pt(k,j,i)
+                ELSE IF ( cloud_physics )  THEN
+                    IF ( ql(k,j,i) == 0.0_wp )  THEN
+                       k1 = 1.0_wp + 0.61_wp * q(k,j,i)
+                       k2 = 0.61_wp * pt(k,j,i)
+                    ELSE
+                       theta = pt(k,j,i) + pt_d_t(k) * l_d_cp * ql(k,j,i)
+                       temp  = theta * t_d_pt(k)
+                       k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp *                    &
+                                     ( q(k,j,i) - ql(k,j,i) ) *                &
+                            ( 1.0_wp + 0.622_wp * l_d_r / temp ) ) /           &
+                            ( 1.0_wp + 0.622_wp * l_d_r * l_d_cp *             &
+                            ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
+                       k2 = theta * ( l_d_cp / temp * k1 - 1.0_wp )
+                   ENDIF
+                ELSE IF ( cloud_droplets )  THEN
+                   k1 = 1.0_wp + 0.61_wp * q(k,j,i) - ql(k,j,i)
+                   k2 = 0.61_wp * pt(k,j,i)
+                ENDIF
+
+                tend(k,j,i) = tend(k,j,i) + g /                                &
+                                MERGE( vpt_reference, vpt(k,j,i),              &
+                                       use_single_reference_value ) *          &
+                                         ( k1 * surf_usm_h%shf(m) +            &
+                                           k2 * surf_usm_h%qsws(m)             &
+                                         ) * drho_air_zw(k-1)
+             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)
+
+
+
+                IF ( .NOT. cloud_physics .AND. .NOT. cloud_droplets )  THEN
+                   k1 = 1.0_wp + 0.61_wp * q(k,j,i)
+                   k2 = 0.61_wp * pt(k,j,i)
+                ELSE IF ( cloud_physics )  THEN
+                   IF ( ql(k,j,i) == 0.0_wp )  THEN
+                      k1 = 1.0_wp + 0.61_wp * q(k,j,i)
+                      k2 = 0.61_wp * pt(k,j,i)
+                   ELSE
+                      theta = pt(k,j,i) + pt_d_t(k) * l_d_cp * ql(k,j,i)
+                      temp  = theta * t_d_pt(k)
+                      k1 = ( 1.0_wp - q(k,j,i) + 1.61_wp *                     &
+                                 ( q(k,j,i) - ql(k,j,i) ) *                    &
+                        ( 1.0_wp + 0.622_wp * l_d_r / temp ) ) /               &
+                        ( 1.0_wp + 0.622_wp * l_d_r * l_d_cp *                 &
+                        ( q(k,j,i) - ql(k,j,i) ) / ( temp * temp ) )
+                      k2 = theta * ( l_d_cp / temp * k1 - 1.0_wp )
+                   ENDIF
+                ELSE IF ( cloud_droplets )  THEN
+                   k1 = 1.0_wp + 0.61_wp * q(k,j,i) - ql(k,j,i)
+                   k2 = 0.61_wp * pt(k,j,i)
+                ENDIF
+
+                tend(k,j,i) = tend(k,j,i) + g /                                &
+                                MERGE( vpt_reference, vpt(k,j,i),              &
+                                       use_single_reference_value ) *          &
+                            ( k1* surf_def_h(2)%shf(m) +                       &
+                              k2 * surf_def_h(2)%qsws(m)                       &
+                            ) * drho_air_zw(k)
+             ENDDO
+
+          ENDIF
+
+       ENDIF
+
+    ENDIF
+
+  END SUBROUTINE production_e_ij
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Diffusion and dissipation terms for the TKE.
+!> Vector-optimized version
+!------------------------------------------------------------------------------!
+ SUBROUTINE diffusion_e( var, var_reference )
+
+    USE arrays_3d,                                                             &
+        ONLY:  ddzu, ddzw, drho_air, rho_air_zw
+
+    USE grid_variables,                                                        &
+        ONLY:  ddx2, ddy2
+
+    USE microphysics_mod,                                                      &
+        ONLY:  collision_turbulence
+
+    USE particle_attributes,                                                   &
+        ONLY:  use_sgs_for_particles, wang_kernel
+
+    USE surface_mod,                                                           &
+       ONLY :  bc_h
+
+    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)     ::  flag           !< flag to mask topography
+    REAL(wp)     ::  l              !< mixing length
+    REAL(wp)     ::  ll             !< adjusted l
+    REAL(wp)     ::  var_reference  !< 
+
+#if defined( __nopointer )
+    REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  var  !< 
+#else
+    REAL(wp), DIMENSION(:,:,:), POINTER ::  var  !< 
+#endif
+    REAL(wp), DIMENSION(nzb+1:nzt,nys:nyn) ::  dissipation  !< TKE dissipation
+
+
+!
+!-- Calculate the tendency terms
+    DO  i = nxl, nxr
+       DO  j = nys, nyn
+          DO  k = nzb+1, nzt
+
+!
+!--          Calculate dissipation
+             IF ( les_mw )  THEN
+
+                CALL mixing_length_les( i, j, k, l, ll, var, var_reference )
+
+                dissipation(k,j) = ( 0.19_wp + 0.74_wp * l / ll )              &
+                                   * e(k,j,i) * SQRT( e(k,j,i) ) / l
+
+             ELSEIF ( rans_tke_l )  THEN
+
+                CALL mixing_length_rans( i, j, k, l, ll, var, var_reference )
+
+                dissipation(k,j) = c_m**3 * e(k,j,i) * SQRT( e(k,j,i) ) / ll
+
+             ELSEIF ( rans_tke_e )  THEN
+
+                dissipation(k,j) = diss(k,j,i)
+
+             ENDIF
+
+!
+!--          Predetermine flag to mask topography
+             flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
+
+             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  * flag                        &
+                                     + (                                       &
+                       ( 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  * flag                        &
+                                     + (                                       &
+            ( 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) * flag        &
+                          - dissipation(k,j) * flag
+
+          ENDDO
+       ENDDO
+
+!
+!--    Store dissipation if needed for calculating the sgs particle
+!--    velocities
+       IF ( .NOT. rans_tke_e .AND. ( use_sgs_for_particles  .OR.               &
+            wang_kernel  .OR.  collision_turbulence  ) )  THEN
+          DO  j = nys, nyn
+             DO  k = nzb+1, nzt
+                diss(k,j,i) = dissipation(k,j) * MERGE( 1.0_wp, 0.0_wp,        &
+                                               BTEST( wall_flags_0(k,j,i), 0 ) )
+             ENDDO
+          ENDDO
+       ENDIF
+
+    ENDDO
+
+!
+!-- Neumann boundary condition for dissipation diss(nzb,:,:) = diss(nzb+1,:,:)
+    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
+!------------------------------------------------------------------------------!
+ SUBROUTINE diffusion_e_ij( i, j, var, var_reference )
+
+    USE arrays_3d,                                                             &
+        ONLY:  ddzu, ddzw, drho_air, rho_air_zw
+
+    USE grid_variables,                                                        &
+        ONLY:  ddx2, ddy2
+        
+    USE microphysics_mod,                                                      &
+        ONLY:  collision_turbulence
+
+    USE particle_attributes,                                                   &
+        ONLY:  use_sgs_for_particles, wang_kernel
+
+    USE surface_mod,                                                           &
+       ONLY :  bc_h
+
+    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
+    REAL(wp)     ::  l              !< mixing length
+    REAL(wp)     ::  ll             !< adjusted l
+    REAL(wp)     ::  var_reference  !< 
+
+#if defined( __nopointer )
+    REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  var  !<
+#else
+    REAL(wp), DIMENSION(:,:,:), POINTER ::  var     !<
+#endif
+    REAL(wp), DIMENSION(nzb+1:nzt) ::  dissipation  !< dissipation of TKE
+
+!
+!-- 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_0(k,j,i), 0 ) )
+
+!
+!--    Calculate dissipation...
+!--    ...in case of LES
+       IF ( les_mw )  THEN
+
+          CALL mixing_length_les( i, j, k, l, ll, var, var_reference )
+
+          dissipation(k) = ( 0.19_wp + 0.74_wp * l / ll )                      &
+                           * e(k,j,i) * SQRT( e(k,j,i) ) / l
+
+!
+!--    ...in case of RANS
+       ELSEIF ( rans_tke_l )  THEN
+
+          CALL mixing_length_rans( i, j, k, l, ll, var, var_reference  )
+
+          dissipation(k) = c_m**3 * e(k,j,i) * SQRT( e(k,j,i) ) / ll
+
+       ELSEIF ( rans_tke_e )  THEN
+
+          dissipation(k) = diss(k,j,i)
+
+       ENDIF
+
+!
+!--    Calculate the tendency term
+       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  * flag / sig_e                 &
+                                    + (                                        &
+                      ( 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  * flag / sig_e                 &
+                                    + (                                        &
+           ( 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) * flag / sig_e &
+                                    - dissipation(k) * flag
+
+    ENDDO
+
+!
+!-- Store dissipation if needed for calculating the sgs particle velocities
+    IF ( .NOT. rans_tke_e .AND.  ( use_sgs_for_particles  .OR.  wang_kernel    &
+          .OR.  collision_turbulence ) )  THEN
+       DO  k = nzb+1, nzt
+          diss(k,j,i) = dissipation(k) * MERGE( 1.0_wp, 0.0_wp,                &
+                                               BTEST( wall_flags_0(k,j,i), 0 ) )
+       ENDDO
+!
+!--    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.
+       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_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  * flag                              &
+                               + (                                             &
+                 ( 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  * flag                              &
+                               + (                                             &
+      ( 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              &
+                               - 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
+
+    REAL(wp), DIMENSION(nzb+1:nzt) :: tend_temp
+
+!
+!-- 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_0(k,j,i), 0 ) )
+
+!
+!--    Calculate the tendency term
+       tend_temp(k) =           (                                              &
+                ( 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  * flag / sig_diss                    &
+                              + (                                              &
+                ( 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  * flag / sig_diss                    &
+                              + (                                              &
+     ( 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 / sig_diss    &
+                              - c_2 * diss(k,j,i)**2                           &
+                                    / ( e(k,j,i) + 1.0E-20_wp ) * flag
+
+       tend(k,j,i) = tend(k,j,i) + tend_temp(k)
+
+    ENDDO
+
+ END SUBROUTINE diffusion_diss_ij
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Calculate mixing length for LES mode.
+!------------------------------------------------------------------------------!
+ SUBROUTINE mixing_length_les( i, j, k, l, ll, var, var_reference )
+
+    USE arrays_3d,                                                             &
+        ONLY:  dd2zu, l_grid, l_wall
+
+    USE control_parameters,                                                    &
+        ONLY:  atmos_ocean_sign, g, use_single_reference_value,                &
+               wall_adjustment, wall_adjustment_factor
+
+    IMPLICIT NONE
+
+    INTEGER(iwp) :: i   !< loop index
+    INTEGER(iwp) :: j   !< loop index
+    INTEGER(iwp) :: k   !< loop index
+
+    REAL(wp)     :: dvar_dz         !< vertical gradient of var
+    REAL(wp)     :: l               !< mixing length
+    REAL(wp)     :: l_stable        !< mixing length according to stratification
+    REAL(wp)     :: ll              !< adjusted l_grid
+    REAL(wp)     :: var_reference   !< var at reference height
+
+#if defined( __nopointer )
+    REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  var  !< temperature
+#else
+    REAL(wp), DIMENSION(:,:,:), POINTER ::  var     !< temperature
+#endif
+
+    dvar_dz = atmos_ocean_sign * ( var(k+1,j,i) - var(k-1,j,i) ) * dd2zu(k)
+    IF ( dvar_dz > 0.0_wp ) THEN
+       IF ( use_single_reference_value )  THEN
+          l_stable = 0.76_wp * SQRT( e(k,j,i) )                                &
+                             / SQRT( g / var_reference * dvar_dz ) + 1E-5_wp
+       ELSE
+          l_stable = 0.76_wp * SQRT( e(k,j,i) )                                &
+                             / SQRT( g / var(k,j,i) * dvar_dz ) + 1E-5_wp
+       ENDIF
+    ELSE
+       l_stable = l_grid(k)
+    ENDIF
+!
+!-- Adjustment of the mixing length
+    IF ( wall_adjustment )  THEN
+       l  = MIN( wall_adjustment_factor * l_wall(k,j,i), l_grid(k), l_stable )
+       ll = MIN( wall_adjustment_factor * l_wall(k,j,i), l_grid(k) )
+    ELSE
+       l  = MIN( l_grid(k), l_stable )
+       ll = l_grid(k)
+    ENDIF
+
+ END SUBROUTINE mixing_length_les
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Calculate mixing length for RANS mode.
+!------------------------------------------------------------------------------!
+ SUBROUTINE mixing_length_rans( i, j, k, l, l_diss, var, var_reference  )
+
+    USE arrays_3d,                                                             &
+        ONLY:  dd2zu
+
+    USE control_parameters,                                                    &
+        ONLY:  atmos_ocean_sign, g, use_single_reference_value
+
+    IMPLICIT NONE
+
+    INTEGER(iwp) :: i   !< loop index
+    INTEGER(iwp) :: j   !< loop index
+    INTEGER(iwp) :: k   !< loop index
+
+    REAL(wp)     :: duv2_dz2        !< squared vertical gradient of wind vector
+    REAL(wp)     :: dvar_dz         !< vertical gradient of var
+    REAL(wp)     :: l               !< mixing length
+    REAL(wp)     :: l_diss          !< mixing length for dissipation
+    REAL(wp)     :: rif             !< Richardson flux number
+    REAL(wp)     :: var_reference   !< var at reference height
+
+#if defined( __nopointer )
+    REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  var  !< temperature
+#else
+    REAL(wp), DIMENSION(:,:,:), POINTER ::  var     !< temperature
+#endif
+
+    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
+
+    IF ( use_single_reference_value )  THEN
+       rif = g / var_reference * dvar_dz / duv2_dz2
+    ELSE
+       rif = g / var(k,j,i) * dvar_dz / duv2_dz2
+    ENDIF
+
+    rif = MAX( rif, -5.0_wp )
+    rif = MIN( rif,  1.0_wp )
+
+!
+!-- Calculate diabatic mixing length using Dyer-profile functions
+    IF ( rif >= 0.0_wp )  THEN
+       l      = l_black(k) / ( 1.0_wp + 5.0_wp * rif )
+       l_diss = l
+    ELSE
+!
+!--    In case of unstable stratification, use mixing length of neutral case
+!--    for l, but consider profile functions for l_diss
+       l      = l_black(k)
+       l_diss = l_black(k) * SQRT( 1.0_wp - 16.0_wp * rif )
+    ENDIF
+
+ END SUBROUTINE mixing_length_rans
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Computation of the turbulent diffusion coefficients for momentum and heat 
+!> according to Prandtl-Kolmogorov.
+!------------------------------------------------------------------------------!
+ SUBROUTINE tcm_diffusivities( var, var_reference )
+ 
+
+    USE control_parameters,                                                    &
+        ONLY:  e_min, outflow_l, outflow_n, outflow_r, outflow_s
+
+    USE statistics,                                                            &
+        ONLY :  rmask, sums_l_l
+
+    USE surface_mod,                                                           &
+        ONLY :  bc_h, surf_def_h
+
+    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) ::  sr                  !<
+    INTEGER(iwp) ::  tn                  !<
+
+    REAL(wp)     ::  flag                !<
+    REAL(wp)     ::  l                   !<
+    REAL(wp)     ::  ll                  !<
+    REAL(wp)     ::  var_reference       !<
+
+#if defined( __nopointer )
+    REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg) ::  var  !< 
+#else
+    REAL(wp), DIMENSION(:,:,:), POINTER ::  var  !< 
+#endif
+
+!
+!-- Default thread number in case of one thread
+    tn = 0
+
+!
+!-- Initialization for calculation of the mixing length profile
+    sums_l_l = 0.0_wp
+
+!
+!-- Compute the turbulent diffusion coefficient for momentum
+    !$OMP PARALLEL PRIVATE (i,j,k,l,ll,sr,tn,flag)
+!$  tn = omp_get_thread_num()
+
+!
+!-- Introduce an optional minimum tke
+    IF ( e_min > 0.0_wp )  THEN
+       !$OMP DO
+       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_0(k,j,i), 0 ) )
+             ENDDO
+          ENDDO
+       ENDDO
+    ENDIF
+
+    IF ( les_mw )  THEN
+       !$OMP DO
+       DO  i = nxlg, nxrg
+          DO  j = nysg, nyng
+             DO  k = nzb+1, nzt
+
+                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
+
+!
+!--             Determine the mixing length for LES closure
+                CALL mixing_length_les( i, j, k, l, ll, var, var_reference )
+!
+!--             Compute diffusion coefficients for momentum and heat
+                km(k,j,i) = c_m * l * SQRT( e(k,j,i) ) * flag
+                kh(k,j,i) = ( 1.0_wp + 2.0_wp * l / ll ) * km(k,j,i) * flag
+!
+!--             Summation for averaged profile (cf. flow_statistics)
+                DO  sr = 0, statistic_regions
+                   sums_l_l(k,sr,tn) = sums_l_l(k,sr,tn) + l * rmask(j,i,sr)   &
+                                                             * flag
+                ENDDO
+
+             ENDDO
+          ENDDO
+       ENDDO
+
+    ELSEIF ( rans_tke_l )  THEN
+
+       !$OMP DO
+       DO  i = nxlg, nxrg
+          DO  j = nysg, nyng
+             DO  k = nzb+1, nzt
+
+                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
+!
+!--             Mixing length for RANS mode with TKE-l closure
+                CALL mixing_length_rans( i, j, k, l, ll, var, var_reference )
+!
+!--             Compute diffusion coefficients for momentum and heat
+                km(k,j,i) = c_m * l * SQRT( e(k,j,i) ) * flag
+                kh(k,j,i) = km(k,j,i) / prandtl_number * flag
+!
+!--             Summation for averaged profile (cf. flow_statistics)
+                DO  sr = 0, statistic_regions
+                   sums_l_l(k,sr,tn) = sums_l_l(k,sr,tn) + l * rmask(j,i,sr)   &
+                                                             * flag
+                ENDDO
+
+             ENDDO
+          ENDDO
+       ENDDO
+
+    ELSEIF ( rans_tke_e )  THEN
+
+       !$OMP DO
+       DO  i = nxlg, nxrg
+          DO  j = nysg, nyng
+             DO  k = nzb+1, nzt
+
+                flag = MERGE( 1.0_wp, 0.0_wp, BTEST( wall_flags_0(k,j,i), 0 ) )
+!
+!--             Compute diffusion coefficients for momentum and heat
+                km(k,j,i) = c_mu * e(k,j,i)**2 / ( diss(k,j,i) + 1.E-10 ) * flag
+                kh(k,j,i) = km(k,j,i) / prandtl_number * flag
+
+             ENDDO
+          ENDDO
+       ENDDO
+
+    ENDIF
+
+    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 upward- and 
+!-- downward facing walls. To set wall-boundary values, the surface data type 
+!-- is applied.
+!-- Horizontal boundary conditions at vertical walls are not set because
+!-- so far vertical surfaces require usage of a Prandtl-layer where the boundary
+!-- values of the diffusivities are not needed.
+
+    IF ( .NOT. rans_tke_e )  THEN
+!
+!--    Upward-facing
+       !$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)
+          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 )
+       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
+    ELSE
+!
+!--    Up- and downward facing surfaces
+       DO  n = 0, 1
+          DO  m = 1, surf_def_h(n)%ns
+             i = surf_def_h(n)%i(m)
+             j = surf_def_h(n)%j(m)
+             k = surf_def_h(n)%k(m)
+             km(k,j,i) = kappa * surf_def_h(n)%us(m) * dzu(k)
+             kh(k,j,i) = 1.35_wp * km(k,j,i)
+          ENDDO
+       ENDDO
+
+       CALL exchange_horiz( km, nbgp )
+       CALL exchange_horiz( kh, nbgp )
+
+    ENDIF
+!
+!-- Model top
+    !$OMP PARALLEL DO
+    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 ( 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 tcm_diffusivities
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Swapping of timelevels.
+!------------------------------------------------------------------------------!
+ SUBROUTINE tcm_swap_timelevel ( mod_count )
+
+    IMPLICIT NONE
+
+    INTEGER(iwp) ::  i      !< loop index x direction
+    INTEGER(iwp) ::  j      !< loop index y direction
+    INTEGER(iwp) ::  k      !< loop index z direction
+    INTEGER, INTENT(IN) ::  mod_count  !<
+
+#if defined( __nopointer )
+
+    IF ( .NOT. constant_diffusion )  THEN
+       DO  i = nxlg, nxrg
+          DO  j = nysg, nyng
+             DO  k = nzb, nzt+1
+                e(k,j,i) = e_p(k,j,i)
+             ENDDO
+          ENDDO
+       ENDDO
+    ENDIF
+
+    IF ( rans_tke_e )  THEN
+       DO  i = nxlg, nxrg
+          DO  j = nysg, nyng
+             DO  k = nzb, nzt+1
+                diss(k,j,i) = diss_p(k,j,i)
+             ENDDO
+          ENDDO
+       ENDDO
+    ENDIF
+
+#else
+    
+    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
+#endif
+
+ 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 2689)
+++ palm/trunk/SOURCE/urban_surface_mod.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file urban_surface_mod.f90
-!--------------------------------------------------------------------------------!
-! This file is part of PALM.
+!------------------------------------------------------------------------------!
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
@@ -26,4 +26,31 @@
 ! -----------------
 ! $Id$
+! - Bugfix in calculation of pt_surface and related fluxes. (BM)
+! - Do not write surface temperatures onto pt array as this might cause 
+!   problems with nesting. (MS)
+! - Revised calculation of pt1 (now done in surface_layer_fluxes).
+!   Bugfix, f_shf_window and f_shf_green were not set at vertical surface 
+!   elements. (MS)
+! - merged with branch ebsolver
+!   green building surfaces do not evaporate yet
+!   properties of green wall layers and window layers are taken from wall layers
+!   this input data is missing. (RvT)
+! - Merged with branch radiation (developed by Mohamed Salim)
+! - Revised initialization. (MS)
+! - Rename emiss_surf into emissivity, roughness_wall into z0, albedo_surf into 
+!   albedo. (MS)
+! - Move first call of usm_radiatin from usm_init to init_3d_model
+! - fixed problem with near surface temperature
+! - added near surface temperature t_surf_10cm_h(m), t_surf_10cm_v(l)%t(m)
+! - does not work with temp profile including stability, ol
+!   t_surf_10cm = pt1 now
+! - merged with 2357 bugfix, error message for nopointer version
+! - added indoor model coupling with wall heat flux
+! - added green substrate/ dry vegetation layer for buildings
+! - merged with 2232 new surface-type structure
+! - added transmissivity of window tiles
+! - added MOSAIK tile approach for 3 different surfaces (RvT)
+! 
+! 2583 2017-10-26 13:58:38Z knoop
 ! Date and time quantities are now read from date_and_time_mod. Solar constant is
 ! read from radiation_model_mod
@@ -142,4 +169,5 @@
 !>    1.2 Km/s, which seem to be not realistic.
 !>
+!> @todo Output of _av variables in case of restarts
 !> @todo Revise flux conversion in energy-balance solver
 !> @todo Bugfixing in nopointer branch 
@@ -148,4 +176,8 @@
 !> @todo Check for load imbalances in CPU measures, e.g. for exchange_horiz_prog
 !>       factor 3 between min and max time
+!> @todo Move setting of flag indoor_model to indoor_model_mod once available
+!> @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
@@ -170,15 +202,15 @@
                g, pt_surface, large_scale_forcing, lsf_surf, spinup,           &
                spinup_pt_mean, spinup_time, time_do3d, dt_do3d,                &
-               average_count_3d, varnamelength, urban_surface
+               average_count_3d, varnamelength, urban_surface, kappa
 
     USE cpulog,                                                                &
         ONLY:  cpu_log, log_point, log_point_s
-     
+
     USE date_and_time_mod,                                                     &
         ONLY:  d_seconds_year, day_of_year_init, time_utc_init
-   
+
     USE grid_variables,                                                        &
         ONLY:  dx, dy, ddx, ddy, ddx2, ddy2
-    
+
     USE indices,                                                               &
         ONLY:  nx, ny, nnx, nny, nnz, nxl, nxlg, nxr, nxrg, nyn, nyng, nys,    &
@@ -192,12 +224,23 @@
     
     USE plant_canopy_model_mod,                                                &
-        ONLY:  plant_canopy, pch_index,                                        &
-               pc_heating_rate, lad_s
+        ONLY:  pc_heating_rate, plant_canopy, usm_lad_rma
     
     USE radiation_model_mod,                                                   &
-        ONLY:  radiation, calc_zenith, zenith,                                 &
-               rad_net, rad_sw_in, rad_lw_in, rad_sw_out, rad_lw_out,          &
+        ONLY:  albedo_type, radiation, calc_zenith, zenith,                    &
+               rad_sw_in, rad_lw_in, rad_sw_out, rad_lw_out,                   &
                sigma_sb, solar_constant, sun_direction, sun_dir_lat,           &
-               sun_dir_lon, force_radiation_call
+               sun_dir_lon,                                                    &
+               force_radiation_call, surfinsw, surfinlw, surfinswdir,          &
+               surfinswdif, surfoutsw, surfoutlw, surfins,nsvfl, svf, svfsurf, &
+               surfinl, surfinlwdif, energy_balance_surf_h,                    &
+               energy_balance_surf_v, rad_sw_in_dir, rad_sw_in_diff,           &
+               rad_lw_in_diff, surfouts, surfoutl, surfoutsl, surfoutll, surf, &
+               surfl, nsurfl, nsurfs, surfstart, pcbinsw, pcbinlw, pcbl, npcbl, startenergy,      &
+               endenergy, nenergy, iup_u, inorth_u, isouth_u, ieast_u, iwest_u, iup_l,  &
+               inorth_l, isouth_l, ieast_l, iwest_l, startsky, endsky,id,      &
+               iz, iy, ix, idir, jdir, kdir, startborder, endborder, nsurf_type, nzub, nzut,   &
+               isky, inorth_b,idown_a, isouth_b, ieast_b, iwest_b, nzu, pch, nsurf,  &
+               iup_a, inorth_a, isouth_a, ieast_a, iwest_a, idsvf, ndsvf,      &
+               idcsf, ndcsf, kdcsf, pct, startland, endland, startwall, endwall
 
     USE statistics,                                                            &
@@ -206,111 +249,176 @@
     USE surface_mod
 
-               
 
     IMPLICIT NONE
 
+
 !-- configuration parameters (they can be setup in PALM config)
-    LOGICAL                                        ::  split_diffusion_radiation = .TRUE. !< split direct and diffusion dw radiation
-                                                                                          !< (.F. in case the radiation model already does it)    
-    LOGICAL                                        ::  usm_energy_balance_land = .TRUE.   !< flag parameter indicating wheather the energy balance is calculated for land and roofs
-    LOGICAL                                        ::  usm_energy_balance_wall = .TRUE.   !< flag parameter indicating wheather the energy balance is calculated for land and roofs
     LOGICAL                                        ::  usm_material_model = .TRUE.        !< flag parameter indicating wheather the  model of heat in materials is used
     LOGICAL                                        ::  usm_anthropogenic_heat = .FALSE.   !< flag parameter indicating wheather the anthropogenic heat sources (e.g.transportation) are used
     LOGICAL                                        ::  force_radiation_call_l = .FALSE.   !< flag parameter for unscheduled radiation model calls
-    LOGICAL                                        ::  mrt_factors = .FALSE.              !< whether to generate MRT factor files during init
-    LOGICAL                                        ::  write_svf_on_init = .FALSE.
-    LOGICAL                                        ::  read_svf_on_init = .FALSE.
-    LOGICAL                                        ::  usm_lad_rma = .TRUE.               !< use MPI RMA to access LAD for raytracing (instead of global array)
-    
-    INTEGER(iwp)                                   ::  nrefsteps = 0                      !< number of reflection steps to perform
-    
+    LOGICAL                                        ::  indoor_model = .FALSE.              !< whether to use the indoor model
+
+   
+    INTEGER(iwp)                                   ::  building_type = 1                  !< default building type (preleminary setting)
     INTEGER(iwp)                                   ::  land_category = 2                  !< default category for land surface
     INTEGER(iwp)                                   ::  wall_category = 2                  !< default category for wall surface over pedestrian zone
     INTEGER(iwp)                                   ::  pedestrant_category = 2            !< default category for wall surface in pedestrian zone
     INTEGER(iwp)                                   ::  roof_category = 2                  !< default category for root surface
-    REAL(wp)                                       ::  roof_height_limit = 4._wp          !< height for distinguish between land surfaces and roofs
-
-    REAL(wp), PARAMETER                            ::  ext_coef = 0.6_wp                  !< extinction coefficient (a.k.a. alpha)
-    REAL(wp)                                       ::  ra_horiz_coef = 5.0_wp             !< mysterious coefficient for correction of overestimation
+
+!
+!-- Indices of input attributes for (above) ground floor level 
+    INTEGER(iwp) ::  ind_alb_wall          = 38 !< index in input list for albedo_type of wall fraction
+    INTEGER(iwp) ::  ind_alb_green         = 39 !< index in input list for albedo_type of green fraction
+    INTEGER(iwp) ::  ind_alb_win           = 40 !< index in input list for albedo_type of window fraction
+    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_green_agfl   = 15 !< index in input list for green emissivity, above ground floor level
+    INTEGER(iwp) ::  ind_emis_green_gfl    = 33 !< index in input list for green emissivity, ground floor level
+    INTEGER(iwp) ::  ind_emis_win_agfl     = 16 !< index in input list for window emissivity, above ground floor level
+    INTEGER(iwp) ::  ind_emis_win_gfl      = 34 !< index in input list for window emissivity, ground floor level
+    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_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_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_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_gflh              = 20 !< index in input list for ground floor level height
+    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_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_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_thick_1           = 41 !< index for wall layer thickness - 1st layer
+    INTEGER(iwp) ::  ind_thick_2           = 42 !< index for wall layer thickness - 2nd layer
+    INTEGER(iwp) ::  ind_thick_3           = 43 !< index for wall layer thickness - 3rd layer
+    INTEGER(iwp) ::  ind_thick_4           = 44 !< index for wall layer thickness - 4th layer
+    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_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_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_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
+
+
+    REAL(wp)  ::  roof_height_limit = 4._wp          !< height for distinguish between land surfaces and roofs
+    REAL(wp)  ::  ground_floor_level = 4.0_wp        !< default ground floor level
+    REAL(wp)  ::  ra_horiz_coef = 5.0_wp             !< mysterious coefficient for correction of overestimation
                                                                                           !< of r_a for horizontal surfaces -> TODO
-    
-!-- parameters of urban surface model
-    INTEGER(iwp), PARAMETER                        ::  usm_version_len = 10               !< length of identification string of usm version
-    CHARACTER(usm_version_len), PARAMETER          ::  usm_version = 'USM v. 1.0'         !< identification of version of binary svf and restart files
-    INTEGER(iwp), PARAMETER                        ::  svf_code_len = 15                  !< length of code for verification of the end of svf file
-    CHARACTER(svf_code_len), PARAMETER             ::  svf_code = '*** end svf ***'       !< code for verification of the end of svf file
-    INTEGER(iwp)                                   ::  nzu                                !< number of layers of urban surface (will be calculated)
-    INTEGER(iwp)                                   ::  nzub,nzut                          !< bottom and top layer of urban surface (will be calculated)
-    INTEGER(iwp), PARAMETER                        ::  nzut_free = 3                      !< number of free layers in urban surface layer above top of buildings 
-    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 = 2                          !< 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                        ::  iroof = 0                          !< 0 - index of ground or roof
-    INTEGER(iwp), PARAMETER                        ::  isouth = 1                         !< 1 - index of south facing wall
-    INTEGER(iwp), PARAMETER                        ::  inorth = 2                         !< 2 - index of north facing wall
-    INTEGER(iwp), PARAMETER                        ::  iwest  = 3                         !< 3 - index of west facing wall
-    INTEGER(iwp), PARAMETER                        ::  ieast  = 4                         !< 4 - index of east facing wall
-    INTEGER(iwp), PARAMETER                        ::  isky = 5                           !< 5 - index of top border of the urban surface layer ("urban sky")
-    INTEGER(iwp), PARAMETER                        ::  inorthb = 6                        !< 6 - index of free north border of the domain (south facing)
-    INTEGER(iwp), PARAMETER                        ::  isouthb = 7                        !< 7 - index of north south border of the domain (north facing)
-    INTEGER(iwp), PARAMETER                        ::  ieastb  = 8                        !< 8 - index of east border of the domain (west facing)
-    INTEGER(iwp), PARAMETER                        ::  iwestb  = 9                        !< 9 - index of wast border of the domain (east facing)
-    INTEGER(iwp), DIMENSION(0:9), PARAMETER        ::  idir = (/0,0,0,-1,1,0,0,0,-1,1/)   !< surface normal direction x indices
-    INTEGER(iwp), DIMENSION(0:9), PARAMETER        ::  jdir = (/0,-1,1,0,0,0,-1,1,0,0/)   !< surface normal direction y indices
-    INTEGER(iwp), DIMENSION(0:9), PARAMETER        ::  kdir = (/1,0,0,0,0,-1,0,0,0,0/)    !< surface normal direction z indices
-    REAL(wp), DIMENSION(1:4)                       ::  ddxy2                              !< 1/dx^2 or 1/dy^2 (in surface normal direction)
-    INTEGER(iwp), DIMENSION(1:4,6:9)               ::  ijdb                               !< start and end of the local domain border coordinates (set in code)
-    LOGICAL, DIMENSION(6:9)                        ::  isborder                           !< is PE on the border of the domain in four corresponding directions
-                                                                                          !< parameter but set in the code
-
-!-- indices and sizes of urban surface model
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE      ::  surfl            !< coordinates of i-th local surface in local grid - surfl[:,k] = [d, z, y, x]
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE      ::  surf             !< coordinates of i-th surface in grid - surf[:,k] = [d, z, y, x]
-    INTEGER(iwp)                                   ::  nsurfl           !< number of all surfaces in local processor
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE        ::  nsurfs           !< array of number of all surfaces in individual processors
-    INTEGER(iwp)                                   ::  startsky         !< start index of block of sky
-    INTEGER(iwp)                                   ::  endsky           !< end index of block of sky
-    INTEGER(iwp)                                   ::  nskys            !< number of sky surfaces in local processor
-    INTEGER(iwp)                                   ::  startland        !< start index of block of land and roof surfaces
-    INTEGER(iwp)                                   ::  endland          !< end index of block of land and roof surfaces
-    INTEGER(iwp)                                   ::  nlands           !< number of land and roof surfaces in local processor
-    INTEGER(iwp)                                   ::  startwall        !< start index of block of wall surfaces
-    INTEGER(iwp)                                   ::  endwall          !< end index of block of wall surfaces
-    INTEGER(iwp)                                   ::  nwalls           !< number of wall surfaces in local processor
-    INTEGER(iwp)                                   ::  startenergy      !< start index of block of real surfaces (land, walls and roofs)
-    INTEGER(iwp)                                   ::  endenergy        !< end index of block of real surfaces (land, walls and roofs)
-    INTEGER(iwp)                                   ::  nenergy          !< number of real surfaces in local processor
-    INTEGER(iwp)                                   ::  nsurf            !< global number of surfaces in index array of surfaces (nsurf = Î£proc nsurfs)
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE        ::  surfstart        !< starts of blocks of surfaces for individual processors in array surf
-                                                                        !< respective block for particular processor is surfstart[iproc]+1 : surfstart[iproc+1]
-    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 usm_calc_svf and usm_raytrace
-
-!-- 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            !< 
-        REAL(wp)                                   :: rsvf              !< 
-        REAL(wp)                                   :: rtransp           !< 
-    END TYPE
+
+    CHARACTER(37), DIMENSION(0:6), PARAMETER :: building_type_name = (/     &
+                                   'user-defined                         ', & !  0 
+                                   'residential - 1950                   ', & !  1 
+                                   'residential 1951 - 2000              ', & !  2
+                                   'residential 2001 -                   ', & !  3
+                                   'office - 1950                        ', & !  4 
+                                   'office 1951 - 2000                   ', & !  5
+                                   'office 2001 -                        '  & !  6
+                                                                     /)
+!
+!-- building parameters, 4 different types
+!-- 0 - wall fraction, 1- window fraction, 2 - green fraction on wall, 3- green fraction 
+!-- at roof, 4 - lai of green fraction at roof,  5 - lai of green fraction at wall, 
+!-- 6 - heat capacity of wall layer 1, 7 - heat capacity of wall layer 2, 
+!-- 8 - heat capacity of wall layer 3, 9 - thermal conductivity of wall layer 1, 
+!-- 10 - thermal conductivity of wall layer 2, 11 - thermal conductivity of wall layer 3,  
+!-- 12 - indoor target summer temperature ( K ), 13 - indoor target winter temperature (K),
+!-- 14 - emissivity of wall fraction, 15 - emissivity of green fraction, 16 - emissivity of window fraction,
+!-- 17 - transmissivity of window fraction, 18 - z0, 19 - z0h/z0q, 20 - ground floor height, 
+!-- 21 - ground floor wall fraction, 22 - ground floor window fraction, 23 ground floor green fraction,
+!-- 24 - ground floor green fraction on roof, 25 - ground floor lai of green fraction, 
+!-- 26 - ground floor heat capacity of wall layer 1, 27 - ground floor heat capacity of wall layer 1,
+!-- 28 - ground floor heat capacity of wall layer 3, 29 - ground floor thermal conductivity of wall layer 1,
+!-- 30 - ground floor thermal conductivity of wall layer 2, 31 - ground floor thermal conductivity of wall layer 3,
+!-- 32 - ground floor emissivity of wall fraction, 33 - ground floor emissivity of green fraction,
+!-- 34 - ground floor emissivity of window fraction, 35 - ground floor transmissivity of window fraction, 
+!-- 36 - ground floor z0, 37 - ground floor z0h/z0q, 38 - albedo type wall fraction
+!-- 39 - albedo type green fraction, 40 - albedo type window fraction
+!-- 41 - wall layer thickness - 1st layer, 42 - wall layer thickness - 2nd layer,
+!-- 43 - wall layer thickness - 3rd layer, 44 - wall layer thickness - 4th layer,
+!-- 45 - heat capacity of the wall surface, 46 - heat conductivity
+!-- Please note, only preleminary dummy values so far!
+    REAL(wp), DIMENSION(0:46,1:6), PARAMETER :: building_pars = RESHAPE( (/    &
+        1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp, 1.0_wp,                        & !parameter 0-5
+        1000000.0_wp, 1000000.0_wp, 1000000.0_wp, 0.3_wp, 0.3_wp, 0.3_wp,      & !parameter 6-11
+        296.15_wp, 293.15_wp, 0.9_wp, 0.9_wp, 0.01_wp, 0.99_wp,                & !parameter 12-17
+        0.01_wp, 0.001_wp, 4.0_wp,                                             & !parameter 18-20
+        1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, 3.0_wp,                                & !parameter 21-25
+        1000000.0_wp, 1000000.0_wp, 1000000.0_wp,                              & !parameter 26-28                     
+        0.3_wp, 0.3_wp, 0.3_wp,                                                & !parameter 29-31       
+        0.4_wp, 0.4_wp, 0.4_wp, 0.4_wp, 0.01_wp, 0.001_wp,                     & !parameter 32-37
+        24.0_wp, 24.0_wp, 24.0_wp,                                             & !parameter 38-40
+        0.0242_wp, 0.0969_wp, 0.346_wp, 1.0_wp,                                & !parameter 41-44
+        20000.0_wp, 10.0_wp,                                                   & !parameter 45-46 - end of type 1
+        1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp, 1.0_wp,                        & !parameter 0-5
+        1000000.0_wp, 1000000.0_wp, 1000000.0_wp, 0.3_wp, 0.3_wp, 0.3_wp,      & !parameter 6-11
+        296.15_wp, 293.15_wp, 0.9_wp, 0.9_wp, 0.01_wp, 0.99_wp,                & !parameter 12-17
+        0.01_wp, 0.001_wp, 4.0_wp,                                             & !parameter 18-20
+        1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, 3.0_wp,                                & !parameter 21-25
+        1000000.0_wp, 1000000.0_wp, 1000000.0_wp,                              & !parameter 26-28                     
+        0.3_wp, 0.3_wp, 0.3_wp,                                                & !parameter 29-31       
+        0.4_wp, 0.4_wp, 0.4_wp, 0.4_wp, 0.01_wp, 0.001_wp,                     & !parameter 32-37
+        24.0_wp, 24.0_wp, 24.0_wp,                                             & !parameter 38-40
+        0.0242_wp, 0.0969_wp, 0.346_wp, 1.0_wp,                                & !parameter 41-44
+        20000.0_wp, 10.0_wp,                                                   & !parameter 45-46 - end of type 2
+        1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp, 1.0_wp,                        & !parameter 0-5
+        1000000.0_wp, 1000000.0_wp, 1000000.0_wp, 0.3_wp, 0.3_wp, 0.3_wp,      & !parameter 6-11
+        296.15_wp, 293.15_wp, 0.9_wp, 0.9_wp, 0.01_wp, 0.99_wp,                & !parameter 12-17
+        0.01_wp, 0.001_wp, 4.0_wp,                                             & !parameter 18-20
+        1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, 3.0_wp,                                & !parameter 21-25
+        1000000.0_wp, 1000000.0_wp, 1000000.0_wp,                              & !parameter 26-28                     
+        0.3_wp, 0.3_wp, 0.3_wp,                                                & !parameter 29-31       
+        0.4_wp, 0.4_wp, 0.4_wp, 0.4_wp, 0.01_wp, 0.001_wp,                     & !parameter 32-37
+        24.0_wp, 24.0_wp, 24.0_wp,                                             & !parameter 38-40
+        0.0242_wp, 0.0969_wp, 0.346_wp, 1.0_wp,                                & !parameter 41-44
+        20000.0_wp, 10.0_wp,                                                   & !parameter 45-46 - end of type 3
+        1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp, 1.0_wp,                        & !parameter 0-5
+        1000000.0_wp, 1000000.0_wp, 1000000.0_wp, 0.3_wp, 0.3_wp, 0.3_wp,      & !parameter 6-11
+        296.15_wp, 293.15_wp, 0.9_wp, 0.9_wp, 0.01_wp, 0.99_wp,                & !parameter 12-17
+        0.01_wp, 0.001_wp, 4.0_wp,                                             & !parameter 18-20
+        1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, 3.0_wp,                                & !parameter 21-25
+        1000000.0_wp, 1000000.0_wp, 1000000.0_wp,                              & !parameter 26-28                     
+        0.3_wp, 0.3_wp, 0.3_wp,                                                & !parameter 29-31       
+        0.4_wp, 0.4_wp, 0.4_wp, 0.4_wp, 0.01_wp, 0.001_wp,                     & !parameter 32-37
+        24.0_wp, 24.0_wp, 24.0_wp,                                             & !parameter 38-40
+        0.0242_wp, 0.0969_wp, 0.346_wp, 1.0_wp,                                & !parameter 41-44
+        20000.0_wp, 10.0_wp,                                                   & !parameter 45-46 - end of type 4
+        1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp, 1.0_wp,                        & !parameter 0-5
+        1000000.0_wp, 1000000.0_wp, 1000000.0_wp, 0.3_wp, 0.3_wp, 0.3_wp,      & !parameter 6-11
+        296.15_wp, 293.15_wp, 0.9_wp, 0.9_wp, 0.01_wp, 0.99_wp,                & !parameter 12-17
+        0.01_wp, 0.001_wp, 4.0_wp,                                             & !parameter 18-20
+        1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, 3.0_wp,                                & !parameter 21-25
+        1000000.0_wp, 1000000.0_wp, 1000000.0_wp,                              & !parameter 26-28                     
+        0.3_wp, 0.3_wp, 0.3_wp,                                                & !parameter 29-31       
+        0.4_wp, 0.4_wp, 0.4_wp, 0.4_wp, 0.01_wp, 0.001_wp,                     & !parameter 32-37
+        24.0_wp, 24.0_wp, 24.0_wp,                                             & !parameter 38-40
+        0.0242_wp, 0.0969_wp, 0.346_wp, 1.0_wp,                                & !parameter 41-44
+        20000.0_wp, 10.0_wp,                                                   & !parameter 45-46 - end of type 5
+        1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, 1.0_wp, 1.0_wp,                        & !parameter 0-5
+        1000000.0_wp, 1000000.0_wp, 1000000.0_wp, 0.3_wp, 0.3_wp, 0.3_wp,      & !parameter 6-11
+        296.15_wp, 293.15_wp, 0.9_wp, 0.9_wp, 0.01_wp, 0.99_wp,                & !parameter 12-17
+        0.01_wp, 0.001_wp, 4.0_wp,                                             & !parameter 18-20
+        1.0_wp, 0.0_wp, 0.0_wp, 0.0_wp, 3.0_wp,                                & !parameter 21-25
+        1000000.0_wp, 1000000.0_wp, 1000000.0_wp,                              & !parameter 26-28                     
+        0.3_wp, 0.3_wp, 0.3_wp,                                                & !parameter 29-31       
+        0.4_wp, 0.4_wp, 0.4_wp, 0.4_wp, 0.01_wp, 0.001_wp,                     & !parameter 32-37
+        24.0_wp, 24.0_wp, 24.0_wp,                                             & !parameter 38-40
+        0.0242_wp, 0.0969_wp, 0.346_wp, 1.0_wp,                                & !parameter 41-44
+        20000.0_wp, 10.0_wp                                                    & !parameter 45-46 - end of type 6
+                                                                          /),  &
+                                                               (/47, 6/) )
+
 !
 !-- Type for surface temperatures at vertical walls. Is not necessary for horizontal walls. 
@@ -324,48 +432,7 @@
     END TYPE t_wall_vertical
 
-!-- arrays for calculation of svf and csf
-    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(:), ALLOCATABLE, TARGET ::  asvf1, asvf2     !< realizations of svf array
-    TYPE(t_csf), DIMENSION(:), ALLOCATABLE, TARGET ::  acsf1, acsf2     !< realizations of csf array
-    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)                                   ::  msvf, mcsf       !< mod for swapping the growing array
-    INTEGER(iwp), PARAMETER                        ::  gasize = 10000   !< initial size of growing arrays
-!-- 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      ::  boxes            !< coordinates of gridboxes being crossed by ray
-    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  crlens           !< array of crossing lengths of ray for particular grid boxes
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE        ::  lad_ip           !< array of numbers of process where lad is stored 
-#if defined( __parallel )
-    INTEGER(kind=MPI_ADDRESS_KIND), &
-                  DIMENSION(:), ALLOCATABLE        ::  lad_disp         !< array of displaycements of lad in local array of proc lad_ip
-#endif
-    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  lad_s_ray        !< array of received lad_s for appropriate gridboxes crossed by ray 
-
-!-- arrays storing the values of USM
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE      ::  svfsurf          !< svfsurf[:,isvf] = index of source and target surface for svf[isvf]
-    REAL(wp), DIMENSION(:,:), ALLOCATABLE          ::  svf              !< array of shape view factors+direct irradiation factors for local surfaces
-    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
-    
-                                                                        !< Inward radiation is also valid for virtual surfaces (radiation leaving domain)
-    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            ::  surfoutsw        !< array of total sw radiation outgoing from nonvirtual surfaces surfaces after all reflection
-    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  surfoutlw        !< array of total lw radiation outgoing from nonvirtual surfaces surfaces after all reflection
-    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  surfhf           !< array of total radiation flux incoming to minus outgoing from local surface
-    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  rad_net_l        !< local copy of rad_net (net radiation at surface)
 
 !-- arrays for time averages
+!-- Attention: the variable rad_net_av is also used in the 3d field variable in radiation_model_mod.f90. It may be better to rename it 
     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
@@ -381,25 +448,12 @@
     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            ::  wshf_eb_av       !< average of wshf_eb
+    REAL(wp), DIMENSION(:,:), ALLOCATABLE          ::  t_wall_av        !< Average of t_wall
+    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  wghf_eb_green_av !< average of wghf_eb_green
+    REAL(wp), DIMENSION(:,:), ALLOCATABLE          ::  t_green_av       !< Average of t_green
+    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  wghf_eb_window_av !< average of wghf_eb_window
+    REAL(wp), DIMENSION(:,:), ALLOCATABLE          ::  t_window_av      !< Average of t_window    
     
-!-- 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)
-                                                                        !< for local surfaces
-    INTEGER(wp), DIMENSION(:,:), ALLOCATABLE       ::  pcbl             !< k,j,i coordinates of l-th local plant canopy box pcbl[:,l] = [k, j, i]
-    INTEGER(iwp), DIMENSION(:,:,:), ALLOCATABLE    ::  gridpcbl         !< index of local pcb[k,j,i]
-    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  pcbinsw          !< array of absorbed sw radiation for local plant canopy box
-    REAL(wp), DIMENSION(:), ALLOCATABLE            ::  pcbinlw          !< array of absorbed lw radiation for local plant canopy box
-    INTEGER(iwp)                                   ::  npcbl            !< number of the plant canopy gridboxes in local processor
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE      ::  pch              !< heights of the plant canopy
-    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE      ::  pct              !< top layer of the plant canopy
-    REAL(wp), DIMENSION(:,:,:), POINTER            ::  usm_lad          !< subset of lad_s within urban surface, transformed to plain Z coordinate
-    REAL(wp), DIMENSION(:), POINTER                ::  usm_lad_g        !< usm_lad globalized (used to avoid MPI RMA calls in raytracing)
-    REAL(wp)                                       ::  prototype_lad    !< prototype leaf area density for computing effective optical depth
-    INTEGER(iwp), DIMENSION(:), ALLOCATABLE        ::  nzterr, plantt   !< temporary global arrays for raytracing
-    
-!-- radiation related arrays (it should be better in interface of radiation module of PALM
-    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
 
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -419,8 +473,19 @@
     REAL(wp), DIMENSION(nzb_wall:nzt_wall)         :: zwn_default = (/0.0242_wp, 0.0969_wp, 0.346_wp, 1.0_wp /)
                                                                          !< normalized soil, wall and roof layer depths (m/m)
+!    REAL(wp), DIMENSION(nzb_wall:nzt_wall)         :: zwn_default = (/0.33_wp, 0.66_wp, 1.0_wp /)
+    REAL(wp), DIMENSION(nzb_wall:nzt_wall)         :: zwn_default_window = (/0.25_wp, 0.5_wp, 0.75_wp, 1.0_wp /)
+!    REAL(wp), DIMENSION(nzb_wall:nzt_wall)         :: zwn_default_window = (/0.33_wp, 0.66_wp, 1.0_wp /)
+!    REAL(wp), DIMENSION(nzb_wall:nzt_wall)         :: zwn_default_window = (/0.0242_wp, 0.0969_wp, 0.346_wp, 1.0_wp /)
+                                                                         !< normalized window layer depths (m/m)
+!    REAL(wp), DIMENSION(nzb_wall:nzt_wall)         :: zwn_default_green = (/0.0242_wp, 0.0969_wp, 0.346_wp, 1.0_wp /)
+                                                                         !< normalized green layer depths (m/m)
+    REAL(wp), DIMENSION(nzb_wall:nzt_wall)         :: zwn_default_green = (/0.25_wp, 0.5_wp, 0.75_wp, 1.0_wp /)
+!    REAL(wp), DIMENSION(nzb_wall:nzt_wall)         :: zwn_default_green = (/0.33_wp, 0.66_wp, 1.0_wp /)
+
                                                                         
     REAL(wp)                                       ::   wall_inner_temperature = 296.0_wp    !< temperature of the inner wall surface (~23 degrees C) (K)
     REAL(wp)                                       ::   roof_inner_temperature = 296.0_wp    !< temperature of the inner roof surface (~23 degrees C) (K)
     REAL(wp)                                       ::   soil_inner_temperature = 283.0_wp    !< temperature of the deep soil (~10 degrees C) (K)
+    REAL(wp)                                       ::   window_inner_temperature = 296.0_wp  !< temperature of the inner window surface (~23 degrees C) (K)
 
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -428,28 +493,84 @@
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
     REAL(wp), DIMENSION(:), ALLOCATABLE            :: zwn                !< normalized wall layer depths (m)
+    REAL(wp), DIMENSION(:), ALLOCATABLE            :: zwn_window         !< normalized window layer depths (m)
+    REAL(wp), DIMENSION(:), ALLOCATABLE            :: zwn_green          !< normalized green layer depths (m)
 
 #if defined( __nopointer )
     REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_h           !< wall surface temperature (K) at horizontal walls
     REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_h_p         !< progn. wall surface temperature (K) at horizontal walls
-
+    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_window_h    !< window surface temperature (K) at horizontal walls
+    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_window_h_p  !< progn. window surface temperature (K) at horizontal walls
+    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_green_h     !< green surface temperature (K) at horizontal walls
+    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_green_h_p   !< progn. green surface temperature (K) at horizontal walls
+    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_whole_h     !< whole surface temperature (K) at horizontal walls
+    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_whole_h_p   !< progn. whole surface temperature (K) at horizontal walls
+    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_10cm_h      !< near surface temperature (10cm) (K) at horizontal walls
+    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_10cm_h_p    !< progn. near surface temperature (10cm) (K) at horizontal walls
     TYPE(t_surf_vertical), DIMENSION(0:3), TARGET  ::  t_surf_v
     TYPE(t_surf_vertical), DIMENSION(0:3), TARGET  ::  t_surf_v_p
+    TYPE(t_surf_vertical), DIMENSION(0:3), TARGET  ::  t_surf_window_v
+    TYPE(t_surf_vertical), DIMENSION(0:3), TARGET  ::  t_surf_window_v_p
+    TYPE(t_surf_vertical), DIMENSION(0:3), TARGET  ::  t_surf_green_v
+    TYPE(t_surf_vertical), DIMENSION(0:3), TARGET  ::  t_surf_green_v_p
+    TYPE(t_surf_vertical), DIMENSION(0:3), TARGET  ::  t_surf_whole_v
+    TYPE(t_surf_vertical), DIMENSION(0:3), TARGET  ::  t_surf_whole_v_p
+    TYPE(t_surf_vertical), DIMENSION(0:3), TARGET  ::  t_surf_10cm_v
+    TYPE(t_surf_vertical), DIMENSION(0:3), TARGET  ::  t_surf_10cm_v_p
 #else
     REAL(wp), DIMENSION(:), POINTER                :: t_surf_h
     REAL(wp), DIMENSION(:), POINTER                :: t_surf_h_p 
+    REAL(wp), DIMENSION(:), POINTER                :: t_surf_window_h
+    REAL(wp), DIMENSION(:), POINTER                :: t_surf_window_h_p 
+    REAL(wp), DIMENSION(:), POINTER                :: t_surf_green_h
+    REAL(wp), DIMENSION(:), POINTER                :: t_surf_green_h_p 
+    REAL(wp), DIMENSION(:), POINTER                :: t_surf_whole_h
+    REAL(wp), DIMENSION(:), POINTER                :: t_surf_whole_h_p 
+    REAL(wp), DIMENSION(:), POINTER                :: t_surf_10cm_h
+    REAL(wp), DIMENSION(:), POINTER                :: t_surf_10cm_h_p
 
     REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_h_1
     REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_h_2
+    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_window_h_1
+    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_window_h_2
+    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_green_h_1
+    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_green_h_2
+    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_whole_h_1
+    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_whole_h_2
+    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_10cm_h_1
+    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_10cm_h_2
 
     TYPE(t_surf_vertical), DIMENSION(:), POINTER ::  t_surf_v
     TYPE(t_surf_vertical), DIMENSION(:), POINTER ::  t_surf_v_p
+    TYPE(t_surf_vertical), DIMENSION(:), POINTER ::  t_surf_window_v
+    TYPE(t_surf_vertical), DIMENSION(:), POINTER ::  t_surf_window_v_p
+    TYPE(t_surf_vertical), DIMENSION(:), POINTER ::  t_surf_green_v
+    TYPE(t_surf_vertical), DIMENSION(:), POINTER ::  t_surf_green_v_p
+    TYPE(t_surf_vertical), DIMENSION(:), POINTER ::  t_surf_whole_v
+    TYPE(t_surf_vertical), DIMENSION(:), POINTER ::  t_surf_whole_v_p
+    TYPE(t_surf_vertical), DIMENSION(:), POINTER ::  t_surf_10cm_v
+    TYPE(t_surf_vertical), DIMENSION(:), POINTER ::  t_surf_10cm_v_p
 
     TYPE(t_surf_vertical), DIMENSION(0:3), TARGET  :: t_surf_v_1
     TYPE(t_surf_vertical), DIMENSION(0:3), TARGET  :: t_surf_v_2
+    TYPE(t_surf_vertical), DIMENSION(0:3), TARGET  :: t_surf_window_v_1
+    TYPE(t_surf_vertical), DIMENSION(0:3), TARGET  :: t_surf_window_v_2
+    TYPE(t_surf_vertical), DIMENSION(0:3), TARGET  :: t_surf_green_v_1
+    TYPE(t_surf_vertical), DIMENSION(0:3), TARGET  :: t_surf_green_v_2
+    TYPE(t_surf_vertical), DIMENSION(0:3), TARGET  :: t_surf_whole_v_1
+    TYPE(t_surf_vertical), DIMENSION(0:3), TARGET  :: t_surf_whole_v_2
+    TYPE(t_surf_vertical), DIMENSION(0:3), TARGET  :: t_surf_10cm_v_1
+    TYPE(t_surf_vertical), DIMENSION(0:3), TARGET  :: t_surf_10cm_v_2
+    
 #endif
     REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_av          !< average of wall surface temperature (K)
+    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_window_av   !< average of window surface temperature (K)
+    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_green_av    !< average of green wall surface temperature (K)
+    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_whole_av    !< average of whole wall surface temperature (K)
+    REAL(wp), DIMENSION(:), ALLOCATABLE, TARGET    :: t_surf_10cm_av    !< average of whole wall surface temperature (K)
 
 !-- Temporal tendencies for time stepping            
-    REAL(wp), DIMENSION(:), ALLOCATABLE            :: tt_surface_m       !< surface temperature tendency (K)
+    REAL(wp), DIMENSION(:), ALLOCATABLE            :: tt_surface_m       !< surface temperature tendency of wall (K)
+    REAL(wp), DIMENSION(:), ALLOCATABLE            :: tt_surface_window_m !< surface temperature tendency of window (K)
+    REAL(wp), DIMENSION(:), ALLOCATABLE            :: tt_surface_green_m !< surface temperature tendency of green wall (K)
 
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
@@ -457,7 +578,4 @@
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 !-- parameters of the land, roof and wall surfaces
-    REAL(wp), DIMENSION(:), ALLOCATABLE            :: albedo_surf        !< albedo of the surface
-!-- parameters of the wall surfaces
-    REAL(wp), DIMENSION(:), ALLOCATABLE            :: emiss_surf         !< emissivity of the wall surface
 
 #if defined( __nopointer )
@@ -465,18 +583,40 @@
     REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET    :: t_wall_h_av          !< Average of t_wall
     REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET    :: t_wall_h_p           !< Prog. wall temperature (K)
+    REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET    :: t_window_h           !< Window temperature (K)
+    REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET    :: t_window_h_av        !< Average of t_window
+    REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET    :: t_window_h_p         !< Prog. window temperature (K)
+    REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET    :: t_green_h            !< Green temperature (K)
+    REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET    :: t_green_h_av         !< Average of t_green
+    REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET    :: t_green_h_p          !< Prog. green temperature (K)
 
     TYPE(t_wall_vertical), DIMENSION(0:3), TARGET  :: t_wall_v             !< Wall temperature (K)
     TYPE(t_wall_vertical), DIMENSION(0:3), TARGET  :: t_wall_v_av          !< Average of t_wall
     TYPE(t_wall_vertical), DIMENSION(0:3), TARGET  :: t_wall_v_p           !< Prog. wall temperature (K)
+    TYPE(t_wall_vertical), DIMENSION(0:3), TARGET  :: t_window_v           !< Window temperature (K)
+    TYPE(t_wall_vertical), DIMENSION(0:3), TARGET  :: t_window_v_av        !< Average of t_window
+    TYPE(t_wall_vertical), DIMENSION(0:3), TARGET  :: t_window_v_p         !< Prog. window temperature (K)
+    TYPE(t_wall_vertical), DIMENSION(0:3), TARGET  :: t_green_v            !< Green temperature (K)
+    TYPE(t_wall_vertical), DIMENSION(0:3), TARGET  :: t_green_v_av         !< Average of t_green
+    TYPE(t_wall_vertical), DIMENSION(0:3), TARGET  :: t_green_v_p          !< Prog. green temperature (K)
 #else
     REAL(wp), DIMENSION(:,:), POINTER                :: t_wall_h, t_wall_h_p
     REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET    :: t_wall_h_av, t_wall_h_1, t_wall_h_2
+    REAL(wp), DIMENSION(:,:), POINTER                :: t_window_h, t_window_h_p
+    REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET    :: t_window_h_av, t_window_h_1, t_window_h_2
+    REAL(wp), DIMENSION(:,:), POINTER                :: t_green_h, t_green_h_p
+    REAL(wp), DIMENSION(:,:), ALLOCATABLE, TARGET    :: t_green_h_av, t_green_h_1, t_green_h_2
 
     TYPE(t_wall_vertical), DIMENSION(:), POINTER   :: t_wall_v, t_wall_v_p
     TYPE(t_wall_vertical), DIMENSION(0:3), TARGET  :: t_wall_v_av, t_wall_v_1, t_wall_v_2
+    TYPE(t_wall_vertical), DIMENSION(:), POINTER   :: t_window_v, t_window_v_p
+    TYPE(t_wall_vertical), DIMENSION(0:3), TARGET  :: t_window_v_av, t_window_v_1, t_window_v_2
+    TYPE(t_wall_vertical), DIMENSION(:), POINTER   :: t_green_v, t_green_v_p
+    TYPE(t_wall_vertical), DIMENSION(0:3), TARGET  :: t_green_v_av, t_green_v_1, t_green_v_2
 #endif
 
 !-- Wall temporal tendencies for time stepping
     REAL(wp), DIMENSION(:,:), ALLOCATABLE          :: tt_wall_m          !< t_wall prognostic array 
+    REAL(wp), DIMENSION(:,:), ALLOCATABLE          :: tt_window_m        !< t_window prognostic array 
+    REAL(wp), DIMENSION(:,:), ALLOCATABLE          :: tt_green_m         !< t_green prognostic array 
 
 !-- Surface and material parameters classes (surface_type)
@@ -495,8 +635,11 @@
     INTEGER(iwp), DIMENSION(:), ALLOCATABLE        :: surface_type_codes   !< codes of wall types
     REAL(wp), DIMENSION(:,:), ALLOCATABLE          :: surface_params       !< parameters of wall types
-    
-    CHARACTER(len=*), PARAMETER                    :: svf_file_name='usm_svf'
+
     
 !-- interfaces of subroutines accessed from outside of this module
+    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
@@ -523,12 +666,16 @@
     END INTERFACE usm_material_heat_model
     
+    INTERFACE usm_green_heat_model
+       MODULE PROCEDURE usm_green_heat_model
+    END INTERFACE usm_green_heat_model
+    
     INTERFACE usm_parin
        MODULE PROCEDURE usm_parin
     END INTERFACE usm_parin
-
-    INTERFACE usm_radiation
-       MODULE PROCEDURE usm_radiation
-    END INTERFACE usm_radiation
     
+    INTERFACE usm_temperature_near_surface
+       MODULE PROCEDURE usm_temperature_near_surface
+    END INTERFACE usm_temperature_near_surface
+
     INTERFACE usm_read_restart_data 
        MODULE PROCEDURE usm_read_restart_data
@@ -546,4 +693,13 @@
        MODULE PROCEDURE usm_write_restart_data
     END INTERFACE usm_write_restart_data
+
+    INTERFACE usm_allocate_surface
+       MODULE PROCEDURE usm_allocate_surface
+    END INTERFACE usm_allocate_surface
+
+    INTERFACE usm_average_3d_data
+       MODULE PROCEDURE usm_average_3d_data
+    END INTERFACE usm_average_3d_data
+
     
     SAVE
@@ -551,22 +707,20 @@
     PRIVATE 
     
+!-- Public functions
+    PUBLIC usm_boundary_condition, usm_check_parameters, usm_init_urban_surface,&
+           usm_read_restart_data,                                               & 
+           usm_surface_energy_balance, usm_material_heat_model,                 &
+           usm_swap_timelevel, usm_check_data_output, usm_average_3d_data,      &
+           usm_data_output_3d, usm_define_netcdf_grid, usm_parin,               &
+           usm_write_restart_data, usm_allocate_surface
+
 !-- Public parameters, constants and initial values
-    PUBLIC split_diffusion_radiation,                                          &
-           usm_anthropogenic_heat, usm_material_model, mrt_factors,            &
-           usm_check_parameters,                                               &
-           usm_energy_balance_land, usm_energy_balance_wall, nrefsteps,        &
-           usm_init_urban_surface, usm_radiation, usm_read_restart_data,       &
-           usm_surface_energy_balance, usm_material_heat_model,                &
-           usm_swap_timelevel, usm_check_data_output, usm_average_3d_data,     &
-           usm_data_output_3d, usm_define_netcdf_grid, usm_parin,              &
-           usm_write_restart_data,                                             &
-           nzub, nzut, ra_horiz_coef, usm_lad_rma,                             &
-           land_category, pedestrant_category, wall_category, roof_category,   &
-           write_svf_on_init, read_svf_on_init
+    PUBLIC usm_anthropogenic_heat, usm_material_model, ra_horiz_coef,           &
+           usm_green_heat_model, usm_temperature_near_surface
+
 
 
  CONTAINS
 
- 
 !------------------------------------------------------------------------------!
 ! Description:
@@ -575,318 +729,9 @@
 !> and plant canopy and it allocates the needed arrays for USM
 !------------------------------------------------------------------------------!
-    SUBROUTINE usm_allocate_urban_surface
+    SUBROUTINE usm_allocate_surface
     
         IMPLICIT NONE
        
-        INTEGER(iwp) :: i, j, k, d, l, ir, jr, ids, m
-        INTEGER(iwp) :: k_topo     !< vertical index indicating topography top for given (j,i)
-        INTEGER(iwp) :: k_topo2    !< vertical index indicating topography top for given (j,i)
-        INTEGER(iwp) :: nzubl, nzutl, isurf, ipcgb
-        INTEGER(iwp) :: procid
-
-        
-
-        
-!--     auxiliary vars
-        ddxy2 = (/ddy2,ddy2,ddx2,ddx2/)      !< 1/dx^2 or 1/dy^2 (in surface normal direction)
-        
-        CALL location_message( '', .TRUE. )
-        CALL location_message( '    allocation of needed arrays', .TRUE. )
-!
-!--     Find nzub, nzut, nzu 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(                                                        &
-                    MAXLOC(                                                    &
-                          MERGE( 1, 0,                                         &
-                                 BTEST( wall_flags_0(:,nys:nyn,nxl:nxr), 12 )  &
-                               ), DIM = 1                                      &
-                          ) - 1                                                & 
-                            )
-        nzutl = MAXVAL(                                                        &
-                   MAXLOC(                                                     &
-                          MERGE( 1, 0,                                         &
-                                 BTEST( wall_flags_0(:,nys:nyn,nxl:nxr), 12 )  &
-                               ), DIM = 1                                      &
-                          ) - 1                                                &
-                            )
-        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.0_wp
-            pch = 0.0_wp
-            DO i = nxl, nxr
-                DO j = nys, nyn
-!
-!--                 Find topography top index
-                    k_topo = get_topography_top_index( j, i, 's' )
-
-                    DO k = nzt+1, 0, -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 + pch(j,i)
-                            EXIT
-                        ENDIF
-                    ENDDO
-                ENDDO
-            ENDDO
-            
-            nzutl = max(nzutl, maxval(pct))
-!--         code of plant canopy model uses parameter pch_index
-!--         we need to setup it here to right value
-!--         (pch_index, lad_s and other arrays in PCM are defined flat)
-            pch_index = maxval(pch)
-
-            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('usm_init_urban_surface', 'PA0520', 0, 0, -1, 6, 0)
-        ENDIF
-        
-        nzutl = min(nzutl+nzut_free, nzt)
-                  
-#if defined( __parallel )
-        CALL MPI_AllReduce(nzubl,nzub,1,MPI_INTEGER,MPI_MIN,comm2d,ierr);
-        CALL MPI_AllReduce(nzutl,nzut,1,MPI_INTEGER,MPI_MAX,comm2d,ierr);
-#else
-        nzub = nzubl
-        nzut = nzutl
-#endif
-
-!--     global number of urban layers
-        nzu = nzut - nzub + 1
-        
-!--     allocate urban surfaces grid
-!--     calc number of surfaces in local proc
-        CALL location_message( '    calculation of indices for surfaces', .TRUE. )
-        nsurfl = 0
-!
-!--     Number of land- and roof surfaces. Note, since horizontal surface elements
-!--     are already counted in surface_mod, in case be simply reused here.
-        startland = 1
-        nsurfl    = surf_usm_h%ns
-        endland   = nsurfl
-        nlands    = endland-startland+1
-
-!
-!--     Number of vertical surfaces. As vertical surfaces are already 
-!--     counted in surface mod, it can be reused here. 
-        startwall = nsurfl+1
-        nsurfl = nsurfl + surf_usm_v(0)%ns + surf_usm_v(1)%ns +        &
-                          surf_usm_v(2)%ns + surf_usm_v(3)%ns 
-        endwall = nsurfl
-        nwalls = endwall-startwall+1
-
-        
-!--     range of energy balance surfaces  ! will be treated separately by surf_usm_h and surf_usm_v
-        nenergy = 0
-        IF ( usm_energy_balance_land )  THEN
-            startenergy = startland
-            nenergy = nenergy + nlands
-        ELSE
-            startenergy = startwall
-        ENDIF
-        IF ( usm_energy_balance_wall )  THEN
-            endenergy = endwall
-            nenergy = nenergy + nwalls
-        ELSE
-            endenergy = endland
-        ENDIF
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!--     block of virtual surfaces
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!--     calculate sky surfaces  ! not used so far!
-        startsky = nsurfl+1
-        nsurfl = nsurfl+(nxr-nxl+1)*(nyn-nys+1)
-        endsky = nsurfl
-        nskys = endsky-startsky+1
-        
-!--     border flags
-#if defined( __parallel )
-        isborder = (/ north_border_pe, south_border_pe, right_border_pe, left_border_pe /)
-#else
-        isborder = (/.TRUE.,.TRUE.,.TRUE.,.TRUE./)
-#endif
-!--     fill array of the limits of the local domain borders
-        ijdb = RESHAPE( (/ nxl,nxr,nyn,nyn,nxl,nxr,nys,nys,nxr,nxr,nys,nyn,nxl,nxl,nys,nyn /), (/4, 4/) )
-!--     calulation of the free borders of the domain
-        DO  ids = 6,9
-           IF ( isborder(ids) )  THEN
-!--           free border of the domain in direction ids
-              DO  i = ijdb(1,ids), ijdb(2,ids)
-                 DO  j = ijdb(3,ids), ijdb(4,ids)
-
-                    k_topo  = get_topography_top_index( j, i, 's' )
-                    k_topo2 = get_topography_top_index( j-jdir(ids), i-idir(ids), 's' )
-
-                    k = nzut - MAX( k_topo, k_topo2 )
-                    nsurfl = nsurfl + k
-                 ENDDO
-              ENDDO
-           ENDIF
-        ENDDO
-        
-!--     fill gridpcbl and pcbl
-        IF ( plant_canopy )  THEN
-            ALLOCATE( pcbl(iz:ix, 1:npcbl) )
-            ALLOCATE( gridpcbl(nzub:nzut,nys:nyn,nxl:nxr) )
-            gridpcbl(:,:,:) = 0
-            ipcgb = 0
-            DO i = nxl, nxr
-                DO j = nys, nyn
-!
-!--                 Find topography top index
-                    k_topo = get_topography_top_index( j, i, 's' )
-
-                    DO k = k_topo + 1, pct(j,i)
-                        ipcgb = ipcgb + 1
-                        gridpcbl(k,j,i) = ipcgb
-                        pcbl(:,ipcgb) = (/ k, j, i /)
-                    ENDDO
-                ENDDO
-            ENDDO
-
-            ALLOCATE( pcbinsw( 1:npcbl ) )
-            ALLOCATE( pcbinlw( 1:npcbl ) )
-        ENDIF
-
-!--     fill surfl
-        ALLOCATE(surfl(5,nsurfl))
-        isurf = 0
-        
-!--     add land surfaces or roofs
-        DO i = nxl, nxr
-            DO j = nys, nyn
-               DO  m = surf_usm_h%start_index(j,i), surf_usm_h%end_index(j,i)
-                  k = surf_usm_h%k(m)
-
-                  isurf = isurf + 1
-                  surfl(:,isurf) = (/iroof,k,j,i,m/)
-               ENDDO
-            ENDDO
-        ENDDO
-
-!--     add walls
-        DO i = nxl, nxr
-            DO j = nys, nyn
-               l = 0
-               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) = (/2,k,j,i,m/)
-               ENDDO
-               l = 1
-               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) = (/1,k,j,i,m/)
-               ENDDO
-               l = 2
-               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) = (/4,k,j,i,m/)
-               ENDDO
-               l = 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) = (/3,k,j,i,m/)
-               ENDDO
-            ENDDO
-        ENDDO
-
-!--     add sky
-        DO i = nxl, nxr
-            DO j = nys, nyn
-                isurf = isurf + 1
-                k = nzut
-                surfl(:,isurf) = (/isky,k,j,i,-1/)
-            ENDDO
-        ENDDO
-        
-!--     calulation of the free borders of the domain
-        DO ids = 6,9
-            IF ( isborder(ids) )  THEN
-!--             free border of the domain in direction ids
-                DO i = ijdb(1,ids), ijdb(2,ids)
-                    DO j = ijdb(3,ids), ijdb(4,ids)
-                        k_topo  = get_topography_top_index( j, i, 's' )
-                        k_topo2 = get_topography_top_index( j-jdir(ids), i-idir(ids), 's' )
-
-                        DO k = MAX(k_topo,k_topo2)+1, nzut
-                            isurf = isurf + 1
-                            surfl(:,isurf) = (/ids,k,j,i,-1/)
-                        ENDDO
-                    ENDDO
-                ENDDO
-            ENDIF
-        ENDDO
-        
-!--     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)
-#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
-        ALLOCATE(surf(5,nsurf))
-        
-#if defined( __parallel )
-        CALL MPI_AllGatherv(surfl, nsurfl*5, MPI_INTEGER, surf, nsurfs*5, surfstart*5, MPI_INTEGER, comm2d, ierr)
-#else
-        surf = surfl
-#endif
-        
-!--
-!--     allocation of the arrays for direct and diffusion radiation
-        CALL location_message( '    allocation of radiation arrays', .TRUE. )
-!--     rad_sw_in, rad_lw_in are computed in radiation model,
-!--     splitting of direct and diffusion part is done
-!--     in usm_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) )
-        
-!--     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(startenergy:endenergy) )
-        ALLOCATE( surfoutll(startenergy:endenergy) )
-        ALLOCATE( surfoutsw(startenergy:endenergy) )
-        ALLOCATE( surfoutlw(startenergy:endenergy) )
-        ALLOCATE( surfouts(nsurf) ) !TODO: global surfaces without virtual
-        ALLOCATE( surfoutl(nsurf) ) !TODO: global surfaces without virtual
-
-
+        INTEGER(iwp) ::  l
 
 !
@@ -896,18 +741,8 @@
         ALLOCATE( surf_usm_h%rad_net_l(1:surf_usm_h%ns) )
 !
-!--  New
-        ALLOCATE( surf_usm_h%rad_in_sw(1:surf_usm_h%ns)  )
-        ALLOCATE( surf_usm_h%rad_out_sw(1:surf_usm_h%ns) )
-        ALLOCATE( surf_usm_h%rad_in_lw(1:surf_usm_h%ns)  )
-        ALLOCATE( surf_usm_h%rad_out_lw(1:surf_usm_h%ns) )
-!
 !--     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) )
-           ALLOCATE( surf_usm_v(l)%rad_in_sw(1:surf_usm_v(l)%ns)  )
-           ALLOCATE( surf_usm_v(l)%rad_out_sw(1:surf_usm_v(l)%ns) )
-           ALLOCATE( surf_usm_v(l)%rad_in_lw(1:surf_usm_v(l)%ns)  )
-           ALLOCATE( surf_usm_v(l)%rad_out_lw(1:surf_usm_v(l)%ns) )
         ENDDO
 
@@ -920,43 +755,92 @@
            ALLOCATE( surf_usm_v(l)%surface_types(1:surf_usm_v(l)%ns) )
         ENDDO
-       
-!--     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
-        ALLOCATE ( surf_usm_h%albedo_surf(1:surf_usm_h%ns) )
+!
+!--     Allocate albedo_type and albedo. Each surface element
+!--     has 3 values, 0: wall fraction, 1: green fraction, 2: window fraction.
+        ALLOCATE( surf_usm_h%albedo_type(0:2,1:surf_usm_h%ns) )
+        ALLOCATE( surf_usm_h%albedo(0:2,1:surf_usm_h%ns)      )
+        surf_usm_h%albedo_type = albedo_type
         DO  l = 0, 3
-           ALLOCATE( surf_usm_v(l)%albedo_surf(1:surf_usm_v(l)%ns) )
-        ENDDO
+           ALLOCATE( surf_usm_v(l)%albedo_type(0:2,1:surf_usm_v(l)%ns) )
+           ALLOCATE( surf_usm_v(l)%albedo(0:2,1:surf_usm_v(l)%ns)      )
+           surf_usm_v(l)%albedo_type = albedo_type
+        ENDDO       
+
+
+!
+!--     Allocate indoor target temperature for summer and winter
+        ALLOCATE( surf_usm_h%target_temp_summer(1:surf_usm_h%ns) )
+        ALLOCATE( surf_usm_h%target_temp_winter(1:surf_usm_h%ns) )
+        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   
+!
+!--     Allocate flag indicating ground floor level surface elements
+        ALLOCATE ( surf_usm_h%ground_level(1:surf_usm_h%ns) ) 
+        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
+         ALLOCATE( surf_usm_h%frac(0:2,1:surf_usm_h%ns) )
+         surf_usm_h%frac = 0.0_wp
+         DO  l = 0, 3
+            ALLOCATE( surf_usm_v(l)%frac(0:2,1:surf_usm_v(l)%ns) )
+            surf_usm_v(l)%frac = 0.0_wp
+         ENDDO
        
 !--     wall and roof surface parameters. First for horizontal surfaces
-        ALLOCATE ( emiss_surf(startenergy:endenergy) )
-
-        ALLOCATE ( surf_usm_h%isroof_surf(1:surf_usm_h%ns)    )
-        ALLOCATE ( surf_usm_h%emiss_surf(1:surf_usm_h%ns)     )
-        ALLOCATE ( surf_usm_h%lambda_surf(1:surf_usm_h%ns)    )
-        ALLOCATE ( surf_usm_h%c_surface(1:surf_usm_h%ns)      )
-        ALLOCATE ( surf_usm_h%roughness_wall(1:surf_usm_h%ns) )
+        ALLOCATE ( surf_usm_h%isroof_surf(1:surf_usm_h%ns)     )
+        ALLOCATE ( surf_usm_h%lambda_surf(1:surf_usm_h%ns)     )
+        ALLOCATE ( surf_usm_h%lambda_surf_window(1:surf_usm_h%ns) )
+        ALLOCATE ( surf_usm_h%lambda_surf_green(1:surf_usm_h%ns)  )
+        ALLOCATE ( surf_usm_h%c_surface(1:surf_usm_h%ns)       )
+        ALLOCATE ( surf_usm_h%c_surface_window(1:surf_usm_h%ns)   )
+        ALLOCATE ( surf_usm_h%c_surface_green(1:surf_usm_h%ns)    )
+        ALLOCATE ( surf_usm_h%transmissivity(1:surf_usm_h%ns)  )
+        ALLOCATE ( surf_usm_h%lai(1:surf_usm_h%ns)             )
+        ALLOCATE ( surf_usm_h%emissivity(0:2,1:surf_usm_h%ns)  )
+
 !
 !--     For vertical surfaces.
         DO  l = 0, 3
-           ALLOCATE ( surf_usm_v(l)%emiss_surf(1:surf_usm_v(l)%ns)     )
-           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)%roughness_wall(1:surf_usm_v(l)%ns) )
+           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(0:2,1:surf_usm_v(l)%ns)  )
         ENDDO
-       
+
+!       
 !--     allocate wall and roof material parameters. First for horizontal surfaces
         ALLOCATE ( surf_usm_h%thickness_wall(1:surf_usm_h%ns)               )
+        ALLOCATE ( surf_usm_h%thickness_window(1:surf_usm_h%ns)                  )
+        ALLOCATE ( surf_usm_h%thickness_green(1:surf_usm_h%ns)                   )
         ALLOCATE ( surf_usm_h%lambda_h(nzb_wall:nzt_wall,1:surf_usm_h%ns)   )
         ALLOCATE ( surf_usm_h%rho_c_wall(nzb_wall:nzt_wall,1:surf_usm_h%ns) )
+        ALLOCATE ( surf_usm_h%lambda_h_window(nzb_wall:nzt_wall,1:surf_usm_h%ns) )
+        ALLOCATE ( surf_usm_h%rho_c_window(nzb_wall:nzt_wall,1:surf_usm_h%ns)    )
+        ALLOCATE ( surf_usm_h%lambda_h_green(nzb_wall:nzt_wall,1:surf_usm_h%ns)  )
+        ALLOCATE ( surf_usm_h%rho_c_green(nzb_wall:nzt_wall,1:surf_usm_h%ns)     )
+
 !
 !--     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
 
@@ -964,16 +848,38 @@
         ALLOCATE ( zwn(nzb_wall:nzt_wall) )
         ALLOCATE ( surf_usm_h%dz_wall(nzb_wall:nzt_wall+1,1:surf_usm_h%ns)     )
+        ALLOCATE ( zwn_window(nzb_wall:nzt_wall) )
+        ALLOCATE ( surf_usm_h%dz_window(nzb_wall:nzt_wall+1,1:surf_usm_h%ns)     )
+        ALLOCATE ( zwn_green(nzb_wall:nzt_wall) )
+        ALLOCATE ( surf_usm_h%dz_green(nzb_wall:nzt_wall+1,1:surf_usm_h%ns)      )
         ALLOCATE ( surf_usm_h%ddz_wall(nzb_wall:nzt_wall+1,1:surf_usm_h%ns)    )
         ALLOCATE ( surf_usm_h%dz_wall_stag(nzb_wall:nzt_wall,1:surf_usm_h%ns)  )
         ALLOCATE ( surf_usm_h%ddz_wall_stag(nzb_wall:nzt_wall,1:surf_usm_h%ns) )
         ALLOCATE ( surf_usm_h%zw(nzb_wall:nzt_wall,1:surf_usm_h%ns)            )
+        ALLOCATE ( surf_usm_h%ddz_window(nzb_wall:nzt_wall+1,1:surf_usm_h%ns)    )
+        ALLOCATE ( surf_usm_h%dz_window_stag(nzb_wall:nzt_wall,1:surf_usm_h%ns)  )
+        ALLOCATE ( surf_usm_h%ddz_window_stag(nzb_wall:nzt_wall,1:surf_usm_h%ns) )
+        ALLOCATE ( surf_usm_h%zw_window(nzb_wall:nzt_wall,1:surf_usm_h%ns)       )
+        ALLOCATE ( surf_usm_h%ddz_green(nzb_wall:nzt_wall+1,1:surf_usm_h%ns)     )
+        ALLOCATE ( surf_usm_h%dz_green_stag(nzb_wall:nzt_wall,1:surf_usm_h%ns)   )
+        ALLOCATE ( surf_usm_h%ddz_green_stag(nzb_wall:nzt_wall,1:surf_usm_h%ns)  )
+        ALLOCATE ( surf_usm_h%zw_green(nzb_wall:nzt_wall,1:surf_usm_h%ns)        )
 !
 !--     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
 
@@ -988,4 +894,28 @@
         IF ( .NOT. ALLOCATED( t_wall_h_p ) )                                   &           
            ALLOCATE ( t_wall_h_p(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )  
+        IF ( .NOT. ALLOCATED( t_surf_window_h ) )                              &
+           ALLOCATE ( t_surf_window_h(1:surf_usm_h%ns) )
+        IF ( .NOT. ALLOCATED( t_surf_window_h_p ) )                            &
+           ALLOCATE ( t_surf_window_h_p(1:surf_usm_h%ns) )
+        IF ( .NOT. ALLOCATED( t_window_h ) )                                   &           
+           ALLOCATE ( t_window_h(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) ) 
+        IF ( .NOT. ALLOCATED( t_window_h_p ) )                                 &           
+           ALLOCATE ( t_window_h_p(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )  
+        IF ( .NOT. ALLOCATED( t_surf_green_h ) )                               &
+           ALLOCATE ( t_surf_green_h(1:surf_usm_h%ns) )
+        IF ( .NOT. ALLOCATED( t_surf_green_h_p ) )                             &
+           ALLOCATE ( t_surf_green_h_p(1:surf_usm_h%ns) )           
+        IF ( .NOT. ALLOCATED( t_green_h ) )                                    &           
+           ALLOCATE ( t_green_h(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) ) 
+        IF ( .NOT. ALLOCATED( t_green_h_p ) )                                  &           
+           ALLOCATE ( t_green_h_p(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )  
+        IF ( .NOT. ALLOCATED( t_surf_whole_h ) )                               &
+           ALLOCATE ( t_surf_whole_h(1:surf_usm_h%ns) )
+        IF ( .NOT. ALLOCATED( t_surf_whole_h_p ) )                             &
+           ALLOCATE ( t_surf_whole_h_p(1:surf_usm_h%ns) )           
+        IF ( .NOT. ALLOCATED( t_surf_10cm_h ) )                                &
+           ALLOCATE ( t_surf_10cm_h(1:surf_usm_h%ns) )
+        IF ( .NOT. ALLOCATED( t_surf_10cm_h_p ) )                              &
+           ALLOCATE ( t_surf_10cm_h_p(1:surf_usm_h%ns) )
 #else
 !
@@ -1000,8 +930,39 @@
         IF ( .NOT. ALLOCATED( t_wall_h_2 ) )                                   &           
            ALLOCATE ( t_wall_h_2(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )          
+        IF ( .NOT. ALLOCATED( t_surf_window_h_1 ) )                            &
+           ALLOCATE ( t_surf_window_h_1(1:surf_usm_h%ns) )
+        IF ( .NOT. ALLOCATED( t_surf_window_h_2 ) )                            &
+           ALLOCATE ( t_surf_window_h_2(1:surf_usm_h%ns) )
+        IF ( .NOT. ALLOCATED( t_window_h_1 ) )                                 &           
+           ALLOCATE ( t_window_h_1(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) ) 
+        IF ( .NOT. ALLOCATED( t_window_h_2 ) )                                 &           
+           ALLOCATE ( t_window_h_2(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )          
+        IF ( .NOT. ALLOCATED( t_surf_green_h_1 ) )                             &
+           ALLOCATE ( t_surf_green_h_1(1:surf_usm_h%ns) )
+        IF ( .NOT. ALLOCATED( t_surf_green_h_2 ) )                             &
+           ALLOCATE ( t_surf_green_h_2(1:surf_usm_h%ns) )
+        IF ( .NOT. ALLOCATED( t_green_h_1 ) )                                  &           
+           ALLOCATE ( t_green_h_1(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) ) 
+        IF ( .NOT. ALLOCATED( t_green_h_2 ) )                                  &           
+           ALLOCATE ( t_green_h_2(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )          
+        IF ( .NOT. ALLOCATED( t_surf_whole_h_1 ) )                             &
+           ALLOCATE ( t_surf_whole_h_1(1:surf_usm_h%ns) )
+        IF ( .NOT. ALLOCATED( t_surf_whole_h_2 ) )                             &
+           ALLOCATE ( t_surf_whole_h_2(1:surf_usm_h%ns) )
+        IF ( .NOT. ALLOCATED( t_surf_10cm_h_1 ) )                              &
+           ALLOCATE ( t_surf_10cm_h_1(1:surf_usm_h%ns) )
+        IF ( .NOT. ALLOCATED( t_surf_10cm_h_2 ) )                              &
+           ALLOCATE ( t_surf_10cm_h_2(1:surf_usm_h%ns) )
 !           
 !--     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_h => t_surf_h_1; t_surf_h_p => t_surf_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           
+        t_surf_whole_h => t_surf_whole_h_1; t_surf_whole_h_p => t_surf_whole_h_2
+        t_surf_10cm_h => t_surf_10cm_h_1; t_surf_10cm_h_p => t_surf_10cm_h_2  
+ 
 #endif
 
@@ -1017,4 +978,28 @@
            IF ( .NOT. ALLOCATED( t_wall_v_p(l)%t ) )                           &                 
               ALLOCATE ( t_wall_v_p(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
+           IF ( .NOT. ALLOCATED( t_surf_window_v(l)%t ) )                      &
+              ALLOCATE ( t_surf_window_v(l)%t(1:surf_usm_v(l)%ns) )
+           IF ( .NOT. ALLOCATED( t_surf_window_v_p(l)%t ) )                    &
+              ALLOCATE ( t_surf_window_v_p(l)%t(1:surf_usm_v(l)%ns) )
+           IF ( .NOT. ALLOCATED( t_window_v(l)%t ) )                           &
+              ALLOCATE ( t_window_v(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
+           IF ( .NOT. ALLOCATED( t_window_v_p(l)%t ) )                         &                 
+              ALLOCATE ( t_window_v_p(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
+           IF ( .NOT. ALLOCATED( t_green_v(l)%t ) )                            &
+              ALLOCATE ( t_green_v(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
+           IF ( .NOT. ALLOCATED( t_green_v_p(l)%t ) )                          &                 
+              ALLOCATE ( t_green_v_p(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )
+           IF ( .NOT. ALLOCATED( t_surf_green_v(l)%t ) )                       &
+              ALLOCATE ( t_surf_green_v(l)%t(1:surf_usm_v(l)%ns) )
+           IF ( .NOT. ALLOCATED( t_surf_green_v_p(l)%t ) )                     &
+              ALLOCATE ( t_surf_green_v_p(l)%t(1:surf_usm_v(l)%ns) )
+           IF ( .NOT. ALLOCATED( t_surf_whole_v(l)%t ) )                       &
+              ALLOCATE ( t_surf_whole_v(l)%t(1:surf_usm_v(l)%ns) )
+           IF ( .NOT. ALLOCATED( t_surf_whole_v_p(l)%t ) )                     &
+              ALLOCATE ( t_surf_whole_v_p(l)%t(1:surf_usm_v(l)%ns) )
+           IF ( .NOT. ALLOCATED( t_surf_10cm_v(l)%t ) )                        &
+              ALLOCATE ( t_surf_10cm_v(l)%t(1:surf_usm_v(l)%ns) )
+           IF ( .NOT. ALLOCATED( t_surf_10cm_v_p(l)%t ) )                        &
+              ALLOCATE ( t_surf_10cm_v_p(l)%t(1:surf_usm_v(l)%ns) )
         ENDDO
 #else
@@ -1031,4 +1016,28 @@
            IF ( .NOT. ALLOCATED( t_wall_v_2(l)%t ) )                           &           
               ALLOCATE ( t_wall_v_2(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )  
+           IF ( .NOT. ALLOCATED( t_surf_window_v_1(l)%t ) )                    &
+              ALLOCATE ( t_surf_window_v_1(l)%t(1:surf_usm_v(l)%ns) )
+           IF ( .NOT. ALLOCATED( t_surf_window_v_2(l)%t ) )                    &
+              ALLOCATE ( t_surf_window_v_2(l)%t(1:surf_usm_v(l)%ns) )
+           IF ( .NOT. ALLOCATED( t_window_v_1(l)%t ) )                         &           
+              ALLOCATE ( t_window_v_1(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) ) 
+           IF ( .NOT. ALLOCATED( t_window_v_2(l)%t ) )                         &           
+              ALLOCATE ( t_window_v_2(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )  
+           IF ( .NOT. ALLOCATED( t_surf_green_v_1(l)%t ) )                     &
+              ALLOCATE ( t_surf_green_v_1(l)%t(1:surf_usm_v(l)%ns) )
+           IF ( .NOT. ALLOCATED( t_surf_green_v_2(l)%t ) )                     &
+              ALLOCATE ( t_surf_green_v_2(l)%t(1:surf_usm_v(l)%ns) )
+           IF ( .NOT. ALLOCATED( t_green_v_1(l)%t ) )                          &           
+              ALLOCATE ( t_green_v_1(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) ) 
+           IF ( .NOT. ALLOCATED( t_green_v_2(l)%t ) )                          &           
+              ALLOCATE ( t_green_v_2(l)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(l)%ns) )  
+           IF ( .NOT. ALLOCATED( t_surf_whole_v_1(l)%t ) )                     &
+              ALLOCATE ( t_surf_whole_v_1(l)%t(1:surf_usm_v(l)%ns) )
+           IF ( .NOT. ALLOCATED( t_surf_whole_v_2(l)%t ) )                     &
+              ALLOCATE ( t_surf_whole_v_2(l)%t(1:surf_usm_v(l)%ns) )
+           IF ( .NOT. ALLOCATED( t_surf_10cm_v_1(l)%t ) )                     &
+              ALLOCATE ( t_surf_10cm_v_1(l)%t(1:surf_usm_v(l)%ns) )
+           IF ( .NOT. ALLOCATED( t_surf_10cm_v_2(l)%t ) )                     &
+              ALLOCATE ( t_surf_10cm_v_2(l)%t(1:surf_usm_v(l)%ns) )
         ENDDO
 !
@@ -1036,4 +1045,11 @@
         t_wall_v    => t_wall_v_1;    t_wall_v_p    => t_wall_v_2
         t_surf_v => t_surf_v_1; t_surf_v_p => t_surf_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
+        t_surf_whole_v => t_surf_whole_v_1; t_surf_whole_v_p => t_surf_whole_v_2
+        t_surf_10cm_v => t_surf_10cm_v_1; t_surf_10cm_v_p => t_surf_10cm_v_2
+
 #endif
 !
@@ -1041,8 +1057,17 @@
         ALLOCATE ( surf_usm_h%tt_surface_m(1:surf_usm_h%ns)                  )
         ALLOCATE ( surf_usm_h%tt_wall_m(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
+        ALLOCATE ( surf_usm_h%tt_surface_window_m(1:surf_usm_h%ns)             )
+        ALLOCATE ( surf_usm_h%tt_window_m(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
+        ALLOCATE ( surf_usm_h%tt_green_m(nzb_wall:nzt_wall+1,1:surf_usm_h%ns)  )
+        ALLOCATE ( surf_usm_h%tt_surface_green_m(1:surf_usm_h%ns)              )
+
 !
 !--     Set inital values for prognostic quantities
         IF ( ALLOCATED( surf_usm_h%tt_surface_m ) )  surf_usm_h%tt_surface_m = 0.0_wp
         IF ( ALLOCATED( surf_usm_h%tt_wall_m    ) )  surf_usm_h%tt_wall_m    = 0.0_wp
+        IF ( ALLOCATED( surf_usm_h%tt_surface_window_m ) )  surf_usm_h%tt_surface_window_m = 0.0_wp
+        IF ( ALLOCATED( surf_usm_h%tt_window_m    )      )  surf_usm_h%tt_window_m         = 0.0_wp
+        IF ( ALLOCATED( surf_usm_h%tt_green_m    )       )  surf_usm_h%tt_green_m          = 0.0_wp
+        IF ( ALLOCATED( surf_usm_h%tt_surface_green_m )  )  surf_usm_h%tt_surface_green_m  = 0.0_wp
 !
 !--     Now, for vertical surfaces
@@ -1052,4 +1077,12 @@
            IF ( ALLOCATED( surf_usm_v(l)%tt_surface_m ) )  surf_usm_v(l)%tt_surface_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
 
@@ -1058,7 +1091,15 @@
         ALLOCATE ( surf_usm_h%wshf_eb(1:surf_usm_h%ns) )
         ALLOCATE ( surf_usm_h%wghf_eb(1:surf_usm_h%ns) )
+        ALLOCATE ( surf_usm_h%wghf_eb_window(1:surf_usm_h%ns) )
+        ALLOCATE ( surf_usm_h%wghf_eb_green(1:surf_usm_h%ns) )
+        ALLOCATE ( surf_usm_h%iwghf_eb(1:surf_usm_h%ns) )
+        ALLOCATE ( surf_usm_h%iwghf_eb_window(1:surf_usm_h%ns) )
         IF ( ALLOCATED( surf_usm_h%wshf    ) )  surf_usm_h%wshf    = 0.0_wp
         IF ( ALLOCATED( surf_usm_h%wshf_eb ) )  surf_usm_h%wshf_eb = 0.0_wp
         IF ( ALLOCATED( surf_usm_h%wghf_eb ) )  surf_usm_h%wghf_eb = 0.0_wp
+        IF ( ALLOCATED( surf_usm_h%wghf_eb_window ) )  surf_usm_h%wghf_eb_window = 0.0_wp
+        IF ( ALLOCATED( surf_usm_h%wghf_eb_green ) )  surf_usm_h%wghf_eb_green = 0.0_wp
+        IF ( ALLOCATED( surf_usm_h%iwghf_eb ) )  surf_usm_h%iwghf_eb = 0.0_wp
+        IF ( ALLOCATED( surf_usm_h%iwghf_eb_window ) )  surf_usm_h%iwghf_eb_window = 0.0_wp
 !
 !--     Now, for vertical surfaces
@@ -1067,11 +1108,18 @@
            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)%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
         
-    END SUBROUTINE usm_allocate_urban_surface
-
+    END SUBROUTINE usm_allocate_surface
 
 
@@ -1115,4 +1163,24 @@
             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
@@ -1264,4 +1332,56 @@
                     ENDDO
 
+                CASE ( 'usm_wghf_window' )
+!--                 array of heat flux from window ground (wall, roof, land)
+                    IF ( .NOT.  ALLOCATED(surf_usm_h%wghf_eb_window_av) )  THEN
+                        ALLOCATE( surf_usm_h%wghf_eb_window_av(1:surf_usm_h%ns) )
+                        surf_usm_h%wghf_eb_window_av = 0.0_wp
+                    ENDIF
+                    DO  l = 0, 3
+                       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
+                    ENDDO
+
+                CASE ( 'usm_wghf_green' )
+!--                 array of heat flux from green ground (wall, roof, land)
+                    IF ( .NOT.  ALLOCATED(surf_usm_h%wghf_eb_green_av) )  THEN
+                        ALLOCATE( surf_usm_h%wghf_eb_green_av(1:surf_usm_h%ns) )
+                        surf_usm_h%wghf_eb_green_av = 0.0_wp
+                    ENDIF
+                    DO  l = 0, 3
+                       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
+                    ENDDO
+
+                CASE ( 'usm_iwghf' )
+!--                 array of heat flux from indoor ground (wall, roof, land)
+                    IF ( .NOT.  ALLOCATED(surf_usm_h%iwghf_eb_av) )  THEN
+                        ALLOCATE( surf_usm_h%iwghf_eb_av(1:surf_usm_h%ns) )
+                        surf_usm_h%iwghf_eb_av = 0.0_wp
+                    ENDIF
+                    DO  l = 0, 3
+                       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
+                    ENDDO
+
+                CASE ( 'usm_iwghf_window' )
+!--                 array of heat flux from indoor window ground (wall, roof, land)
+                    IF ( .NOT.  ALLOCATED(surf_usm_h%iwghf_eb_window_av) )  THEN
+                        ALLOCATE( surf_usm_h%iwghf_eb_window_av(1:surf_usm_h%ns) )
+                        surf_usm_h%iwghf_eb_window_av = 0.0_wp
+                    ENDIF
+                    DO  l = 0, 3
+                       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
+                    ENDDO
+                    
                 CASE ( 'usm_t_surf' )
 !--                 surface temperature for surfaces
@@ -1277,4 +1397,56 @@
                     ENDDO
 
+                CASE ( 'usm_t_surf_window' )
+!--                 surface temperature for window surfaces
+                    IF ( .NOT.  ALLOCATED(surf_usm_h%t_surf_window_av) )  THEN
+                        ALLOCATE( surf_usm_h%t_surf_window_av(1:surf_usm_h%ns) )
+                        surf_usm_h%t_surf_window_av = 0.0_wp
+                    ENDIF
+                    DO  l = 0, 3
+                       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
+                    ENDDO
+                    
+                CASE ( 'usm_t_surf_green' )
+!--                 surface temperature for green surfaces
+                    IF ( .NOT.  ALLOCATED(surf_usm_h%t_surf_green_av) )  THEN
+                        ALLOCATE( surf_usm_h%t_surf_green_av(1:surf_usm_h%ns) )
+                        surf_usm_h%t_surf_green_av = 0.0_wp
+                    ENDIF
+                    DO  l = 0, 3
+                       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
+                    ENDDO
+                
+                CASE ( 'usm_t_surf_whole' )
+!--                 surface temperature for whole surfaces
+                    IF ( .NOT.  ALLOCATED(surf_usm_h%t_surf_whole_av) )  THEN
+                        ALLOCATE( surf_usm_h%t_surf_whole_av(1:surf_usm_h%ns) )
+                        surf_usm_h%t_surf_whole_av = 0.0_wp
+                    ENDIF
+                    DO  l = 0, 3
+                       IF ( .NOT.  ALLOCATED(surf_usm_v(l)%t_surf_whole_av) )  THEN
+                           ALLOCATE( surf_usm_v(l)%t_surf_whole_av(1:surf_usm_v(l)%ns) )
+                           surf_usm_v(l)%t_surf_whole_av = 0.0_wp
+                       ENDIF
+                    ENDDO
+                    
+                CASE ( 'usm_t_surf_10cm' )
+!--                 near surface temperature for whole surfaces
+                    IF ( .NOT.  ALLOCATED(surf_usm_h%t_surf_10cm_av) )  THEN
+                        ALLOCATE( surf_usm_h%t_surf_10cm_av(1:surf_usm_h%ns) )
+                        surf_usm_h%t_surf_10cm_av = 0.0_wp
+                    ENDIF
+                    DO  l = 0, 3
+                       IF ( .NOT.  ALLOCATED(surf_usm_v(l)%t_surf_10cm_av) )  THEN
+                           ALLOCATE( surf_usm_v(l)%t_surf_10cm_av(1:surf_usm_v(l)%ns) )
+                           surf_usm_v(l)%t_surf_10cm_av = 0.0_wp
+                       ENDIF
+                    ENDDO
+
                 CASE ( 'usm_t_wall' )
 !--                 wall temperature for iwl layer of walls and land
@@ -1290,4 +1462,30 @@
                     ENDDO
 
+                CASE ( 'usm_t_window' )
+!--                 window temperature for iwl layer of walls and land
+                    IF ( .NOT.  ALLOCATED(surf_usm_h%t_window_av) )  THEN
+                        ALLOCATE( surf_usm_h%t_window_av(nzb_wall:nzt_wall,1:surf_usm_h%ns) )
+                        surf_usm_h%t_window_av = 0.0_wp
+                    ENDIF
+                    DO  l = 0, 3
+                       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
+                    ENDDO
+
+                CASE ( 'usm_t_green' )
+!--                 green temperature for iwl layer of walls and land
+                    IF ( .NOT.  ALLOCATED(surf_usm_h%t_green_av) )  THEN
+                        ALLOCATE( surf_usm_h%t_green_av(nzb_wall:nzt_wall,1:surf_usm_h%ns) )
+                        surf_usm_h%t_green_av = 0.0_wp
+                    ENDIF
+                    DO  l = 0, 3
+                       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
+                    ENDDO
+
                CASE DEFAULT
                    CONTINUE
@@ -1451,4 +1649,64 @@
                     ENDDO
                     
+                CASE ( 'usm_wghf_window' )
+!--                 array of heat flux from window ground (wall, roof, land)
+                    DO  m = 1, surf_usm_h%ns
+                       surf_usm_h%wghf_eb_window_av(m) =                              &
+                                          surf_usm_h%wghf_eb_window_av(m) +           &
+                                          surf_usm_h%wghf_eb_window(m)
+                    ENDDO
+                    DO  l = 0, 3
+                       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
+                    ENDDO
+
+                CASE ( 'usm_wghf_green' )
+!--                 array of heat flux from green ground (wall, roof, land)
+                    DO  m = 1, surf_usm_h%ns
+                       surf_usm_h%wghf_eb_green_av(m) =                              &
+                                          surf_usm_h%wghf_eb_green_av(m) +           &
+                                          surf_usm_h%wghf_eb_green(m)
+                    ENDDO
+                    DO  l = 0, 3
+                       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
+                    ENDDO
+                    
+                CASE ( 'usm_iwghf' )
+!--                 array of heat flux from indoor ground (wall, roof, land)
+                    DO  m = 1, surf_usm_h%ns
+                       surf_usm_h%iwghf_eb_av(m) =                              &
+                                          surf_usm_h%iwghf_eb_av(m) +           &
+                                          surf_usm_h%iwghf_eb(m)
+                    ENDDO
+                    DO  l = 0, 3
+                       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
+                    ENDDO
+                    
+                CASE ( 'usm_iwghf_window' )
+!--                 array of heat flux from indoor window ground (wall, roof, land)
+                    DO  m = 1, surf_usm_h%ns
+                       surf_usm_h%iwghf_eb_window_av(m) =                              &
+                                          surf_usm_h%iwghf_eb_window_av(m) +           &
+                                          surf_usm_h%iwghf_eb_window(m)
+                    ENDDO
+                    DO  l = 0, 3
+                       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
+                    ENDDO
+                    
                 CASE ( 'usm_t_surf' )
 !--                 surface temperature for surfaces
@@ -1465,4 +1723,65 @@
                        ENDDO
                     ENDDO
+                    
+                CASE ( 'usm_t_surf_window' )
+!--                 surface temperature for window surfaces
+                    DO  m = 1, surf_usm_h%ns
+                       surf_usm_h%t_surf_window_av(m) =                               & 
+                                          surf_usm_h%t_surf_window_av(m) +            &
+                                          t_surf_window_h(m)
+                    ENDDO
+                    DO  l = 0, 3
+                       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)%t(m)
+                       ENDDO
+                    ENDDO
+                    
+                CASE ( 'usm_t_surf_green' )
+!--                 surface temperature for green surfaces
+                    DO  m = 1, surf_usm_h%ns
+                       surf_usm_h%t_surf_green_av(m) =                               & 
+                                          surf_usm_h%t_surf_green_av(m) +            &
+                                          t_surf_green_h(m)
+                    ENDDO
+                    DO  l = 0, 3
+                       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)%t(m)
+                       ENDDO
+                    ENDDO
+                
+                CASE ( 'usm_t_surf_whole' )
+!--                 surface temperature for whole surfaces
+                    DO  m = 1, surf_usm_h%ns
+                       surf_usm_h%t_surf_whole_av(m) =                               & 
+                                          surf_usm_h%t_surf_whole_av(m) +            &
+                                          t_surf_whole_h(m)
+                    ENDDO
+                    DO  l = 0, 3
+                       DO  m = 1, surf_usm_v(l)%ns
+                          surf_usm_v(l)%t_surf_whole_av(m) =                         &
+                                          surf_usm_v(l)%t_surf_whole_av(m) +         &
+                                          t_surf_whole_v(l)%t(m)
+                       ENDDO
+                    ENDDO
+                    
+                CASE ( 'usm_t_surf_10cm' )
+!--                 near surface temperature for whole surfaces
+                    DO  m = 1, surf_usm_h%ns
+                       surf_usm_h%t_surf_10cm_av(m) =                               & 
+                                          surf_usm_h%t_surf_10cm_av(m) +            &
+                                          t_surf_10cm_h(m)
+                    ENDDO
+                    DO  l = 0, 3
+                       DO  m = 1, surf_usm_v(l)%ns
+                          surf_usm_v(l)%t_surf_10cm_av(m) =                         &
+                                          surf_usm_v(l)%t_surf_10cm_av(m) +         &
+                                          t_surf_10cm_v(l)%t(m)
+                       ENDDO
+                    ENDDO
+
                     
                 CASE ( 'usm_t_wall' )
@@ -1481,4 +1800,34 @@
                     ENDDO
                     
+                CASE ( 'usm_t_window' )
+!--                 window temperature for  iwl layer of walls and land
+                    DO  m = 1, surf_usm_h%ns
+                       surf_usm_h%t_window_av(iwl,m) =                           &
+                                          surf_usm_h%t_window_av(iwl,m) +        &
+                                          t_window_h(iwl,m)
+                    ENDDO
+                    DO  l = 0, 3
+                       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)%t(iwl,m)
+                       ENDDO
+                    ENDDO
+
+                CASE ( 'usm_t_green' )
+!--                 green temperature for  iwl layer of walls and land
+                    DO  m = 1, surf_usm_h%ns
+                       surf_usm_h%t_green_av(iwl,m) =                           &
+                                          surf_usm_h%t_green_av(iwl,m) +        &
+                                          t_green_h(iwl,m)
+                    ENDDO
+                    DO  l = 0, 3
+                       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)%t(iwl,m)
+                       ENDDO
+                    ENDDO
+
                 CASE DEFAULT
                     CONTINUE
@@ -1638,4 +1987,64 @@
                     ENDDO
                     
+                CASE ( 'usm_wghf_window' )
+!--                 array of heat flux from window ground (wall, roof, land)
+                    DO  m = 1, surf_usm_h%ns
+                       surf_usm_h%wghf_eb_window_av(m) =                              &
+                                          surf_usm_h%wghf_eb_window_av(m) /           &
+                                          REAL( average_count_3d, kind=wp )
+                    ENDDO
+                    DO  l = 0, 3
+                       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
+                    ENDDO
+
+                CASE ( 'usm_wghf_green' )
+!--                 array of heat flux from green ground (wall, roof, land)
+                    DO  m = 1, surf_usm_h%ns
+                       surf_usm_h%wghf_eb_green_av(m) =                              &
+                                          surf_usm_h%wghf_eb_green_av(m) /           &
+                                          REAL( average_count_3d, kind=wp )
+                    ENDDO
+                    DO  l = 0, 3
+                       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
+                    ENDDO
+
+                CASE ( 'usm_iwghf' )
+!--                 array of heat flux from indoor ground (wall, roof, land)
+                    DO  m = 1, surf_usm_h%ns
+                       surf_usm_h%iwghf_eb_av(m) =                              &
+                                          surf_usm_h%iwghf_eb_av(m) /           &
+                                          REAL( average_count_3d, kind=wp )
+                    ENDDO
+                    DO  l = 0, 3
+                       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
+                    ENDDO
+                    
+                CASE ( 'usm_iwghf_window' )
+!--                 array of heat flux from indoor window ground (wall, roof, land)
+                    DO  m = 1, surf_usm_h%ns
+                       surf_usm_h%iwghf_eb_window_av(m) =                              &
+                                          surf_usm_h%iwghf_eb_window_av(m) /           &
+                                          REAL( average_count_3d, kind=wp )
+                    ENDDO
+                    DO  l = 0, 3
+                       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
+                    ENDDO
+                    
                 CASE ( 'usm_t_surf' )
 !--                 surface temperature for surfaces
@@ -1649,4 +2058,64 @@
                           surf_usm_v(l)%t_surf_av(m) =                         &
                                           surf_usm_v(l)%t_surf_av(m) /         &
+                                          REAL( average_count_3d, kind=wp )
+                       ENDDO
+                    ENDDO
+                    
+                CASE ( 'usm_t_surf_window' )
+!--                 surface temperature for window surfaces
+                    DO  m = 1, surf_usm_h%ns
+                       surf_usm_h%t_surf_window_av(m) =                               & 
+                                          surf_usm_h%t_surf_window_av(m) /            &
+                                          REAL( average_count_3d, kind=wp )
+                    ENDDO
+                    DO  l = 0, 3
+                       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
+                    ENDDO
+                    
+                CASE ( 'usm_t_surf_green' )
+!--                 surface temperature for green surfaces
+                    DO  m = 1, surf_usm_h%ns
+                       surf_usm_h%t_surf_green_av(m) =                               & 
+                                          surf_usm_h%t_surf_green_av(m) /            &
+                                          REAL( average_count_3d, kind=wp )
+                    ENDDO
+                    DO  l = 0, 3
+                       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
+                    ENDDO
+                    
+                CASE ( 'usm_t_surf_whole' )
+!--                 surface temperature for whole surfaces
+                    DO  m = 1, surf_usm_h%ns
+                       surf_usm_h%t_surf_whole_av(m) =                               & 
+                                          surf_usm_h%t_surf_whole_av(m) /            &
+                                          REAL( average_count_3d, kind=wp )
+                    ENDDO
+                    DO  l = 0, 3
+                       DO  m = 1, surf_usm_v(l)%ns
+                          surf_usm_v(l)%t_surf_whole_av(m) =                         &
+                                          surf_usm_v(l)%t_surf_whole_av(m) /         &
+                                          REAL( average_count_3d, kind=wp )
+                       ENDDO
+                    ENDDO
+                    
+                CASE ( 'usm_t_surf_10cm' )
+!--                 near surface temperature for whole surfaces
+                    DO  m = 1, surf_usm_h%ns
+                       surf_usm_h%t_surf_10cm_av(m) =                               & 
+                                          surf_usm_h%t_surf_10cm_av(m) /            &
+                                          REAL( average_count_3d, kind=wp )
+                    ENDDO
+                    DO  l = 0, 3
+                       DO  m = 1, surf_usm_v(l)%ns
+                          surf_usm_v(l)%t_surf_10cm_av(m) =                         &
+                                          surf_usm_v(l)%t_surf_10cm_av(m) /         &
                                           REAL( average_count_3d, kind=wp )
                        ENDDO
@@ -1668,4 +2137,35 @@
                     ENDDO
 
+                CASE ( 'usm_t_window' )
+!--                 window temperature for  iwl layer of walls and land
+                    DO  m = 1, surf_usm_h%ns
+                       surf_usm_h%t_window_av(iwl,m) =                           &
+                                          surf_usm_h%t_window_av(iwl,m) /        &
+                                          REAL( average_count_3d, kind=wp )
+                    ENDDO
+                    DO  l = 0, 3
+                       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
+                    ENDDO
+
+                CASE ( 'usm_t_green' )
+!--                 green temperature for  iwl layer of walls and land
+                    DO  m = 1, surf_usm_h%ns
+                       surf_usm_h%t_green_av(iwl,m) =                           &
+                                          surf_usm_h%t_green_av(iwl,m) /        &
+                                          REAL( average_count_3d, kind=wp )
+                    ENDDO
+                    DO  l = 0, 3
+                       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
+                    ENDDO
+
+
            END SELECT
 
@@ -1675,661 +2175,44 @@
 
 
-!------------------------------------------------------------------------------!
-!> 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 usm_box_absorb(boxsize, resol, dens, uvec, area, absorb)
-        IMPLICIT NONE
-
-        REAL(wp), DIMENSION(3), INTENT(in) :: &
-            boxsize, &      !< z, y, x size of box in m
-            uvec            !< z, y, x unit vector of incoming flux
-        INTEGER(iwp), INTENT(in) :: &
-            resol           !< No. of rays in x and y dimensions
-        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) :: &
-            xshift, yshift, &
-            xmin, xmax, ymin, ymax, &
-            xorig, yorig, &
-            dx1, dy1, dz1, dx2, dy2, dz2, &
-            crdist, &
-            transp
-        INTEGER(iwp) :: &
-            i, j
-
-        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 IF ( uvec(2) < 0._wp )  THEN
-                    dy1 = (boxsize(2)-yorig) / uvec(2) !< crossing with y=boxsize(2)
-                    dy2 = -yorig             / uvec(2) !< crossing with y=0
-                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 IF ( uvec(3) < 0._wp )  THEN
-                    dx1 = (boxsize(3)-xorig) / uvec(3) !< crossing with x=boxsize(3)
-                    dx2 = -xorig             / uvec(3) !< crossing with x=0
-                ELSE !uvec(1)==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 usm_box_absorb
-    
-    
+
 !------------------------------------------------------------------------------!
 ! Description:
 ! ------------
-!> This subroutine splits direct and diffusion dw radiation
-!> It sould not be called in case the radiation model already does it
-!> It follows <CITATION>
+!> Set internal Neumann boundary condition at outer soil grid points 
+!> for temperature and humidity. 
 !------------------------------------------------------------------------------!
-    SUBROUTINE usm_calc_diffusion_radiation 
-    
-        REAL(wp), PARAMETER                          :: lowest_solarUp = 0.1_wp  !< limit the sun elevation to protect stability of the calculation
-        INTEGER(iwp)                                 :: i, j
-        REAL(wp)                                     ::  year_angle              !< angle
-        REAL(wp)                                     ::  etr                     !< extraterestrial radiation
-        REAL(wp)                                     ::  corrected_solarUp       !< corrected solar up radiation
-        REAL(wp)                                     ::  horizontalETR           !< horizontal extraterestrial radiation
-        REAL(wp)                                     ::  clearnessIndex          !< clearness index
-        REAL(wp)                                     ::  diff_frac               !< diffusion fraction of the radiation
-
-        
-!--     Calculate current day and time based on the initial values and simulation time
-        year_angle = ( (day_of_year_init * 86400) + time_utc_init              &
-                        + time_since_reference_point )  * d_seconds_year       &
-                        * 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 ( zenith(0) <= lowest_solarUp )  THEN
-            corrected_solarUp = lowest_solarUp
-        ELSE
-            corrected_solarUp = zenith(0)
-        ENDIF
-        
-        horizontalETR = etr * corrected_solarUp
-        
-        DO i = nxlg, nxrg
-            DO j = nysg, nyng
-                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 usm_calc_diffusion_radiation
-    
-
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Calculates shape view factors SVF and plant sink canopy factors PSCF
-!> !!!!!DESCRIPTION!!!!!!!!!!
-!------------------------------------------------------------------------------!
-    SUBROUTINE usm_calc_svf
-    
-        IMPLICIT NONE
-        
-        INTEGER(iwp)                                :: i, j, k, l, d, ip, jp
-        INTEGER(iwp)                                :: isvf, ksvf, icsf, kcsf, npcsfl, isvf_surflt, imrtt, imrtf
-        INTEGER(iwp)                                :: sd, td, ioln, iproc
-        REAL(wp),     DIMENSION(0:9)                :: facearea
-        INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE   :: nzterrl, planthl
-        REAL(wp),     DIMENSION(:,:), ALLOCATABLE   :: csflt, pcsflt
-        INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE   :: kcsflt,kpcsflt
-        INTEGER(iwp), DIMENSION(:), ALLOCATABLE     :: icsflt,dcsflt,ipcsflt,dpcsflt
-        REAL(wp), DIMENSION(3)                      :: uv
-        LOGICAL                                     :: visible
-        REAL(wp), DIMENSION(3)                      :: sa, ta          !< real coordinates z,y,x of source and target
-        REAL(wp)                                    :: transparency, rirrf, sqdist, svfsum
-        INTEGER(iwp)                                :: isurflt, isurfs, isurflt_prev
-        INTEGER(iwp)                                :: itx, ity, itz
-        CHARACTER(len=7)                            :: pid_char = ''
-        INTEGER(iwp)                                :: win_lad, minfo
-        REAL(wp), DIMENSION(:,:,:), POINTER         :: lad_s_rma       !< fortran pointer, but lower bounds are 1
-        TYPE(c_ptr)                                 :: lad_s_rma_p     !< allocated c pointer
-#if defined( __parallel )
-        INTEGER(kind=MPI_ADDRESS_KIND)              :: size_lad_rma
-#endif
-!    
-!--     calculation of the SVF
-        CALL location_message( '    calculation of SVF and CSF', .TRUE. )
-!
-!--     precalculate face areas for different face directions using normal vector
-        DO d = 0, 9
-            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
-        ENDDO
-
-!--     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
-        
-!--     initialize temporary terrain and plant canopy height arrays (global 2D array!)
-        ALLOCATE( nzterr(0:(nx+1)*(ny+1)-1) )
-#if defined( __parallel )
-        ALLOCATE( nzterrl(nys:nyn,nxl:nxr) )
-        nzterrl = MAXLOC(                                                      &
-                          MERGE( 1, 0,                                         &
-                                 BTEST( wall_flags_0(:,nys:nyn,nxl:nxr), 12 )  &
-                               ), DIM = 1                                      &
-                        ) - 1  ! = nzb_s_inner(nys:nyn,nxl:nxr)
-        CALL MPI_AllGather( nzterrl, nnx*nny, MPI_INTEGER, &
-                            nzterr, nnx*nny, MPI_INTEGER, comm2d, ierr )
-        DEALLOCATE(nzterrl)
-#else
-        nzterr = RESHAPE( MAXLOC(                                              &
-                          MERGE( 1, 0,                                         &
-                                 BTEST( wall_flags_0(:,nys:nyn,nxl:nxr), 12 )  &
-                               ), DIM = 1                                      &
-                                ) - 1,                                         &
-                          (/(nx+1)*(ny+1)/)                                    &
-                        )
-#endif
-        IF ( plant_canopy )  THEN
-            ALLOCATE( plantt(0:(nx+1)*(ny+1)-1) )
-            maxboxesg = nx + ny + nzu + 1
-!--         temporary arrays storing values for csf calculation during raytracing
-            ALLOCATE( boxes(3, maxboxesg) )
-            ALLOCATE( crlens(maxboxesg) )
-
-#if defined( __parallel )
-            ALLOCATE( planthl(nys:nyn,nxl:nxr) )
-            planthl = pch(nys:nyn,nxl:nxr)
-        
-            CALL MPI_AllGather( planthl, nnx*nny, MPI_INTEGER, &
-                                plantt, nnx*nny, MPI_INTEGER, comm2d, ierr )
-            DEALLOCATE( planthl )
-            
-!--         temporary arrays storing values for csf calculation during raytracing
-            ALLOCATE( lad_ip(maxboxesg) )
-            ALLOCATE( lad_disp(maxboxesg) )
-
-            IF ( usm_lad_rma )  THEN
-                ALLOCATE( lad_s_ray(maxboxesg) )
-                
-                ! set conditions for RMA communication
-                CALL MPI_Info_create(minfo, ierr)
-                CALL MPI_Info_set(minfo, 'accumulate_ordering', '', ierr)
-                CALL MPI_Info_set(minfo, 'accumulate_ops', 'same_op', ierr)
-                CALL MPI_Info_set(minfo, 'same_size', 'true', ierr)
-                CALL MPI_Info_set(minfo, 'same_disp_unit', 'true', ierr)
-
-!--             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 c_sizeof(X) needs arbitrary REAL(wp) value, set to 1.0_wp for now
-                size_lad_rma = c_sizeof(1.0_wp)*nnx*nny*nzu
-                CALL MPI_Win_allocate(size_lad_rma, c_sizeof(1.0_wp), minfo, comm2d, &
-                                        lad_s_rma_p, win_lad, ierr)
-                CALL c_f_pointer(lad_s_rma_p, lad_s_rma, (/ nzu, nny, nnx /))
-                usm_lad(nzub:, nys:, nxl:) => lad_s_rma(:,:,:)
-            ELSE
-                ALLOCATE(usm_lad(nzub:nzut, nys:nyn, nxl:nxr))
-            ENDIF
-#else
-            plantt = RESHAPE( pct(nys:nyn,nxl:nxr), (/(nx+1)*(ny+1)/) )
-            ALLOCATE(usm_lad(nzub:nzut, nys:nyn, nxl:nxr))
-#endif
-            usm_lad(:,:,:) = 0._wp
-            DO i = nxl, nxr
-                DO j = nys, nyn
-                    k = get_topography_top_index( j, i, 's' )
-
-                    usm_lad(k:nzut, j, i) = lad_s(0:nzut-k, j, i)
-                ENDDO
-            ENDDO
-
-#if defined( __parallel )
-            IF ( usm_lad_rma )  THEN
-                CALL MPI_Info_free(minfo, ierr)
-                CALL MPI_Win_lock_all(0, win_lad, ierr)
-            ELSE
-                ALLOCATE( usm_lad_g(0:(nx+1)*(ny+1)*nzu-1) )
-                CALL MPI_AllGather( usm_lad, nnx*nny*nzu, MPI_REAL, &
-                                    usm_lad_g, nnx*nny*nzu, MPI_REAL, comm2d, ierr )
-            ENDIF
-#endif
-        ENDIF
-
-        IF ( mrt_factors )  THEN
-            OPEN(153, file='MRT_TARGETS', access='SEQUENTIAL', &
-                    action='READ', status='OLD', form='FORMATTED', err=524)
-            OPEN(154, file='MRT_FACTORS'//myid_char, access='DIRECT', recl=(5*4+2*8), &
-                    action='WRITE', status='REPLACE', form='UNFORMATTED', err=525)
-            imrtf = 1
-            DO
-                READ(153, *, end=526, err=524) imrtt, i, j, k
-                IF ( i < nxl  .OR.  i > nxr &
-                     .OR.  j < nys  .OR.  j > nyn ) CYCLE
-                ta = (/ REAL(k), REAL(j), REAL(i) /)
-
-                DO isurfs = 1, nsurf
-                    IF ( .NOT.  usm_facing(i, j, k, -1, &
-                        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, (ta(2)-sa(2))*dy, (ta(3)-sa(3))*dx /)
-                    sqdist = SUM(uv(:)**2)
-                    uv = uv / SQRT(sqdist)
-
-!--                 irradiance factor - see svf. Here we consider that target face is always normal,
-!--                 i.e. the second dot product equals 1
-                    rirrf = dot_product((/ kdir(sd), jdir(sd), idir(sd) /), uv) &
-                        / (pi * sqdist) * facearea(sd)
-
-!--                 raytrace while not creating any canopy sink factors
-                    CALL usm_raytrace(sa, ta, isurfs, rirrf, 1._wp, .FALSE., &
-                            visible, transparency, win_lad)
-                    IF ( .NOT.  visible ) CYCLE
-
-                    !rsvf = rirrf * transparency
-                    WRITE(154, rec=imrtf, err=525) INT(imrtt, kind=4), &
-                        INT(surf(id, isurfs), kind=4), &
-                        INT(surf(iz, isurfs), kind=4), &
-                        INT(surf(iy, isurfs), kind=4), &
-                        INT(surf(ix, isurfs), kind=4), &
-                        REAL(rirrf, kind=8), REAL(transparency, kind=8)
-                    imrtf = imrtf + 1
-
-                ENDDO !< isurfs
-            ENDDO !< MRT_TARGETS record
-
-524         message_string = 'error reading file MRT_TARGETS'
-            CALL message( 'usm_calc_svf', 'PA0524', 1, 2, 0, 6, 0 )
-
-525         message_string = 'error writing file MRT_FACTORS'//myid_char
-            CALL message( 'usm_calc_svf', 'PA0525', 1, 2, 0, 6, 0 )
-
-526         CLOSE(153)
-            CLOSE(154)
-        ENDIF  !< mrt_factors
-
-        
-        DO isurflt = 1, nsurfl
-!--         determine face centers
-            td = surfl(id, isurflt)
-            IF ( td >= isky  .AND.  .NOT.  plant_canopy ) CYCLE
-            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)  /)
-            DO isurfs = 1, nsurf
-                IF ( .NOT.  usm_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, (ta(2)-sa(2))*dy, (ta(3)-sa(3))*dx /)
-                sqdist = SUM(uv(:)**2)
-                uv = uv / SQRT(sqdist)
-                
-!--             irradiance factor (our unshaded shape view factor) = view factor per differential target area * source area
-                rirrf = 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
-                    * facearea(sd)
-
-!--             raytrace + process plant canopy sinks within
-                CALL usm_raytrace(sa, ta, isurfs, rirrf, facearea(td), .TRUE., &
-                        visible, transparency, win_lad)
-                
-                IF ( .NOT.  visible ) CYCLE
-                IF ( td >= isky ) CYCLE !< we calculated these only for raytracing
-                                        !< to find plant canopy sinks, we don't need svf for them
-                ! rsvf = rirrf * transparency
-
-!--             write to the svf array
-                nsvfl = nsvfl + 1
-!--             check dimmension of asvf array and enlarge it if needed
-                IF ( nsvfla < nsvfl )  THEN
-                    k = nsvfla * 2
-                    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
-                    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
-        ENDDO
-
-        CALL location_message( '    waiting for completion of SVF and CSF calculation in all processes', .TRUE. )
-!--     deallocate temporary global arrays
-        DEALLOCATE(nzterr)
-        
-        IF ( plant_canopy )  THEN
-!--         finalize mpi_rma communication and deallocate temporary arrays
-#if defined( __parallel )
-            IF ( usm_lad_rma )  THEN
-                CALL MPI_Win_flush_all(win_lad, ierr)
-!--             unlock MPI window
-                CALL MPI_Win_unlock_all(win_lad, ierr)
-!--             free MPI window
-                CALL MPI_Win_free(win_lad, ierr)
-                
-!--             deallocate temporary arrays storing values for csf calculation during raytracing
-                DEALLOCATE( lad_s_ray )
-!--             usm_lad is the pointer to lad_s_rma in case of usm_lad_rma
-!--             and must not be deallocated here
-            ELSE
-                DEALLOCATE(usm_lad)
-                DEALLOCATE(usm_lad_g)
-            ENDIF
-#else
-            DEALLOCATE(usm_lad)
-#endif
-            DEALLOCATE( boxes )
-            DEALLOCATE( crlens )
-            DEALLOCATE( plantt )
-        ENDIF
-
-        CALL location_message( '    calculation of the complete SVF array', .TRUE. )
-
-!--     sort svf ( a version of quicksort )
-        CALL quicksort_svf(asvf,1,nsvfl)
-
-        ALLOCATE( svf(ndsvf,nsvfl) )
-        ALLOCATE( svfsurf(idsvf,nsvfl) )
-
-        !< load svf from the structure array to plain arrays
-        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
-!--                 TODO detect and log when normalization differs too much from 1
-                    svf(1, isvf_surflt:isvf-1) = svf(1, isvf_surflt:isvf-1) / svfsum
-                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
-!--         TODO detect and log when normalization differs too much from 1
-            svf(1, isvf_surflt:nsvfl) = svf(1, isvf_surflt:nsvfl) / svfsum
-        ENDIF
-
-!--     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
-
-            CALL location_message( '    calculation of the complete CSF array', .TRUE. )
-
-!--         sort and merge csf for the last time, keeping the array size to minimum
-            CALL usm_merge_and_grow_csf(-1)
-            
-!--         aggregate csb among processors
-!--         allocate necessary arrays
-            ALLOCATE( csflt(ndcsf,max(ncsfl,ndcsf)) )
-            ALLOCATE( kcsflt(kdcsf,max(ncsfl,kdcsf)) )
-            ALLOCATE( icsflt(0:numprocs-1) )
-            ALLOCATE( dcsflt(0:numprocs-1) )
-            ALLOCATE( ipcsflt(0:numprocs-1) )
-            ALLOCATE( dpcsflt(0:numprocs-1) )
-            
-!--         fill out arrays of csf values and 
-!--         arrays of number of elements and displacements
-!--         for particular precessors
-            icsflt = 0
-            dcsflt = 0
-            ip = -1
-            j = -1
-            d = 0
-            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
-                    d = d+j
-!--                 blank blocks
-                    DO jp = ip+1, acsf(kcsf)%ip-1
-!--                     number of elements is zero, displacement is equal to previous
-                        icsflt(jp) = 0
-                        dcsflt(jp) = d
-                    ENDDO
-!--                 the actual block
-                    ip = acsf(kcsf)%ip
-                    dcsflt(ip) = d
-                    j = 0
-                ENDIF
-!--             fill out real values of rsvf, rtransp
-                csflt(1,kcsf) = acsf(kcsf)%rsvf
-                csflt(2,kcsf) = acsf(kcsf)%rtransp
-!--             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
-            d = d+j
-            DO jp = ip+1, numprocs-1
-!--             number of elements is zero, displacement is equal to previous
-                icsflt(jp) = 0
-                dcsflt(jp) = d
-            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 )
-!--         scatter and gather the number of elements to and from all processor
-!--         and calculate displacements
-            CALL MPI_AlltoAll(icsflt,1,MPI_INTEGER,ipcsflt,1,MPI_INTEGER,comm2d, ierr)
-            
-            npcsfl = SUM(ipcsflt)
-            d = 0
-            DO i = 0, numprocs-1
-                dpcsflt(i) = d
-                d = d + ipcsflt(i)
-            ENDDO
-        
-!--         exchange csf fields between processors
-            ALLOCATE( pcsflt(ndcsf,max(npcsfl,ndcsf)) )
-            ALLOCATE( kpcsflt(kdcsf,max(npcsfl,kdcsf)) )
-            CALL MPI_AlltoAllv(csflt, ndcsf*icsflt, ndcsf*dcsflt, MPI_REAL, &
-                pcsflt, ndcsf*ipcsflt, ndcsf*dpcsflt, MPI_REAL, comm2d, ierr)
-            CALL MPI_AlltoAllv(kcsflt, kdcsf*icsflt, kdcsf*dcsflt, MPI_INTEGER, &
-                kpcsflt, kdcsf*ipcsflt, kdcsf*dpcsflt, MPI_INTEGER, comm2d, ierr)
-            
-#else
-            npcsfl = ncsfl
-            ALLOCATE( pcsflt(ndcsf,max(npcsfl,ndcsf)) )
-            ALLOCATE( kpcsflt(kdcsf,max(npcsfl,kdcsf)) )
-            pcsflt = csflt
-            kpcsflt = kcsflt
-#endif
-
-!--         deallocate temporary arrays
-            DEALLOCATE( csflt )
-            DEALLOCATE( kcsflt )
-            DEALLOCATE( icsflt )
-            DEALLOCATE( dcsflt )
-            DEALLOCATE( ipcsflt )
-            DEALLOCATE( dpcsflt )
-
-!--         sort csf ( a version of quicksort )
-            CALL quicksort_csf2(kpcsflt, pcsflt, 1, npcsfl)
-
-!--         aggregate canopy sink factor records with identical box & source
-!--         againg across all values from all processors
-            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
-!--                     We could simply take either first or second rtransp, both are valid. As a very simple heuristic about which ray
-!--                     probably passes nearer the center of the target box, we choose DIF from the entry with greater CSF, since that
-!--                     might mean that the traced beam passes longer through the canopy box.
-                        IF ( pcsflt(1,kcsf) < pcsflt(1,icsf+1) )  THEN
-                            pcsflt(2,kcsf) = pcsflt(2,icsf+1)
-                        ENDIF
-                        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
-            DEALLOCATE( pcsflt )
-            DEALLOCATE( kpcsflt )
-            
-        ENDIF
-        
-        RETURN
-        
-301     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 usm_calc_svf
+ 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
+
+    koff = surf_usm_h%koff
+    DO  m = 1, surf_usm_h%ns
+       i = surf_usm_h%i(m)
+       j = surf_usm_h%j(m)
+       k = surf_usm_h%k(m)
+       pt(k+koff,j,i) = pt(k,j,i)
+    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
 
 
@@ -2339,5 +2222,5 @@
 ! ------------
 !> Subroutine checks variables and assigns units.
-!> It is caaled out from subroutine check_parameters.
+!> It is called out from subroutine check_parameters.
 !------------------------------------------------------------------------------!
     SUBROUTINE usm_check_data_output( variable, unit )
@@ -2358,7 +2241,13 @@
              var(1:14) == 'usm_rad_ressw_'  .OR.  var(1:14) == 'usm_rad_reslw_'  .OR.     &
              var(1:11) == 'usm_rad_hf_'  .OR.                                             &
-             var(1:9)  == 'usm_wshf_'  .OR.  var(1:9) == 'usm_wghf_' )  THEN
+             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_' )  THEN
             unit = 'W/m2'
-        ELSE IF ( var(1:10) == 'usm_t_surf'  .OR.  var(1:10) == 'usm_t_wall' )  THEN
+        ELSE IF ( var(1:10) == 'usm_t_surf'  .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:16) == 'usm_t_surf_whole' .OR. var(1:11) == 'usm_t_green' .OR.    &
+                  var(1:15) == 'usm_t_surf_10cm')  THEN
             unit = 'K'
         ELSE IF ( var(1:9) == 'usm_surfz'  .OR.  var(1:7) == 'usm_svf'  .OR.              & 
@@ -2414,5 +2303,4 @@
        ENDIF
 
-
     END SUBROUTINE usm_check_parameters
 
@@ -2443,5 +2331,5 @@
         INTEGER(iwp), PARAMETER                                :: nd = 5
         CHARACTER(len=6), DIMENSION(0:nd-1), PARAMETER         :: dirname = (/ '_roof ', '_south', '_north', '_west ', '_east ' /)
-        INTEGER(iwp), DIMENSION(0:nd-1), PARAMETER             :: dirint = (/ iroof, isouth, inorth, iwest, ieast /)
+        INTEGER(iwp), DIMENSION(0:nd-1), PARAMETER             :: dirint = (/ iup_u, isouth_u, inorth_u, iwest_u, ieast_u /)
         INTEGER(iwp), DIMENSION(0:nd-1)                        :: dirstart
         INTEGER(iwp), DIMENSION(0:nd-1)                        :: dirend
@@ -2477,4 +2365,18 @@
             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_svf_'  .OR.  var(1:8) == 'usm_dif_')  .AND.  len(TRIM(var)) >= 13 )  THEN
 !--         svf values to particular surface
@@ -2531,10 +2433,15 @@
               
           CASE ( 'usm_surfalb' )
-!--           surface albedo
+!--           surface albedo, weighted average
               DO  m = 1, surf_usm_h%ns
                  i = surf_usm_h%i(m)
                  j = surf_usm_h%j(m)
                  k = surf_usm_h%k(m)
-                 temp_pf(k,j,i) = surf_usm_h%albedo_surf(m)
+                 temp_pf(k,j,i) = surf_usm_h%frac(0,m)     *                   &
+                                  surf_usm_h%albedo(0,m) +                     &
+                                  surf_usm_h%frac(1,m)     *                   &
+                                  surf_usm_h%albedo(1,m) +                     &
+                                  surf_usm_h%frac(2,m)     *                   &
+                                  surf_usm_h%albedo(2,m)
               ENDDO
               DO  l = 0, 3
@@ -2543,15 +2450,25 @@
                     j = surf_usm_v(l)%j(m)
                     k = surf_usm_v(l)%k(m)
-                    temp_pf(k,j,i) = surf_usm_v(l)%albedo_surf(m)
+                    temp_pf(k,j,i) = surf_usm_v(l)%frac(0,m)     *             &
+                                     surf_usm_v(l)%albedo(0,m) +               &
+                                     surf_usm_v(l)%frac(1,m)     *             &
+                                     surf_usm_v(l)%albedo(1,m) +               &
+                                     surf_usm_v(l)%frac(2,m)     *             &
+                                     surf_usm_v(l)%albedo(2,m)
                  ENDDO
               ENDDO
               
           CASE ( 'usm_surfemis' )
-!--           surface albedo
+!--           surface emissivity, weighted average
               DO  m = 1, surf_usm_h%ns
                  i = surf_usm_h%i(m)
                  j = surf_usm_h%j(m)
                  k = surf_usm_h%k(m)
-                 temp_pf(k,j,i) = surf_usm_h%emiss_surf(m)
+                 temp_pf(k,j,i) =  surf_usm_h%frac(0,m)     *                  &
+                                   surf_usm_h%emissivity(0,m) +                &
+                                   surf_usm_h%frac(1,m)     *                  &
+                                   surf_usm_h%emissivity(1,m) +                &
+                                   surf_usm_h%frac(2,m)     *                  &
+                                   surf_usm_h%emissivity(2,m)
               ENDDO
               DO  l = 0, 3
@@ -2560,7 +2477,31 @@
                     j = surf_usm_v(l)%j(m)
                     k = surf_usm_v(l)%k(m)
-                    temp_pf(k,j,i) = surf_usm_v(l)%emiss_surf(m)
+                    temp_pf(k,j,i) = surf_usm_v(l)%frac(0,m)       *           &
+                                     surf_usm_v(l)%emissivity(0,m) +           &
+                                     surf_usm_v(l)%frac(1,m) *                 &
+                                     surf_usm_v(l)%emissivity(1,m) +           &
+                                     surf_usm_v(l)%frac(2,m)     *             &
+                                     surf_usm_v(l)%emissivity(2,m)
                  ENDDO
               ENDDO
+
+          CASE ( 'usm_surfwintrans' )
+!--           transmissivity window tiles
+              DO  m = 1, surf_usm_h%ns
+                 i = surf_usm_h%i(m)
+                 j = surf_usm_h%j(m)
+                 k = surf_usm_h%k(m)
+                 temp_pf(k,j,i) = surf_usm_h%transmissivity(m)
+              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)
+                    temp_pf(k,j,i) = surf_usm_v(l)%transmissivity(m)
+                 ENDDO
+
+              ENDDO
+
 !
 !-- Not adjusted so far              
@@ -2841,4 +2782,143 @@
               ENDIF
 
+          CASE ( 'usm_wghf_window' )
+!--           array of heat flux from window ground (land, wall, roof)
+
+              IF ( av == 0 )  THEN
+                 DO  m = 1, surf_usm_h%ns
+                    i = surf_usm_h%i(m)
+                    j = surf_usm_h%j(m)
+                    k = surf_usm_h%k(m)
+                    temp_pf(k,j,i) = surf_usm_h%wghf_eb_window(m)
+                 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)
+                       temp_pf(k,j,i) = surf_usm_v(l)%wghf_eb_window(m)
+                    ENDDO
+                 ENDDO
+              ELSE
+                 DO  m = 1, surf_usm_h%ns
+                    i = surf_usm_h%i(m)
+                    j = surf_usm_h%j(m)
+                    k = surf_usm_h%k(m)
+                    temp_pf(k,j,i) = surf_usm_h%wghf_eb_window_av(m)
+                 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)
+                       temp_pf(k,j,i) = surf_usm_v(l)%wghf_eb_window_av(m)
+                    ENDDO
+                 ENDDO
+              ENDIF
+
+          CASE ( 'usm_wghf_green' )
+!--           array of heat flux from green ground (land, wall, roof)
+
+              IF ( av == 0 )  THEN
+                 DO  m = 1, surf_usm_h%ns
+                    i = surf_usm_h%i(m)
+                    j = surf_usm_h%j(m)
+                    k = surf_usm_h%k(m)
+                    temp_pf(k,j,i) = surf_usm_h%wghf_eb_green(m)
+                 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)
+                       temp_pf(k,j,i) = surf_usm_v(l)%wghf_eb_green(m)
+                    ENDDO
+                 ENDDO
+              ELSE
+                 DO  m = 1, surf_usm_h%ns
+                    i = surf_usm_h%i(m)
+                    j = surf_usm_h%j(m)
+                    k = surf_usm_h%k(m)
+                    temp_pf(k,j,i) = surf_usm_h%wghf_eb_green_av(m)
+                 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)
+                       temp_pf(k,j,i) = surf_usm_v(l)%wghf_eb_green_av(m)
+                    ENDDO
+                 ENDDO
+              ENDIF
+
+          CASE ( 'usm_iwghf' )
+!--           array of heat flux from indoor ground (land, wall, roof)
+              IF ( av == 0 )  THEN
+                 DO  m = 1, surf_usm_h%ns
+                    i = surf_usm_h%i(m)
+                    j = surf_usm_h%j(m)
+                    k = surf_usm_h%k(m)
+                    temp_pf(k,j,i) = surf_usm_h%iwghf_eb(m)
+                 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)
+                       temp_pf(k,j,i) = surf_usm_v(l)%iwghf_eb(m)
+                    ENDDO
+                 ENDDO
+              ELSE
+                 DO  m = 1, surf_usm_h%ns
+                    i = surf_usm_h%i(m)
+                    j = surf_usm_h%j(m)
+                    k = surf_usm_h%k(m)
+                    temp_pf(k,j,i) = surf_usm_h%iwghf_eb_av(m)
+                 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)
+                       temp_pf(k,j,i) = surf_usm_v(l)%iwghf_eb_av(m)
+                    ENDDO
+                 ENDDO
+              ENDIF
+
+          CASE ( 'usm_iwghf_window' )
+!--           array of heat flux from indoor window ground (land, wall, roof)
+
+              IF ( av == 0 )  THEN
+                 DO  m = 1, surf_usm_h%ns
+                    i = surf_usm_h%i(m)
+                    j = surf_usm_h%j(m)
+                    k = surf_usm_h%k(m)
+                    temp_pf(k,j,i) = surf_usm_h%iwghf_eb_window(m)
+                 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)
+                       temp_pf(k,j,i) = surf_usm_v(l)%iwghf_eb_window(m)
+                    ENDDO
+                 ENDDO
+              ELSE
+                 DO  m = 1, surf_usm_h%ns
+                    i = surf_usm_h%i(m)
+                    j = surf_usm_h%j(m)
+                    k = surf_usm_h%k(m)
+                    temp_pf(k,j,i) = surf_usm_h%iwghf_eb_window_av(m)
+                 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)
+                       temp_pf(k,j,i) = surf_usm_v(l)%iwghf_eb_window_av(m)
+                    ENDDO
+                 ENDDO
+              ENDIF
+              
           CASE ( 'usm_t_surf' )
 !--           surface temperature for surfaces
@@ -2874,4 +2954,157 @@
                  ENDDO
               ENDIF
+              
+          CASE ( 'usm_t_surf_window' )
+!--           surface temperature for window surfaces
+
+              IF ( av == 0 )  THEN
+                 DO  m = 1, surf_usm_h%ns
+                    i = surf_usm_h%i(m)
+                    j = surf_usm_h%j(m)
+                    k = surf_usm_h%k(m)
+                    temp_pf(k,j,i) = t_surf_window_h(m)
+                 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)
+                       temp_pf(k,j,i) = t_surf_window_v(l)%t(m)
+                    ENDDO
+                 ENDDO
+
+              ELSE
+                 DO  m = 1, surf_usm_h%ns
+                    i = surf_usm_h%i(m)
+                    j = surf_usm_h%j(m)
+                    k = surf_usm_h%k(m)
+                    temp_pf(k,j,i) = surf_usm_h%t_surf_window_av(m)
+                 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)
+                       temp_pf(k,j,i) = surf_usm_v(l)%t_surf_window_av(m)
+                    ENDDO
+
+                 ENDDO
+
+              ENDIF
+
+          CASE ( 'usm_t_surf_green' )
+!--           surface temperature for green surfaces
+
+              IF ( av == 0 )  THEN
+                 DO  m = 1, surf_usm_h%ns
+                    i = surf_usm_h%i(m)
+                    j = surf_usm_h%j(m)
+                    k = surf_usm_h%k(m)
+                    temp_pf(k,j,i) = t_surf_green_h(m)
+                 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)
+                       temp_pf(k,j,i) = t_surf_green_v(l)%t(m)
+                    ENDDO
+                 ENDDO
+
+              ELSE
+                 DO  m = 1, surf_usm_h%ns
+                    i = surf_usm_h%i(m)
+                    j = surf_usm_h%j(m)
+                    k = surf_usm_h%k(m)
+                    temp_pf(k,j,i) = surf_usm_h%t_surf_green_av(m)
+                 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)
+                       temp_pf(k,j,i) = surf_usm_v(l)%t_surf_green_av(m)
+                    ENDDO
+
+                 ENDDO
+
+              ENDIF
+
+          CASE ( 'usm_t_surf_whole' )
+!--           surface temperature for whole surfaces
+
+              IF ( av == 0 )  THEN
+                 DO  m = 1, surf_usm_h%ns
+                    i = surf_usm_h%i(m)
+                    j = surf_usm_h%j(m)
+                    k = surf_usm_h%k(m)
+                    temp_pf(k,j,i) = t_surf_whole_h(m)
+                 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)
+                       temp_pf(k,j,i) = t_surf_whole_v(l)%t(m)
+                    ENDDO
+                 ENDDO
+
+              ELSE
+                 DO  m = 1, surf_usm_h%ns
+                    i = surf_usm_h%i(m)
+                    j = surf_usm_h%j(m)
+                    k = surf_usm_h%k(m)
+                    temp_pf(k,j,i) = surf_usm_h%t_surf_whole_av(m)
+                 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)
+                       temp_pf(k,j,i) = surf_usm_v(l)%t_surf_whole_av(m)
+                    ENDDO
+
+                 ENDDO
+
+              ENDIF
+              
+          CASE ( 'usm_t_surf_10cm' )
+!--           near surface temperature for whole surfaces
+
+              IF ( av == 0 )  THEN
+                 DO  m = 1, surf_usm_h%ns
+                    i = surf_usm_h%i(m)
+                    j = surf_usm_h%j(m)
+                    k = surf_usm_h%k(m)
+                    temp_pf(k,j,i) = t_surf_10cm_h(m)
+                 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)
+                       temp_pf(k,j,i) = t_surf_10cm_v(l)%t(m)
+                    ENDDO
+                 ENDDO
+
+              ELSE
+                 DO  m = 1, surf_usm_h%ns
+                    i = surf_usm_h%i(m)
+                    j = surf_usm_h%j(m)
+                    k = surf_usm_h%k(m)
+                    temp_pf(k,j,i) = surf_usm_h%t_surf_10cm_av(m)
+                 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)
+                       temp_pf(k,j,i) = surf_usm_v(l)%t_surf_10cm_av(m)
+                    ENDDO
+
+                 ENDDO
+
+              ENDIF
+
               
           CASE ( 'usm_t_wall' )
@@ -2909,8 +3142,78 @@
               ENDIF
              
+          CASE ( 'usm_t_window' )
+!--           window temperature for iwl layer of walls and land
+              IF ( av == 0 )  THEN
+                 DO  m = 1, surf_usm_h%ns
+                    i = surf_usm_h%i(m)
+                    j = surf_usm_h%j(m)
+                    k = surf_usm_h%k(m)
+                    temp_pf(k,j,i) = t_window_h(iwl,m)
+                 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)
+                       temp_pf(k,j,i) = t_window_v(l)%t(iwl,m)
+                    ENDDO
+                 ENDDO
+              ELSE
+                 DO  m = 1, surf_usm_h%ns
+                    i = surf_usm_h%i(m)
+                    j = surf_usm_h%j(m)
+                    k = surf_usm_h%k(m)
+                    temp_pf(k,j,i) = surf_usm_h%t_window_av(iwl,m)
+                 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)
+                       temp_pf(k,j,i) = surf_usm_v(l)%t_window_av(iwl,m)
+                    ENDDO
+                 ENDDO
+              ENDIF
+
+          CASE ( 'usm_t_green' )
+!--           green temperature for  iwl layer of walls and land
+              IF ( av == 0 )  THEN
+                 DO  m = 1, surf_usm_h%ns
+                    i = surf_usm_h%i(m)
+                    j = surf_usm_h%j(m)
+                    k = surf_usm_h%k(m)
+                    temp_pf(k,j,i) = t_green_h(iwl,m)
+                 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)
+                       temp_pf(k,j,i) = t_green_v(l)%t(iwl,m)
+                    ENDDO
+                 ENDDO
+              ELSE
+                 DO  m = 1, surf_usm_h%ns
+                    i = surf_usm_h%i(m)
+                    j = surf_usm_h%j(m)
+                    k = surf_usm_h%k(m)
+                    temp_pf(k,j,i) = surf_usm_h%t_green_av(iwl,m)
+                 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)
+                       temp_pf(k,j,i) = surf_usm_v(l)%t_green_av(iwl,m)
+                    ENDDO
+                 ENDDO
+              ENDIF
+
+             
           CASE DEFAULT
               found = .FALSE.
               
         END SELECT
+
 !
 !--     Rearrange dimensions for NetCDF output
@@ -2954,8 +3257,14 @@
              var(1:11) == 'usm_rad_hf_'  .OR.                                               &
              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:10) == 'usm_t_surf'  .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:16) == 'usm_t_surf_whole' .OR.    &
+             var(1:15) == 'usm_t_surf_10cm' .OR.                                            &
              var(1:9) == 'usm_surfz'  .OR.  var(1:7) == 'usm_svf'  .OR.                     & 
              var(1:7) == 'usm_dif'  .OR.  var(1:11) == 'usm_surfcat'  .OR.                  &
-             var(1:11) == 'usm_surfalb'  .OR.  var(1:12) == 'usm_surfemis' )  THEN
+             var(1:11) == 'usm_surfalb'  .OR.  var(1:12) == 'usm_surfemis'  .OR.            &
+             var(1:16) == 'usm_surfwintrans' )  THEN
 
             found = .TRUE.
@@ -2972,118 +3281,4 @@
     END SUBROUTINE usm_define_netcdf_grid
     
-    
-!------------------------------------------------------------------------------!
-!> Finds first model boundary crossed by a ray
-!------------------------------------------------------------------------------!
-    PURE SUBROUTINE usm_find_boundary_face(origin, uvect, bdycross)
-    
-       IMPLICIT NONE
-       
-       INTEGER(iwp) ::  d       !<
-       INTEGER(iwp) ::  seldim  !< found fist crossing index
-
-       INTEGER(iwp), DIMENSION(3)              ::  bdyd      !< boundary direction       
-       INTEGER(iwp), DIMENSION(4), INTENT(out) ::  bdycross  !< found boundary crossing (d, z, y, x)
-       
-       REAL(wp)                                ::  bdydim  !< 
-       REAL(wp)                                ::  dist    !<
-       
-       REAL(wp), DIMENSION(3)             ::  crossdist  !< crossing distance
-       REAL(wp), DIMENSION(3), INTENT(in) ::  origin     !< ray origin
-       REAL(wp), DIMENSION(3), INTENT(in) ::  uvect      !< ray unit vector
- 
-
-       bdydim       = nzut + .5_wp  !< top boundary
-       bdyd(1)      = isky
-       crossdist(1) = ( bdydim - origin(1) ) / uvect(1)  !< subroutine called only when uvect(1)>0
-
-       IF ( uvect(2) == 0._wp )  THEN
-          crossdist(2) = huge(1._wp)
-       ELSE
-          IF ( uvect(2) >= 0._wp )  THEN
-             bdydim  = ny + .5_wp  !< north global boundary
-             bdyd(2) = inorthb
-          ELSE
-             bdydim  = -.5_wp  !< south global boundary
-             bdyd(2) = isouthb
-          ENDIF
-          crossdist(2) = ( bdydim - origin(2) ) / uvect(2)
-       ENDIF
-
-       IF ( uvect(3) == 0._wp )  THEN
-          crossdist(3) = huge(1._wp)
-       ELSE
-          IF ( uvect(3) >= 0._wp )  THEN
-             bdydim  = nx + .5_wp  !< east global boundary
-             bdyd(3) = ieastb
-          ELSE
-             bdydim  = -.5_wp  !< west global boundary
-             bdyd(3) = iwestb
-          ENDIF
-          crossdist(3) = ( bdydim - origin(3) ) / uvect(3)
-       ENDIF
-
-       seldim = minloc(crossdist, 1)
-       dist   = crossdist(seldim)
-       d      = bdyd(seldim)
-
-       bdycross(1)   = d
-       bdycross(2:4) = NINT( origin(:) + uvect(:) * dist &
-                                       + .5_wp * (/ kdir(d), jdir(d), idir(d) /) )
-                        
-    END SUBROUTINE
-
-
-!------------------------------------------------------------------------------!
-!> Determines whether two faces are oriented towards each other
-!------------------------------------------------------------------------------!
-    PURE LOGICAL FUNCTION usm_facing(x, y, z, d, x2, y2, z2, d2)
-        IMPLICIT NONE
-        INTEGER(iwp),   INTENT(in)  :: x, y, z, d, x2, y2, z2, d2
-      
-        usm_facing = .FALSE.
-        IF ( d==iroof  .AND.  d2==iroof ) RETURN
-        IF ( d==isky  .AND.  d2==isky ) RETURN
-        IF ( (d==isouth  .OR.  d==inorthb)  .AND.  (d2==isouth.OR.d2==inorthb) ) RETURN
-        IF ( (d==inorth  .OR.  d==isouthb)  .AND.  (d2==inorth.OR.d2==isouthb) ) RETURN
-        IF ( (d==iwest  .OR.  d==ieastb)  .AND.  (d2==iwest.OR.d2==ieastb) ) RETURN
-        IF ( (d==ieast  .OR.  d==iwestb)  .AND.  (d2==ieast.OR.d2==iwestb) ) RETURN
-
-        SELECT CASE (d)
-            CASE (iroof)                   !< ground, roof
-                IF ( z2 < z ) RETURN
-            CASE (isky)                    !< sky
-                IF ( z2 > z ) RETURN
-            CASE (isouth, inorthb)         !< south facing
-                IF ( y2 > y ) RETURN
-            CASE (inorth, isouthb)         !< north facing
-                IF ( y2 < y ) RETURN
-            CASE (iwest, ieastb)           !< west facing
-                IF ( x2 > x ) RETURN
-            CASE (ieast, iwestb)           !< east facing
-                IF ( x2 < x ) RETURN
-        END SELECT
-
-        SELECT CASE (d2)
-            CASE (iroof)                   !< ground, roof
-                IF ( z < z2 ) RETURN
-            CASE (isky)                    !< sky
-                IF ( z > z2 ) RETURN
-            CASE (isouth, inorthb)         !< south facing
-                IF ( y > y2 ) RETURN
-            CASE (inorth, isouthb)         !< north facing
-                IF ( y < y2 ) RETURN
-            CASE (iwest, ieastb)           !< west facing
-                IF ( x > x2 ) RETURN
-            CASE (ieast, iwestb)           !< east facing
-                IF ( x < x2 ) RETURN
-            CASE (-1)
-                CONTINUE
-        END SELECT
-
-        usm_facing = .TRUE.
-        
-    END FUNCTION usm_facing
-    
 
 !------------------------------------------------------------------------------!
@@ -3102,13 +3297,8 @@
 !--     Calculate wall grid spacings. 
 !--     Temperature is defined at the center of the wall layers,
-!--     whereas gradients/fluxes are defined at the edges (_stag)
-        DO k = nzb_wall, nzt_wall
-           zwn(k) = zwn_default(k)
-        ENDDO
-!        
+!--     whereas gradients/fluxes are defined at the edges (_stag)      
 !--     apply for all particular surface grids. First for horizontal surfaces
         DO  m = 1, surf_usm_h%ns
-           surf_usm_h%zw(:,m)             = zwn(:) *                           &
-                                            surf_usm_h%thickness_wall(m)
+
            surf_usm_h%dz_wall(nzb_wall,m) = surf_usm_h%zw(nzb_wall,m)
            DO k = nzb_wall+1, nzt_wall
@@ -3116,4 +3306,14 @@
                                          surf_usm_h%zw(k-1,m)
            ENDDO
+           surf_usm_h%dz_window(nzb_wall,m) = surf_usm_h%zw_window(nzb_wall,m)
+           DO k = nzb_wall+1, nzt_wall
+               surf_usm_h%dz_window(k,m) = surf_usm_h%zw_window(k,m) -         &
+                                         surf_usm_h%zw_window(k-1,m)
+           ENDDO
+           surf_usm_h%dz_green(nzb_wall,m) = surf_usm_h%zw_green(nzb_wall,m)
+           DO k = nzb_wall+1, nzt_wall
+               surf_usm_h%dz_green(k,m) = surf_usm_h%zw_green(k,m) -           &
+                                         surf_usm_h%zw_green(k-1,m)
+           ENDDO
            
            surf_usm_h%dz_wall(nzt_wall+1,m) = surf_usm_h%dz_wall(nzt_wall,m)
@@ -3124,17 +3324,45 @@
            ENDDO
            surf_usm_h%dz_wall_stag(nzt_wall,m) = surf_usm_h%dz_wall(nzt_wall,m)
+           
+           surf_usm_h%dz_window(nzt_wall+1,m) = surf_usm_h%dz_window(nzt_wall,m)
+
+           DO k = nzb_wall, nzt_wall-1
+               surf_usm_h%dz_window_stag(k,m) = 0.5 * (                        &
+                           surf_usm_h%dz_window(k+1,m) + surf_usm_h%dz_window(k,m) )
+           ENDDO
+           surf_usm_h%dz_window_stag(nzt_wall,m) = surf_usm_h%dz_window(nzt_wall,m)
+
+           surf_usm_h%dz_green(nzt_wall+1,m) = surf_usm_h%dz_green(nzt_wall,m)
+
+           DO k = nzb_wall, nzt_wall-1
+               surf_usm_h%dz_green_stag(k,m) = 0.5 * (                         &
+                           surf_usm_h%dz_green(k+1,m) + surf_usm_h%dz_green(k,m) )
+           ENDDO
+           surf_usm_h%dz_green_stag(nzt_wall,m) = surf_usm_h%dz_green(nzt_wall,m)
         ENDDO
-        surf_usm_h%ddz_wall      = 1.0_wp / surf_usm_h%dz_wall
-        surf_usm_h%ddz_wall_stag = 1.0_wp / surf_usm_h%dz_wall_stag
+        surf_usm_h%ddz_wall        = 1.0_wp / surf_usm_h%dz_wall
+        surf_usm_h%ddz_wall_stag   = 1.0_wp / surf_usm_h%dz_wall_stag
+        surf_usm_h%ddz_window      = 1.0_wp / surf_usm_h%dz_window
+        surf_usm_h%ddz_window_stag = 1.0_wp / surf_usm_h%dz_window_stag
+        surf_usm_h%ddz_green       = 1.0_wp / surf_usm_h%dz_green
+        surf_usm_h%ddz_green_stag  = 1.0_wp / surf_usm_h%dz_green_stag
 !        
 !--     For vertical surfaces
         DO  l = 0, 3
            DO  m = 1, surf_usm_v(l)%ns
-              surf_usm_v(l)%zw(:,m)             = zwn(:) *                     &
-                                                  surf_usm_v(l)%thickness_wall(m)
               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
            
@@ -3149,7 +3377,31 @@
               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_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      
 
@@ -3168,9 +3420,41 @@
 !------------------------------------------------------------------------------!
     SUBROUTINE usm_init_urban_surface
+
+        USE arrays_3d,                                                         &
+            ONLY:  zw
+
+        USE netcdf_data_input_mod,                                             &
+            ONLY:  building_pars_f, building_type_f, terrain_height_f
     
         IMPLICIT NONE
 
-        INTEGER(iwp) ::  i, j, k, l, m            !< running indices
-        REAL(wp)     ::  c, d, tin, exn
+        INTEGER(iwp) ::  i                   !< loop index x-dirction
+        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_hc2             !< index in input list for heat capacity at second wall layer
+        INTEGER(iwp) ::  ind_hc3             !< index in input list for heat capacity at third wall 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_tc2             !< index in input list for thermal conductivity at second wall layer
+        INTEGER(iwp) ::  ind_tc3             !< index in input list for thermal conductivity at third wall 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) ::  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  
+
+        REAL(wp)     ::  c, d, tin, twin, exn
+        REAL(wp)     ::  ground_floor_level_l         !< local height of ground floor level
+        REAL(wp)     ::  z_agl                        !< height above ground
 
 !
@@ -3187,9 +3471,949 @@
             lsf_surf = .FALSE.
         ENDIF
-       
-!--     init anthropogenic sources of heat
-        CALL usm_allocate_urban_surface()
-       
-!--     read the surface_types array somewhere
+
+!
+!--     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.
+        surf_usm_h%ground_level = .FALSE. 
+        DO  m = 1, surf_usm_h%ns
+           i = surf_usm_h%i(m)
+           j = surf_usm_h%j(m)
+           k = surf_usm_h%k(m)
+!
+!--        Get local ground level. If no ground level is given in input file,
+!--        use default value.
+           ground_floor_level_l = ground_floor_level
+           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
+           IF (  terrain_height_f%from_file )  THEN
+              z_agl = zw(k) - terrain_height_f%var(j,i)
+           ELSE
+              z_agl = zw(k)
+           ENDIF
+!
+!--        Set flag for ground level
+           IF ( z_agl <= ground_floor_level_l )                                &
+              surf_usm_h%ground_level(m) = .TRUE.
+        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)
+!
+!--           Get local ground level. If no ground level is given in input file,
+!--           use default value.
+              ground_floor_level_l = ground_floor_level
+              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, height of surface element is determined with respect to
+!--           its height of the adjoing atmospheric grid point. 
+              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
+!
+!--     Initialize urban-type surface attribute. According to initialization in 
+!--     land-surface model, follow a 3-level approach.
+!--     Level 1 - initialization via default attributes 
+        DO  m = 1, surf_usm_h%ns
+!
+!--        Now, all horizontal surfaces are roof surfaces (?)
+           surf_usm_h%isroof_surf(m)   = .TRUE.
+           surf_usm_h%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_wall_frac    = MERGE( ind_wall_frac_gfl,    ind_wall_frac_agfl,    &
+                                     surf_usm_h%ground_level(m) )
+           ind_win_frac     = MERGE( ind_win_frac_gfl,     ind_win_frac_agfl,     &
+                                     surf_usm_h%ground_level(m) )
+           ind_green_frac_w = MERGE( ind_green_frac_w_gfl, ind_green_frac_w_agfl, &
+                                     surf_usm_h%ground_level(m) )
+           ind_green_frac_r = MERGE( ind_green_frac_r_gfl, ind_green_frac_r_agfl, &
+                                     surf_usm_h%ground_level(m) )
+           ind_lai_r        = MERGE( ind_lai_r_gfl,        ind_lai_r_agfl,        &
+                                     surf_usm_h%ground_level(m) )
+           ind_lai_w        = MERGE( ind_lai_w_gfl,        ind_lai_w_agfl,        &
+                                     surf_usm_h%ground_level(m) )
+           ind_hc1          = MERGE( ind_hc1_gfl,          ind_hc1_agfl,          &
+                                     surf_usm_h%ground_level(m) )
+           ind_hc2          = MERGE( ind_hc2_gfl,          ind_hc2_agfl,          &
+                                     surf_usm_h%ground_level(m) )
+           ind_hc3          = MERGE( ind_hc3_gfl,          ind_hc3_agfl,          &
+                                     surf_usm_h%ground_level(m) )
+           ind_tc1          = MERGE( ind_tc1_gfl,          ind_tc1_agfl,          &
+                                     surf_usm_h%ground_level(m) )
+           ind_tc2          = MERGE( ind_tc2_gfl,          ind_tc2_agfl,          &
+                                     surf_usm_h%ground_level(m) )
+           ind_tc3          = MERGE( ind_tc3_gfl,          ind_tc3_agfl,          &
+                                     surf_usm_h%ground_level(m) )
+           ind_emis_wall    = MERGE( ind_emis_wall_gfl,    ind_emis_wall_agfl,    &
+                                     surf_usm_h%ground_level(m) )
+           ind_emis_green   = MERGE( ind_emis_green_gfl,   ind_emis_green_agfl,   &
+                                     surf_usm_h%ground_level(m) )
+           ind_emis_win     = MERGE( ind_emis_win_gfl,     ind_emis_win_agfl,     &
+                                     surf_usm_h%ground_level(m) )
+           ind_trans        = MERGE( ind_trans_gfl,        ind_trans_agfl,        &
+                                     surf_usm_h%ground_level(m) )
+           ind_z0           = MERGE( ind_z0_gfl,           ind_z0_agfl,           &
+                                     surf_usm_h%ground_level(m) )
+           ind_z0qh         = MERGE( ind_z0qh_gfl,         ind_z0qh_agfl,         &
+                                     surf_usm_h%ground_level(m) )
+!
+!--        Initialize relatvie wall- (0), green- (1) and window (2) fractions
+           surf_usm_h%frac(0,m)  = building_pars(ind_wall_frac,building_type)   
+           surf_usm_h%frac(1,m)  = building_pars(ind_green_frac_r,building_type)  
+           surf_usm_h%frac(2,m)  = building_pars(ind_win_frac,building_type)  
+           surf_usm_h%lai(m)     = building_pars(ind_green_frac_r,building_type)  
+
+           surf_usm_h%rho_c_wall(nzb_wall,m)   = building_pars(ind_hc1,building_type)  
+           surf_usm_h%rho_c_wall(nzb_wall+1,m) = building_pars(ind_hc1,building_type)
+           surf_usm_h%rho_c_wall(nzb_wall+2,m) = building_pars(ind_hc2,building_type)
+           surf_usm_h%rho_c_wall(nzb_wall+3,m) = building_pars(ind_hc3,building_type)    
+           surf_usm_h%lambda_h(nzb_wall,m)   = building_pars(ind_tc1,building_type)  
+           surf_usm_h%lambda_h(nzb_wall+1,m) = building_pars(ind_tc1,building_type) 
+           surf_usm_h%lambda_h(nzb_wall+2,m) = building_pars(ind_tc2,building_type)
+           surf_usm_h%lambda_h(nzb_wall+3,m) = building_pars(ind_tc3,building_type)    
+           surf_usm_h%rho_c_green(nzb_wall,m)   = building_pars(ind_hc1,building_type)  
+           surf_usm_h%rho_c_green(nzb_wall+1,m) = building_pars(ind_hc1,building_type)
+           surf_usm_h%rho_c_green(nzb_wall+2,m) = building_pars(ind_hc2,building_type)
+           surf_usm_h%rho_c_green(nzb_wall+3,m) = building_pars(ind_hc3,building_type)    
+           surf_usm_h%lambda_h_green(nzb_wall,m)   = building_pars(ind_tc1,building_type)  
+           surf_usm_h%lambda_h_green(nzb_wall+1,m) = building_pars(ind_tc1,building_type) 
+           surf_usm_h%lambda_h_green(nzb_wall+2,m) = building_pars(ind_tc2,building_type)
+           surf_usm_h%lambda_h_green(nzb_wall+3,m) = building_pars(ind_tc3,building_type)
+           surf_usm_h%rho_c_window(nzb_wall,m)   = building_pars(ind_hc1,building_type)  
+           surf_usm_h%rho_c_window(nzb_wall+1,m) = building_pars(ind_hc1,building_type)
+           surf_usm_h%rho_c_window(nzb_wall+2,m) = building_pars(ind_hc2,building_type)
+           surf_usm_h%rho_c_window(nzb_wall+3,m) = building_pars(ind_hc3,building_type)    
+           surf_usm_h%lambda_h_window(nzb_wall,m)   = building_pars(ind_tc1,building_type)  
+           surf_usm_h%lambda_h_window(nzb_wall+1,m) = building_pars(ind_tc1,building_type) 
+           surf_usm_h%lambda_h_window(nzb_wall+2,m) = building_pars(ind_tc2,building_type)
+           surf_usm_h%lambda_h_window(nzb_wall+3,m) = building_pars(ind_tc3,building_type)    
+
+           surf_usm_h%target_temp_summer(m)  = building_pars(12,building_type)    
+           surf_usm_h%target_temp_winter(m)  = building_pars(13,building_type)    
+!
+!--        emissivity of wall-, green- and window fraction 
+           surf_usm_h%emissivity(0,m)        = building_pars(ind_emis_wall,building_type)
+           surf_usm_h%emissivity(1,m)        = building_pars(ind_emis_green,building_type)
+           surf_usm_h%emissivity(2,m)        = building_pars(ind_emis_win,building_type)
+
+           surf_usm_h%transmissivity(m)      = building_pars(ind_trans,building_type)
+
+           surf_usm_h%z0(m)                  = building_pars(ind_z0,building_type)
+           surf_usm_h%z0h(m)                 = building_pars(ind_z0qh,building_type)
+           surf_usm_h%z0q(m)                 = building_pars(ind_z0qh,building_type)
+!
+!--        albedo type for wall fraction, green fraction, window fraction
+           surf_usm_h%albedo_type(0,m)       = INT( building_pars(ind_alb_wall,building_type)  )
+           surf_usm_h%albedo_type(1,m)       = INT( building_pars(ind_alb_green,building_type) )
+           surf_usm_h%albedo_type(2,m)       = INT( building_pars(ind_alb_win,building_type)   )
+
+           surf_usm_h%zw(nzb_wall,m)         = building_pars(ind_thick_1,building_type)
+           surf_usm_h%zw(nzb_wall+1,m)       = building_pars(ind_thick_2,building_type)
+           surf_usm_h%zw(nzb_wall+2,m)       = building_pars(ind_thick_3,building_type)
+           surf_usm_h%zw(nzb_wall+3,m)       = building_pars(ind_thick_4,building_type)
+           
+           surf_usm_h%zw_green(nzb_wall,m)         = building_pars(ind_thick_1,building_type)
+           surf_usm_h%zw_green(nzb_wall+1,m)       = building_pars(ind_thick_2,building_type)
+           surf_usm_h%zw_green(nzb_wall+2,m)       = building_pars(ind_thick_3,building_type)
+           surf_usm_h%zw_green(nzb_wall+3,m)       = building_pars(ind_thick_4,building_type)
+           
+           surf_usm_h%zw_window(nzb_wall,m)         = building_pars(ind_thick_1,building_type)
+           surf_usm_h%zw_window(nzb_wall+1,m)       = building_pars(ind_thick_2,building_type)
+           surf_usm_h%zw_window(nzb_wall+2,m)       = building_pars(ind_thick_3,building_type)
+           surf_usm_h%zw_window(nzb_wall+3,m)       = building_pars(ind_thick_4,building_type)
+
+           surf_usm_h%c_surface(m)           = building_pars(45,building_type)  
+           surf_usm_h%lambda_surf(m)         = building_pars(46,building_type)  
+           surf_usm_h%c_surface_green(m)     = building_pars(45,building_type)  
+           surf_usm_h%lambda_surf_green(m)   = building_pars(46,building_type)  
+           surf_usm_h%c_surface_window(m)    = building_pars(45,building_type)  
+           surf_usm_h%lambda_surf_window(m)  = building_pars(46,building_type)  
+
+        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_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_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_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_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) )
+
+!
+!--           Initialize relatvie wall- (0), green- (1) and window (2) fractions
+              surf_usm_v(l)%frac(0,m)              = building_pars(ind_wall_frac,building_type)   
+              surf_usm_v(l)%frac(1,m)              = building_pars(ind_green_frac_w,building_type) 
+              surf_usm_v(l)%frac(2,m)              = 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_hc1,building_type)
+              surf_usm_v(l)%rho_c_wall(nzb_wall+2,m) = building_pars(ind_hc2,building_type)
+              surf_usm_v(l)%rho_c_wall(nzb_wall+3,m) = building_pars(ind_hc3,building_type)    
+              
+              surf_usm_v(l)%rho_c_green(nzb_wall,m)   = building_pars(ind_hc1,building_type)  
+              surf_usm_v(l)%rho_c_green(nzb_wall+1,m) = building_pars(ind_hc1,building_type)
+              surf_usm_v(l)%rho_c_green(nzb_wall+2,m) = building_pars(ind_hc2,building_type)
+              surf_usm_v(l)%rho_c_green(nzb_wall+3,m) = building_pars(ind_hc3,building_type)    
+              
+              surf_usm_v(l)%rho_c_window(nzb_wall,m)   = building_pars(ind_hc1,building_type)  
+              surf_usm_v(l)%rho_c_window(nzb_wall+1,m) = building_pars(ind_hc1,building_type)
+              surf_usm_v(l)%rho_c_window(nzb_wall+2,m) = building_pars(ind_hc2,building_type)
+              surf_usm_v(l)%rho_c_window(nzb_wall+3,m) = building_pars(ind_hc3,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_tc1,building_type) 
+              surf_usm_v(l)%lambda_h(nzb_wall+2,m) = building_pars(ind_tc2,building_type)
+              surf_usm_v(l)%lambda_h(nzb_wall+3,m) = building_pars(ind_tc3,building_type)    
+              
+              surf_usm_v(l)%lambda_h_green(nzb_wall,m)   = building_pars(ind_tc1,building_type)  
+              surf_usm_v(l)%lambda_h_green(nzb_wall+1,m) = building_pars(ind_tc1,building_type) 
+              surf_usm_v(l)%lambda_h_green(nzb_wall+2,m) = building_pars(ind_tc2,building_type)
+              surf_usm_v(l)%lambda_h_green(nzb_wall+3,m) = building_pars(ind_tc3,building_type)    
+
+              surf_usm_v(l)%lambda_h_window(nzb_wall,m)   = building_pars(ind_tc1,building_type)  
+              surf_usm_v(l)%lambda_h_window(nzb_wall+1,m) = building_pars(ind_tc1,building_type) 
+              surf_usm_v(l)%lambda_h_window(nzb_wall+2,m) = building_pars(ind_tc2,building_type)
+              surf_usm_v(l)%lambda_h_window(nzb_wall+3,m) = building_pars(ind_tc3,building_type)    
+
+              surf_usm_v(l)%target_temp_summer(m)  = building_pars(12,building_type)    
+              surf_usm_v(l)%target_temp_winter(m)  = building_pars(13,building_type)    
+!
+!--           emissivity of wall-, green- and window fraction 
+              surf_usm_v(l)%emissivity(0,m)        = building_pars(ind_emis_wall,building_type)
+              surf_usm_v(l)%emissivity(1,m)        = building_pars(ind_emis_green,building_type)
+              surf_usm_v(l)%emissivity(2,m)        = 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(0,m)       = INT( building_pars(ind_alb_wall,building_type) )
+              surf_usm_v(l)%albedo_type(1,m)       = INT( building_pars(ind_alb_green,building_type) )
+              surf_usm_v(l)%albedo_type(2,m)       = 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,building_type)
+              surf_usm_v(l)%zw_window(nzb_wall+1,m)       = building_pars(ind_thick_2,building_type)
+              surf_usm_v(l)%zw_window(nzb_wall+2,m)       = building_pars(ind_thick_3,building_type)
+              surf_usm_v(l)%zw_window(nzb_wall+3,m)       = building_pars(ind_thick_4,building_type)
+
+              surf_usm_v(l)%c_surface(m)           = building_pars(45,building_type)  
+              surf_usm_v(l)%lambda_surf(m)         = building_pars(46,building_type)
+              surf_usm_v(l)%c_surface_green(m)     = building_pars(45,building_type)  
+              surf_usm_v(l)%lambda_surf_green(m)   = building_pars(46,building_type)
+              surf_usm_v(l)%c_surface_window(m)    = building_pars(45,building_type)  
+              surf_usm_v(l)%lambda_surf_window(m)  = building_pars(46,building_type)
+
+           ENDDO
+        ENDDO
+!
+!--     Level 2 - initialization via building type read from file
+        IF ( building_type_f%from_file )  THEN
+           DO  m = 1, surf_usm_h%ns
+              i = surf_usm_h%i(m)
+              j = surf_usm_h%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_wall_frac    = MERGE( ind_wall_frac_gfl,    ind_wall_frac_agfl,    &
+                                           surf_usm_h%ground_level(m) )
+                 ind_win_frac     = MERGE( ind_win_frac_gfl,     ind_win_frac_agfl,     &
+                                           surf_usm_h%ground_level(m) )
+                 ind_green_frac_w = MERGE( ind_green_frac_w_gfl, ind_green_frac_w_agfl, &
+                                           surf_usm_h%ground_level(m) )
+                 ind_green_frac_r = MERGE( ind_green_frac_r_gfl, ind_green_frac_r_agfl, &
+                                           surf_usm_h%ground_level(m) )
+                 ind_lai_r        = MERGE( ind_lai_r_gfl,        ind_lai_r_agfl,        &
+                                           surf_usm_h%ground_level(m) )
+                 ind_lai_w        = MERGE( ind_lai_w_gfl,        ind_lai_w_agfl,        &
+                                           surf_usm_h%ground_level(m) )
+                 ind_hc1          = MERGE( ind_hc1_gfl,          ind_hc1_agfl,          &
+                                           surf_usm_h%ground_level(m) )
+                 ind_hc2          = MERGE( ind_hc2_gfl,          ind_hc2_agfl,          &
+                                           surf_usm_h%ground_level(m) )
+                 ind_hc3          = MERGE( ind_hc3_gfl,          ind_hc3_agfl,          &
+                                           surf_usm_h%ground_level(m) )
+                 ind_tc1          = MERGE( ind_tc1_gfl,          ind_tc1_agfl,          &
+                                           surf_usm_h%ground_level(m) )
+                 ind_tc2          = MERGE( ind_tc2_gfl,          ind_tc2_agfl,          &
+                                           surf_usm_h%ground_level(m) )
+                 ind_tc3          = MERGE( ind_tc3_gfl,          ind_tc3_agfl,          &
+                                           surf_usm_h%ground_level(m) )
+                 ind_emis_wall    = MERGE( ind_emis_wall_gfl,    ind_emis_wall_agfl,    &
+                                           surf_usm_h%ground_level(m) )
+                 ind_emis_green   = MERGE( ind_emis_green_gfl,   ind_emis_green_agfl,   &
+                                           surf_usm_h%ground_level(m) )
+                 ind_emis_win     = MERGE( ind_emis_win_gfl,     ind_emis_win_agfl,     &
+                                           surf_usm_h%ground_level(m) )
+                 ind_trans        = MERGE( ind_trans_gfl,        ind_trans_agfl,        &
+                                           surf_usm_h%ground_level(m) )
+                 ind_z0           = MERGE( ind_z0_gfl,           ind_z0_agfl,           &
+                                           surf_usm_h%ground_level(m) )
+                 ind_z0qh         = MERGE( ind_z0qh_gfl,         ind_z0qh_agfl,         &
+                                           surf_usm_h%ground_level(m) )
+
+!
+!--              Initialize relatvie wall- (0), green- (1) and window (2) fractions
+                 surf_usm_h%frac(0,m)   = building_pars(ind_wall_frac,st)   
+                 surf_usm_h%frac(1,m)   = building_pars(ind_green_frac_r,st)  
+                 surf_usm_h%frac(2,m)   = building_pars(ind_win_frac,st)  
+                 surf_usm_h%lai(m)      = building_pars(ind_green_frac_r,st)  
+
+                 surf_usm_h%rho_c_wall(nzb_wall,m)   = building_pars(ind_hc1,st)  
+                 surf_usm_h%rho_c_wall(nzb_wall+1,m) = building_pars(ind_hc1,st)
+                 surf_usm_h%rho_c_wall(nzb_wall+2,m) = building_pars(ind_hc2,st)
+                 surf_usm_h%rho_c_wall(nzb_wall+3,m) = building_pars(ind_hc3,st)    
+                 surf_usm_h%lambda_h(nzb_wall,m)   = building_pars(ind_tc1,st)  
+                 surf_usm_h%lambda_h(nzb_wall+1,m) = building_pars(ind_tc1,st) 
+                 surf_usm_h%lambda_h(nzb_wall+2,m) = building_pars(ind_tc2,st)
+                 surf_usm_h%lambda_h(nzb_wall+3,m) = building_pars(ind_tc3,st)    
+                 
+                 surf_usm_h%rho_c_green(nzb_wall,m)   = building_pars(ind_hc1,st)  
+                 surf_usm_h%rho_c_green(nzb_wall+1,m) = building_pars(ind_hc1,st)
+                 surf_usm_h%rho_c_green(nzb_wall+2,m) = building_pars(ind_hc2,st)
+                 surf_usm_h%rho_c_green(nzb_wall+3,m) = building_pars(ind_hc3,st)    
+                 surf_usm_h%lambda_h_green(nzb_wall,m)   = building_pars(ind_tc1,st)  
+                 surf_usm_h%lambda_h_green(nzb_wall+1,m) = building_pars(ind_tc1,st) 
+                 surf_usm_h%lambda_h_green(nzb_wall+2,m) = building_pars(ind_tc2,st)
+                 surf_usm_h%lambda_h_green(nzb_wall+3,m) = building_pars(ind_tc3,st)    
+                
+                 surf_usm_h%rho_c_window(nzb_wall,m)   = building_pars(ind_hc1,st)  
+                 surf_usm_h%rho_c_window(nzb_wall+1,m) = building_pars(ind_hc1,st)
+                 surf_usm_h%rho_c_window(nzb_wall+2,m) = building_pars(ind_hc2,st)
+                 surf_usm_h%rho_c_window(nzb_wall+3,m) = building_pars(ind_hc3,st)    
+                 surf_usm_h%lambda_h_window(nzb_wall,m)   = building_pars(ind_tc1,st)  
+                 surf_usm_h%lambda_h_window(nzb_wall+1,m) = building_pars(ind_tc1,st) 
+                 surf_usm_h%lambda_h_window(nzb_wall+2,m) = building_pars(ind_tc2,st)
+                 surf_usm_h%lambda_h_window(nzb_wall+3,m) = building_pars(ind_tc3,st)    
+
+                 surf_usm_h%target_temp_summer(m)  = building_pars(12,st)    
+                 surf_usm_h%target_temp_winter(m)  = building_pars(13,st)    
+!
+!--              emissivity of wall-, green- and window fraction 
+                 surf_usm_h%emissivity(0,m)        = building_pars(ind_emis_wall,st)
+                 surf_usm_h%emissivity(1,m)        = building_pars(ind_emis_green,st)
+                 surf_usm_h%emissivity(2,m)        = building_pars(ind_emis_win,st)
+
+                 surf_usm_h%transmissivity(m)      = building_pars(ind_trans,st)
+
+                 surf_usm_h%z0(m)                  = building_pars(ind_z0,st)
+                 surf_usm_h%z0h(m)                 = building_pars(ind_z0qh,st)
+                 surf_usm_h%z0q(m)                 = building_pars(ind_z0qh,st)
+!
+!--              albedo type for wall fraction, green fraction, window fraction
+                 surf_usm_h%albedo_type(0,m)       = INT( building_pars(ind_alb_wall,st) )
+                 surf_usm_h%albedo_type(1,m)       = INT( building_pars(ind_alb_green,st) )
+                 surf_usm_h%albedo_type(2,m)       = INT( building_pars(ind_alb_win,st) )
+
+                 surf_usm_h%zw(nzb_wall,m)         = building_pars(ind_thick_1,st)
+                 surf_usm_h%zw(nzb_wall+1,m)       = building_pars(ind_thick_2,st)
+                 surf_usm_h%zw(nzb_wall+2,m)       = building_pars(ind_thick_3,st)
+                 surf_usm_h%zw(nzb_wall+3,m)       = building_pars(ind_thick_4,st)
+                 
+                 surf_usm_h%zw_green(nzb_wall,m)         = building_pars(ind_thick_1,st)
+                 surf_usm_h%zw_green(nzb_wall+1,m)       = building_pars(ind_thick_2,st)
+                 surf_usm_h%zw_green(nzb_wall+2,m)       = building_pars(ind_thick_3,st)
+                 surf_usm_h%zw_green(nzb_wall+3,m)       = building_pars(ind_thick_4,st)
+
+                 surf_usm_h%zw_window(nzb_wall,m)         = building_pars(ind_thick_1,st)
+                 surf_usm_h%zw_window(nzb_wall+1,m)       = building_pars(ind_thick_2,st)
+                 surf_usm_h%zw_window(nzb_wall+2,m)       = building_pars(ind_thick_3,st)
+                 surf_usm_h%zw_window(nzb_wall+3,m)       = building_pars(ind_thick_4,st)
+
+                 surf_usm_h%c_surface(m)           = building_pars(45,st)  
+                 surf_usm_h%lambda_surf(m)         = building_pars(46,st)
+                 surf_usm_h%c_surface_green(m)     = building_pars(45,st)  
+                 surf_usm_h%lambda_surf_green(m)   = building_pars(46,st)
+                 surf_usm_h%c_surface_window(m)    = building_pars(45,st)  
+                 surf_usm_h%lambda_surf_window(m)  = building_pars(46,st)
+
+              ENDIF
+           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_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_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_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_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) )
+
+!
+!--                 Initialize relatvie wall- (0), green- (1) and window (2) fractions
+                    surf_usm_v(l)%frac(0,m) = building_pars(ind_wall_frac,st)   
+                    surf_usm_v(l)%frac(1,m) = building_pars(ind_green_frac_w,st)  
+                    surf_usm_v(l)%frac(2,m) = 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_hc1,st)
+                    surf_usm_v(l)%rho_c_wall(nzb_wall+2,m) = building_pars(ind_hc2,st)
+                    surf_usm_v(l)%rho_c_wall(nzb_wall+3,m) = building_pars(ind_hc3,st)
+                    
+                    surf_usm_v(l)%rho_c_green(nzb_wall,m)   = building_pars(ind_hc1,st)  
+                    surf_usm_v(l)%rho_c_green(nzb_wall+1,m) = building_pars(ind_hc1,st)
+                    surf_usm_v(l)%rho_c_green(nzb_wall+2,m) = building_pars(ind_hc2,st)
+                    surf_usm_v(l)%rho_c_green(nzb_wall+3,m) = building_pars(ind_hc3,st)
+                    
+                    surf_usm_v(l)%rho_c_window(nzb_wall,m)   = building_pars(ind_hc1,st)  
+                    surf_usm_v(l)%rho_c_window(nzb_wall+1,m) = building_pars(ind_hc1,st)
+                    surf_usm_v(l)%rho_c_window(nzb_wall+2,m) = building_pars(ind_hc2,st)
+                    surf_usm_v(l)%rho_c_window(nzb_wall+3,m) = building_pars(ind_hc3,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_tc1,st) 
+                    surf_usm_v(l)%lambda_h(nzb_wall+2,m) = building_pars(ind_tc2,st)
+                    surf_usm_v(l)%lambda_h(nzb_wall+3,m) = building_pars(ind_tc3,st) 
+                    
+                    surf_usm_v(l)%lambda_h_green(nzb_wall,m)   = building_pars(ind_tc1,st)  
+                    surf_usm_v(l)%lambda_h_green(nzb_wall+1,m) = building_pars(ind_tc1,st) 
+                    surf_usm_v(l)%lambda_h_green(nzb_wall+2,m) = building_pars(ind_tc2,st)
+                    surf_usm_v(l)%lambda_h_green(nzb_wall+3,m) = building_pars(ind_tc3,st) 
+                    
+                    surf_usm_v(l)%lambda_h_window(nzb_wall,m)   = building_pars(ind_tc1,st)  
+                    surf_usm_v(l)%lambda_h_window(nzb_wall+1,m) = building_pars(ind_tc1,st) 
+                    surf_usm_v(l)%lambda_h_window(nzb_wall+2,m) = building_pars(ind_tc2,st)
+                    surf_usm_v(l)%lambda_h_window(nzb_wall+3,m) = building_pars(ind_tc3,st) 
+
+                    surf_usm_v(l)%target_temp_summer(m)  = building_pars(12,st)    
+                    surf_usm_v(l)%target_temp_winter(m)  = building_pars(13,st)    
+!
+!--                 emissivity of wall-, green- and window fraction 
+                    surf_usm_v(l)%emissivity(0,m)        = building_pars(ind_emis_wall,st)
+                    surf_usm_v(l)%emissivity(1,m)        = building_pars(ind_emis_green,st)
+                    surf_usm_v(l)%emissivity(2,m)        = 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(0,m)       = INT( building_pars(ind_alb_wall,st) )
+                    surf_usm_v(l)%albedo_type(1,m)       = INT( building_pars(ind_alb_green,st) )
+                    surf_usm_v(l)%albedo_type(2,m)       = 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,st)
+                    surf_usm_v(l)%zw_window(nzb_wall+1,m)       = building_pars(ind_thick_2,st)
+                    surf_usm_v(l)%zw_window(nzb_wall+2,m)       = building_pars(ind_thick_3,st)
+                    surf_usm_v(l)%zw_window(nzb_wall+3,m)       = building_pars(ind_thick_4,st)
+
+                    surf_usm_v(l)%c_surface(m)           = building_pars(45,st)  
+                    surf_usm_v(l)%lambda_surf(m)         = building_pars(46,st) 
+                    surf_usm_v(l)%c_surface_green(m)     = building_pars(45,st)  
+                    surf_usm_v(l)%lambda_surf_green(m)   = building_pars(46,st) 
+                    surf_usm_v(l)%c_surface_window(m)    = building_pars(45,st)  
+                    surf_usm_v(l)%lambda_surf_window(m)  = building_pars(46,st) 
+
+
+                 ENDIF
+              ENDDO
+           ENDDO
+        ENDIF 
+
+!
+!--     Level 3 - initialization via building_pars read from file
+        IF ( building_pars_f%from_file )  THEN
+           DO  m = 1, surf_usm_h%ns
+              i = surf_usm_h%i(m)
+              j = surf_usm_h%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%ground_level(m) )
+              ind_win_frac     = MERGE( ind_win_frac_gfl,     ind_win_frac_agfl,     &
+                                        surf_usm_h%ground_level(m) )
+              ind_green_frac_w = MERGE( ind_green_frac_w_gfl, ind_green_frac_w_agfl, &
+                                        surf_usm_h%ground_level(m) )
+              ind_green_frac_r = MERGE( ind_green_frac_r_gfl, ind_green_frac_r_agfl, &
+                                        surf_usm_h%ground_level(m) )
+              ind_lai_r        = MERGE( ind_lai_r_gfl,        ind_lai_r_agfl,        &
+                                        surf_usm_h%ground_level(m) )
+              ind_lai_w        = MERGE( ind_lai_w_gfl,        ind_lai_w_agfl,        &
+                                        surf_usm_h%ground_level(m) )
+              ind_hc1          = MERGE( ind_hc1_gfl,          ind_hc1_agfl,          &
+                                        surf_usm_h%ground_level(m) )
+              ind_hc2          = MERGE( ind_hc2_gfl,          ind_hc2_agfl,          &
+                                        surf_usm_h%ground_level(m) )
+              ind_hc3          = MERGE( ind_hc3_gfl,          ind_hc3_agfl,          &
+                                        surf_usm_h%ground_level(m) )
+              ind_tc1          = MERGE( ind_tc1_gfl,          ind_tc1_agfl,          &
+                                        surf_usm_h%ground_level(m) )
+              ind_tc2          = MERGE( ind_tc2_gfl,          ind_tc2_agfl,          &
+                                        surf_usm_h%ground_level(m) )
+              ind_tc3          = MERGE( ind_tc3_gfl,          ind_tc3_agfl,          &
+                                        surf_usm_h%ground_level(m) )
+              ind_emis_wall    = MERGE( ind_emis_wall_gfl,    ind_emis_wall_agfl,    &
+                                        surf_usm_h%ground_level(m) )
+              ind_emis_green   = MERGE( ind_emis_green_gfl,   ind_emis_green_agfl,   &
+                                        surf_usm_h%ground_level(m) )
+              ind_emis_win     = MERGE( ind_emis_win_gfl,     ind_emis_win_agfl,     &
+                                        surf_usm_h%ground_level(m) )
+              ind_trans        = MERGE( ind_trans_gfl,        ind_trans_agfl,        &
+                                        surf_usm_h%ground_level(m) )
+              ind_z0           = MERGE( ind_z0_gfl,           ind_z0_agfl,           &
+                                        surf_usm_h%ground_level(m) )
+              ind_z0qh         = MERGE( ind_z0qh_gfl,         ind_z0qh_agfl,         &
+                                        surf_usm_h%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%frac(0,m)  = 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%frac(1,m)  = 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%frac(2,m)  = 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%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 )  THEN 
+                 surf_usm_h%rho_c_wall(nzb_wall,m)   = building_pars_f%pars_xy(ind_hc1,j,i)  
+                 surf_usm_h%rho_c_wall(nzb_wall+1,m) = building_pars_f%pars_xy(ind_hc1,j,i)
+              ENDIF
+              IF ( building_pars_f%pars_xy(ind_hc2,j,i) /= building_pars_f%fill )    &
+                 surf_usm_h%rho_c_wall(nzb_wall+2,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%rho_c_wall(nzb_wall+3,m) = building_pars_f%pars_xy(ind_hc3,j,i)
+              IF ( building_pars_f%pars_xy(ind_hc1,j,i) /= building_pars_f%fill )  THEN 
+                 surf_usm_h%rho_c_green(nzb_wall,m)   = building_pars_f%pars_xy(ind_hc1,j,i)  
+                 surf_usm_h%rho_c_green(nzb_wall+1,m) = building_pars_f%pars_xy(ind_hc1,j,i)
+              ENDIF
+              IF ( building_pars_f%pars_xy(ind_hc2,j,i) /= building_pars_f%fill )    &
+                 surf_usm_h%rho_c_green(nzb_wall+2,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%rho_c_green(nzb_wall+3,m) = building_pars_f%pars_xy(ind_hc3,j,i)
+              IF ( building_pars_f%pars_xy(ind_hc1,j,i) /= building_pars_f%fill )  THEN 
+                 surf_usm_h%rho_c_window(nzb_wall,m)   = building_pars_f%pars_xy(ind_hc1,j,i)  
+                 surf_usm_h%rho_c_window(nzb_wall+1,m) = building_pars_f%pars_xy(ind_hc1,j,i)
+              ENDIF
+              IF ( building_pars_f%pars_xy(ind_hc2,j,i) /= building_pars_f%fill )    &
+                 surf_usm_h%rho_c_window(nzb_wall+2,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%rho_c_window(nzb_wall+3,m) = building_pars_f%pars_xy(ind_hc3,j,i)
+
+              IF ( building_pars_f%pars_xy(ind_tc1,j,i) /= building_pars_f%fill )  THEN
+                 surf_usm_h%lambda_h(nzb_wall,m)   = building_pars_f%pars_xy(ind_tc1,j,i)         
+                 surf_usm_h%lambda_h(nzb_wall+1,m) = building_pars_f%pars_xy(ind_tc1,j,i)        
+              ENDIF
+              IF ( building_pars_f%pars_xy(ind_tc2,j,i) /= building_pars_f%fill )    &
+                 surf_usm_h%lambda_h(nzb_wall+2,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%lambda_h(nzb_wall+3,m) = building_pars_f%pars_xy(ind_tc3,j,i)    
+              IF ( building_pars_f%pars_xy(ind_tc1,j,i) /= building_pars_f%fill )  THEN
+                 surf_usm_h%lambda_h_green(nzb_wall,m)   = building_pars_f%pars_xy(ind_tc1,j,i)         
+                 surf_usm_h%lambda_h_green(nzb_wall+1,m) = building_pars_f%pars_xy(ind_tc1,j,i)        
+              ENDIF
+              IF ( building_pars_f%pars_xy(ind_tc2,j,i) /= building_pars_f%fill )    &
+                 surf_usm_h%lambda_h_green(nzb_wall+2,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%lambda_h_green(nzb_wall+3,m) = building_pars_f%pars_xy(ind_tc3,j,i)    
+              IF ( building_pars_f%pars_xy(ind_tc1,j,i) /= building_pars_f%fill )  THEN
+                 surf_usm_h%lambda_h_window(nzb_wall,m)   = building_pars_f%pars_xy(ind_tc1,j,i)         
+                 surf_usm_h%lambda_h_window(nzb_wall+1,m) = building_pars_f%pars_xy(ind_tc1,j,i)        
+              ENDIF
+              IF ( building_pars_f%pars_xy(ind_tc2,j,i) /= building_pars_f%fill )    &
+                 surf_usm_h%lambda_h_window(nzb_wall+2,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%lambda_h_window(nzb_wall+3,m) = building_pars_f%pars_xy(ind_tc3,j,i)    
+
+              IF ( building_pars_f%pars_xy(12,j,i) /= building_pars_f%fill )         & 
+                 surf_usm_h%target_temp_summer(m)  = building_pars_f%pars_xy(12,j,i)   
+              IF ( building_pars_f%pars_xy(13,j,i) /= building_pars_f%fill )         & 
+                 surf_usm_h%target_temp_winter(m)  = building_pars_f%pars_xy(13,j,i)   
+
+              IF ( building_pars_f%pars_xy(ind_emis_wall,j,i) /= building_pars_f%fill ) & 
+                 surf_usm_h%emissivity(0,m)        = 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%emissivity(1,m)        = 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%emissivity(2,m)        = 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%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%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%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%z0q(m)                 = building_pars_f%pars_xy(ind_z0qh,j,i)
+
+              IF ( building_pars_f%pars_xy(ind_alb_wall,j,i) /= building_pars_f%fill )    & 
+                 surf_usm_h%albedo_type(0,m)       = building_pars_f%pars_xy(ind_alb_wall,j,i)
+              IF ( building_pars_f%pars_xy(ind_alb_green,j,i) /= building_pars_f%fill )    & 
+                 surf_usm_h%albedo_type(1,m)       = building_pars_f%pars_xy(ind_alb_green,j,i)
+              IF ( building_pars_f%pars_xy(ind_alb_win,j,i) /= building_pars_f%fill )    & 
+                 surf_usm_h%albedo_type(2,m)       = building_pars_f%pars_xy(ind_alb_win,j,i)
+
+              IF ( building_pars_f%pars_xy(ind_thick_1,j,i) /= building_pars_f%fill )    & 
+                 surf_usm_h%zw(nzb_wall,m) = building_pars_f%pars_xy(ind_thick_1,j,i)
+              IF ( building_pars_f%pars_xy(ind_thick_2,j,i) /= building_pars_f%fill )    & 
+                 surf_usm_h%zw(nzb_wall+1,m) = building_pars_f%pars_xy(ind_thick_2,j,i)
+              IF ( building_pars_f%pars_xy(ind_thick_3,j,i) /= building_pars_f%fill )    & 
+                 surf_usm_h%zw(nzb_wall+2,m) = building_pars_f%pars_xy(ind_thick_3,j,i)
+              IF ( building_pars_f%pars_xy(ind_thick_4,j,i) /= building_pars_f%fill )    & 
+                 surf_usm_h%zw(nzb_wall+3,m) = building_pars_f%pars_xy(ind_thick_4,j,i)
+              IF ( building_pars_f%pars_xy(ind_thick_1,j,i) /= building_pars_f%fill )    & 
+                 surf_usm_h%zw_green(nzb_wall,m) = building_pars_f%pars_xy(ind_thick_1,j,i)
+              IF ( building_pars_f%pars_xy(ind_thick_2,j,i) /= building_pars_f%fill )    & 
+                 surf_usm_h%zw_green(nzb_wall+1,m) = building_pars_f%pars_xy(ind_thick_2,j,i)
+              IF ( building_pars_f%pars_xy(ind_thick_3,j,i) /= building_pars_f%fill )    & 
+                 surf_usm_h%zw_green(nzb_wall+2,m) = building_pars_f%pars_xy(ind_thick_3,j,i)
+              IF ( building_pars_f%pars_xy(ind_thick_4,j,i) /= building_pars_f%fill )    & 
+                 surf_usm_h%zw_green(nzb_wall+3,m) = building_pars_f%pars_xy(ind_thick_4,j,i)
+              IF ( building_pars_f%pars_xy(ind_thick_1,j,i) /= building_pars_f%fill )    & 
+                 surf_usm_h%zw_window(nzb_wall,m) = building_pars_f%pars_xy(ind_thick_1,j,i)
+              IF ( building_pars_f%pars_xy(ind_thick_2,j,i) /= building_pars_f%fill )    & 
+                 surf_usm_h%zw_window(nzb_wall+1,m) = building_pars_f%pars_xy(ind_thick_2,j,i)
+              IF ( building_pars_f%pars_xy(ind_thick_3,j,i) /= building_pars_f%fill )    & 
+                 surf_usm_h%zw_window(nzb_wall+2,m) = building_pars_f%pars_xy(ind_thick_3,j,i)
+              IF ( building_pars_f%pars_xy(ind_thick_4,j,i) /= building_pars_f%fill )    & 
+                 surf_usm_h%zw_window(nzb_wall+3,m) = building_pars_f%pars_xy(ind_thick_4,j,i)
+
+              IF ( building_pars_f%pars_xy(45,j,i) /= building_pars_f%fill )    & 
+                 surf_usm_h%c_surface(m)           = building_pars_f%pars_xy(45,j,i)
+              IF ( building_pars_f%pars_xy(46,j,i) /= building_pars_f%fill )    & 
+                 surf_usm_h%lambda_surf(m)         = building_pars_f%pars_xy(46,j,i)
+              IF ( building_pars_f%pars_xy(45,j,i) /= building_pars_f%fill )    & 
+                 surf_usm_h%c_surface_green(m)           = building_pars_f%pars_xy(45,j,i)
+              IF ( building_pars_f%pars_xy(46,j,i) /= building_pars_f%fill )    & 
+                 surf_usm_h%lambda_surf_green(m)         = building_pars_f%pars_xy(46,j,i)
+              IF ( building_pars_f%pars_xy(45,j,i) /= building_pars_f%fill )    & 
+                 surf_usm_h%c_surface_window(m)           = building_pars_f%pars_xy(45,j,i)
+              IF ( building_pars_f%pars_xy(46,j,i) /= building_pars_f%fill )    & 
+                 surf_usm_h%lambda_surf_window(m)         = building_pars_f%pars_xy(46,j,i)
+           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_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_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_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_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) )
+
+!
+!--              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(0,m)  = 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(1,m)  = 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(2,m)  = 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 )    &
+                 THEN 
+                    surf_usm_v(l)%rho_c_wall(nzb_wall,m)   =                            &
+                                                    building_pars_f%pars_xy(ind_hc1,j,i)  
+                    surf_usm_v(l)%rho_c_wall(nzb_wall+1,m) =                            &
+                                                    building_pars_f%pars_xy(ind_hc1,j,i)
+                 ENDIF
+                 IF ( building_pars_f%pars_xy(ind_hc2,j,i) /= building_pars_f%fill )    &
+                    surf_usm_v(l)%rho_c_wall(nzb_wall+2,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+3,m) =                            &
+                                                    building_pars_f%pars_xy(ind_hc3,j,i)
+                 IF ( building_pars_f%pars_xy(ind_hc1,j,i) /= building_pars_f%fill )  THEN 
+                    surf_usm_v(l)%rho_c_green(nzb_wall,m)   =                           &
+                                                    building_pars_f%pars_xy(ind_hc1,j,i)  
+                    surf_usm_v(l)%rho_c_green(nzb_wall+1,m) =                           &
+                                                    building_pars_f%pars_xy(ind_hc1,j,i)
+                 ENDIF
+                 IF ( building_pars_f%pars_xy(ind_hc2,j,i) /= building_pars_f%fill )    &
+                    surf_usm_v(l)%rho_c_green(nzb_wall+2,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+3,m) = building_pars_f%pars_xy(ind_hc3,j,i)    
+                 IF ( building_pars_f%pars_xy(ind_hc1,j,i) /= building_pars_f%fill )  THEN 
+                    surf_usm_v(l)%rho_c_window(nzb_wall,m)   = building_pars_f%pars_xy(ind_hc1,j,i)  
+                    surf_usm_v(l)%rho_c_window(nzb_wall+1,m) = building_pars_f%pars_xy(ind_hc1,j,i)
+                 ENDIF
+                 IF ( building_pars_f%pars_xy(ind_hc2,j,i) /= building_pars_f%fill )    &
+                    surf_usm_v(l)%rho_c_window(nzb_wall+2,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+3,m) = building_pars_f%pars_xy(ind_hc3,j,i)
+
+                 IF ( building_pars_f%pars_xy(ind_tc1,j,i) /= building_pars_f%fill )  THEN
+                    surf_usm_v(l)%lambda_h(nzb_wall,m)   = building_pars_f%pars_xy(ind_tc1,j,i)         
+                    surf_usm_v(l)%lambda_h(nzb_wall+1,m) = building_pars_f%pars_xy(ind_tc1,j,i)        
+                 ENDIF
+                 IF ( building_pars_f%pars_xy(ind_tc2,j,i) /= building_pars_f%fill )    &
+                    surf_usm_v(l)%lambda_h(nzb_wall+2,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+3,m) = building_pars_f%pars_xy(ind_tc3,j,i)    
+                 IF ( building_pars_f%pars_xy(ind_tc1,j,i) /= building_pars_f%fill )  THEN
+                    surf_usm_v(l)%lambda_h_green(nzb_wall,m)   = building_pars_f%pars_xy(ind_tc1,j,i)         
+                    surf_usm_v(l)%lambda_h_green(nzb_wall+1,m) = building_pars_f%pars_xy(ind_tc1,j,i)        
+                 ENDIF
+                 IF ( building_pars_f%pars_xy(ind_tc2,j,i) /= building_pars_f%fill )    &
+                    surf_usm_v(l)%lambda_h_green(nzb_wall+2,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+3,m) = building_pars_f%pars_xy(ind_tc3,j,i)    
+                 IF ( building_pars_f%pars_xy(ind_tc1,j,i) /= building_pars_f%fill )  THEN
+                    surf_usm_v(l)%lambda_h_window(nzb_wall,m)   = building_pars_f%pars_xy(ind_tc1,j,i)         
+                    surf_usm_v(l)%lambda_h_window(nzb_wall+1,m) = building_pars_f%pars_xy(ind_tc1,j,i)        
+                 ENDIF
+                 IF ( building_pars_f%pars_xy(ind_tc2,j,i) /= building_pars_f%fill )    &
+                    surf_usm_v(l)%lambda_h_window(nzb_wall+2,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+3,m) = building_pars_f%pars_xy(ind_tc3,j,i)
+
+                 IF ( building_pars_f%pars_xy(12,j,i) /= building_pars_f%fill )         & 
+                    surf_usm_v(l)%target_temp_summer(m)  = building_pars_f%pars_xy(12,j,i)   
+                 IF ( building_pars_f%pars_xy(13,j,i) /= building_pars_f%fill )         & 
+                    surf_usm_v(l)%target_temp_winter(m)  = building_pars_f%pars_xy(13,j,i)   
+
+                 IF ( building_pars_f%pars_xy(ind_emis_wall,j,i) /= building_pars_f%fill ) & 
+                    surf_usm_v(l)%emissivity(0,m)        = 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(1,m)        = 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(2,m)        = 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,j,i) /= building_pars_f%fill )    & 
+                    surf_usm_v(l)%albedo_type(0,m)       = building_pars_f%pars_xy(ind_alb_wall,j,i)
+                 IF ( building_pars_f%pars_xy(ind_alb_green,j,i) /= building_pars_f%fill )    & 
+                    surf_usm_v(l)%albedo_type(1,m)       = building_pars_f%pars_xy(ind_alb_green,j,i)
+                 IF ( building_pars_f%pars_xy(ind_alb_win,j,i) /= building_pars_f%fill )    & 
+                    surf_usm_v(l)%albedo_type(2,m)       = building_pars_f%pars_xy(ind_alb_win,j,i)
+
+                 IF ( building_pars_f%pars_xy(ind_thick_1,j,i) /= building_pars_f%fill )    & 
+                    surf_usm_v(l)%zw(nzb_wall,m) = building_pars_f%pars_xy(ind_thick_1,j,i)
+                 IF ( building_pars_f%pars_xy(ind_thick_2,j,i) /= building_pars_f%fill )    & 
+                    surf_usm_v(l)%zw(nzb_wall+1,m) = building_pars_f%pars_xy(ind_thick_2,j,i)
+                 IF ( building_pars_f%pars_xy(ind_thick_3,j,i) /= building_pars_f%fill )    & 
+                    surf_usm_v(l)%zw(nzb_wall+2,m) = building_pars_f%pars_xy(ind_thick_3,j,i)
+                 IF ( building_pars_f%pars_xy(ind_thick_4,j,i) /= building_pars_f%fill )    & 
+                    surf_usm_v(l)%zw(nzb_wall+3,m) = building_pars_f%pars_xy(ind_thick_4,j,i)
+                 IF ( building_pars_f%pars_xy(ind_thick_1,j,i) /= building_pars_f%fill )    & 
+                    surf_usm_v(l)%zw_green(nzb_wall,m) = building_pars_f%pars_xy(ind_thick_1,j,i)
+                 IF ( building_pars_f%pars_xy(ind_thick_2,j,i) /= building_pars_f%fill )    & 
+                    surf_usm_v(l)%zw_green(nzb_wall+1,m) = building_pars_f%pars_xy(ind_thick_2,j,i)
+                 IF ( building_pars_f%pars_xy(ind_thick_3,j,i) /= building_pars_f%fill )    & 
+                    surf_usm_v(l)%zw_green(nzb_wall+2,m) = building_pars_f%pars_xy(ind_thick_3,j,i)
+                 IF ( building_pars_f%pars_xy(ind_thick_4,j,i) /= building_pars_f%fill )    & 
+                    surf_usm_v(l)%zw_green(nzb_wall+3,m) = building_pars_f%pars_xy(ind_thick_4,j,i)
+                 IF ( building_pars_f%pars_xy(ind_thick_1,j,i) /= building_pars_f%fill )    & 
+                    surf_usm_v(l)%zw_window(nzb_wall,m) = building_pars_f%pars_xy(ind_thick_1,j,i)
+                 IF ( building_pars_f%pars_xy(ind_thick_2,j,i) /= building_pars_f%fill )    & 
+                    surf_usm_v(l)%zw_window(nzb_wall+1,m) = building_pars_f%pars_xy(ind_thick_2,j,i)
+                 IF ( building_pars_f%pars_xy(ind_thick_3,j,i) /= building_pars_f%fill )    & 
+                    surf_usm_v(l)%zw_window(nzb_wall+2,m) = building_pars_f%pars_xy(ind_thick_3,j,i)
+                 IF ( building_pars_f%pars_xy(ind_thick_4,j,i) /= building_pars_f%fill )    & 
+                    surf_usm_v(l)%zw_window(nzb_wall+3,m) = building_pars_f%pars_xy(ind_thick_4,j,i)
+
+                 IF ( building_pars_f%pars_xy(45,j,i) /= building_pars_f%fill )    & 
+                    surf_usm_v(l)%c_surface(m)           = building_pars_f%pars_xy(45,j,i)
+                 IF ( building_pars_f%pars_xy(46,j,i) /= building_pars_f%fill )    & 
+                    surf_usm_v(l)%lambda_surf(m)         = building_pars_f%pars_xy(46,j,i)
+                 IF ( building_pars_f%pars_xy(45,j,i) /= building_pars_f%fill )    & 
+                    surf_usm_v(l)%c_surface_green(m)     = building_pars_f%pars_xy(45,j,i)
+                 IF ( building_pars_f%pars_xy(46,j,i) /= building_pars_f%fill )    & 
+                    surf_usm_v(l)%lambda_surf_green(m)   = building_pars_f%pars_xy(46,j,i)
+                 IF ( building_pars_f%pars_xy(45,j,i) /= building_pars_f%fill )    & 
+                    surf_usm_v(l)%c_surface_window(m)    = building_pars_f%pars_xy(45,j,i)
+                 IF ( building_pars_f%pars_xy(46,j,i) /= building_pars_f%fill )    & 
+                    surf_usm_v(l)%lambda_surf_window(m)  = building_pars_f%pars_xy(46,j,i)
+
+              ENDDO
+           ENDDO
+        ENDIF 
+!       
+!--     Read the surface_types array.
+!--     Please note, here also initialization of surface attributes is done as
+!--     long as _urbsurf and _surfpar files are available. Values from above
+!--     will be overwritten. This might be removed later, but is still in the 
+!--     code to enable compatibility with older model version.
         CALL usm_read_urban_surface_types()
         
@@ -3197,33 +4421,13 @@
         CALL usm_init_material_model()
         
+!--     init anthropogenic sources of heat
         IF ( usm_anthropogenic_heat )  THEN
 !--         init anthropogenic sources of heat (from transportation for now)
             CALL usm_read_anthropogenic_heat()
         ENDIF
-        
-        IF ( read_svf_on_init )  THEN
-!--         read svf, csf, svfsurf and csfsurf data from file
-            CALL location_message( '    Start reading SVF from file', .TRUE. )
-            CALL usm_read_svf_from_file()
-            CALL location_message( '    Reading SVF from file has finished', .TRUE. )
-        ELSE
-!--         calculate SFV and CSF
-            CALL location_message( '    Start calculation of SVF', .TRUE. )
-            CALL cpu_log( log_point_s(79), 'usm_calc_svf', 'start' )
-            CALL usm_calc_svf()
-            CALL cpu_log( log_point_s(79), 'usm_calc_svf', 'stop' )
-            CALL location_message( '    Calculation of SVF has finished', .TRUE. )
-        ENDIF
-
-        IF ( write_svf_on_init )  THEN
-!--         write svf, csf svfsurf and csfsurf data to file
-            CALL location_message( '    Store SVF and CSF to file', .TRUE. )
-            CALL usm_write_svf_to_file()
-        ENDIF
-        
+                
         IF ( plant_canopy )  THEN
-!--         gridpcbl was only necessary for initialization
-            DEALLOCATE( gridpcbl )
-            IF ( .NOT.  ALLOCATED(pc_heating_rate) )  THEN
+            
+            IF ( .NOT.  ALLOCATED( pc_heating_rate) )  THEN
 !--             then pc_heating_rate is allocated in init_plant_canopy
 !--             in case of cthf /= 0 => we need to allocate it for our use here
@@ -3251,4 +4455,7 @@
 
                t_surf_h(m) = pt(k,j,i) * exn
+               t_surf_window_h(m) = pt(k,j,i) * exn
+               t_surf_green_h(m) = pt(k,j,i) * exn
+               t_surf_whole_h(m) = pt(k,j,i) * exn
             ENDDO
 !
@@ -3261,4 +4468,7 @@
 
                   t_surf_v(l)%t(m) = pt(k,j,i) * exn
+                  t_surf_window_v(l)%t(m) = pt(k,j,i) * exn
+                  t_surf_green_v(l)%t(m) = pt(k,j,i) * exn
+                  t_surf_whole_v(l)%t(m) = pt(k,j,i) * exn
                ENDDO
             ENDDO
@@ -3275,8 +4485,10 @@
                IF ( surf_usm_h%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
 
@@ -3286,4 +4498,6 @@
 
                    t_wall_h(k,m) = ( 1.0_wp - c ) * t_surf_h(m) + c * tin
+                   t_window_h(k,m) = ( 1.0_wp - c ) * t_surf_window_h(m) + c * twin
+                   t_green_h(k,m) = t_surf_h(m)
                ENDDO
             ENDDO
@@ -3295,11 +4509,12 @@
 !--               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)%t(k,m) = ( 1.0_wp - c ) * t_surf_v(l)%t(m) +  &
-                                          c * tin
+                     t_wall_v(l)%t(k,m) = ( 1.0_wp - c ) * t_surf_v(l)%t(m) + c * tin
+                     t_window_v(l)%t(k,m) = ( 1.0_wp - c ) * t_surf_window_v(l)%t(m) + c * twin
+                     t_green_v(l)%t(k,m) = t_surf_v(l)%t(m)
                   ENDDO
                ENDDO
@@ -3315,14 +4530,22 @@
         t_surf_h_p = t_surf_h
         t_surf_v_p = t_surf_v
+        t_surf_window_h_p = t_surf_window_h
+        t_surf_window_v_p = t_surf_window_v
+        t_surf_whole_h_p = t_surf_whole_h
+        t_surf_whole_v_p = t_surf_whole_v
+        t_surf_green_h_p = t_surf_green_h
+        t_surf_green_v_p = t_surf_green_v
+        t_surf_10cm_h_p = t_surf_10cm_h
+        t_surf_10cm_v_p = t_surf_10cm_v
 
         t_wall_h_p = t_wall_h
         t_wall_v_p = t_wall_v
-        
-!--     Adjust radiative fluxes for urban surface at model start
-        CALL usm_radiation
+        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
         
         CALL cpu_log( log_point_s(78), 'usm_init', 'stop' )
 
-        
     END SUBROUTINE usm_init_urban_surface
 
@@ -3342,5 +4565,5 @@
         INTEGER(iwp) ::  i,j,k,l,kw, m                      !< running indices
 
-        REAL(wp), DIMENSION(nzb_wall:nzt_wall) :: wtend  !< tendency
+        REAL(wp), DIMENSION(nzb_wall:nzt_wall) :: wtend, wintend  !< tendency
 
 !
@@ -3355,22 +4578,59 @@
 !--        prognostic equation for ground/roof temperature t_wall_h
            wtend(:) = 0.0_wp
-           wtend(nzb_wall) = (1.0_wp / surf_usm_h%rho_c_wall(nzb_wall,m)) *    &
-                                      ( surf_usm_h%lambda_h(nzb_wall,m) *      &
-                                        ( t_wall_h(nzb_wall+1,m)               &
-                                        - t_wall_h(nzb_wall,m) ) *             &
-                                        surf_usm_h%ddz_wall(nzb_wall+1,m)      &
-                                      + surf_usm_h%wghf_eb(m) ) *              &
-                                        surf_usm_h%ddz_wall_stag(nzb_wall,m)
-            
-           DO  kw = nzb_wall+1, nzt_wall
-               wtend(kw) = (1.0_wp / surf_usm_h%rho_c_wall(kw,m))              &
-                              * (   surf_usm_h%lambda_h(kw,m)                  &
-                                 * ( t_wall_h(kw+1,m) - t_wall_h(kw,m) )       &
-                                 * surf_usm_h%ddz_wall(kw+1,m)                 &
-                              - surf_usm_h%lambda_h(kw-1,m)                    &
-                                 * ( t_wall_h(kw,m) - t_wall_h(kw-1,m) )       &
-                                 * surf_usm_h%ddz_wall(kw,m)                   &
-                              ) * surf_usm_h%ddz_wall_stag(kw,m)
-            ENDDO
+           wtend(nzb_wall) = (1.0_wp / surf_usm_h%rho_c_wall(nzb_wall,m)) *        &
+                                       ( surf_usm_h%lambda_h(nzb_wall,m) *         &
+                                         ( t_wall_h(nzb_wall+1,m)                  &
+                                         - t_wall_h(nzb_wall,m) ) *                &
+                                         surf_usm_h%ddz_wall(nzb_wall+1,m)         &
+                                       + surf_usm_h%frac(0,m)                      &
+                                         / (surf_usm_h%frac(0,m)                   &
+                                           + surf_usm_h%frac(1,m) )                &
+                                         * surf_usm_h%wghf_eb(m)                   &
+                                       - surf_usm_h%frac(1,m)                      &
+                                          / (surf_usm_h%frac(0,m)                  &
+                                            + surf_usm_h%frac(1,m) )               &
+                                         * ( surf_usm_h%lambda_h_green(nzt_wall,m) &
+                                           * surf_usm_h%ddz_green(nzt_wall,m)      &
+                                           + surf_usm_h%lambda_h(nzb_wall,m)       &
+                                           * surf_usm_h%ddz_wall(nzb_wall,m) )     &
+                                         / ( surf_usm_h%ddz_green(nzt_wall,m)      &
+                                           + surf_usm_h%ddz_wall(nzb_wall,m) )     &
+                                         * ( t_wall_h(nzb_wall,m)                  &
+                                           - t_green_h(nzt_wall,m) ) ) *           &
+                                       surf_usm_h%ddz_wall_stag(nzb_wall,m)
+
+!dummy value for testing
+surf_usm_h%iwghf_eb(m) = 0.
+
+           IF ( indoor_model ) then 
+              DO  kw = nzb_wall+1, nzt_wall-1
+                  wtend(kw) = (1.0_wp / surf_usm_h%rho_c_wall(kw,m))              &
+                                 * (   surf_usm_h%lambda_h(kw,m)                  &
+                                    * ( t_wall_h(kw+1,m) - t_wall_h(kw,m) )       &
+                                    * surf_usm_h%ddz_wall(kw+1,m)                 &
+                                 - surf_usm_h%lambda_h(kw-1,m)                    &
+                                    * ( t_wall_h(kw,m) - t_wall_h(kw-1,m) )       &
+                                    * surf_usm_h%ddz_wall(kw,m)                   &
+                                   ) * surf_usm_h%ddz_wall_stag(kw,m)
+              ENDDO
+              wtend(nzt_wall) = (1.0_wp / surf_usm_h%rho_c_wall(nzt_wall,m)) *    &
+                                         ( surf_usm_h%lambda_h(nzt_wall-1,m) *    &
+                                           ( t_wall_h(nzt_wall,m)                 &
+                                           - t_wall_h(nzt_wall-1,m) ) *           &
+                                           surf_usm_h%ddz_wall(nzt_wall,m)        &
+                                         + surf_usm_h%iwghf_eb(m) ) *             &
+                                           surf_usm_h%ddz_wall_stag(nzt_wall,m)
+           ELSE
+              DO  kw = nzb_wall+1, nzt_wall
+                  wtend(kw) = (1.0_wp / surf_usm_h%rho_c_wall(kw,m))              &
+                                 * (   surf_usm_h%lambda_h(kw,m)                  &
+                                    * ( t_wall_h(kw+1,m) - t_wall_h(kw,m) )       &
+                                    * surf_usm_h%ddz_wall(kw+1,m)                 &
+                                 - surf_usm_h%lambda_h(kw-1,m)                    &
+                                    * ( t_wall_h(kw,m) - t_wall_h(kw-1,m) )       &
+                                    * surf_usm_h%ddz_wall(kw,m)                   &
+                                   ) * surf_usm_h%ddz_wall_stag(kw,m)
+              ENDDO
+           ENDIF
 
            t_wall_h_p(nzb_wall:nzt_wall,m) = t_wall_h(nzb_wall:nzt_wall,m)     &
@@ -3378,5 +4638,69 @@
                                  * wtend(nzb_wall:nzt_wall) + tsc(3)           &
                                  * surf_usm_h%tt_wall_m(nzb_wall:nzt_wall,m) )   
-            
+
+!--        prognostic equation for ground/roof window temperature t_window_h
+           wintend(:) = 0.0_wp
+           wintend(nzb_wall) = (1.0_wp / surf_usm_h%rho_c_window(nzb_wall,m)) *   &
+                                      ( surf_usm_h%lambda_h_window(nzb_wall,m) *  &
+                                        ( t_window_h(nzb_wall+1,m)                &
+                                        - t_window_h(nzb_wall,m) ) *              &
+                                        surf_usm_h%ddz_window(nzb_wall+1,m)       &
+                                      + surf_usm_h%wghf_eb_window(m)              &
+                                      + surf_usm_h%rad_sw_in(m)                   &
+                                        * (1.0_wp - exp(-surf_usm_h%transmissivity(m) &
+                                        * surf_usm_h%zw_window(nzb_wall,m) ) )    &
+                                      ) * surf_usm_h%ddz_window_stag(nzb_wall,m)
+
+           IF ( indoor_model ) then 
+              DO  kw = nzb_wall+1, nzt_wall-1
+                  wintend(kw) = (1.0_wp / surf_usm_h%rho_c_window(kw,m))          &
+                                 * (   surf_usm_h%lambda_h_window(kw,m)           &
+                                    * ( t_window_h(kw+1,m) - t_window_h(kw,m) )   &
+                                    * surf_usm_h%ddz_window(kw+1,m)               &
+                                 - surf_usm_h%lambda_h_window(kw-1,m)             &
+                                    * ( t_window_h(kw,m) - t_window_h(kw-1,m) )   &
+                                    * surf_usm_h%ddz_window(kw,m)                 &
+                                 + surf_usm_h%rad_sw_in(m)                        &
+                                    * (exp(-surf_usm_h%transmissivity(m)       &
+                                        * surf_usm_h%zw_window(kw-1,m) )          &
+                                        - exp(-surf_usm_h%transmissivity(m)    &
+                                        * surf_usm_h%zw_window(kw,m) ) )          &
+                                   ) * surf_usm_h%ddz_window_stag(kw,m)
+
+              ENDDO
+              wintend(nzt_wall) = (1.0_wp / surf_usm_h%rho_c_window(nzt_wall,m)) *     &
+                                         ( surf_usm_h%lambda_h_window(nzt_wall-1,m) *  &
+                                           ( t_window_h(nzt_wall,m)                    &
+                                           - t_window_h(nzt_wall-1,m) ) *              &
+                                           surf_usm_h%ddz_window(nzt_wall,m)           &
+                                         + surf_usm_h%iwghf_eb_window(m)               &
+                                         + surf_usm_h%rad_sw_in(m)                     &
+                                           * (1.0_wp - exp(-surf_usm_h%transmissivity(m) &
+                                           * surf_usm_h%zw_window(nzt_wall,m) ) )      &
+                                         ) * surf_usm_h%ddz_window_stag(nzt_wall,m)
+           ELSE
+              DO  kw = nzb_wall+1, nzt_wall
+                  wintend(kw) = (1.0_wp / surf_usm_h%rho_c_window(kw,m))          &
+                                 * (   surf_usm_h%lambda_h_window(kw,m)           &
+                                    * ( t_window_h(kw+1,m) - t_window_h(kw,m) )   &
+                                    * surf_usm_h%ddz_window(kw+1,m)               &
+                                 - surf_usm_h%lambda_h_window(kw-1,m)             &
+                                    * ( t_window_h(kw,m) - t_window_h(kw-1,m) )   &
+                                    * surf_usm_h%ddz_window(kw,m)                 &
+                                 + surf_usm_h%rad_sw_in(m)                        &
+                                    * (exp(-surf_usm_h%transmissivity(m)       &
+                                        * surf_usm_h%zw_window(kw-1,m) )          &
+                                        - exp(-surf_usm_h%transmissivity(m)    &
+                                        * surf_usm_h%zw_window(kw,m) ) )          &
+                                   ) * surf_usm_h%ddz_window_stag(kw,m)
+
+              ENDDO
+           ENDIF
+
+           t_window_h_p(nzb_wall:nzt_wall,m) = t_window_h(nzb_wall:nzt_wall,m)    &
+                                 + dt_3d * ( tsc(2)                               &
+                                 * wintend(nzb_wall:nzt_wall) + tsc(3)            &
+                                 * surf_usm_h%tt_window_m(nzb_wall:nzt_wall,m) )   
+           
 !
 !--        calculate t_wall tendencies for the next Runge-Kutta step
@@ -3394,5 +4718,21 @@
                ENDIF
            ENDIF
+
+!--        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_usm_h%tt_window_m(kw,m) = wintend(kw)
+                  ENDDO
+               ELSEIF ( intermediate_timestep_count <                          &
+                        intermediate_timestep_count_max )  THEN
+                   DO  kw = nzb_wall, nzt_wall
+                      surf_usm_h%tt_window_m(kw,m) = -9.5625_wp * wintend(kw) +    &
+                                         5.3125_wp * surf_usm_h%tt_window_m(kw,m)
+                   ENDDO
+               ENDIF
+           ENDIF
         ENDDO
+
 !
 !--     For vertical surfaces     
@@ -3407,22 +4747,60 @@
 !--           prognostic equation for wall temperature t_wall_v
               wtend(:) = 0.0_wp
-              wtend(nzb_wall) = (1.0_wp / surf_usm_v(l)%rho_c_wall(nzb_wall,m)) * &
-                                      ( surf_usm_v(l)%lambda_h(nzb_wall,m) *   &
-                                        ( t_wall_v(l)%t(nzb_wall+1,m)          &
-                                        - t_wall_v(l)%t(nzb_wall,m) ) *        &
-                                        surf_usm_v(l)%ddz_wall(nzb_wall+1,m)   &
-                                      + surf_usm_v(l)%wghf_eb(m) ) *           &
-                                        surf_usm_v(l)%ddz_wall_stag(nzb_wall,m)
-            
-              DO  kw = nzb_wall+1, nzt_wall
-                  wtend(kw) = (1.0_wp / surf_usm_v(l)%rho_c_wall(kw,m))        &
-                           * (   surf_usm_v(l)%lambda_h(kw,m)                  &
-                              * ( t_wall_v(l)%t(kw+1,m) - t_wall_v(l)%t(kw,m) )&
-                              * surf_usm_v(l)%ddz_wall(kw+1,m)                 &
-                           - surf_usm_v(l)%lambda_h(kw-1,m)                    &
-                              * ( t_wall_v(l)%t(kw,m) - t_wall_v(l)%t(kw-1,m) )&
-                              * surf_usm_v(l)%ddz_wall(kw,m)                   &
-                              ) * surf_usm_v(l)%ddz_wall_stag(kw,m)
-               ENDDO
+
+               wtend(nzb_wall) = (1.0_wp / surf_usm_v(l)%rho_c_wall(nzb_wall,m)) *    &
+                                       ( surf_usm_v(l)%lambda_h(nzb_wall,m) *         &
+                                         ( t_wall_v(l)%t(nzb_wall+1,m)                &
+                                         - t_wall_v(l)%t(nzb_wall,m) ) *              &
+                                         surf_usm_v(l)%ddz_wall(nzb_wall+1,m)         &
+                                       + surf_usm_v(l)%frac(0,m)                      &
+                                         / (surf_usm_v(l)%frac(0,m)                   &
+                                           + surf_usm_v(l)%frac(1,m) )                &
+                                         * surf_usm_v(l)%wghf_eb(m)                   &
+                                       - surf_usm_v(l)%frac(1,m)                      &
+                                         / (surf_usm_v(l)%frac(0,m)                    &
+                                           + surf_usm_v(l)%frac(1,m) )                &
+                                         * ( surf_usm_v(l)%lambda_h_green(nzt_wall,m) &
+                                           * surf_usm_v(l)%ddz_green(nzt_wall,m)      &
+                                           + surf_usm_v(l)%lambda_h(nzb_wall,m)       &
+                                           * surf_usm_v(l)%ddz_wall(nzb_wall,m) )     &
+                                         / ( surf_usm_v(l)%ddz_green(nzt_wall,m)      &
+                                           + surf_usm_v(l)%ddz_wall(nzb_wall,m) )     &
+                                         * ( t_wall_v(l)%t(nzb_wall,m)                &
+                                           - t_green_v(l)%t(nzt_wall,m) ) ) *         &
+                                         surf_usm_v(l)%ddz_wall_stag(nzb_wall,m)
+
+!dummy value for testing
+surf_usm_v(l)%iwghf_eb(m) = 0.
+
+              IF ( indoor_model ) then 
+                 DO  kw = nzb_wall+1, nzt_wall-1
+                     wtend(kw) = (1.0_wp / surf_usm_v(l)%rho_c_wall(kw,m))        &
+                              * (   surf_usm_v(l)%lambda_h(kw,m)                  &
+                                 * ( t_wall_v(l)%t(kw+1,m) - t_wall_v(l)%t(kw,m) )&
+                                 * surf_usm_v(l)%ddz_wall(kw+1,m)                 &
+                              - surf_usm_v(l)%lambda_h(kw-1,m)                    &
+                                 * ( t_wall_v(l)%t(kw,m) - t_wall_v(l)%t(kw-1,m) )&
+                                 * surf_usm_v(l)%ddz_wall(kw,m)                   &
+                                 ) * surf_usm_v(l)%ddz_wall_stag(kw,m)
+                 ENDDO
+                 wtend(nzt_wall) = (1.0_wp / surf_usm_v(l)%rho_c_wall(nzt_wall,m)) * &
+                                         ( surf_usm_v(l)%lambda_h(nzt_wall-1,m) *    &
+                                           ( t_wall_v(l)%t(nzt_wall,m)               &
+                                           - t_wall_v(l)%t(nzt_wall-1,m) ) *         &
+                                           surf_usm_v(l)%ddz_wall(nzt_wall,m)        &
+                                         + surf_usm_v(l)%iwghf_eb(m) ) *             &
+                                           surf_usm_v(l)%ddz_wall_stag(nzt_wall,m)
+              ELSE
+                 DO  kw = nzb_wall+1, nzt_wall
+                     wtend(kw) = (1.0_wp / surf_usm_v(l)%rho_c_wall(kw,m))        &
+                              * (   surf_usm_v(l)%lambda_h(kw,m)                  &
+                                 * ( t_wall_v(l)%t(kw+1,m) - t_wall_v(l)%t(kw,m) )&
+                                 * surf_usm_v(l)%ddz_wall(kw+1,m)                 &
+                              - surf_usm_v(l)%lambda_h(kw-1,m)                    &
+                                 * ( t_wall_v(l)%t(kw,m) - t_wall_v(l)%t(kw-1,m) )&
+                                 * surf_usm_v(l)%ddz_wall(kw,m)                   &
+                                 ) * surf_usm_v(l)%ddz_wall_stag(kw,m)
+                 ENDDO
+              ENDIF
 
               t_wall_v_p(l)%t(nzb_wall:nzt_wall,m) =                           &
@@ -3431,5 +4809,68 @@
                                  * wtend(nzb_wall:nzt_wall) + tsc(3)           &
                                  * surf_usm_v(l)%tt_wall_m(nzb_wall:nzt_wall,m) )   
-            
+
+!--           prognostic equation for window temperature t_window_v
+              wintend(:) = 0.0_wp
+              wintend(nzb_wall) = (1.0_wp / surf_usm_v(l)%rho_c_window(nzb_wall,m)) * &
+                                      ( surf_usm_v(l)%lambda_h_window(nzb_wall,m) *   &
+                                        ( t_window_v(l)%t(nzb_wall+1,m)               &
+                                        - t_window_v(l)%t(nzb_wall,m) ) *             &
+                                        surf_usm_v(l)%ddz_window(nzb_wall+1,m)        &
+                                      + surf_usm_v(l)%wghf_eb_window(m)               &
+                                      + surf_usm_v(l)%rad_sw_in(m)                    &
+                                        * (1.0_wp - exp(-surf_usm_v(l)%transmissivity(m) &
+                                        * surf_usm_v(l)%zw_window(nzb_wall,m) ) )     &
+                                      ) * surf_usm_v(l)%ddz_window_stag(nzb_wall,m)
+
+              IF ( indoor_model ) then 
+                 DO  kw = nzb_wall+1, nzt_wall -1
+                     wintend(kw) = (1.0_wp / surf_usm_v(l)%rho_c_window(kw,m))         &
+                              * (   surf_usm_v(l)%lambda_h_window(kw,m)                &
+                                 * ( t_window_v(l)%t(kw+1,m) - t_window_v(l)%t(kw,m) ) &
+                                 * surf_usm_v(l)%ddz_window(kw+1,m)                    &
+                              - surf_usm_v(l)%lambda_h_window(kw-1,m)                  &
+                                 * ( t_window_v(l)%t(kw,m) - t_window_v(l)%t(kw-1,m) ) &
+                                 * surf_usm_v(l)%ddz_window(kw,m)                      &
+                              + surf_usm_v(l)%rad_sw_in(m)                             &
+                                 * (exp(-surf_usm_v(l)%transmissivity(m)            &
+                                    * surf_usm_v(l)%zw_window(kw-1,m)       )          &
+                                        - exp(-surf_usm_v(l)%transmissivity(m)      &
+                                        * surf_usm_v(l)%zw_window(kw,m) ) )            &
+                                 ) * surf_usm_v(l)%ddz_window_stag(kw,m)
+                  ENDDO
+                  wintend(nzt_wall) = (1.0_wp / surf_usm_v(l)%rho_c_window(nzt_wall,m)) * &
+                                          ( surf_usm_v(l)%lambda_h_window(nzt_wall-1,m) * &
+                                            ( t_window_v(l)%t(nzt_wall,m)                 &
+                                            - t_window_v(l)%t(nzt_wall-1,m) ) *           &
+                                            surf_usm_v(l)%ddz_window(nzt_wall,m)          &
+                                          + surf_usm_v(l)%iwghf_eb_window(m)              &
+                                          + surf_usm_v(l)%rad_sw_in(m)                    &
+                                            * (1.0_wp - exp(-surf_usm_v(l)%transmissivity(m) &
+                                            * surf_usm_v(l)%zw_window(nzt_wall,m) ) )     &
+                                          ) * surf_usm_v(l)%ddz_window_stag(nzt_wall,m)
+              ELSE
+                 DO  kw = nzb_wall+1, nzt_wall
+                     wintend(kw) = (1.0_wp / surf_usm_v(l)%rho_c_window(kw,m))         &
+                              * (   surf_usm_v(l)%lambda_h_window(kw,m)                &
+                                 * ( t_window_v(l)%t(kw+1,m) - t_window_v(l)%t(kw,m) ) &
+                                 * surf_usm_v(l)%ddz_window(kw+1,m)                    &
+                              - surf_usm_v(l)%lambda_h_window(kw-1,m)                  &
+                                 * ( t_window_v(l)%t(kw,m) - t_window_v(l)%t(kw-1,m) ) &
+                                 * surf_usm_v(l)%ddz_window(kw,m)                      &
+                              + surf_usm_v(l)%rad_sw_in(m)                             &
+                                 * (exp(-surf_usm_v(l)%transmissivity(m)            &
+                                    * surf_usm_v(l)%zw_window(kw-1,m)       )          &
+                                        - exp(-surf_usm_v(l)%transmissivity(m)      &
+                                        * surf_usm_v(l)%zw_window(kw,m) ) )            &
+                                 ) * surf_usm_v(l)%ddz_window_stag(kw,m)
+                 ENDDO
+              ENDIF
+
+              t_window_v_p(l)%t(nzb_wall:nzt_wall,m) =                           &
+                                   t_window_v(l)%t(nzb_wall:nzt_wall,m)          &
+                                 + dt_3d * ( tsc(2)                              &
+                                 * wintend(nzb_wall:nzt_wall) + tsc(3)           &
+                                 * surf_usm_v(l)%tt_window_m(nzb_wall:nzt_wall,m) )   
+
 !
 !--           calculate t_wall tendencies for the next Runge-Kutta step
@@ -3448,4 +4889,19 @@
                   ENDIF
               ENDIF
+!--           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_usm_v(l)%tt_window_m(kw,m) = wintend(kw)
+                     ENDDO
+                  ELSEIF ( intermediate_timestep_count <                       &
+                           intermediate_timestep_count_max )  THEN
+                      DO  kw = nzb_wall, nzt_wall
+                         surf_usm_v(l)%tt_window_m(kw,m) =                     &
+                                     - 9.5625_wp * wintend(kw) +               &
+                                       5.3125_wp * surf_usm_v(l)%tt_window_m(kw,m)
+                      ENDDO
+                  ENDIF
+              ENDIF
            ENDDO
         ENDDO
@@ -3453,4 +4909,135 @@
     END SUBROUTINE usm_material_heat_model
 
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!
+!> Green and substrate model as part of the urban surface model. The model predicts ground
+!> temperatures.
+!------------------------------------------------------------------------------!
+    SUBROUTINE usm_green_heat_model
+
+
+        IMPLICIT NONE
+
+        INTEGER(iwp) ::  i,j,k,l,kw, m                      !< running indices
+
+        REAL(wp), DIMENSION(nzb_wall:nzt_wall) :: gtend  !< tendency
+
+!
+!--     For horizontal surfaces                                   
+        DO  m = 1, surf_usm_h%ns
+!
+!--        Obtain indices
+           i = surf_usm_h%i(m)            
+           j = surf_usm_h%j(m)
+           k = surf_usm_h%k(m)
+
+           t_green_h(nzt_wall+1,m) = t_wall_h(nzb_wall,m)
+!
+!--        prognostic equation for ground/roof temperature t_green_h
+           gtend(:) = 0.0_wp
+           gtend(nzb_wall) = (1.0_wp / surf_usm_h%rho_c_green(nzb_wall,m)) *    &
+                                      ( surf_usm_h%lambda_h_green(nzb_wall,m) * &
+                                        ( t_green_h(nzb_wall+1,m)               &
+                                        - t_green_h(nzb_wall,m) ) *             &
+                                        surf_usm_h%ddz_green(nzb_wall+1,m)      &
+                                      + surf_usm_h%wghf_eb_green(m) ) *         &
+                                        surf_usm_h%ddz_green_stag(nzb_wall,m)
+           
+            DO  kw = nzb_wall+1, nzt_wall
+                gtend(kw) = (1.0_wp / surf_usm_h%rho_c_green(kw,m))             &
+                               * (   surf_usm_h%lambda_h_green(kw,m)            &
+                                  * ( t_green_h(kw+1,m) - t_green_h(kw,m) )     &
+                                  * surf_usm_h%ddz_green(kw+1,m)                &
+                               - surf_usm_h%lambda_h_green(kw-1,m)              &
+                                  * ( t_green_h(kw,m) - t_green_h(kw-1,m) )     &
+                                  * surf_usm_h%ddz_green(kw,m)                  &
+                                 ) * surf_usm_h%ddz_green_stag(kw,m)
+            ENDDO
+
+           t_green_h_p(nzb_wall:nzt_wall,m) = t_green_h(nzb_wall:nzt_wall,m)    &
+                                 + dt_3d * ( tsc(2)                             &
+                                 * gtend(nzb_wall:nzt_wall) + tsc(3)            &
+                                 * surf_usm_h%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_usm_h%tt_green_m(kw,m) = gtend(kw)
+                  ENDDO
+               ELSEIF ( intermediate_timestep_count <                           &
+                        intermediate_timestep_count_max )  THEN
+                   DO  kw = nzb_wall, nzt_wall
+                      surf_usm_h%tt_green_m(kw,m) = -9.5625_wp * gtend(kw) +    &
+                                         5.3125_wp * surf_usm_h%tt_green_m(kw,m)
+                   ENDDO
+               ENDIF
+           ENDIF
+        ENDDO
+
+!
+!--     For vertical surfaces     
+        DO  l = 0, 3                              
+           DO  m = 1, surf_usm_v(l)%ns
+!
+!--           Obtain indices
+              i = surf_usm_v(l)%i(m)            
+              j = surf_usm_v(l)%j(m)
+              k = surf_usm_v(l)%k(m)
+
+              t_green_v(l)%t(nzt_wall+1,m) = t_wall_v(l)%t(nzb_wall,m)
+!
+!--           prognostic equation for green temperature t_green_v
+              gtend(:) = 0.0_wp
+              gtend(nzb_wall) = (1.0_wp / surf_usm_v(l)%rho_c_green(nzb_wall,m)) * &
+                                      ( surf_usm_v(l)%lambda_h_green(nzb_wall,m) * &
+                                        ( t_green_v(l)%t(nzb_wall+1,m)             &
+                                        - t_green_v(l)%t(nzb_wall,m) ) *           &
+                                        surf_usm_v(l)%ddz_green(nzb_wall+1,m)      &
+                                      + surf_usm_v(l)%wghf_eb(m) ) *               &
+                                        surf_usm_v(l)%ddz_green_stag(nzb_wall,m)
+            
+              DO  kw = nzb_wall+1, nzt_wall
+                 gtend(kw) = (1.0_wp / surf_usm_v(l)%rho_c_green(kw,m))          &
+                           * (   surf_usm_v(l)%lambda_h_green(kw,m)              &
+                             * ( t_green_v(l)%t(kw+1,m) - t_green_v(l)%t(kw,m) ) &
+                             * surf_usm_v(l)%ddz_green(kw+1,m)                   &
+                           - surf_usm_v(l)%lambda_h(kw-1,m)                      &
+                             * ( t_green_v(l)%t(kw,m) - t_green_v(l)%t(kw-1,m) ) &
+                             * surf_usm_v(l)%ddz_green(kw,m) )                   &
+                           * surf_usm_v(l)%ddz_green_stag(kw,m)
+              ENDDO
+
+              t_green_v_p(l)%t(nzb_wall:nzt_wall,m) =                              &
+                                   t_green_v(l)%t(nzb_wall:nzt_wall,m)             &
+                                 + dt_3d * ( tsc(2)                                &
+                                 * gtend(nzb_wall:nzt_wall) + tsc(3)               &
+                                 * surf_usm_v(l)%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_usm_v(l)%tt_green_m(kw,m) = gtend(kw)
+                     ENDDO
+                  ELSEIF ( intermediate_timestep_count <                           &
+                           intermediate_timestep_count_max )  THEN
+                      DO  kw = nzb_wall, nzt_wall
+                         surf_usm_v(l)%tt_green_m(kw,m) =                          &
+                                     - 9.5625_wp * gtend(kw) +                     &
+                                       5.3125_wp * surf_usm_v(l)%tt_green_m(kw,m)
+                      ENDDO
+                  ENDIF
+              ENDIF
+
+           ENDDO
+        ENDDO
+
+    END SUBROUTINE usm_green_heat_model
 
 !------------------------------------------------------------------------------!
@@ -3466,20 +5053,15 @@
 
        NAMELIST /urban_surface_par/                                            &
+                           building_type,                                      &
                            land_category,                                      &
-                           mrt_factors,                                        &
-                           nrefsteps,                                          &
                            pedestrant_category,                                &
                            ra_horiz_coef,                                      &
-                           read_svf_on_init,                                   &
                            roof_category,                                      &
-                           split_diffusion_radiation,                          &
                            urban_surface,                                      &
                            usm_anthropogenic_heat,                             &
-                           usm_energy_balance_land,                            &
-                           usm_energy_balance_wall,                            &
                            usm_material_model,                                 &
                            usm_lad_rma,                                        &
                            wall_category,                                      &
-                           write_svf_on_init
+                           indoor_model
 
        line = ' '
@@ -3516,586 +5098,52 @@
     END SUBROUTINE usm_parin
 
-
 !------------------------------------------------------------------------------!
 ! Description:
 ! ------------
-!> This subroutine calculates interaction of the solar radiation
-!> with urban surface and updates surface, roofs and walls heatfluxes.
-!> It also updates rad_sw_out and rad_lw_out.
+!> Calculates temperature near surface (10 cm) for indoor model
 !------------------------------------------------------------------------------!
-    SUBROUTINE usm_radiation
-    
-        IMPLICIT NONE
-       
-        INTEGER(iwp)               :: i, j, k, kk, is, js, d, ku, refstep, m, mm, l, ll
-        INTEGER(iwp)               :: nzubl, nzutl, isurf, isurfsrc, isurf1, isvf, icsf, ipcgb
-        INTEGER(iwp), DIMENSION(4) :: bdycross
-        REAL(wp), DIMENSION(3,3)   :: mrot            !< grid rotation matrix (xyz)
-        REAL(wp), DIMENSION(3,0:9) :: vnorm           !< face direction normal vectors (xyz)
-        REAL(wp), DIMENSION(3)     :: sunorig         !< grid rotated solar direction unit vector (xyz)
-        REAL(wp), DIMENSION(3)     :: sunorig_grid    !< grid squashed solar direction unit vector (zyx)
-        REAL(wp), DIMENSION(0:9)   :: costheta        !< direct irradiance factor of solar angle
-        REAL(wp), DIMENSION(nzub:nzut) :: pchf_prep   !< precalculated factor for canopy temp tendency
-        REAL(wp), PARAMETER        :: alpha = 0._wp   !< grid rotation (TODO: add to namelist or remove)
-        REAL(wp)                   :: rx, ry, rz
-        REAL(wp)                   :: pc_box_area, pc_abs_frac, pc_abs_eff
-        INTEGER(iwp)               :: pc_box_dimshift !< transform for best accuracy
-        INTEGER(iwp), DIMENSION(0:3) :: reorder = (/ 1, 0, 3, 2 /)
-        
-#if ! defined( __nopointer )
-        IF ( plant_canopy )  THEN
-            pchf_prep(:) = r_d * (hyp(nzub:nzut) / 100000.0_wp)**0.286_wp &
-                        / (cp * hyp(nzub:nzut) * dx*dy*dz) !< equals to 1 / (rho * c_p * Vbox * T)
-        ENDIF
-#endif
-        sun_direction = .TRUE.
-        CALL calc_zenith  !< required also for diffusion radiation
-
-!--     prepare rotated normal vectors and irradiance factor
-        vnorm(1,:) = idir(:)
-        vnorm(2,:) = jdir(:)
-        vnorm(3,:) = kdir(:)
-        mrot(1, :) = (/ cos(alpha), -sin(alpha), 0._wp /)
-        mrot(2, :) = (/ sin(alpha),  cos(alpha), 0._wp /)
-        mrot(3, :) = (/ 0._wp,       0._wp,      1._wp /)
-        sunorig = (/ sun_dir_lon, sun_dir_lat, zenith(0) /)
-        sunorig = matmul(mrot, sunorig)
-        DO d = 0, 9
-            costheta(d) = dot_product(sunorig, vnorm(:,d))
-        ENDDO
-        
-        IF ( zenith(0) > 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(3)/dz, sunorig(2)/dy, sunorig(1)/dx /)
-!--         sunorig_grid = sunorig_grid / norm2(sunorig_grid)
-            sunorig_grid = sunorig_grid / SQRT(SUM(sunorig_grid**2))
-
-            IF ( plant_canopy )  THEN
-!--            precompute effective box depth with prototype Leaf Area Density
-               pc_box_dimshift = maxloc(sunorig, 1) - 1
-               CALL usm_box_absorb(cshift((/dx,dy,dz/), pc_box_dimshift),      &
-                                   60, prototype_lad,                          &
-                                   cshift(sunorig, pc_box_dimshift),           &
-                                   pc_box_area, pc_abs_frac)
-               pc_box_area = pc_box_area * sunorig(pc_box_dimshift+1) / sunorig(3)
-               pc_abs_eff = log(1._wp - pc_abs_frac) / prototype_lad
-            ENDIF
-        ENDIF
-        
-!--     split diffusion and direct part of the solar downward radiation
-!--     comming from radiation model and store it in 2D arrays
-!--     rad_sw_in_diff, rad_sw_in_dir and rad_lw_in_diff
-        IF ( split_diffusion_radiation )  THEN
-            CALL usm_calc_diffusion_radiation
-        ELSE
-            rad_sw_in_diff = 0.0_wp
-            rad_sw_in_dir(:,:)  = rad_sw_in(0,:,:)
-            rad_lw_in_diff(:,:) = rad_lw_in(0,:,:)
-        ENDIF
-
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!--     First pass: direct + diffuse irradiance
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-        surfinswdir   = 0._wp !nsurfl
-        surfinswdif   = 0._wp !nsurfl
-        surfinlwdif   = 0._wp !nsurfl
-        surfins       = 0._wp !nsurfl
-        surfinl       = 0._wp !nsurfl
-        surfoutsl(:)  = 0.0_wp !start-end
-        surfoutll(:)  = 0.0_wp !start-end
-        
-!--     Set up thermal radiation from surfaces
-!--     emiss_surf is defined only for surfaces for which energy balance is calculated
-!--     Workaround: reorder surface data type back on 1D array including all surfaces, 
-!--     which implies to reorder horizontal and vertical surfaces
-!
-!--     Horizontal walls
-        mm = 1
-        DO  i = nxl, nxr
-           DO  j = nys, nyn
-
-              DO  m = surf_usm_h%start_index(j,i), surf_usm_h%end_index(j,i)
-                 surfoutll(mm) = surf_usm_h%emiss_surf(m) * sigma_sb   &
-                                     * t_surf_h(m)**4
-                 albedo_surf(mm) = surf_usm_h%albedo_surf(m)
-                 emiss_surf(mm)  = surf_usm_h%emiss_surf(m)
-                 mm = mm + 1
-              ENDDO
-           ENDDO
-        ENDDO
-!
-!--     Vertical walls
-        DO  i = nxl, nxr
-           DO  j = nys, nyn
-              DO  ll = 0, 3
-                 l = reorder(ll)
-                 DO  m = surf_usm_v(l)%start_index(j,i), surf_usm_v(l)%end_index(j,i)
-                    surfoutll(mm) = surf_usm_v(l)%emiss_surf(m) * sigma_sb   &
-                                     * t_surf_v(l)%t(m)**4
-                    albedo_surf(mm) = surf_usm_v(l)%albedo_surf(m)
-                    emiss_surf(mm) = surf_usm_v(l)%emiss_surf(m)
-                    mm = mm + 1
-                 ENDDO
-              ENDDO
-           ENDDO
-        ENDDO
-        
-#if defined( __parallel )
-!--     might be optimized and gather only values relevant for current processor
-        
-        CALL MPI_AllGatherv(surfoutll, nenergy, MPI_REAL, &
-                            surfoutl, nsurfs, surfstart, MPI_REAL, comm2d, ierr) !nsurf global
-#else
-        surfoutl(:) = surfoutll(:) !nsurf global
-#endif
-        
-        isurf1 = -1   !< previous processed surface
-        DO isvf = 1, nsvfl
-            isurf = svfsurf(1, isvf)
-            k = surfl(iz, isurf)
-            j = surfl(iy, isurf)
-            i = surfl(ix, isurf)
-            isurfsrc = svfsurf(2, isvf)
-            IF ( zenith(0) > 0  .AND.  isurf /= isurf1 )  THEN
-!--             locate the virtual surface where the direct solar ray crosses domain boundary
-!--             (once per target surface)
-                d = surfl(id, isurf)
-                rz = REAL(k, wp) - 0.5_wp * kdir(d)
-                ry = REAL(j, wp) - 0.5_wp * jdir(d)
-                rx = REAL(i, wp) - 0.5_wp * idir(d)
-                
-                CALL usm_find_boundary_face( (/ rz, ry, rx /), sunorig_grid, bdycross)
-                
-                isurf1 = isurf
-            ENDIF
-
-            IF ( surf(id, isurfsrc) >= isky )  THEN
-!--             diffuse rad from boundary surfaces. Since it is a simply
-!--             calculated value, it is not assigned to surfref(s/l),
-!--             instead it is used directly here
-!--             we consider the radiation from the radiation model falling on surface
-!--             as the radiation falling on the top of urban layer into the place of the source surface
-!--             we consider it as a very reasonable simplification which allow as avoid
-!--             necessity of other global range arrays and some all to all mpi communication
-                surfinswdif(isurf) = surfinswdif(isurf) + rad_sw_in_diff(j,i) * svf(1,isvf) * svf(2,isvf)
-                                                                !< canopy shading is applied only to shortwave
-                surfinlwdif(isurf) = surfinlwdif(isurf) + rad_lw_in_diff(j,i) * svf(1,isvf)
-            ELSE
-!--             for surface-to-surface factors we calculate thermal radiation in 1st pass
-                surfinl(isurf) = surfinl(isurf) + svf(1,isvf) * surfoutl(isurfsrc)
-            ENDIF
-
-            IF ( zenith(0) > 0  .AND.  all( surf(1:4,isurfsrc) == bdycross ) )  THEN
-!--             found svf between model boundary and the face => face isn't shaded
-                surfinswdir(isurf) = rad_sw_in_dir(j,i) &
-                    * costheta(surfl(id, isurf)) * svf(2,isvf) / zenith(0)
-
-            ENDIF
-        ENDDO
-
-        IF ( plant_canopy )  THEN
-        
-            pcbinsw(:) = 0._wp
-            pcbinlw(:) = 0._wp  !< will stay always 0 since we don't absorb lw anymore
-            !
-!--         pcsf first pass
-            isurf1 = -1  !< previous processed pcgb
-            DO icsf = 1, ncsfl
-                ipcgb = csfsurf(1, icsf)
-                i = pcbl(ix,ipcgb)
-                j = pcbl(iy,ipcgb)
-                k = pcbl(iz,ipcgb)
-                isurfsrc = csfsurf(2, icsf)
-
-                IF ( zenith(0) > 0  .AND.  ipcgb /= isurf1 )  THEN
-!--                 locate the virtual surface where the direct solar ray crosses domain boundary
-!--                 (once per target PC gridbox)
-                    rz = REAL(k, wp)
-                    ry = REAL(j, wp)
-                    rx = REAL(i, wp)
-                    CALL usm_find_boundary_face( (/ rz, ry, rx /), &
-                        sunorig_grid, bdycross)
-
-                    isurf1 = ipcgb
-                ENDIF
-
-                IF ( surf(id, isurfsrc) >= isky )  THEN
-!--                 Diffuse rad from boundary surfaces. See comments for svf above.
-                    pcbinsw(ipcgb) = pcbinsw(ipcgb) + csf(1,icsf) * csf(2,icsf) * rad_sw_in_diff(j,i)
-!--                 canopy shading is applied only to shortwave, therefore no absorbtion for lw
-!--                 pcbinlw(ipcgb) = pcbinlw(ipcgb) + svf(1,isvf) * rad_lw_in_diff(j,i)
-                !ELSE
-!--                 Thermal radiation in 1st pass
-!--                 pcbinlw(ipcgb) = pcbinlw(ipcgb) + svf(1,isvf) * surfoutl(isurfsrc)
-                ENDIF
-
-                IF ( zenith(0) > 0  .AND.  all( surf(1:4,isurfsrc) == bdycross ) )  THEN
-!--                 found svf between model boundary and the pcgb => pcgb isn't shaded
-                    pc_abs_frac = 1._wp - exp(pc_abs_eff * lad_s(k,j,i))
-                    pcbinsw(ipcgb) = pcbinsw(ipcgb) &
-                        + rad_sw_in_dir(j, i) * pc_box_area * csf(2,icsf) * pc_abs_frac
-                ENDIF
-            ENDDO
-        ENDIF
-
-        surfins(startenergy:endenergy) = surfinswdir(startenergy:endenergy) + surfinswdif(startenergy:endenergy)
-        surfinl(startenergy:endenergy) = surfinl(startenergy:endenergy) + surfinlwdif(startenergy:endenergy)
-        surfinsw(:) = surfins(:)
-        surfinlw(:) = surfinl(:)
-        surfoutsw(:) = 0.0_wp
-        surfoutlw(:) = surfoutll(:)
-!         surfhf(startenergy:endenergy) = surfinsw(startenergy:endenergy) + surfinlw(startenergy:endenergy) &
-!                                       - surfoutsw(startenergy:endenergy) - surfoutlw(startenergy:endenergy)
-        
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-!--     Next passes - reflections
-!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-        DO refstep = 1, nrefsteps
-        
-            surfoutsl(startenergy:endenergy) = albedo_surf(startenergy:endenergy) * surfins(startenergy:endenergy)
-!--         for non-transparent surfaces, longwave albedo is 1 - emissivity
-            surfoutll(startenergy:endenergy) = (1._wp - emiss_surf(startenergy:endenergy)) * surfinl(startenergy:endenergy)
-
-#if defined( __parallel )
-            CALL MPI_AllGatherv(surfoutsl, nsurfl, MPI_REAL, &
-                surfouts, nsurfs, surfstart, MPI_REAL, comm2d, ierr)
-            CALL MPI_AllGatherv(surfoutll, nsurfl, MPI_REAL, &
-                surfoutl, nsurfs, surfstart, MPI_REAL, comm2d, ierr)
-#else
-            surfouts(:) = surfoutsl(:)
-            surfoutl(:) = surfoutll(:)
-#endif
-
-!--         reset for next pass input
-            surfins(:) = 0._wp
-            surfinl(:) = 0._wp
-            
-!--         reflected radiation
-            DO isvf = 1, nsvfl
-                isurf = svfsurf(1, isvf)
-                isurfsrc = svfsurf(2, isvf)
-
-!--             TODO: to remove if, use start+end for isvf
-                IF ( surf(id, isurfsrc) < isky )  THEN
-                    surfins(isurf) = surfins(isurf) + svf(1,isvf) * svf(2,isvf) * surfouts(isurfsrc)
-                    surfinl(isurf) = surfinl(isurf) + svf(1,isvf) * surfoutl(isurfsrc)
-                ENDIF
-            ENDDO
-
-!--         radiation absorbed by plant canopy
-            DO icsf = 1, ncsfl
-                ipcgb = csfsurf(1, icsf)
-                isurfsrc = csfsurf(2, icsf)
-
-                IF ( surf(id, isurfsrc) < isky )  THEN
-                    pcbinsw(ipcgb) = pcbinsw(ipcgb) + csf(1,icsf) * csf(2,icsf) * surfouts(isurfsrc)
-!--                 pcbinlw(ipcgb) = pcbinlw(ipcgb) + csf(1,icsf) * surfoutl(isurfsrc)
-                ENDIF
-            ENDDO
-            
-            surfinsw(:) = surfinsw(:)  + surfins(:)
-            surfinlw(:) = surfinlw(:)  + surfinl(:)
-            surfoutsw(startenergy:endenergy) = surfoutsw(startenergy:endenergy) + surfoutsl(startenergy:endenergy)
-            surfoutlw(startenergy:endenergy) = surfoutlw(startenergy:endenergy) + surfoutll(startenergy:endenergy)
-!             surfhf(startenergy:endenergy) = surfinsw(startenergy:endenergy) + surfinlw(startenergy:endenergy) &
-!                                           - surfoutsw(startenergy:endenergy) - surfoutlw(startenergy:endenergy)
-        
-        ENDDO
-
-!--     push heat flux absorbed by plant canopy to respective 3D arrays
-#if ! defined( __nopointer )
-        IF ( plant_canopy )  THEN
-            pc_heating_rate(:,:,:) = 0._wp
-            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 - ( get_topography_top_index( j, i, 's' ) )  !- lad arrays are defined flat
-                pc_heating_rate(kk, j, i) = (pcbinsw(ipcgb) + pcbinlw(ipcgb)) &
-                    * pchf_prep(k) * pt(k, j, i) !-- = dT/dt
-            ENDDO
-        ENDIF
-#endif
-!
-!--     Transfer radiation arrays required for energy balance to the respective data types
-        DO  i = startenergy, endenergy
-           m  = surfl(5,i)          
-!
-!--        upward-facing
-           IF ( surfl(1,i) == 0 )  THEN
-              surf_usm_h%rad_in_sw(m)  = surfinsw(i) 
-              surf_usm_h%rad_out_sw(m) = surfoutsw(i) 
-              surf_usm_h%rad_in_lw(m)  = surfinlw(i)
-              surf_usm_h%rad_out_lw(m) = surfoutlw(i)
-!
-!--        southward-facding
-           ELSEIF ( surfl(1,i) == 1 )  THEN
-              surf_usm_v(1)%rad_in_sw(m)  = surfinsw(i) 
-              surf_usm_v(1)%rad_out_sw(m) = surfoutsw(i) 
-              surf_usm_v(1)%rad_in_lw(m)  = surfinlw(i)
-              surf_usm_v(1)%rad_out_lw(m) = surfoutlw(i)
-!
-!--        northward-facding
-           ELSEIF ( surfl(1,i) == 2 )  THEN
-              surf_usm_v(0)%rad_in_sw(m)  = surfinsw(i) 
-              surf_usm_v(0)%rad_out_sw(m) = surfoutsw(i) 
-              surf_usm_v(0)%rad_in_lw(m)  = surfinlw(i)
-              surf_usm_v(0)%rad_out_lw(m) = surfoutlw(i)
-!
-!--        westward-facding
-           ELSEIF ( surfl(1,i) == 3 )  THEN
-              surf_usm_v(3)%rad_in_sw(m)  = surfinsw(i) 
-              surf_usm_v(3)%rad_out_sw(m) = surfoutsw(i) 
-              surf_usm_v(3)%rad_in_lw(m)  = surfinlw(i)
-              surf_usm_v(3)%rad_out_lw(m) = surfoutlw(i)
-!
-!--        eastward-facing
-           ELSEIF ( surfl(1,i) == 4 )  THEN
-              surf_usm_v(2)%rad_in_sw(m)  = surfinsw(i) 
-              surf_usm_v(2)%rad_out_sw(m) = surfoutsw(i) 
-              surf_usm_v(2)%rad_in_lw(m)  = surfinlw(i)
-              surf_usm_v(2)%rad_out_lw(m) = surfoutlw(i)
-           ENDIF
-
-        ENDDO
-
-
-        DO  m = 1, surf_usm_h%ns
-           surf_usm_h%surfhf(m) = surf_usm_h%rad_in_sw(m)  +                   &
-                                  surf_usm_h%rad_in_lw(m)  -                   &
-                                  surf_usm_h%rad_out_sw(m) -                   &
-                                  surf_usm_h%rad_out_lw(m)
-        ENDDO
-
-        DO  l = 0, 3
-           DO  m = 1, surf_usm_v(l)%ns
-              surf_usm_v(l)%surfhf(m) = surf_usm_v(l)%rad_in_sw(m)  +          &
-                                        surf_usm_v(l)%rad_in_lw(m)  -          &
-                                        surf_usm_v(l)%rad_out_sw(m) -          &
-                                        surf_usm_v(l)%rad_out_lw(m)
-           ENDDO
-        ENDDO
-
-!--     return surface radiation to horizontal surfaces 
-!--     to rad_sw_in, rad_lw_in and rad_net for outputs
-        !!!!!!!!!!
-!--     we need the original radiation on urban top layer
-!--     for calculation of MRT so we can't do adjustment here for now
-        !!!!!!!!!!
-        !!!DO isurf = 1, nsurfl
-        !!!    i = surfl(ix,isurf)
-        !!!    j = surfl(iy,isurf)
-        !!!    k = surfl(iz,isurf)
-        !!!    d = surfl(id,isurf)
-        !!!    IF ( d==iroof )  THEN
-        !!!        rad_sw_in(:,j,i) = surfinsw(isurf)
-        !!!        rad_lw_in(:,j,i) = surfinlw(isurf)
-        !!!        rad_net(j,i) = rad_sw_in(k,j,i) - rad_sw_out(k,j,i) + rad_lw_in(k,j,i) - rad_lw_out(k,j,i)
-        !!!    ENDIF
-        !!!ENDDO
-
-    END SUBROUTINE usm_radiation
-
-    
-!------------------------------------------------------------------------------!
-! Description:
-! ------------
-!> Raytracing for detecting obstacles and calculating compound canopy sink
-!> factors. (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 usm_raytrace(src, targ, isrc, rirrf, atarg, create_csf, visible, transparency, win_lad)
-        IMPLICIT NONE
-
-        REAL(wp), DIMENSION(3), INTENT(in)     :: src, targ    !< real coordinates z,y,x
-        INTEGER(iwp), INTENT(in)               :: isrc         !< index of source face for csf
-        REAL(wp), INTENT(in)                   :: rirrf        !< irradiance factor for csf
-        REAL(wp), INTENT(in)                   :: atarg        !< target surface area for csf
-        LOGICAL, INTENT(in)                    :: create_csf   !< whether to generate new CSFs during raytracing
-        LOGICAL, INTENT(out)                   :: visible
-        REAL(wp), INTENT(out)                  :: transparency !< along whole path
-        INTEGER(iwp), INTENT(in)               :: win_lad
-        INTEGER(iwp)                           :: i, j, k, d
-        INTEGER(iwp)                           :: seldim       !< dimension to be incremented
-        INTEGER(iwp)                           :: ncsb         !< no of written plant canopy sinkboxes
-        INTEGER(iwp)                           :: maxboxes     !< max no of gridboxes visited
-        REAL(wp)                               :: distance     !< euclidean along path
-        REAL(wp)                               :: crlen        !< length of gridbox crossing
-        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)                               :: crmid        !< midpoint of crossing
-        REAL(wp)                               :: cursink      !< sink factor for current canopy box
-        REAL(wp), DIMENSION(3)                 :: delta        !< path vector
-        REAL(wp), DIMENSION(3)                 :: uvect        !< unit vector
-        REAL(wp), DIMENSION(3)                 :: dimnextdist  !< distance for each dimension increments
-        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
-        INTEGER(iwp)                           :: px, py       !< number of processors in x and y dir before 
-                                                               !< the processor in the question
-        INTEGER(iwp)                           :: ip           !< number of processor where gridbox reside
-        INTEGER(iwp)                           :: ig           !< 1D index of gridbox in global 2D array
-        REAL(wp)                               :: lad_s_target !< recieved lad_s of particular grid box
-        REAL(wp), PARAMETER                    :: grow_factor = 1.5_wp !< factor of expansion of grow arrays
-
-!
-!--     Maximum number of gridboxes visited equals to 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) - NINT(src))) + 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 usm_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,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)
-
-!--             calculate index of the grid with global indices (box(2),box(3))
-!--             in the array nzterr and plantt and id of the coresponding processor
-                px = box(3)/nnx
-                py = box(2)/nny
-                ip = px*pdims(2)+py
-                ig = ip*nnx*nny + (box(3)-px*nnx)*nny + box(2)-py*nny
-                IF ( box(1) <= nzterr(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 )
-                        lad_ip(ncsb) = ip
-                        lad_disp(ncsb) = (box(3)-px*nnx)*(nny*nzu) + (box(2)-py*nny)*nzu + box(1)-nzub
-#endif
-                    ENDIF
-                ENDIF
-            ENDIF
-
-            IF ( nextdist >= distance ) 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 ( usm_lad_rma )  THEN
-!--             send requests for lad_s to appropriate processor
-                CALL cpu_log( log_point_s(77), 'usm_init_rma', '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(message_string, *) 'MPI error ', ierr, ' at MPI_Get'
-                        CALL message( 'usm_raytrace', 'PA0519', 1, 2, 0, 6, 0 )
-                    ENDIF
-                ENDDO
-                
-!--             wait for all pending local requests complete
-                CALL MPI_Win_flush_local_all(win_lad, ierr)
-                IF ( ierr /= 0 )  THEN
-                    WRITE(message_string, *) 'MPI error ', ierr, ' at MPI_Win_flush_local_all'
-                    CALL message( 'usm_raytrace', 'PA0519', 1, 2, 0, 6, 0 )
-                ENDIF
-                CALL cpu_log( log_point_s(77), 'usm_init_rma', 'stop' )
-                
-            ENDIF
-#endif
-
-!--         calculate csf and transparency
-            DO i = 1, ncsb
-#if defined( __parallel )
-                IF ( usm_lad_rma )  THEN
-                    lad_s_target = lad_s_ray(i)
-                ELSE
-                    lad_s_target = usm_lad_g(lad_ip(i)*nnx*nny*nzu + lad_disp(i))
-                ENDIF
-#else
-                lad_s_target = usm_lad(boxes(1,i),boxes(2,i),boxes(3,i))
-#endif
-                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)%rsvf = REAL(cursink*rirrf*atarg, wp) !-- we postpone multiplication by transparency
-                    acsf(ncsfl)%rtransp = REAL(transparency, wp)
-                ENDIF  !< create_csf
-
-                transparency = transparency * (1._wp - cursink)
-                
-            ENDDO
-        ENDIF
-        
-        visible = .TRUE.
-
-    END SUBROUTINE usm_raytrace
+    SUBROUTINE usm_temperature_near_surface
+
+       IMPLICIT NONE
+
+       INTEGER(iwp)                          :: i, j, k, l, m   !< running indices
+
+!        
+!--    First, treat horizontal surface elements
+       DO  m = 1, surf_usm_h%ns
+
+!--       Get indices of respective grid point
+          i = surf_usm_h%i(m)
+          j = surf_usm_h%j(m)
+          k = surf_usm_h%k(m)
+
+          t_surf_10cm_h(m) = t_surf_whole_h(m) + surf_usm_h%ts(m) / kappa        &
+                             * ( log( 0.1_wp /  surf_usm_h%z0h(m) )              &
+                               - psi_h( 0.1_wp / surf_usm_h%ol(m) )              &
+                               + psi_h( surf_usm_h%z0h(m) / surf_usm_h%ol(m) ) )
+
+       ENDDO
+!
+!--    Now, treat vertical surface elements
+       DO  l = 0, 3
+          DO  m = 1, surf_usm_v(l)%ns
+
+!--          Get indices of respective grid point
+             i = surf_usm_v(l)%i(m)
+             j = surf_usm_v(l)%j(m)
+             k = surf_usm_v(l)%k(m)
+
+             t_surf_10cm_v(l)%t(m) = t_surf_whole_v(l)%t(m) + surf_usm_v(l)%ts(m) / kappa &
+                                     * ( log( 0.1_wp / surf_usm_v(l)%z0h(m) )             &
+                                       - psi_h( 0.1_wp / surf_usm_v(l)%ol(m) )            &
+                                       + psi_h( surf_usm_v(l)%z0h(m) / surf_usm_v(l)%ol(m) ) )
+
+          ENDDO
+
+       ENDDO
+
+
+    END SUBROUTINE usm_temperature_near_surface
+
     
  
@@ -4242,9 +5290,9 @@
        INTEGER(iwp), DIMENSION(nys_on_file:nyn_on_file,nxl_on_file:nxr_on_file) ::  end_index_on_file
        
-       REAL(wp), DIMENSION(:), ALLOCATABLE   ::  tmp_surf_h
-       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  tmp_wall_h
+       REAL(wp), DIMENSION(:), ALLOCATABLE   ::  tmp_surf_h, tmp_surf_window_h, tmp_surf_green_h
+       REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  tmp_wall_h, tmp_window_h, tmp_green_h
        
-       TYPE( t_surf_vertical ), DIMENSION(0:3) ::  tmp_surf_v
-       TYPE( t_wall_vertical ), DIMENSION(0:3) ::  tmp_wall_v
+       TYPE( t_surf_vertical ), DIMENSION(0:3) ::  tmp_surf_v, tmp_surf_window_v, tmp_surf_green_v
+       TYPE( t_wall_vertical ), DIMENSION(0:3) ::  tmp_wall_v, tmp_window_v, tmp_green_v
 
        
@@ -4274,8 +5322,16 @@
           ALLOCATE( tmp_surf_h(1:ns_h_on_file_usm) )
           ALLOCATE( tmp_wall_h(nzb_wall:nzt_wall+1,1:ns_h_on_file_usm) )
+          ALLOCATE( tmp_surf_window_h(1:ns_h_on_file_usm) )
+          ALLOCATE( tmp_window_h(nzb_wall:nzt_wall+1,1:ns_h_on_file_usm) )
+          ALLOCATE( tmp_surf_green_h(1:ns_h_on_file_usm) )
+          ALLOCATE( tmp_green_h(nzb_wall:nzt_wall+1,1:ns_h_on_file_usm) )
           
           DO  l = 0, 3
              ALLOCATE( tmp_surf_v(l)%t(1:ns_v_on_file_usm(l)) )
              ALLOCATE( tmp_wall_v(l)%t(nzb_wall:nzt_wall+1,1:ns_v_on_file_usm(l) ) )
+             ALLOCATE( tmp_surf_window_v(l)%t(1:ns_v_on_file_usm(l)) )
+             ALLOCATE( tmp_window_v(l)%t(nzb_wall:nzt_wall+1,1:ns_v_on_file_usm(l) ) )
+             ALLOCATE( tmp_surf_green_v(l)%t(1:ns_v_on_file_usm(l)) )
+             ALLOCATE( tmp_green_v(l)%t(nzb_wall:nzt_wall+1,1:ns_v_on_file_usm(l) ) )
           ENDDO
           
@@ -4316,7 +5372,13 @@
                          READ ( 13 )  tmp_surf_h
                       ENDIF
-                      CALL restore_surface_elements_usm_1d(                    &
+                      CALL surface_restore_elements(                           &
                                               t_surf_h, tmp_surf_h,            &
-                                              surf_usm_h%start_index )
+                                              surf_usm_h%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 )
 #else                      
                       IF ( kk == 1 )  THEN
@@ -4325,7 +5387,13 @@
                          READ ( 13 )  tmp_surf_h
                       ENDIF
-                      CALL restore_surface_elements_usm_1d(                    &
+                      CALL surface_restore_elements(                           &
                                               t_surf_h_1, tmp_surf_h,          &
-                                              surf_usm_h%start_index )
+                                              surf_usm_h%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 )
 #endif
 
@@ -4337,7 +5405,13 @@
                          READ ( 13 )  tmp_surf_v(0)%t
                       ENDIF
-                      CALL restore_surface_elements_usm_1d(                    &
+                      CALL surface_restore_elements(                           &
                                               t_surf_v(0)%t, tmp_surf_v(0)%t,  &
-                                              surf_usm_v(0)%start_index )
+                                              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 )
 #else                      
                       IF ( kk == 1 )  THEN
@@ -4346,7 +5420,13 @@
                          READ ( 13 )  tmp_surf_v(0)%t
                       ENDIF
-                      CALL restore_surface_elements_usm_1d(                    &
+                      CALL surface_restore_elements(                           &
                                               t_surf_v_1(0)%t, tmp_surf_v(0)%t,&
-                                              surf_usm_v(0)%start_index )
+                                              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 )
 #endif
                          
@@ -4358,7 +5438,13 @@
                          READ ( 13 )  tmp_surf_v(1)%t
                       ENDIF
-                      CALL restore_surface_elements_usm_1d(                    &
+                      CALL surface_restore_elements(                           &
                                               t_surf_v(1)%t, tmp_surf_v(1)%t,  &
-                                              surf_usm_v(1)%start_index )                        
+                                              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 )                 
 #else                      
                       IF ( kk == 1 )  THEN
@@ -4367,7 +5453,13 @@
                          READ ( 13 )  tmp_surf_v(1)%t
                       ENDIF
-                      CALL restore_surface_elements_usm_1d(                    &
+                      CALL surface_restore_elements(                           &
                                               t_surf_v_1(1)%t, tmp_surf_v(1)%t,&
-                                              surf_usm_v(1)%start_index )
+                                              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 )
 #endif
 
@@ -4379,7 +5471,13 @@
                          READ ( 13 )  tmp_surf_v(2)%t
                       ENDIF
-                      CALL restore_surface_elements_usm_1d(                    &
+                      CALL surface_restore_elements(                           &
                                               t_surf_v(2)%t, tmp_surf_v(2)%t,  &
-                                              surf_usm_v(2)%start_index )
+                                              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 )
 #else                      
                       IF ( kk == 1 )  THEN
@@ -4388,7 +5486,13 @@
                          READ ( 13 )  tmp_surf_v(2)%t
                       ENDIF
-                      CALL restore_surface_elements_usm_1d(                    &
+                      CALL surface_restore_elements(                           &
                                               t_surf_v_1(2)%t, tmp_surf_v(2)%t,&
-                                              surf_usm_v(2)%start_index ) 
+                                              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 )
 #endif
                          
@@ -4400,7 +5504,13 @@
                          READ ( 13 )  tmp_surf_v(3)%t
                       ENDIF
-                      CALL restore_surface_elements_usm_1d(                    &
+                      CALL surface_restore_elements(                           &
                                               t_surf_v(3)%t, tmp_surf_v(3)%t,  &
-                                              surf_usm_v(3)%start_index ) 
+                                              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 )
 #else                      
                       IF ( kk == 1 )  THEN
@@ -4409,7 +5519,341 @@
                          READ ( 13 )  tmp_surf_v(3)%t
                       ENDIF
-                      CALL restore_surface_elements_usm_1d(                    &
+                      CALL surface_restore_elements(                           &
                                               t_surf_v_1(3)%t, tmp_surf_v(3)%t,&
-                                              surf_usm_v(3)%start_index )
+                                              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 )
+#endif
+                   CASE ( 't_surf_green_h' )
+#if defined( __nopointer )                   
+                      IF ( kk == 1 )  THEN
+                         IF ( .NOT.  ALLOCATED( t_surf_green_h ) )                   &
+                            ALLOCATE( t_surf_green_h(1:surf_usm_h%ns) )
+                         READ ( 13 )  tmp_surf_green_h
+                      ENDIF
+                      CALL surface_restore_elements(                           &
+                                              t_surf_green_h, tmp_surf_green_h, &
+                                              surf_usm_h%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 )
+#else                      
+                      IF ( kk == 1 )  THEN
+                         IF ( .NOT.  ALLOCATED( t_surf_green_h_1 ) )                 &
+                            ALLOCATE( t_surf_green_h_1(1:surf_usm_h%ns) )
+                         READ ( 13 )  tmp_surf_green_h
+                      ENDIF
+                      CALL surface_restore_elements(                           &
+                                              t_surf_green_h_1, tmp_surf_green_h, &
+                                              surf_usm_h%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 )
+#endif
+
+                   CASE ( 't_surf_green_v(0)' )
+#if defined( __nopointer )            
+                      IF ( kk == 1 )  THEN
+                         IF ( .NOT.  ALLOCATED( t_surf_green_v(0)%t ) )              &
+                            ALLOCATE( t_surf_green_v(0)%t(1:surf_usm_v(0)%ns) )
+                         READ ( 13 )  tmp_surf_green_v(0)%t
+                      ENDIF
+                      CALL surface_restore_elements(                           &
+                                              t_surf_green_v(0)%t, tmp_surf_green_v(0)%t,  &
+                                              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 )
+#else                      
+                      IF ( kk == 1 )  THEN
+                         IF ( .NOT.  ALLOCATED( t_surf_green_v_1(0)%t ) )            &
+                            ALLOCATE( t_surf_green_v_1(0)%t(1:surf_usm_v(0)%ns) )
+                         READ ( 13 )  tmp_surf_green_v(0)%t
+                      ENDIF
+                      CALL surface_restore_elements(                           &
+                                              t_surf_green_v_1(0)%t, tmp_surf_green_v(0)%t,&
+                                              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 )
+#endif
+                         
+                   CASE ( 't_surf_green_v(1)' )
+#if defined( __nopointer )        
+                      IF ( kk == 1 )  THEN
+                         IF ( .NOT.  ALLOCATED( t_surf_green_v(1)%t ) )              &
+                            ALLOCATE( t_surf_green_v(1)%t(1:surf_usm_v(1)%ns) )
+                         READ ( 13 )  tmp_surf_green_v(1)%t
+                      ENDIF
+                      CALL surface_restore_elements(                           &
+                                              t_surf_green_v(1)%t, tmp_surf_green_v(1)%t,  &
+                                              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 )                 
+#else                      
+                      IF ( kk == 1 )  THEN
+                         IF ( .NOT.  ALLOCATED( t_surf_green_v_1(1)%t ) )            &
+                            ALLOCATE( t_surf_green_v_1(1)%t(1:surf_usm_v(1)%ns) )
+                         READ ( 13 )  tmp_surf_green_v(1)%t
+                      ENDIF
+                      CALL surface_restore_elements(                           &
+                                              t_surf_green_v_1(1)%t, tmp_surf_green_v(1)%t,&
+                                              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 )
+#endif
+
+                   CASE ( 't_surf_green_v(2)' )
+#if defined( __nopointer )          
+                      IF ( kk == 1 )  THEN
+                         IF ( .NOT.  ALLOCATED( t_surf_green_v(2)%t ) )              &
+                            ALLOCATE( t_surf_green_v(2)%t(1:surf_usm_v(2)%ns) )
+                         READ ( 13 )  tmp_surf_green_v(2)%t
+                      ENDIF
+                      CALL surface_restore_elements(                           &
+                                              t_surf_green_v(2)%t, tmp_surf_green_v(2)%t,  &
+                                              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 )
+#else                      
+                      IF ( kk == 1 )  THEN
+                         IF ( .NOT.  ALLOCATED( t_surf_green_v_1(2)%t ) )            &
+                            ALLOCATE( t_surf_green_v_1(2)%t(1:surf_usm_v(2)%ns) )
+                         READ ( 13 )  tmp_surf_green_v(2)%t
+                      ENDIF
+                      CALL surface_restore_elements(                           &
+                                              t_surf_green_v_1(2)%t, tmp_surf_green_v(2)%t,&
+                                              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 )
+#endif
+                         
+                   CASE ( 't_surf_green_v(3)' )
+#if defined( __nopointer )    
+                      IF ( kk == 1 )  THEN
+                         IF ( .NOT.  ALLOCATED( t_surf_green_v(3)%t ) )              &
+                            ALLOCATE( t_surf_green_v(3)%t(1:surf_usm_v(3)%ns) )
+                         READ ( 13 )  tmp_surf_green_v(3)%t
+                      ENDIF
+                      CALL surface_restore_elements(                           &
+                                              t_surf_green_v(3)%t, tmp_surf_green_v(3)%t,  &
+                                              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 )
+#else                      
+                      IF ( kk == 1 )  THEN
+                         IF ( .NOT.  ALLOCATED( t_surf_green_v_1(3)%t ) )            &
+                            ALLOCATE( t_surf_green_v_1(3)%t(1:surf_usm_v(3)%ns) )
+                         READ ( 13 )  tmp_surf_green_v(3)%t
+                      ENDIF
+                      CALL surface_restore_elements(                           &
+                                              t_surf_green_v_1(3)%t, tmp_surf_green_v(3)%t,&
+                                              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 )
+#endif
+                   CASE ( 't_surf_window_h' )
+#if defined( __nopointer )                   
+                      IF ( kk == 1 )  THEN
+                         IF ( .NOT.  ALLOCATED( t_surf_window_h ) )                   &
+                            ALLOCATE( t_surf_window_h(1:surf_usm_h%ns) )
+                         READ ( 13 )  tmp_surf_window_h
+                      ENDIF
+                      CALL surface_restore_elements(                           &
+                                              t_surf_window_h, tmp_surf_window_h,            &
+                                              surf_usm_h%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 )
+#else                      
+                      IF ( kk == 1 )  THEN
+                         IF ( .NOT.  ALLOCATED( t_surf_window_h_1 ) )                 &
+                            ALLOCATE( t_surf_window_h_1(1:surf_usm_h%ns) )
+                         READ ( 13 )  tmp_surf_window_h
+                      ENDIF
+                      CALL surface_restore_elements(                           &
+                                              t_surf_window_h_1, tmp_surf_window_h,          &
+                                              surf_usm_h%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 )
+#endif
+
+                   CASE ( 't_surf_window_v(0)' )
+#if defined( __nopointer )            
+                      IF ( kk == 1 )  THEN
+                         IF ( .NOT.  ALLOCATED( t_surf_window_v(0)%t ) )              &
+                            ALLOCATE( t_surf_window_v(0)%t(1:surf_usm_v(0)%ns) )
+                         READ ( 13 )  tmp_surf_window_v(0)%t
+                      ENDIF
+                      CALL surface_restore_elements(                           &
+                                              t_surf_window_v(0)%t, tmp_surf_window_v(0)%t,  &
+                                              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 )
+#else                      
+                      IF ( kk == 1 )  THEN
+                         IF ( .NOT.  ALLOCATED( t_surf_window_v_1(0)%t ) )            &
+                            ALLOCATE( t_surf_window_v_1(0)%t(1:surf_usm_v(0)%ns) )
+                         READ ( 13 )  tmp_surf_window_v(0)%t
+                      ENDIF
+                      CALL surface_restore_elements(                           &
+                                              t_surf_window_v_1(0)%t, tmp_surf_window_v(0)%t,&
+                                              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 )
+#endif
+                         
+                   CASE ( 't_surf_window_v(1)' )
+#if defined( __nopointer )        
+                      IF ( kk == 1 )  THEN
+                         IF ( .NOT.  ALLOCATED( t_surf_window_v(1)%t ) )              &
+                            ALLOCATE( t_surf_window_v(1)%t(1:surf_usm_v(1)%ns) )
+                         READ ( 13 )  tmp_surf_window_v(1)%t
+                      ENDIF
+                      CALL surface_restore_elements(                           &
+                                              t_surf_window_v(1)%t, tmp_surf_window_v(1)%t,  &
+                                              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 )                 
+#else                      
+                      IF ( kk == 1 )  THEN
+                         IF ( .NOT.  ALLOCATED( t_surf_window_v_1(1)%t ) )            &
+                            ALLOCATE( t_surf_window_v_1(1)%t(1:surf_usm_v(1)%ns) )
+                         READ ( 13 )  tmp_surf_window_v(1)%t
+                      ENDIF
+                      CALL surface_restore_elements(                           &
+                                              t_surf_window_v_1(1)%t, tmp_surf_window_v(1)%t,&
+                                              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 )
+#endif
+
+                   CASE ( 't_surf_window_v(2)' )
+#if defined( __nopointer )          
+                      IF ( kk == 1 )  THEN
+                         IF ( .NOT.  ALLOCATED( t_surf_window_v(2)%t ) )              &
+                            ALLOCATE( t_surf_window_v(2)%t(1:surf_usm_v(2)%ns) )
+                         READ ( 13 )  tmp_surf_window_v(2)%t
+                      ENDIF
+                      CALL surface_restore_elements(                           &
+                                              t_surf_window_v(2)%t, tmp_surf_window_v(2)%t,  &
+                                              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 )
+#else                      
+                      IF ( kk == 1 )  THEN
+                         IF ( .NOT.  ALLOCATED( t_surf_window_v_1(2)%t ) )            &
+                            ALLOCATE( t_surf_window_v_1(2)%t(1:surf_usm_v(2)%ns) )
+                         READ ( 13 )  tmp_surf_window_v(2)%t
+                      ENDIF
+                      CALL surface_restore_elements(                           &
+                                              t_surf_window_v_1(2)%t, tmp_surf_window_v(2)%t,&
+                                              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 )
+#endif
+                         
+                   CASE ( 't_surf_window_v(3)' )
+#if defined( __nopointer )    
+                      IF ( kk == 1 )  THEN
+                         IF ( .NOT.  ALLOCATED( t_surf_window_v(3)%t ) )              &
+                            ALLOCATE( t_surf_window_v(3)%t(1:surf_usm_v(3)%ns) )
+                         READ ( 13 )  tmp_surf_window_v(3)%t
+                      ENDIF
+                      CALL surface_restore_elements(                           &
+                                              t_surf_window_v(3)%t, tmp_surf_window_v(3)%t,  &
+                                              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 )
+#else                      
+                      IF ( kk == 1 )  THEN
+                         IF ( .NOT.  ALLOCATED( t_surf_window_v_1(3)%t ) )            &
+                            ALLOCATE( t_surf_window_v_1(3)%t(1:surf_usm_v(3)%ns) )
+                         READ ( 13 )  tmp_surf_window_v(3)%t
+                      ENDIF
+                      CALL surface_restore_elements(                           &
+                                              t_surf_window_v_1(3)%t, tmp_surf_window_v(3)%t,&
+                                              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 )
 #endif
                    CASE ( 't_wall_h' )
@@ -4420,7 +5864,13 @@
                          READ ( 13 )  tmp_wall_h
                       ENDIF
-                      CALL restore_surface_elements_usm_2d(                    &
+                      CALL surface_restore_elements(                           &
                                               t_wall_h, tmp_wall_h,            &
-                                              surf_usm_h%start_index )
+                                              surf_usm_h%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 )
 #else
                       IF ( kk == 1 )  THEN
@@ -4429,7 +5879,13 @@
                          READ ( 13 )  tmp_wall_h
                       ENDIF
-                      CALL restore_surface_elements_usm_2d(                    &
+                      CALL surface_restore_elements(                           &
                                               t_wall_h_1, tmp_wall_h,          &
-                                              surf_usm_h%start_index )
+                                              surf_usm_h%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 )
 #endif
                    CASE ( 't_wall_v(0)' )
@@ -4440,7 +5896,13 @@
                          READ ( 13 )  tmp_wall_v(0)%t
                       ENDIF
-                      CALL restore_surface_elements_usm_2d(                    &
+                      CALL surface_restore_elements(                           &
                                               t_wall_v(0)%t, tmp_wall_v(0)%t,  &
-                                              surf_usm_v(0)%start_index )
+                                              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 )
 #else
                       IF ( kk == 1 )  THEN
@@ -4449,7 +5911,13 @@
                          READ ( 13 )  tmp_wall_v(0)%t
                       ENDIF
-                      CALL restore_surface_elements_usm_2d(                    &
+                      CALL surface_restore_elements(                           &
                                               t_wall_v_1(0)%t, tmp_wall_v(0)%t,&
-                                              surf_usm_v(0)%start_index )
+                                              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 )
 #endif
                    CASE ( 't_wall_v(1)' )
@@ -4460,7 +5928,12 @@
                          READ ( 13 )  tmp_wall_v(1)%t
                       ENDIF
-                      CALL restore_surface_elements_usm_2d(                    &
+                      CALL surface_restore_elements(                           &
                                               t_wall_v(1)%t, tmp_wall_v(1)%t,  &
-                                              surf_usm_v(1)%start_index )
+                                              surf_usm_v(1)%start_index,       & 
+                                              start_index_on_file,             &
+                                              end_index_on_file ,              &
+                                              nxlc, nysc,           ,          &
+                                              nys_on_file, nyn_on_file,        &
+                                              nxl_on_file,nxr_on_file )
 #else
                       IF ( kk == 1 )  THEN
@@ -4469,7 +5942,13 @@
                          READ ( 13 )  tmp_wall_v(1)%t
                       ENDIF
-                      CALL restore_surface_elements_usm_2d(                    &
+                      CALL surface_restore_elements(                           &
                                               t_wall_v_1(1)%t, tmp_wall_v(1)%t,&
-                                              surf_usm_v(1)%start_index )
+                                              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 )
 #endif
                    CASE ( 't_wall_v(2)' )
@@ -4480,7 +5959,13 @@
                          READ ( 13 )  tmp_wall_v(2)%t
                       ENDIF
-                      CALL restore_surface_elements_usm_2d(                    &
+                      CALL surface_restore_elements(                           &
                                               t_wall_v(2)%t, tmp_wall_v(2)%t,  &
-                                              surf_usm_v(2)%start_index )
+                                              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 )
 #else
                       IF ( kk == 1 )  THEN
@@ -4489,7 +5974,13 @@
                          READ ( 13 )  tmp_wall_v(2)%t
                       ENDIF
-                      CALL restore_surface_elements_usm_2d(                    &
+                      CALL surface_restore_elements(                           &
                                               t_wall_v_1(2)%t, tmp_wall_v(2)%t,&
-                                              surf_usm_v(2)%start_index )
+                                              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 )
 #endif
                    CASE ( 't_wall_v(3)' )
@@ -4500,7 +5991,13 @@
                          READ ( 13 )  tmp_wall_v(3)%t
                       ENDIF
-                      CALL restore_surface_elements_usm_2d(                    &
+                      CALL surface_restore_elements(                           &
                                               t_wall_v(3)%t, tmp_wall_v(3)%t,  &
-                                              surf_usm_v(3)%start_index )
+                                              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 )
 #else
                       IF ( kk == 1 )  THEN
@@ -4509,9 +6006,332 @@
                          READ ( 13 )  tmp_wall_v(3)%t
                       ENDIF
-                      CALL restore_surface_elements_usm_2d(                    &
+                      CALL surface_restore_elements(                           &
                                               t_wall_v_1(3)%t, tmp_wall_v(3)%t,&
-                                              surf_usm_v(3)%start_index )
+                                              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 )
 #endif
-
+                   CASE ( 't_green_h' )
+#if defined( __nopointer )
+                      IF ( kk == 1 )  THEN
+                         IF ( .NOT.  ALLOCATED( t_green_h ) )                   &
+                            ALLOCATE( t_green_h(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
+                         READ ( 13 )  tmp_green_h
+                      ENDIF
+                      CALL surface_restore_elements(                           &
+                                              t_green_h, tmp_green_h,            &
+                                              surf_usm_h%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 )
+#else
+                      IF ( kk == 1 )  THEN
+                         IF ( .NOT.  ALLOCATED( t_green_h_1 ) )                 &
+                            ALLOCATE( t_green_h_1(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
+                         READ ( 13 )  tmp_green_h
+                      ENDIF
+                      CALL surface_restore_elements(                           &
+                                              t_green_h_1, tmp_green_h,          &
+                                              surf_usm_h%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 )
+#endif
+                   CASE ( 't_green_v(0)' )
+#if defined( __nopointer )
+                      IF ( kk == 1 )  THEN
+                         IF ( .NOT.  ALLOCATED( t_green_v(0)%t ) )              &
+                            ALLOCATE( t_green_v(0)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(0)%ns) )
+                         READ ( 13 )  tmp_green_v(0)%t
+                      ENDIF
+                      CALL surface_restore_elements(                           &
+                                              t_green_v(0)%t, tmp_green_v(0)%t,  &
+                                              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 )
+#else
+                      IF ( kk == 1 )  THEN
+                         IF ( .NOT.  ALLOCATED( t_green_v_1(0)%t ) )            &
+                            ALLOCATE( t_green_v_1(0)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(0)%ns) )
+                         READ ( 13 )  tmp_green_v(0)%t
+                      ENDIF
+                      CALL surface_restore_elements(                           &
+                                              t_green_v_1(0)%t, tmp_green_v(0)%t,&
+                                              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 )
+#endif
+                   CASE ( 't_green_v(1)' )
+#if defined( __nopointer )
+                      IF ( kk == 1 )  THEN
+                         IF ( .NOT.  ALLOCATED( t_green_v(1)%t ) )              &
+                            ALLOCATE( t_green_v(1)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(1)%ns) )
+                         READ ( 13 )  tmp_green_v(1)%t
+                      ENDIF
+                      CALL surface_restore_elements(                           &
+                                              t_green_v(1)%t, tmp_green_v(1)%t,  &
+                                              surf_usm_v(1)%start_index,       & 
+                                              start_index_on_file,             &
+                                              end_index_on_file ,              &
+                                              nxlc, nysc,           ,          &
+                                              nys_on_file, nyn_on_file,        &
+                                              nxl_on_file,nxr_on_file )
+#else
+                      IF ( kk == 1 )  THEN
+                         IF ( .NOT.  ALLOCATED( t_green_v_1(1)%t ) )            &
+                            ALLOCATE( t_green_v_1(1)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(1)%ns) )
+                         READ ( 13 )  tmp_green_v(1)%t
+                      ENDIF
+                      CALL surface_restore_elements(                           &
+                                              t_green_v_1(1)%t, tmp_green_v(1)%t,&
+                                              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 )
+#endif
+                   CASE ( 't_green_v(2)' )
+#if defined( __nopointer )
+                      IF ( kk == 1 )  THEN
+                         IF ( .NOT.  ALLOCATED( t_green_v(2)%t ) )              &
+                            ALLOCATE( t_green_v(2)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(2)%ns) )
+                         READ ( 13 )  tmp_green_v(2)%t
+                      ENDIF
+                      CALL surface_restore_elements(                           &
+                                              t_green_v(2)%t, tmp_green_v(2)%t,  &
+                                              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 )
+#else
+                      IF ( kk == 1 )  THEN
+                         IF ( .NOT.  ALLOCATED( t_green_v_1(2)%t ) )            &
+                            ALLOCATE( t_green_v_1(2)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(2)%ns) )
+                         READ ( 13 )  tmp_green_v(2)%t
+                      ENDIF
+                      CALL surface_restore_elements(                           &
+                                              t_green_v_1(2)%t, tmp_green_v(2)%t,&
+                                              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 )
+#endif
+                   CASE ( 't_green_v(3)' )
+#if defined( __nopointer )
+                      IF ( kk == 1 )  THEN
+                         IF ( .NOT.  ALLOCATED( t_green_v(3)%t ) )              &
+                            ALLOCATE( t_green_v(3)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(3)%ns) )
+                         READ ( 13 )  tmp_green_v(3)%t
+                      ENDIF
+                      CALL surface_restore_elements(                           &
+                                              t_green_v(3)%t, tmp_green_v(3)%t,  &
+                                              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 )
+#else
+                      IF ( kk == 1 )  THEN
+                         IF ( .NOT.  ALLOCATED( t_green_v_1(3)%t ) )            &
+                            ALLOCATE( t_green_v_1(3)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(3)%ns) )
+                         READ ( 13 )  tmp_green_v(3)%t
+                      ENDIF
+                      CALL surface_restore_elements(                           &
+                                              t_green_v_1(3)%t, tmp_green_v(3)%t,&
+                                              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 )
+#endif
+                   CASE ( 't_window_h' )
+#if defined( __nopointer )
+                      IF ( kk == 1 )  THEN
+                         IF ( .NOT.  ALLOCATED( t_window_h ) )                   &
+                            ALLOCATE( t_window_h(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
+                         READ ( 13 )  tmp_window_h
+                      ENDIF
+                      CALL surface_restore_elements(                           &
+                                              t_window_h, tmp_window_h,            &
+                                              surf_usm_h%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 )
+#else
+                      IF ( kk == 1 )  THEN
+                         IF ( .NOT.  ALLOCATED( t_window_h_1 ) )                 &
+                            ALLOCATE( t_window_h_1(nzb_wall:nzt_wall+1,1:surf_usm_h%ns) )
+                         READ ( 13 )  tmp_window_h
+                      ENDIF
+                      CALL surface_restore_elements(                           &
+                                              t_window_h_1, tmp_window_h,          &
+                                              surf_usm_h%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 )
+#endif
+                   CASE ( 't_window_v(0)' )
+#if defined( __nopointer )
+                      IF ( kk == 1 )  THEN
+                         IF ( .NOT.  ALLOCATED( t_window_v(0)%t ) )              &
+                            ALLOCATE( t_window_v(0)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(0)%ns) )
+                         READ ( 13 )  tmp_window_v(0)%t
+                      ENDIF
+                      CALL surface_restore_elements(                           &
+                                              t_window_v(0)%t, tmp_window_v(0)%t,  &
+                                              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 )
+#else
+                      IF ( kk == 1 )  THEN
+                         IF ( .NOT.  ALLOCATED( t_window_v_1(0)%t ) )            &
+                            ALLOCATE( t_window_v_1(0)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(0)%ns) )
+                         READ ( 13 )  tmp_window_v(0)%t
+                      ENDIF
+                      CALL surface_restore_elements(                           &
+                                              t_window_v_1(0)%t, tmp_window_v(0)%t,&
+                                              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 )
+#endif
+                   CASE ( 't_window_v(1)' )
+#if defined( __nopointer )
+                      IF ( kk == 1 )  THEN
+                         IF ( .NOT.  ALLOCATED( t_window_v(1)%t ) )              &
+                            ALLOCATE( t_window_v(1)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(1)%ns) )
+                         READ ( 13 )  tmp_window_v(1)%t
+                      ENDIF
+                      CALL surface_restore_elements(                           &
+                                              t_window_v(1)%t, tmp_window_v(1)%t,  &
+                                              surf_usm_v(1)%start_index,       & 
+                                              start_index_on_file,             &
+                                              end_index_on_file ,              &
+                                              nxlc, nysc,           ,          &
+                                              nys_on_file, nyn_on_file,        &
+                                              nxl_on_file,nxr_on_file )
+#else
+                      IF ( kk == 1 )  THEN
+                         IF ( .NOT.  ALLOCATED( t_window_v_1(1)%t ) )            &
+                            ALLOCATE( t_window_v_1(1)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(1)%ns) )
+                         READ ( 13 )  tmp_window_v(1)%t
+                      ENDIF
+                      CALL surface_restore_elements(                           &
+                                              t_window_v_1(1)%t, tmp_window_v(1)%t,&
+                                              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 )
+#endif
+                   CASE ( 't_window_v(2)' )
+#if defined( __nopointer )
+                      IF ( kk == 1 )  THEN
+                         IF ( .NOT.  ALLOCATED( t_window_v(2)%t ) )              &
+                            ALLOCATE( t_window_v(2)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(2)%ns) )
+                         READ ( 13 )  tmp_window_v(2)%t
+                      ENDIF
+                      CALL surface_restore_elements(                           &
+                                              t_window_v(2)%t, tmp_window_v(2)%t,  &
+                                              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 )
+#else
+                      IF ( kk == 1 )  THEN
+                         IF ( .NOT.  ALLOCATED( t_window_v_1(2)%t ) )            &
+                            ALLOCATE( t_window_v_1(2)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(2)%ns) )
+                         READ ( 13 )  tmp_window_v(2)%t
+                      ENDIF
+                      CALL surface_restore_elements(                           &
+                                              t_window_v_1(2)%t, tmp_window_v(2)%t,&
+                                              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 )
+#endif
+                   CASE ( 't_window_v(3)' )
+#if defined( __nopointer )
+                      IF ( kk == 1 )  THEN
+                         IF ( .NOT.  ALLOCATED( t_window_v(3)%t ) )              &
+                            ALLOCATE( t_window_v(3)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(3)%ns) )
+                         READ ( 13 )  tmp_window_v(3)%t
+                      ENDIF
+                      CALL surface_restore_elements(                           &
+                                              t_window_v(3)%t, tmp_window_v(3)%t,  &
+                                              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 )
+#else
+                      IF ( kk == 1 )  THEN
+                         IF ( .NOT.  ALLOCATED( t_window_v_1(3)%t ) )            &
+                            ALLOCATE( t_window_v_1(3)%t(nzb_wall:nzt_wall+1,1:surf_usm_v(3)%ns) )
+                         READ ( 13 )  tmp_window_v(3)%t
+                      ENDIF
+                      CALL surface_restore_elements(                           &
+                                              t_window_v_1(3)%t, tmp_window_v(3)%t,&
+                                              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 )
+#endif
                    CASE DEFAULT
                       WRITE ( message_string, * )  'unknown variable named "', &
@@ -4530,143 +6350,6 @@
        ENDIF
        
-       CONTAINS
-       
-          SUBROUTINE restore_surface_elements_usm_1d( surf_target, surf_file, start_index_c )
-
-             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), DIMENSION(nys:nyn,nxl:nxr) ::  start_index_c             
-             
-             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 restore_surface_elements_usm_1d
-          
-          SUBROUTINE restore_surface_elements_usm_2d( surf_target, surf_file, start_index_c )
-
-             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), DIMENSION(nys:nyn,nxl:nxr) ::  start_index_c
-             
-             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 restore_surface_elements_usm_2d
-
     END SUBROUTINE usm_read_restart_data
     
-
-
-!------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> Soubroutine reads svf and svfsurf data from saved file
-!------------------------------------------------------------------------------!
-    SUBROUTINE usm_read_svf_from_file
-
-        IMPLICIT NONE
-        INTEGER(iwp)                 :: fsvf = 89
-        INTEGER(iwp)                 :: i
-        CHARACTER(usm_version_len)   :: usm_version_field
-        CHARACTER(svf_code_len)      :: svf_code_field
-
-        DO  i = 0, io_blocks-1
-            IF ( i == io_group )  THEN
-                OPEN ( fsvf, file=TRIM(svf_file_name)//TRIM(coupling_char)//myid_char,               &
-                    form='unformatted', status='old' )
-
-!--             read and check version
-                READ ( fsvf ) usm_version_field
-                IF ( TRIM(usm_version_field) /= TRIM(usm_version) )  THEN
-                    WRITE( message_string, * ) 'Version of binary SVF file "',           &
-                                            TRIM(usm_version_field), '" does not match ',            &
-                                            'the version of model "', TRIM(usm_version), '"'
-                    CALL message( 'usm_read_svf_from_file', 'UI0012', 1, 2, 0, 6, 0 )
-                ENDIF
-                
-!--             read nsvfl, ncsfl
-                READ ( fsvf ) nsvfl, ncsfl
-                IF ( nsvfl <= 0  .OR.  ncsfl < 0 )  THEN
-                    WRITE( message_string, * ) 'Wrong number of SVF or CSF'
-                    CALL message( 'usm_read_svf_from_file', 'UI0012', 1, 2, 0, 6, 0 )
-                ELSE
-                    WRITE(message_string,*) '    Number of SVF and CSF to read', nsvfl, ncsfl
-                    CALL location_message( message_string, .TRUE. )
-                ENDIF
-                
-                ALLOCATE(svf(ndsvf,nsvfl))
-                ALLOCATE(svfsurf(idsvf,nsvfl))
-                READ(fsvf) svf
-                READ(fsvf) svfsurf
-                IF ( plant_canopy )  THEN
-                    ALLOCATE(csf(ndcsf,ncsfl))
-                    ALLOCATE(csfsurf(idcsf,ncsfl))
-                    READ(fsvf) csf
-                    READ(fsvf) csfsurf
-                ENDIF
-                READ ( fsvf ) svf_code_field
-                
-                IF ( TRIM(svf_code_field) /= TRIM(svf_code) )  THEN
-                    WRITE( message_string, * ) 'Wrong structure of binary svf file'
-                    CALL message( 'usm_read_svf_from_file', 'UI0012', 1, 2, 0, 6, 0 )
-                ENDIF
-                
-                CLOSE (fsvf)
-                
-            ENDIF
-#if defined( __parallel )
-            CALL MPI_BARRIER( comm2d, ierr )
-#endif
-        ENDDO
-
-    END SUBROUTINE usm_read_svf_from_file
 
     
@@ -4680,4 +6363,9 @@
     SUBROUTINE usm_read_urban_surface_types
     
+        USE netcdf_data_input_mod,                                             &
+            ONLY:  building_pars_f, building_type_f
+
+        IMPLICIT NONE
+
         CHARACTER(12)                                         :: wtn
         INTEGER(iwp)                                          :: wtc
@@ -4698,4 +6386,13 @@
         REAL(wp)                                              :: wealbedo3, wethick3, snalbedo3, snthick3
         
+        LOGICAL                                               ::  surfpar
+        LOGICAL                                               ::  urbsurf
+
+!
+!--     If building_pars or building_type are already read from static input 
+!--     file, skip reading ASCII file. 
+        IF ( building_type_f%from_file  .OR.  building_pars_f%from_file )      &
+           RETURN
+
 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
 !--     read categories of walls and their parameters
@@ -4844,16 +6541,23 @@
               ENDIF
 #endif
-              surf_usm_h%albedo_surf(m)    = -1.0_wp
+              surf_usm_h%albedo(:,m)    = -1.0_wp
               surf_usm_h%thickness_wall(m) = -1.0_wp
+              surf_usm_h%thickness_green(m) = -1.0_wp
+              surf_usm_h%thickness_window(m) = -1.0_wp
            ELSE
               IF ( usm_par(2,jw,iw)==0 )  THEN
                  surf_usm_h%isroof_surf(m)    = .FALSE.
                  surf_usm_h%thickness_wall(m) = -1.0_wp
+                 surf_usm_h%thickness_window(m) = -1.0_wp
+                 surf_usm_h%thickness_green(m)  = -1.0_wp
               ELSE
                  surf_usm_h%isroof_surf(m)    = .TRUE.
                  surf_usm_h%thickness_wall(m) = usm_val(2,jw,iw)
+                 surf_usm_h%thickness_window(m) = usm_val(2,jw,iw)
+                 surf_usm_h%thickness_green(m)  = usm_val(2,jw,iw)
               ENDIF
               surf_usm_h%surface_types(m) = usm_par(5,jw,iw)
-              surf_usm_h%albedo_surf(m)   = usm_val(1,jw,iw)
+              surf_usm_h%albedo(:,m)   = usm_val(1,jw,iw)
+              surf_usm_h%transmissivity(m)    = 0.0_wp
            ENDIF
 !
@@ -4875,19 +6579,27 @@
 !
 !--        Albedo
-           IF ( surf_usm_h%albedo_surf(m) < 0.0_wp )  THEN
-              surf_usm_h%albedo_surf(m) = surface_params(ialbedo,ip)
+           IF ( surf_usm_h%albedo(0,m) < 0.0_wp )  THEN
+              surf_usm_h%albedo(:,m) = surface_params(ialbedo,ip)
            ENDIF
+!--        Transmissivity
+           IF ( surf_usm_h%transmissivity(m) < 0.0_wp )  THEN
+              surf_usm_h%transmissivity(m) = 0.0_wp
+           ENDIF
 !
 !--        emissivity of the wall
-           surf_usm_h%emiss_surf(m) = surface_params(iemiss,ip)
+           surf_usm_h%emissivity(:,m) = surface_params(iemiss,ip)
 !            
 !--        heat conductivity Î»S between air and wall ( W mâ2 Kâ1 )
            surf_usm_h%lambda_surf(m) = surface_params(ilambdas,ip)
+           surf_usm_h%lambda_surf_window(m) = surface_params(ilambdas,ip)
+           surf_usm_h%lambda_surf_green(m)  = surface_params(ilambdas,ip)
 !            
 !--        roughness relative to concrete
-           surf_usm_h%roughness_wall(m) = surface_params(irough,ip)
+           surf_usm_h%z0(m) = surface_params(irough,ip)
 !            
 !--        Surface skin layer heat capacity (J mâ2 Kâ1 )
            surf_usm_h%c_surface(m) = surface_params(icsurf,ip)
+           surf_usm_h%c_surface_window(m) = surface_params(icsurf,ip)
+           surf_usm_h%c_surface_green(m)  = surface_params(icsurf,ip)
 !            
 !--        wall material parameters:
@@ -4897,10 +6609,20 @@
                 surf_usm_h%thickness_wall(m) = surface_params(ithick,ip)
            ENDIF
+           IF ( surf_usm_h%thickness_window(m) <= 0.001_wp )  THEN
+                surf_usm_h%thickness_window(m) = surface_params(ithick,ip)
+           ENDIF
+           IF ( surf_usm_h%thickness_green(m) <= 0.001_wp )  THEN
+                surf_usm_h%thickness_green(m) = surface_params(ithick,ip)
+           ENDIF
 !            
 !--        volumetric heat capacity rho*C of the wall ( J mâ3 Kâ1 )
            surf_usm_h%rho_c_wall(:,m) = surface_params(irhoC,ip)
+           surf_usm_h%rho_c_window(:,m) = surface_params(irhoC,ip)
+           surf_usm_h%rho_c_green(:,m)  = surface_params(irhoC,ip)
 !            
 !--        thermal conductivity Î»H of the wall (W mâ1 Kâ1 )
            surf_usm_h%lambda_h(:,m) = surface_params(ilambdah,ip)
+           surf_usm_h%lambda_h_window(:,m) = surface_params(ilambdah,ip)
+           surf_usm_h%lambda_h_green(:,m)  = surface_params(ilambdah,ip)
 
         ENDDO
@@ -4940,10 +6662,16 @@
                  IF ( usm_par(ii+1,jw,iw) == 0 )  THEN
                      surf_usm_v(l)%surface_types(m)  = pedestrant_category   !< default category for wall surface in pedestrant zone
-                     surf_usm_v(l)%albedo_surf(m)    = -1.0_wp
+                     surf_usm_v(l)%albedo(:,m)    = -1.0_wp
                      surf_usm_v(l)%thickness_wall(m) = -1.0_wp
+                     surf_usm_v(l)%thickness_window(m)   = -1.0_wp
+                     surf_usm_v(l)%thickness_green(m)    = -1.0_wp
+                     surf_usm_v(l)%transmissivity(m)  = -1.0_wp
                  ELSE
                      surf_usm_v(l)%surface_types(m)  = usm_par(ii+1,jw,iw)
-                     surf_usm_v(l)%albedo_surf(m)    = usm_val(ij,jw,iw)
+                     surf_usm_v(l)%albedo(:,m)    = usm_val(ij,jw,iw)
                      surf_usm_v(l)%thickness_wall(m) = usm_val(ij+1,jw,iw)
+                     surf_usm_v(l)%thickness_window(m)   = usm_val(ij+1,jw,iw)
+                     surf_usm_v(l)%thickness_green(m)    = usm_val(ij+1,jw,iw)
+                     surf_usm_v(l)%transmissivity(m)  = 0.0_wp
                  ENDIF
               ELSE IF ( kw <= usm_par(ii+2,jw,iw) )  THEN
@@ -4951,10 +6679,16 @@
                  IF ( usm_par(ii+3,jw,iw) == 0 )  THEN
                      surf_usm_v(l)%surface_types(m)  = wall_category         !< default category for wall surface
-                     surf_usm_v(l)%albedo_surf(m)    = -1.0_wp
+                     surf_usm_v(l)%albedo(:,m)    = -1.0_wp
                      surf_usm_v(l)%thickness_wall(m) = -1.0_wp
+                     surf_usm_v(l)%thickness_window(m)   = -1.0_wp
+                     surf_usm_v(l)%thickness_green(m)    = -1.0_wp
+                     surf_usm_v(l)%transmissivity(m)  = -1.0_wp
                  ELSE
                      surf_usm_v(l)%surface_types(m)  = usm_par(ii+3,jw,iw)
-                     surf_usm_v(l)%albedo_surf(m)    = usm_val(ij+2,jw,iw)
+                     surf_usm_v(l)%albedo(:,m)    = usm_val(ij+2,jw,iw)
                      surf_usm_v(l)%thickness_wall(m) = usm_val(ij+3,jw,iw)
+                     surf_usm_v(l)%thickness_window(m)   = usm_val(ij+3,jw,iw)
+                     surf_usm_v(l)%thickness_green(m)    = usm_val(ij+3,jw,iw)
+                     surf_usm_v(l)%transmissivity(m)  = 0.0_wp
                  ENDIF
               ELSE IF ( kw <= usm_par(ii+4,jw,iw) )  THEN
@@ -4962,10 +6696,16 @@
                  IF ( usm_par(ii+5,jw,iw) == 0 )  THEN
                      surf_usm_v(l)%surface_types(m)  = roof_category         !< default category for roof surface
-                     surf_usm_v(l)%albedo_surf(m)    = -1.0_wp
+                     surf_usm_v(l)%albedo(:,m)    = -1.0_wp
                      surf_usm_v(l)%thickness_wall(m) = -1.0_wp
+                     surf_usm_v(l)%thickness_window(m)   = -1.0_wp
+                     surf_usm_v(l)%thickness_green(m)    = -1.0_wp
+                     surf_usm_v(l)%transmissivity(m)  = -1.0_wp
                  ELSE
                      surf_usm_v(l)%surface_types(m)  = usm_par(ii+5,jw,iw)
-                     surf_usm_v(l)%albedo_surf(m)    = usm_val(ij+4,jw,iw)
+                     surf_usm_v(l)%albedo(:,m)    = usm_val(ij+4,jw,iw)
                      surf_usm_v(l)%thickness_wall(m) = usm_val(ij+5,jw,iw)
+                     surf_usm_v(l)%thickness_window(m)   = usm_val(ij+5,jw,iw)
+                     surf_usm_v(l)%thickness_green(m)    = usm_val(ij+5,jw,iw)
+                     surf_usm_v(l)%transmissivity(m)  = 0.0_wp
                  ENDIF
               ELSE
@@ -4992,19 +6732,27 @@
 !
 !--           Albedo
-              IF ( surf_usm_v(l)%albedo_surf(m) < 0.0_wp )  THEN
-                 surf_usm_v(l)%albedo_surf(m) = surface_params(ialbedo,ip)
+              IF ( surf_usm_v(l)%albedo(0,m) < 0.0_wp )  THEN
+                 surf_usm_v(l)%albedo(:,m) = surface_params(ialbedo,ip)
               ENDIF
+!--           Transmissivity of the windows
+              IF ( surf_usm_v(l)%transmissivity(m) < 0.0_wp )  THEN
+                 surf_usm_v(l)%transmissivity(m) = 0.0_wp
+              ENDIF
 !
 !--           emissivity of the wall
-              surf_usm_v(l)%emiss_surf(m) = surface_params(iemiss,ip)
+              surf_usm_v(l)%emissivity(:,m) = surface_params(iemiss,ip)
 !            
 !--           heat conductivity Î»S between air and wall ( W mâ2 Kâ1 )
               surf_usm_v(l)%lambda_surf(m) = surface_params(ilambdas,ip)
+              surf_usm_v(l)%lambda_surf_window(m) = surface_params(ilambdas,ip)
+              surf_usm_v(l)%lambda_surf_green(m) = surface_params(ilambdas,ip)
 !            
 !--           roughness relative to concrete
-              surf_usm_v(l)%roughness_wall(m) = surface_params(irough,ip)
+              surf_usm_v(l)%z0(m) = surface_params(irough,ip)
 !            
 !--           Surface skin layer heat capacity (J mâ2 Kâ1 )
               surf_usm_v(l)%c_surface(m) = surface_params(icsurf,ip)
+              surf_usm_v(l)%c_surface_window(m) = surface_params(icsurf,ip)
+              surf_usm_v(l)%c_surface_green(m) = surface_params(icsurf,ip)
 !            
 !--           wall material parameters:
@@ -5014,11 +6762,43 @@
                    surf_usm_v(l)%thickness_wall(m) = surface_params(ithick,ip)
               ENDIF
+              IF ( surf_usm_v(l)%thickness_window(m) <= 0.001_wp )  THEN
+                   surf_usm_v(l)%thickness_window(m) = surface_params(ithick,ip)
+              ENDIF
+              IF ( surf_usm_v(l)%thickness_green(m) <= 0.001_wp )  THEN
+                   surf_usm_v(l)%thickness_green(m) = surface_params(ithick,ip)
+              ENDIF
 !            
 !--           volumetric heat capacity rho*C of the wall ( J mâ3 Kâ1 )
               surf_usm_v(l)%rho_c_wall(:,m) = surface_params(irhoC,ip)
+              surf_usm_v(l)%rho_c_window(:,m) = surface_params(irhoC,ip)
+              surf_usm_v(l)%rho_c_green(:,m) = surface_params(irhoC,ip)
 !            
 !--           thermal conductivity Î»H of the wall (W mâ1 Kâ1 )
               surf_usm_v(l)%lambda_h(:,m) = surface_params(ilambdah,ip)
-
+              surf_usm_v(l)%lambda_h_window(:,m) = surface_params(ilambdah,ip)
+              surf_usm_v(l)%lambda_h_green(:,m) = surface_params(ilambdah,ip)
+
+           ENDDO
+        ENDDO 
+!
+!--     Initialize wall layer thicknesses. Please note, this will be removed
+!--     after migration to Palm input data standard.  
+        DO k = nzb_wall, nzt_wall
+           zwn(k) = zwn_default(k)
+           zwn_green(k) = zwn_default_green(k)
+           zwn_window(k) = zwn_default_window(k)
+        ENDDO
+!
+!--     apply for all particular surface grids. First for horizontal surfaces
+        DO  m = 1, surf_usm_h%ns
+           surf_usm_h%zw(:,m) = zwn(:) * surf_usm_h%thickness_wall(m)
+           surf_usm_h%zw_green(:,m) = zwn_green(:) * surf_usm_h%thickness_green(m)
+           surf_usm_h%zw_window(:,m) = zwn_window(:) * surf_usm_h%thickness_window(m)
+        ENDDO
+        DO  l = 0, 3
+           DO  m = 1, surf_usm_v(l)%ns
+              surf_usm_v(l)%zw(:,m) = zwn(:) * surf_usm_v(l)%thickness_wall(m)
+              surf_usm_v(l)%zw_green(:,m) = zwn_green(:) * surf_usm_v(l)%thickness_green(m)
+              surf_usm_v(l)%zw_window(:,m) = zwn_window(:) * surf_usm_v(l)%thickness_window(m)
            ENDDO
         ENDDO
@@ -5043,15 +6823,28 @@
         INTEGER(iwp)                          :: i, j, k, l, d, m   !< running indices
         
-        REAL(wp)                              :: pt1                !< temperature at first grid box adjacent to surface
         REAL(wp)                              :: u1,v1,w1           !< near wall u,v,w
         REAL(wp)                              :: stend              !< surface tendency
+        REAL(wp)                              :: stend_window       !< surface tendency
+        REAL(wp)                              :: stend_green        !< surface tendency
         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)                              :: rho_cp             !< rho_wall_surface * cp
         REAL(wp)                              :: r_a                !< aerodynamic resistance for horizontal and vertical surfaces
+        REAL(wp)                              :: r_a_window         !< aerodynamic resistance for horizontal and vertical window surfaces
+        REAL(wp)                              :: r_a_green          !< aerodynamic resistance for horizontal and vertical green surfaces
         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)                              :: Ueff               !< effective wind speed for calculation of heat transfer coefficients
         REAL(wp)                              :: httc               !< heat transfer coefficient
+        REAL(wp)                              :: httc_window        !< heat transfer coefficient window
+        REAL(wp)                              :: httc_green         !< heat transfer coefficient green wall
         REAL(wp), DIMENSION(nzub:nzut)        :: exn                !< value of the Exner function in layers
         
@@ -5068,5 +6861,4 @@
 !        
 !--     First, treat horizontal surface elements
-
         DO  m = 1, surf_usm_h%ns
 !
@@ -5081,12 +6873,15 @@
            IF ( surf_usm_h%ol(m) >= 0.0_wp )  THEN
               lambda_surface = surf_usm_h%lambda_surf(m)
+              lambda_surface_window = surf_usm_h%lambda_surf_window(m)
+              lambda_surface_green = surf_usm_h%lambda_surf_green(m)
            ELSE
               lambda_surface = surf_usm_h%lambda_surf(m)
+              lambda_surface_window = surf_usm_h%lambda_surf_window(m)
+              lambda_surface_green = surf_usm_h%lambda_surf_green(m)
            ENDIF
 #if ! defined( __nopointer )
-           pt1  = pt(k,j,i)
 !
 !--        calculate rho * cp coefficient at surface layer
-           rho_cp  = cp * hyp(k) / ( r_d * pt1 * exn(k) )
+           rho_cp  = cp * hyp(k) / ( r_d * surf_usm_h%pt1(m) * exn(k) )
 #endif
 !
@@ -5096,9 +6891,16 @@
 !--        data from the last time step is used here.
                
-           r_a = ( pt1 - t_surf_h(m) / exn(k) ) /                              &
-                 ( surf_usm_h%ts(m) * surf_usm_h%us(m) + 1.0E-10_wp )
+           r_a = ( surf_usm_h%pt1(m) - t_surf_h(m) / exn(k) ) /                              &
+                 ( surf_usm_h%ts(m) * surf_usm_h%us(m) + 1.0E-20_wp )
+           r_a_window = ( surf_usm_h%pt1(m) - t_surf_window_h(m) / exn(k) ) /                &
+                 ( surf_usm_h%ts(m) * surf_usm_h%us(m) + 1.0E-20_wp )
+           r_a_green = ( surf_usm_h%pt1(m) - t_surf_green_h(m) / exn(k) ) /                  &
+                 ( surf_usm_h%ts(m) * surf_usm_h%us(m) + 1.0E-20_wp )
                 
 !--        make sure that the resistance does not drop to zero
-           IF ( ABS(r_a) < 1.0E-10_wp )  r_a = 1.0E-10_wp
+           IF ( r_a        < 1.0_wp )  r_a        = 1.0_wp
+           IF ( r_a_window < 1.0_wp )  r_a_window = 1.0_wp
+           IF ( r_a_green  < 1.0_wp )  r_a_green  = 1.0_wp
+
                 
 !--        the parameterization is developed originally for larger scales
@@ -5106,27 +6908,50 @@
 !--        our first experiences show that the parameterization underestimates
 !--        r_a in meter resolution.
-!--        temporary solution - multiplication by magic constant :-(.
-           r_a = r_a * ra_horiz_coef
+!--        A temporary solution would be multiplication by magic constant :-(.
+!--        For the moment this is comment out.
+           r_a        = r_a        !* ra_horiz_coef
+           r_a_window = r_a_window !* ra_horiz_coef
+           r_a_green  = r_a_green  !* ra_horiz_coef
                 
 !--        factor for shf_eb
            f_shf  = rho_cp / r_a
+           f_shf_window  = rho_cp / r_a_window
+           f_shf_green  = rho_cp / r_a_green
         
 !--        add LW up so that it can be removed in prognostic equation
-           surf_usm_h%rad_net_l(m) = surf_usm_h%rad_in_sw(m)  -                &
-                                     surf_usm_h%rad_out_sw(m) +                &
-                                     surf_usm_h%rad_in_lw(m)  -                &
-                                     surf_usm_h%rad_out_lw(m)
+           surf_usm_h%rad_net_l(m) = surf_usm_h%rad_sw_in(m)  -                &
+                                     surf_usm_h%rad_sw_out(m) +                &
+                                     surf_usm_h%rad_lw_in(m)  -                &
+                                     surf_usm_h%rad_lw_out(m)
 
 !--        numerator of the prognostic equation
+!--     Todo: Adjust to tile approach. So far, emissivity for wall (element 0)
+!--           is used
            coef_1 = surf_usm_h%rad_net_l(m) +                                  & 
-                   ( 3.0_wp + 1.0_wp ) * surf_usm_h%emiss_surf(m) * sigma_sb * &
+                 ( 3.0_wp + 1.0_wp ) * surf_usm_h%emissivity(0,m) * sigma_sb * &
                                        t_surf_h(m) ** 4 +                      &  
-                                       f_shf * pt1 +                           &
+                                       f_shf * surf_usm_h%pt1(m) +                           &
                                        lambda_surface * t_wall_h(nzb_wall,m)
+           coef_window_1 = surf_usm_h%rad_net_l(m) +                                  & 
+                   ( 3.0_wp + 1.0_wp ) * surf_usm_h%emissivity(2,m) * sigma_sb * &
+                                       t_surf_window_h(m) ** 4 +                      &  
+                                       f_shf_window * surf_usm_h%pt1(m) +                           &
+                                       lambda_surface_window * t_window_h(nzb_wall,m)
+           coef_green_1 = surf_usm_h%rad_net_l(m) +                                  & 
+                   ( 3.0_wp + 1.0_wp ) * surf_usm_h%emissivity(1,m) * sigma_sb * &
+                                       t_surf_green_h(m) ** 4 +                      &  
+                                       f_shf_green * surf_usm_h%pt1(m) +                           &
+                                       lambda_surface_green * t_wall_h(nzb_wall,m)
 
 !--        denominator of the prognostic equation
-           coef_2 = 4.0_wp * surf_usm_h%emiss_surf(m) * sigma_sb *            &
+           coef_2 = 4.0_wp * surf_usm_h%emissivity(0,m) * sigma_sb *          &
                              t_surf_h(m) ** 3                                 &
                            + lambda_surface + f_shf / exn(k)
+           coef_window_2 = 4.0_wp * surf_usm_h%emissivity(2,m) * sigma_sb *  &
+                             t_surf_window_h(m) ** 3                              &
+                           + lambda_surface_window + f_shf_window / exn(k)
+           coef_green_2 = 4.0_wp * surf_usm_h%emissivity(1,m) * sigma_sb *    &
+                             t_surf_green_h(m) ** 3                               &
+                           + lambda_surface_green + f_shf_green / exn(k)
 
 !--        implicit solution when the surface layer has no heat capacity,
@@ -5135,12 +6960,32 @@
                              surf_usm_h%c_surface(m) * t_surf_h(m) ) /        & 
                            ( surf_usm_h%c_surface(m) + coef_2 * dt_3d * tsc(2) ) 
+           t_surf_window_h_p(m) = ( coef_window_1 * dt_3d * tsc(2) +                        &
+                             surf_usm_h%c_surface_window(m) * t_surf_window_h(m) ) /        & 
+                           ( surf_usm_h%c_surface_window(m) + coef_window_2 * dt_3d * tsc(2) ) 
+           t_surf_green_h_p(m) = ( coef_green_1 * dt_3d * tsc(2) +                        &
+                             surf_usm_h%c_surface_green(m) * t_surf_green_h(m) ) /        & 
+                           ( surf_usm_h%c_surface_green(m) + coef_green_2 * dt_3d * tsc(2) ) 
 
 !--        add RK3 term
            t_surf_h_p(m) = t_surf_h_p(m) + dt_3d * tsc(3) *                   &
                            surf_usm_h%tt_surface_m(m)
-            
+           t_surf_window_h_p(m) = t_surf_window_h_p(m) + dt_3d * tsc(3) *     &
+                           surf_usm_h%tt_surface_window_m(m)
+           t_surf_green_h_p(m) = t_surf_green_h_p(m) + dt_3d * tsc(3) *       &
+                           surf_usm_h%tt_surface_green_m(m)
+!
+!--        Store surface temperature        
+           surf_usm_h%pt_surface(m) = ( surf_usm_h%frac(0,m) * t_surf_h_p(m)   &
+                               + surf_usm_h%frac(2,m) * t_surf_window_h_p(m)   &
+                               + surf_usm_h%frac(1,m) * t_surf_green_h_p(m) )  &
+                               / exn(k)
+                       
 !--        calculate true tendency
            stend = ( t_surf_h_p(m) - t_surf_h(m) - dt_3d * tsc(3) *           &
                      surf_usm_h%tt_surface_m(m)) / ( dt_3d  * tsc(2) )
+           stend_window = ( t_surf_window_h_p(m) - t_surf_window_h(m) - dt_3d * tsc(3) *        &
+                     surf_usm_h%tt_surface_window_m(m)) / ( dt_3d  * tsc(2) )
+           stend_green = ( t_surf_green_h_p(m) - t_surf_green_h(m) - dt_3d * tsc(3) *           &
+                     surf_usm_h%tt_surface_green_m(m)) / ( dt_3d  * tsc(2) )
 
 !--        calculate t_surf tendencies for the next Runge-Kutta step
@@ -5148,8 +6993,14 @@
               IF ( intermediate_timestep_count == 1 )  THEN
                  surf_usm_h%tt_surface_m(m) = stend
+                 surf_usm_h%tt_surface_window_m(m) = stend_window
+                 surf_usm_h%tt_surface_green_m(m) = stend_green
               ELSEIF ( intermediate_timestep_count <                          &
                         intermediate_timestep_count_max )  THEN
                  surf_usm_h%tt_surface_m(m) = -9.5625_wp * stend +            &
                                      5.3125_wp * surf_usm_h%tt_surface_m(m)
+                 surf_usm_h%tt_surface_window_m(m) = -9.5625_wp * stend_window +   &
+                                     5.3125_wp * surf_usm_h%tt_surface_window_m(m)
+                 surf_usm_h%tt_surface_green_m(m) = -9.5625_wp * stend_green +     &
+                                     5.3125_wp * surf_usm_h%tt_surface_green_m(m)
               ENDIF
            ENDIF
@@ -5157,5 +7008,7 @@
 !--        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_h_p(m) - t_surf_h(m) ) > 1.0_wp )  THEN
+           IF ( ( ABS( t_surf_h_p(m) - t_surf_h(m) ) > 1.0_wp ) .OR. &
+                ( ABS( t_surf_green_h_p(m) - t_surf_green_h(m) ) > 1.0_wp ) .OR. &
+                ( ABS( t_surf_window_h_p(m) - t_surf_window_h(m) ) > 1.0_wp ) ) THEN
               force_radiation_call_l = .TRUE.
            ENDIF
@@ -5166,18 +7019,42 @@
 !--        using surface and wall heat fluxes
 #if ! defined( __nopointer )
-           pt(k-1,j,i) = t_surf_h_p(m) / exn(k)  ! not for vertical surfaces
+!            pt(k-1,j,i) = ( surf_usm_h%frac(0,m) * t_surf_h_p(m)       &
+!                          + surf_usm_h%frac(2,m) * t_surf_window_h_p(m)  &
+!                          + surf_usm_h%frac(1,m) * t_surf_green_h_p(m) ) &
+!                          / exn(k)  ! not for vertical surfaces
 #endif
 
 !--        calculate fluxes
 !--        rad_net_l is never used!           
-           surf_usm_h%rad_net_l(m) = surf_usm_h%rad_net_l(m) +                &
-                                     3.0_wp * sigma_sb *                      &
-                                     t_surf_h(m)**4 - 4.0_wp * sigma_sb *     &
-                                     t_surf_h(m)**3 * t_surf_h_p(m)
+           surf_usm_h%rad_net_l(m) = surf_usm_h%frac(0,m) *                         &
+                                     ( surf_usm_h%rad_net_l(m) +                    &
+                                     3.0_wp * sigma_sb *                            &
+                                     t_surf_h(m)**4 - 4.0_wp * sigma_sb *           &
+                                     t_surf_h(m)**3 * t_surf_h_p(m) )               &
+                                   + surf_usm_h%frac(2,m) *                         &
+                                     ( surf_usm_h%rad_net_l(m) +                    &
+                                     3.0_wp * sigma_sb *                            &
+                                     t_surf_window_h(m)**4 - 4.0_wp * sigma_sb *    &
+                                     t_surf_window_h(m)**3 * t_surf_window_h_p(m) ) &
+                                   + surf_usm_h%frac(1,m) *                         &
+                                     ( surf_usm_h%rad_net_l(m) +                    &
+                                     3.0_wp * sigma_sb *                            &
+                                     t_surf_green_h(m)**4 - 4.0_wp * sigma_sb *     &
+                                     t_surf_green_h(m)**3 * t_surf_green_h_p(m) )
            surf_usm_h%wghf_eb(m)   = lambda_surface *                         &
                                       ( t_surf_h_p(m) - t_wall_h(nzb_wall,m) )
+           surf_usm_h%wghf_eb_green(m)  = lambda_surface_green *                        &
+                                          ( t_surf_green_h_p(m) - t_green_h(nzb_wall,m) )
+           surf_usm_h%wghf_eb_window(m) = lambda_surface_window *                       &
+                                           ( t_surf_window_h_p(m) - t_window_h(nzb_wall,m) )
+
 !
 !--        ground/wall/roof surface heat flux
-           surf_usm_h%wshf_eb(m)   = - f_shf  * ( pt1 - t_surf_h_p(m) )
+           surf_usm_h%wshf_eb(m)   = - f_shf  * ( surf_usm_h%pt1(m) - t_surf_h_p(m) / exn(k) ) *               &
+                                       surf_usm_h%frac(0,m)                         &
+                                     - f_shf_window  * ( surf_usm_h%pt1(m) - t_surf_window_h_p(m) / exn(k) ) * &
+                                       surf_usm_h%frac(2,m)                          &
+                                     - f_shf_green  * ( surf_usm_h%pt1(m) - t_surf_green_h_p(m) / exn(k) ) *   &
+                                       surf_usm_h%frac(1,m)
 !           
 !--        store kinematic surface heat fluxes for utilization in other processes
@@ -5195,4 +7072,5 @@
              j = surf_usm_v(l)%j(m)
              k = surf_usm_v(l)%k(m)
+
 !
 !--          TODO - how to calculate lambda_surface for horizontal (??? do you mean verical ???) surfaces
@@ -5201,9 +7079,11 @@
 !--          stratification is not considered in this case.
              lambda_surface = surf_usm_v(l)%lambda_surf(m)
+             lambda_surface_window = surf_usm_v(l)%lambda_surf_window(m)
+             lambda_surface_green = surf_usm_v(l)%lambda_surf_green(m)
+
 #if ! defined( __nopointer )          
-             pt1  = pt(k,j,i)
 !
 !--          calculate rho * cp coefficient at surface layer
-             rho_cp  = cp * hyp(k) / ( r_d * pt1 * exn(k) )
+             rho_cp  = cp * hyp(k) / ( r_d * surf_usm_v(l)%pt1(m) * exn(k) )
 #endif
 
@@ -5238,25 +7118,44 @@
                 
              Ueff   = SQRT( u1**2 + v1**2 + w1**2 )
-             httc   = surf_usm_v(l)%roughness_wall(m) *                       &
+             httc   = surf_usm_v(l)%z0(m) *                                    &
                        ( 11.8_wp + 4.2_wp * Ueff ) - 4.0_wp
-             f_shf  = httc
+             f_shf         = httc
+             f_shf_window  = httc
+             f_shf_green   = httc
 
 !--          add LW up so that it can be removed in prognostic equation
-             surf_usm_v(l)%rad_net_l(m) = surf_usm_v(l)%rad_in_sw(m)  -        &
-                                          surf_usm_v(l)%rad_out_sw(m) +        &
-                                          surf_usm_v(l)%rad_in_lw(m)  -        &
-                                          surf_usm_v(l)%rad_out_lw(m)
+             surf_usm_v(l)%rad_net_l(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)
 
 !--           numerator of the prognostic equation
               coef_1 = surf_usm_v(l)%rad_net_l(m) +                            & ! coef +1 corresponds to -lwout included in calculation of radnet_l
-               ( 3.0_wp + 1.0_wp ) * surf_usm_v(l)%emiss_surf(m) * sigma_sb *  &
+             ( 3.0_wp + 1.0_wp ) * surf_usm_v(l)%emissivity(0,m) * sigma_sb *  &
                                      t_surf_v(l)%t(m) ** 4 +                   &  
-                                     f_shf * pt1 +                             &
+                                     f_shf * surf_usm_v(l)%pt1(m) +                             &
                                      lambda_surface * t_wall_v(l)%t(nzb_wall,m)
+              coef_window_1 = surf_usm_v(l)%rad_net_l(m) +                            & ! coef +1 corresponds to -lwout included in calculation of radnet_l
+               ( 3.0_wp + 1.0_wp ) * surf_usm_v(l)%emissivity(2,m) * sigma_sb *  &
+                                     t_surf_window_v(l)%t(m) ** 4 +                   &  
+                                     f_shf * surf_usm_v(l)%pt1(m) +                             &
+                                     lambda_surface_window * t_window_v(l)%t(nzb_wall,m)
+
+              coef_green_1 = surf_usm_v(l)%rad_net_l(m) +                            & ! coef +1 corresponds to -lwout included in calculation of radnet_l
+               ( 3.0_wp + 1.0_wp ) * surf_usm_v(l)%emissivity(1,m) * sigma_sb *  &
+                                     t_surf_green_v(l)%t(m) ** 4 +                   &  
+                                     f_shf * surf_usm_v(l)%pt1(m) +                             &
+                                     lambda_surface_green * t_wall_v(l)%t(nzb_wall,m)
 
 !--           denominator of the prognostic equation
-              coef_2 = 4.0_wp * surf_usm_v(l)%emiss_surf(m) * sigma_sb *       &
+              coef_2 = 4.0_wp * surf_usm_v(l)%emissivity(0,m) * sigma_sb *     &
                                 t_surf_v(l)%t(m) ** 3                          &
                               + lambda_surface + f_shf / exn(k)
+              coef_window_2 = 4.0_wp * surf_usm_v(l)%emissivity(2,m) * sigma_sb *     &
+                                t_surf_window_v(l)%t(m) ** 3                         &
+                              + lambda_surface_window + f_shf / exn(k)
+              coef_green_2 = 4.0_wp * surf_usm_v(l)%emissivity(1,m) * sigma_sb *       &
+                                t_surf_green_v(l)%t(m) ** 3                          &
+                              + lambda_surface_green + f_shf / exn(k)
 
 !--           implicit solution when the surface layer has no heat capacity,
@@ -5265,12 +7164,35 @@
                              surf_usm_v(l)%c_surface(m) * t_surf_v(l)%t(m) ) / & 
                            ( surf_usm_v(l)%c_surface(m) + coef_2 * dt_3d * tsc(2) ) 
+              t_surf_window_v_p(l)%t(m) = ( coef_window_1 * dt_3d * tsc(2) +                 &
+                             surf_usm_v(l)%c_surface_window(m) * t_surf_window_v(l)%t(m) ) / & 
+                           ( surf_usm_v(l)%c_surface_window(m) + coef_window_2 * dt_3d * tsc(2) ) 
+
+              t_surf_green_v_p(l)%t(m) = ( coef_green_1 * dt_3d * tsc(2) +                 &
+                             surf_usm_v(l)%c_surface_green(m) * t_surf_green_v(l)%t(m) ) / & 
+                           ( surf_usm_v(l)%c_surface_green(m) + coef_green_2 * dt_3d * tsc(2) ) 
+
+
 
 !--           add RK3 term
               t_surf_v_p(l)%t(m) = t_surf_v_p(l)%t(m) + dt_3d * tsc(3) *       &
                                 surf_usm_v(l)%tt_surface_m(m)
+              t_surf_window_v_p(l)%t(m) = t_surf_window_v_p(l)%t(m) + dt_3d * tsc(3) *     &
+                                surf_usm_v(l)%tt_surface_window_m(m)
+              t_surf_green_v_p(l)%t(m) = t_surf_green_v_p(l)%t(m) + dt_3d * tsc(3) *       &
+                                surf_usm_v(l)%tt_surface_green_m(m)
+!
+!--           Store surface temperature        
+              surf_usm_v(l)%pt_surface(m) =  ( surf_usm_v(l)%frac(0,m) * t_surf_v_p(l)%t(m)  &
+                                      + surf_usm_v(l)%frac(2,m) * t_surf_window_v_p(l)%t(m)  &
+                                      + surf_usm_v(l)%frac(1,m) * t_surf_green_v_p(l)%t(m) ) &
+                                      / exn(k) 
             
 !--           calculate true tendency
               stend = ( t_surf_v_p(l)%t(m) - t_surf_v(l)%t(m) - dt_3d * tsc(3) *&
                         surf_usm_v(l)%tt_surface_m(m) ) / ( dt_3d  * tsc(2) )
+              stend_window = ( t_surf_window_v_p(l)%t(m) - t_surf_window_v(l)%t(m) - dt_3d * tsc(3) *&
+                        surf_usm_v(l)%tt_surface_window_m(m) ) / ( dt_3d  * tsc(2) )
+              stend_green = ( t_surf_green_v_p(l)%t(m) - t_surf_green_v(l)%t(m) - dt_3d * tsc(3) *&
+                        surf_usm_v(l)%tt_surface_green_m(m) ) / ( dt_3d  * tsc(2) )
 
 !--           calculate t_surf tendencies for the next Runge-Kutta step
@@ -5278,8 +7200,14 @@
                  IF ( intermediate_timestep_count == 1 )  THEN
                     surf_usm_v(l)%tt_surface_m(m) = stend
+                    surf_usm_v(l)%tt_surface_window_m(m) = stend_window
+                    surf_usm_v(l)%tt_surface_green_m(m) = stend_green
                  ELSEIF ( intermediate_timestep_count <                        &
                           intermediate_timestep_count_max )  THEN
                     surf_usm_v(l)%tt_surface_m(m) = -9.5625_wp * stend +       &
-                                     5.3125_wp * surf_usm_h%tt_surface_m(m)
+                                     5.3125_wp * surf_usm_v(l)%tt_surface_m(m)
+                    surf_usm_v(l)%tt_surface_green_m(m) = -9.5625_wp * stend_green +       &
+                                     5.3125_wp * surf_usm_v(l)%tt_surface_green_m(m)
+                    surf_usm_v(l)%tt_surface_window_m(m) = -9.5625_wp * stend_window +       &
+                                     5.3125_wp * surf_usm_v(l)%tt_surface_window_m(m)
                  ENDIF
               ENDIF
@@ -5287,5 +7215,8 @@
 !--           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_v_p(l)%t(m) - t_surf_v(l)%t(m) ) > 1.0_wp )  THEN
+
+              IF ( ( ABS( t_surf_v_p(l)%t(m) - t_surf_v(l)%t(m) ) > 1.0_wp ) .OR. &
+                   ( ABS( t_surf_green_v_p(l)%t(m) - t_surf_green_v(l)%t(m) ) > 1.0_wp ) .OR.  &
+                   ( ABS( t_surf_window_v_p(l)%t(m) - t_surf_window_v(l)%t(m) ) > 1.0_wp ) ) THEN
                  force_radiation_call_l = .TRUE.
               ENDIF
@@ -5293,14 +7224,31 @@
 !--           calculate fluxes
 !--           rad_net_l is never used!           
-              surf_usm_v(l)%rad_net_l(m) = surf_usm_v(l)%rad_net_l(m) +        &
-                                     3.0_wp * sigma_sb *                       &
-                                     t_surf_v(l)%t(m)**4 - 4.0_wp * sigma_sb * &
-                                     t_surf_v(l)%t(m)**3 * t_surf_v_p(l)%t(m)
-
+              surf_usm_v(l)%rad_net_l(m) = surf_usm_v(l)%frac(0,m) *                             &
+                                           ( surf_usm_v(l)%rad_net_l(m) +                            &
+                                           3.0_wp * sigma_sb *                                       &
+                                           t_surf_v(l)%t(m)**4 - 4.0_wp * sigma_sb *                 &
+                                           t_surf_v(l)%t(m)**3 * t_surf_v_p(l)%t(m) )                &
+                                         + surf_usm_v(l)%frac(2,m) *                              &
+                                           ( surf_usm_v(l)%rad_net_l(m) +                            &
+                                           3.0_wp * sigma_sb *                                       &
+                                           t_surf_window_v(l)%t(m)**4 - 4.0_wp * sigma_sb *          &
+                                           t_surf_window_v(l)%t(m)**3 * t_surf_window_v_p(l)%t(m) )  &
+                                         + surf_usm_v(l)%frac(1,m) *                            &
+                                           ( surf_usm_v(l)%rad_net_l(m) +                            &
+                                           3.0_wp * sigma_sb *                                       &
+                                           t_surf_green_v(l)%t(m)**4 - 4.0_wp * sigma_sb *           &
+                                           t_surf_green_v(l)%t(m)**3 * t_surf_green_v_p(l)%t(m) )
+
+              surf_usm_v(l)%wghf_eb_window(m) = lambda_surface_window * &
+                                                ( t_surf_window_v_p(l)%t(m) - t_window_v(l)%t(nzb_wall,m) )
               surf_usm_v(l)%wghf_eb(m)   = lambda_surface *                    &
                                      ( t_surf_v_p(l)%t(m) - t_wall_v(l)%t(nzb_wall,m) )
+              surf_usm_v(l)%wghf_eb_green(m)  = lambda_surface_green *  &
+                                                ( t_surf_green_v_p(l)%t(m) - t_green_v(l)%t(nzb_wall,m) )
 
 !--           ground/wall/roof surface heat flux
-              surf_usm_v(l)%wshf_eb(m)   = - f_shf  * ( pt1 - t_surf_v_p(l)%t(m) )
+              surf_usm_v(l)%wshf_eb(m)   = - f_shf  * ( surf_usm_v(l)%pt1(m) - t_surf_v_p(l)%t(m) / exn(k) ) * surf_usm_v(l)%frac(0,m)               &
+                                           - f_shf_window  * ( surf_usm_v(l)%pt1(m) - t_surf_window_v_p(l)%t(m) / exn(k) ) * surf_usm_v(l)%frac(2,m)  &
+                                           - f_shf_green  * ( surf_usm_v(l)%pt1(m) - t_surf_green_v_p(l)%t(m) / exn(k) ) * surf_usm_v(l)%frac(1,m)
 
 !           
@@ -5352,5 +7300,4 @@
         CALL exchange_horiz( pt, nbgp )
 #endif
-
 
 !--     calculation of force_radiation_call:
@@ -5390,4 +7337,14 @@
        t_surf_v    = t_surf_v_p
        t_wall_v    = t_wall_v_p
+       t_surf_window_h    = t_surf_window_h_p
+       t_window_h    = t_window_h_p
+       t_surf_window_v    = t_surf_window_v_p
+       t_window_v    = t_window_v_p
+       t_surf_green_h    = t_surf_green_h_p
+       t_surf_green_v    = t_surf_green_v_p
+       t_green_h    = t_green_h_p
+       t_green_v    = t_green_v_p
+       t_surf_whole_h    = t_surf_whole_h_p
+       t_surf_whole_v    = t_surf_whole_v_p
 #else
        SELECT CASE ( mod_count )
@@ -5397,8 +7354,18 @@
              t_surf_h  => t_surf_h_1; t_surf_h_p  => t_surf_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
+             t_surf_whole_h  => t_surf_whole_h_1; t_surf_whole_h_p  => t_surf_whole_h_2
 !
 !--          Vertical surfaces
              t_surf_v  => t_surf_v_1; t_surf_v_p  => t_surf_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
+             t_surf_whole_v  => t_surf_whole_v_1; t_surf_whole_v_p  => t_surf_whole_v_2
           CASE ( 1 )
 !
@@ -5406,8 +7373,18 @@
              t_surf_h  => t_surf_h_2; t_surf_h_p  => t_surf_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
+             t_surf_whole_h  => t_surf_whole_h_2; t_surf_whole_h_p  => t_surf_whole_h_1
 !
 !--          Vertical surfaces
              t_surf_v  => t_surf_v_2; t_surf_v_p  => t_surf_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
+             t_surf_whole_v  => t_surf_whole_v_2; t_surf_whole_v_p  => t_surf_whole_v_1
        END SELECT
 #endif
@@ -5444,4 +7421,8 @@
        WRITE ( 14 ) 't_surf_h                      '
        WRITE ( 14 ) t_surf_h
+       WRITE ( 14 ) 't_surf_window_h               '
+       WRITE ( 14 ) t_surf_window_h
+       WRITE ( 14 ) 't_surf_green_h                '
+       WRITE ( 14 ) t_surf_green_h
        
        DO  l = 0, 3
@@ -5453,4 +7434,8 @@
           WRITE ( 14 ) 't_surf_v(' // dum // ')                   ' 
           WRITE ( 14 ) t_surf_v(l)%t          
+          WRITE ( 14 ) 't_surf_window_v(' // dum // ')            ' 
+          WRITE ( 14 ) t_surf_window_v(l)%t          
+          WRITE ( 14 ) 't_surf_green_v(' // dum // ')             ' 
+          WRITE ( 14 ) t_surf_green_v(l)%t          
        ENDDO
 
@@ -5461,4 +7446,8 @@
        WRITE ( 14 ) 't_wall_h                      '
        WRITE ( 14 ) t_wall_h
+       WRITE ( 14 ) 't_window_h                    '
+       WRITE ( 14 ) t_window_h
+       WRITE ( 14 ) 't_green_h                     '
+       WRITE ( 14 ) t_green_h
        DO  l = 0, 3
           WRITE ( 14 ) 'usm_start_index_v             '
@@ -5469,4 +7458,8 @@
           WRITE ( 14 )  't_wall_v(' // dum // ')                   ' 
           WRITE ( 14 )  t_wall_v(l)%t          
+          WRITE ( 14 )  't_window_v(' // dum // ')                 ' 
+          WRITE ( 14 )  t_window_v(l)%t          
+          WRITE ( 14 )  't_green_v(' // dum // ')                  ' 
+          WRITE ( 14 )  t_green_v(l)%t          
        ENDDO
 
@@ -5475,263 +7468,37 @@
     END SUBROUTINE usm_write_restart_data
 
-
-!------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> Subroutine stores svf, svfsurf, csf and csfsurf data to a file.
-!------------------------------------------------------------------------------!
-    SUBROUTINE usm_write_svf_to_file
-
-        IMPLICIT NONE
-        INTEGER(iwp)        :: fsvf = 89
-        INTEGER(iwp)        :: i
-
-        DO  i = 0, io_blocks-1
-            IF ( i == io_group )  THEN
-                OPEN ( fsvf, file=TRIM(svf_file_name)//TRIM(coupling_char)//myid_char,               &
-                    form='unformatted', status='new' )
-
-                WRITE ( fsvf )  usm_version
-                WRITE ( fsvf )  nsvfl, ncsfl
-                WRITE ( fsvf )  svf
-                WRITE ( fsvf )  svfsurf
-                IF ( plant_canopy )  THEN
-                    WRITE ( fsvf )  csf
-                    WRITE ( fsvf )  csfsurf
-                ENDIF
-                WRITE ( fsvf )  TRIM(svf_code)
-
-                CLOSE (fsvf)
-#if defined( __parallel )
-                CALL MPI_BARRIER( comm2d, ierr )
-#endif
-            ENDIF
-        ENDDO
-    END SUBROUTINE usm_write_svf_to_file
-
-
-!------------------------------------------------------------------------------!
-!
-! Description:
-! ------------
-!> Block of auxiliary subroutines:
-!> 1. quicksort and corresponding comparison
-!> 2. usm_merge_and_grow_csf for implementation of "dynamical growing"
-!>    array for csf
-!------------------------------------------------------------------------------!    
-    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.
+!
+!-- 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)            :: 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
-          res = .FALSE.
-      ENDIF
-    END FUNCTION svf_lt
-    
- 
-!-- 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
-        TYPE(t_svf), DIMENSION(:), INTENT(INOUT)  :: svfl
-        INTEGER(iwp), INTENT(IN)                  :: first, last
-        TYPE(t_svf)                               :: x, t
-        INTEGER(iwp)                              :: i, j
-
-        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)
-      TYPE (t_csf), INTENT(in) :: csf1,csf2
-      LOGICAL                  :: res
-      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
-
-
-!-- 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
-        TYPE(t_csf), DIMENSION(:), INTENT(INOUT)  :: csfl
-        INTEGER(iwp), INTENT(IN)                  :: first, last
-        TYPE(t_csf)                               :: x, t
-        INTEGER(iwp)                              :: i, j
-
-        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
-
-    
-    SUBROUTINE usm_merge_and_grow_csf(newsize)
-        INTEGER(iwp), INTENT(in)                :: newsize  !< new array size after grow, must be >= ncsfl
-                                                            !< or -1 to shrink to minimum
-        INTEGER(iwp)                            :: iread, iwrite
-        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
-!--                 We could simply take either first or second rtransp, both are valid. As a very simple heuristic about which ray
-!--                 probably passes nearer the center of the target box, we choose DIF from the entry with greater CSF, since that
-!--                 might mean that the traced beam passes longer through the canopy box.
-                    IF ( acsfnew(iwrite)%rsvf < acsf(iread)%rsvf )  THEN
-                        acsfnew(iwrite)%rtransp = acsf(iread)%rtransp
-                    ENDIF
-                    acsfnew(iwrite)%rsvf = acsfnew(iwrite)%rsvf + acsf(iread)%rsvf
-!--                 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
-    END SUBROUTINE usm_merge_and_grow_csf
-
-    
-!-- 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), DIMENSION(:,:), INTENT(INOUT)  :: kpcsflt
-        REAL(wp), DIMENSION(:,:), INTENT(INOUT)      :: pcsflt
-        INTEGER(iwp), INTENT(IN)                     :: first, last
-        REAL(wp), DIMENSION(ndcsf)                   :: t2
-        INTEGER(iwp), DIMENSION(kdcsf)               :: x, t1
-        INTEGER(iwp)                                 :: i, j
-
-        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
-
+         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 urban_surface_mod
Index: palm/trunk/SOURCE/user_3d_data_averaging.f90
===================================================================
--- palm/trunk/SOURCE/user_3d_data_averaging.f90	(revision 2689)
+++ palm/trunk/SOURCE/user_3d_data_averaging.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file user_3d_data_averaging.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/user_actions.f90
===================================================================
--- palm/trunk/SOURCE/user_actions.f90	(revision 2689)
+++ palm/trunk/SOURCE/user_actions.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file user_actions.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/user_additional_routines.f90
===================================================================
--- palm/trunk/SOURCE/user_additional_routines.f90	(revision 2689)
+++ palm/trunk/SOURCE/user_additional_routines.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file user_additional_routines.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/user_check_data_output.f90
===================================================================
--- palm/trunk/SOURCE/user_check_data_output.f90	(revision 2689)
+++ palm/trunk/SOURCE/user_check_data_output.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file user_check_data_output.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/user_check_data_output_pr.f90
===================================================================
--- palm/trunk/SOURCE/user_check_data_output_pr.f90	(revision 2689)
+++ palm/trunk/SOURCE/user_check_data_output_pr.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file user_check_data_output_pr.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/user_check_parameters.f90
===================================================================
--- palm/trunk/SOURCE/user_check_parameters.f90	(revision 2689)
+++ palm/trunk/SOURCE/user_check_parameters.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file user_check_parameters.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/user_data_output_2d.f90
===================================================================
--- palm/trunk/SOURCE/user_data_output_2d.f90	(revision 2689)
+++ palm/trunk/SOURCE/user_data_output_2d.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file user_data_output_2d.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/user_data_output_3d.f90
===================================================================
--- palm/trunk/SOURCE/user_data_output_3d.f90	(revision 2689)
+++ palm/trunk/SOURCE/user_data_output_3d.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file user_data_output_3d.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/user_data_output_dvrp.f90
===================================================================
--- palm/trunk/SOURCE/user_data_output_dvrp.f90	(revision 2689)
+++ palm/trunk/SOURCE/user_data_output_dvrp.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file user_data_output_dvrp.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/user_data_output_mask.f90
===================================================================
--- palm/trunk/SOURCE/user_data_output_mask.f90	(revision 2689)
+++ palm/trunk/SOURCE/user_data_output_mask.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file user_data_output_mask.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/user_define_netcdf_grid.f90
===================================================================
--- palm/trunk/SOURCE/user_define_netcdf_grid.f90	(revision 2689)
+++ palm/trunk/SOURCE/user_define_netcdf_grid.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file user_define_netcdf_grid.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/user_dvrp_coltab.f90
===================================================================
--- palm/trunk/SOURCE/user_dvrp_coltab.f90	(revision 2689)
+++ palm/trunk/SOURCE/user_dvrp_coltab.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file user_dvrp_coltab.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/user_flight.f90
===================================================================
--- palm/trunk/SOURCE/user_flight.f90	(revision 2689)
+++ palm/trunk/SOURCE/user_flight.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file user_actions.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/user_header.f90
===================================================================
--- palm/trunk/SOURCE/user_header.f90	(revision 2689)
+++ palm/trunk/SOURCE/user_header.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file user_header.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/user_init.f90
===================================================================
--- palm/trunk/SOURCE/user_init.f90	(revision 2689)
+++ palm/trunk/SOURCE/user_init.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file user_init.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/user_init_3d_model.f90
===================================================================
--- palm/trunk/SOURCE/user_init_3d_model.f90	(revision 2689)
+++ palm/trunk/SOURCE/user_init_3d_model.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file user_init_3d_model.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/user_init_flight.f90
===================================================================
--- palm/trunk/SOURCE/user_init_flight.f90	(revision 2689)
+++ palm/trunk/SOURCE/user_init_flight.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file user_init_flight.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/user_init_grid.f90
===================================================================
--- palm/trunk/SOURCE/user_init_grid.f90	(revision 2689)
+++ palm/trunk/SOURCE/user_init_grid.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file user_init_grid.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
@@ -25,4 +25,7 @@
 ! -----------------
 ! $Id$
+! Extended argument list (MS)
+! 
+! 2233 2017-05-30 18:08:54Z suehring
 !
 ! 2232 2017-05-30 17:47:52Z suehring
@@ -111,5 +114,5 @@
 !           ENDDO 
 ! 
-!           CALL exchange_horiz_int( topo_3d, nbgp )
+!           CALL exchange_horiz_int( topo_3d, nys, nyn, nxl, nxr, nzt, nbgp )
 
        CASE DEFAULT
Index: palm/trunk/SOURCE/user_init_land_surface.f90
===================================================================
--- palm/trunk/SOURCE/user_init_land_surface.f90	(revision 2689)
+++ palm/trunk/SOURCE/user_init_land_surface.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file user_init_land_surface.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/user_init_plant_canopy.f90
===================================================================
--- palm/trunk/SOURCE/user_init_plant_canopy.f90	(revision 2689)
+++ palm/trunk/SOURCE/user_init_plant_canopy.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file user_init_plant_canopy.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/user_init_radiation.f90
===================================================================
--- palm/trunk/SOURCE/user_init_radiation.f90	(revision 2689)
+++ palm/trunk/SOURCE/user_init_radiation.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file user_init_radiation.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/user_init_urban_surface.f90
===================================================================
--- palm/trunk/SOURCE/user_init_urban_surface.f90	(revision 2689)
+++ palm/trunk/SOURCE/user_init_urban_surface.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file user_init_urban_surface.f90
-!--------------------------------------------------------------------------------!
-! This file is part of PALM.
+!------------------------------------------------------------------------------!
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/user_last_actions.f90
===================================================================
--- palm/trunk/SOURCE/user_last_actions.f90	(revision 2689)
+++ palm/trunk/SOURCE/user_last_actions.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file user_last_actions.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/user_lpm_advec.f90
===================================================================
--- palm/trunk/SOURCE/user_lpm_advec.f90	(revision 2689)
+++ palm/trunk/SOURCE/user_lpm_advec.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file user_lpm_advec.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/user_lpm_init.f90
===================================================================
--- palm/trunk/SOURCE/user_lpm_init.f90	(revision 2689)
+++ palm/trunk/SOURCE/user_lpm_init.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file user_lpm_init.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/user_lpm_set_attributes.f90
===================================================================
--- palm/trunk/SOURCE/user_lpm_set_attributes.f90	(revision 2689)
+++ palm/trunk/SOURCE/user_lpm_set_attributes.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file user_lpm_set_attributes.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/user_module.f90
===================================================================
--- palm/trunk/SOURCE/user_module.f90	(revision 2689)
+++ palm/trunk/SOURCE/user_module.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file user_module.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/user_parin.f90
===================================================================
--- palm/trunk/SOURCE/user_parin.f90	(revision 2689)
+++ palm/trunk/SOURCE/user_parin.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file user_parin.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/user_read_restart_data.f90
===================================================================
--- palm/trunk/SOURCE/user_read_restart_data.f90	(revision 2689)
+++ palm/trunk/SOURCE/user_read_restart_data.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file user_read_restart_data.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/user_spectra.f90
===================================================================
--- palm/trunk/SOURCE/user_spectra.f90	(revision 2689)
+++ palm/trunk/SOURCE/user_spectra.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file user_spectra.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/user_statistics.f90
===================================================================
--- palm/trunk/SOURCE/user_statistics.f90	(revision 2689)
+++ palm/trunk/SOURCE/user_statistics.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file user_statistics.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/uv_exposure_model_mod.f90
===================================================================
--- palm/trunk/SOURCE/uv_exposure_model_mod.f90	(revision 2696)
+++ palm/trunk/SOURCE/uv_exposure_model_mod.f90	(revision 2696)
@@ -0,0 +1,928 @@
+!> @file uv_exposure_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-2017 Leibniz Universitaet Hannover
+!------------------------------------------------------------------------------!
+!
+! Current revisions:
+! -----------------
+! 
+! 
+! Former revisions:
+! -----------------
+! $Id$
+! Initial revision
+!
+! 
+!
+! Authors:
+! --------
+! @author Michael Schrempf
+!
+!
+! Description:
+! ------------
+!> Calculation of vitamin-D weighted UV exposure
+!>
+!>
+!> @todo uv_vitd3dose-->new output type necessary (cumulative)
+!> @todo consider upwelling radiation
+!>
+!> @note <Enter notes on the module>
+!>
+!> @bug  <Enter known bugs here>
+!------------------------------------------------------------------------------!
+ MODULE uv_exposure_model_mod
+ 
+
+    USE kinds
+
+!
+!-- Load required variables from existing modules
+!-- USE modulename,                                                            &
+!--     ONLY: ...
+
+
+    IMPLICIT NONE
+
+
+!
+!-- Declare all global variables within the module (alphabetical order)
+    INTEGER(iwp) ::  ai                      = 0 !< running index
+    INTEGER(iwp) ::  clothing                = 3 !< clothing (0=unclothed, 1=Arms,Hands Face free, 3=Hand, Face free)
+    INTEGER(iwp) ::  consider_obstructions   = 1 !< 0 = unobstructed scenario, 
+                                                 !< 1 = scenario where obstrcutions are considered
+    INTEGER(iwp) ::  orientation_angle       = 0 !< orientation of front/face of the human model
+    INTEGER(iwp) ::  saa_in_south            = 1 !< 0 = sun always in south direction, 1 = actual sun position  
+    INTEGER(iwp) ::  obstruction_direct_beam = 0 !< Obstruction information for direct beam
+    INTEGER(iwp) ::  turn_to_sun             = 1 !< 0 = orientation of human as in orientation_angle,
+                                                 !< 1 = human is always orientated towards the sun
+    INTEGER(iwp) ::  zi                      = 0 !< running index
+
+    INTEGER(iwp), DIMENSION(0:44)  ::  obstruction_temp1 = 0 !< temporary obstruction information
+                                                             !< stored with ibset as logical information 
+    INTEGER(iwp), DIMENSION(0:359) ::  obstruction_temp2 = 0 !< temporary obstruction information restored values
+                                                             !< from logical information, which where stored by ibset  
+    
+    INTEGER(iwp), DIMENSION(0:35,0:9) ::  obstruction = 0 !< final obstruction information array for all
+                                                          !< hemispherical directions
+    
+    INTEGER(KIND=1), DIMENSION(:,:,:), ALLOCATABLE ::  obstruction_lookup_table !< lookup table of obstruction
+                                                                                !< information of entire domain
+
+    REAL(wp) ::  diffuse_exposure            = 0.0_wp !< calculated exposure by diffuse radiation
+    REAL(wp) ::  direct_exposure             = 0.0_wp !< calculated exposure by direct beam   
+    REAL(wp) ::  projection_area_direct_beam = 0.0_wp !< projection area for  by direct beam
+    REAL(wp) ::  saa                         = 180.0_wp !< solar azimuth angle
+    REAL(wp) ::  startpos_human              = 0.0_wp !< start position in azimuth direction for the
+                                                      !< interpolation of the projection area              
+    REAL(wp) ::  startpos_saa_float          = 0.0_wp !< start position in azimuth direction for the
+                                                      !< interpolation of the radiance field             
+    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 contains values
+                                                                       !< for direct, diffuse and global component
+    REAL(wp), DIMENSION(0:35,0:9) ::  integration_array            = 0.0_wp
+    REAL(wp), DIMENSION(0:35,0:9) ::  projection_area              = 0.0_wp
+    REAL(wp), DIMENSION(0:35,0:9) ::  projection_area_lookup_table = 0.0_wp
+    REAL(wp), DIMENSION(0:71,0:9) ::  projection_area_temp         = 0.0_wp
+    REAL(wp), DIMENSION(0:35,0:9) ::  radiance_array               = 0.0_wp
+    REAL(wp), DIMENSION(0:71,0:9) ::  radiance_array_temp          = 0.0_wp
+    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  vitd3_exposure
+    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  vitd3_exposure_av
+
+    REAL(wp), DIMENSION(0:35,0:9,0:90) ::  radiance_lookup_table = 0.0_wp
+
+
+    SAVE
+
+    PRIVATE
+
+    
+!
+!-- Add INTERFACES that must be available to other modules (alphabetical order)
+    PUBLIC uvem_3d_data_averaging, uvem_calc_exposure, uvem_check_data_output, &
+           uvem_data_output_2d, uvem_define_netcdf_grid, uvem_init,            &
+           uvem_init_arrays, uvem_parin
+
+!
+!-- Add VARIABLES that must be available to other modules (alphabetical order)
+!     PUBLIC 
+
+!
+!-- Add PROGNOSTIC QUANTITIES that must be available to other modules (alphabetical order)
+!-- PUBLIC ...
+
+
+!
+!-- Default procedures for all new modules (not all are necessarily required, 
+!-- alphabetical order is not essential)
+
+!
+!-- PALM interfaces:
+!-- Data output checks for 2D/3D data to be done in check_parameters
+    INTERFACE uvem_check_data_output
+       MODULE PROCEDURE uvem_check_data_output
+    END INTERFACE uvem_check_data_output
+    
+! !
+! !-- Data output checks for profile data to be done in check_parameters
+!     INTERFACE uvem_check_data_output_pr
+!        MODULE PROCEDURE uvem_check_data_output_pr
+!     END INTERFACE uvem_check_data_output_pr
+!     
+! !
+! !-- Input parameter checks to be done in check_parameters
+!     INTERFACE uvem_check_parameters
+!        MODULE PROCEDURE uvem_check_parameters
+!     END INTERFACE uvem_check_parameters
+! 
+!
+!-- Averaging of 3D data for output
+    INTERFACE uvem_3d_data_averaging
+       MODULE PROCEDURE uvem_3d_data_averaging
+    END INTERFACE uvem_3d_data_averaging
+! 
+! !
+!-- Data output of 2D quantities
+    INTERFACE uvem_data_output_2d
+       MODULE PROCEDURE uvem_data_output_2d
+    END INTERFACE uvem_data_output_2d
+! 
+! !
+! !-- Data output of 3D data
+!     INTERFACE uvem_data_output_3d
+!        MODULE PROCEDURE uvem_data_output_3d
+!     END INTERFACE uvem_data_output_3d
+! 
+! !
+! !-- Definition of data output quantities
+    INTERFACE uvem_define_netcdf_grid
+       MODULE PROCEDURE uvem_define_netcdf_grid
+    END INTERFACE uvem_define_netcdf_grid
+! 
+! !
+! !-- Output of information to the header file
+!     INTERFACE uvem_header
+!        MODULE PROCEDURE uvem_header
+!     END INTERFACE uvem_header
+  
+!
+!-- Initialization actions  
+    INTERFACE uvem_init
+       MODULE PROCEDURE uvem_init
+    END INTERFACE uvem_init
+ 
+!
+!-- Initialization of arrays
+    INTERFACE uvem_init_arrays
+       MODULE PROCEDURE uvem_init_arrays
+    END INTERFACE uvem_init_arrays
+! 
+! !
+! !-- Writing of binary output for restart runs  !!! renaming?!
+!     INTERFACE uvem_last_actions
+!        MODULE PROCEDURE uvem_last_actions
+!     END INTERFACE uvem_last_actions
+!     
+!
+!-- Reading of NAMELIST parameters
+    INTERFACE uvem_parin
+       MODULE PROCEDURE uvem_parin
+    END INTERFACE uvem_parin
+! 
+! !
+! !-- Reading of parameters for restart runs
+!     INTERFACE uvem_read_restart_data
+!        MODULE PROCEDURE uvem_read_restart_data
+!     END INTERFACE uvem_read_restart_data
+! 
+! !
+! !-- Writing of parameters for restart runs !!! renaming?!
+!     INTERFACE uvem_skip_var_list
+!        MODULE PROCEDURE uvem_skip_var_list
+!     END INTERFACE uvem_skip_var_list
+! 
+! !
+! !-- Swapping of time levels (required for prognostic variables)
+!     INTERFACE uvem_swap_timelevel
+!        MODULE PROCEDURE uvem_swap_timelevel
+!     END INTERFACE uvem_swap_timelevel
+! 
+! !
+! !-- New module-specific procedure(s) (alphabetical order):
+!     INTERFACE uvem_newprocedure
+!        MODULE PROCEDURE uvem_newprocedure
+!     END INTERFACE uvem_newprocedure
+
+ CONTAINS
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Check data output for new module.
+!------------------------------------------------------------------------------!
+ SUBROUTINE uvem_check_data_output( var, unit, i, ilen, k )
+ 
+    USE control_parameters,                                                    &
+        ONLY:  data_output, message_string, uv_exposure
+
+    IMPLICIT NONE
+
+    CHARACTER (LEN=*) ::  unit     !< string for unit of output quantity
+    CHARACTER (LEN=*) ::  var      !< string for output quantity
+
+    INTEGER(iwp) ::  i      !<
+    INTEGER(iwp) ::  ilen   !<   
+    INTEGER(iwp) ::  k      !<
+
+    SELECT CASE ( TRIM( var ) )
+
+
+       CASE ( 'uvem_vitd3*' )
+          IF (  .NOT.  uv_exposure )  THEN
+             message_string = 'output of "' // TRIM( var ) // '" requi' //  &
+                      'res a namelist &uvexposure_par'
+             CALL message( 'uvem_check_data_output', 'UV0001', 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'
+
+       CASE ( 'uvem_vitd3dose*' )
+          IF (  .NOT.  uv_exposure )  THEN
+             message_string = 'output of "' // TRIM( var ) // '" requi' //  &
+                      'res  a namelist &uvexposure_par'
+             CALL message( 'uvem_check_data_output', 'UV0001', 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'
+             
+       CASE DEFAULT
+          unit = 'illegal'
+
+    END SELECT
+
+ END SUBROUTINE uvem_check_data_output
+
+
+!-----------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+!> Subroutine defining 2D output variables
+!-----------------------------------------------------------------------------!
+ SUBROUTINE uvem_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 !< 
+
+    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), DIMENSION(nxl:nxr,nys:nyn,nzb:nzt+1) ::  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 ( '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_exposure_av(j,i)
+                ENDDO
+             ENDDO
+          ENDIF
+
+          two_d = .TRUE.
+          grid = 'zu1'
+
+       CASE DEFAULT
+          found = .FALSE.
+          grid  = 'none'
+
+    END SELECT
+ 
+ END SUBROUTINE uvem_data_output_2d
+
+
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+!> Subroutine defining appropriate grid for netcdf variables.
+!> It is called out from subroutine netcdf.
+!------------------------------------------------------------------------------!
+ SUBROUTINE uvem_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 ( 'uvem_vitd3*_xy', 'uvem_vitd3dose*_xy' )
+          grid_x = 'x'
+          grid_y = 'y'
+          grid_z = 'zu1'
+
+       CASE DEFAULT
+          found  = .FALSE.
+          grid_x = 'none'
+          grid_y = 'none'
+          grid_z = 'none'
+
+    END SELECT
+
+ END SUBROUTINE uvem_define_netcdf_grid
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Parin for &uvexposure_par for UV exposure model
+!------------------------------------------------------------------------------!
+ SUBROUTINE uvem_parin
+
+    USE control_parameters,                                                   &
+        ONLY:  uv_exposure
+
+
+    IMPLICIT NONE
+
+    CHARACTER (LEN=80) ::  line  !< dummy string for current line in parameter file 
+    
+    NAMELIST /uvexposure_par/  clothing
+    
+    line = ' '
+    
+!
+!-- Try to find uv exposure model namelist
+    REWIND ( 11 )
+    line = ' '
+    DO   WHILE ( INDEX( line, '&uvexposure_par' ) == 0 )
+       READ ( 11, '(A)', END=10 )  line
+    ENDDO
+    BACKSPACE ( 11 )
+
+!
+!-- Read user-defined namelist
+    READ ( 11, uvexposure_par )
+
+!
+!-- Set flag that indicates that the uv exposure model is switched on
+    uv_exposure = .TRUE.
+
+
+ 10 CONTINUE
+       
+
+ END SUBROUTINE uvem_parin
+
+
+!------------------------------------------------------------------------------!
+!
+! Description:
+! ------------
+!> Subroutine for averaging 3D data
+!------------------------------------------------------------------------------!
+ SUBROUTINE uvem_3d_data_averaging( mode, variable )
+ 
+
+    USE control_parameters
+
+    USE indices
+
+    USE kinds
+
+    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 ( 'uvem_vitd3dose*' )
+             IF ( .NOT. ALLOCATED( vitd3_exposure_av ) )  THEN
+                ALLOCATE( vitd3_exposure_av(nysg:nyng,nxlg:nxrg) )
+             ENDIF
+             vitd3_exposure_av = 0.0_wp
+
+
+          CASE DEFAULT
+             CONTINUE
+
+       END SELECT
+
+    ELSEIF ( mode == 'sum' )  THEN
+
+       SELECT CASE ( TRIM( variable ) )
+
+          CASE ( 'uvem_vitd3dose*' )
+             DO  i = nxlg, nxrg
+                DO  j = nysg, nyng
+                   vitd3_exposure_av(j,i) = vitd3_exposure_av(j,i) + vitd3_exposure(j,i)
+                ENDDO
+             ENDDO
+
+
+          CASE DEFAULT
+             CONTINUE
+
+       END SELECT
+
+!
+!-- No averaging since we are calculating a dose (only sum is calculated and saved to
+!-- av.nc file)
+!    ELSEIF ( mode == 'average' )  THEN
+
+    ENDIF
+
+ END SUBROUTINE uvem_3d_data_averaging
+
+    
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Initialization of the new module
+!------------------------------------------------------------------------------!
+ SUBROUTINE uvem_init
+    
+
+    USE control_parameters,                                                   &
+        ONLY:  initializing_actions
+
+    IMPLICIT NONE
+
+!
+!-- Actions for initial runs
+    IF ( TRIM( initializing_actions ) /= 'read_restart_data' )  THEN
+       OPEN(90, STATUS='old',FILE=&
+       'RADIANCE', FORM='UNFORMATTED')
+       READ(90) radiance_lookup_table
+       CLOSE(90)
+       OPEN(90, STATUS='old',FILE=&
+       'IRRADIANCE', FORM='UNFORMATTED')
+       READ(90) irradiance_lookup_table
+       CLOSE(90)
+      
+      !________________________LOAD Obstruction information _______________________________
+       IF ( consider_obstructions == 1 )  THEN
+          OPEN(90, STATUS='old',FILE=&
+          'OBSTRUCTION', FORM='UNFORMATTED')
+          READ(90) obstruction_lookup_table
+          CLOSE(90)  
+      ELSEIF( consider_obstructions == 0 ) THEN
+          obstruction(:,:) = 1
+      ENDIF
+
+      !________________________LOAD integration_array ________________________________________________________________________
+      OPEN(90, STATUS='old',FILE=&
+      'SOLIDANGLE', FORM='UNFORMATTED')
+      READ(90) integration_array
+      CLOSE(90)
+
+      IF (clothing==1) THEN
+          OPEN(90, STATUS='old',FILE='HUMAN', FORM='UNFORMATTED')
+      ENDIF
+      READ(90) projection_area_lookup_table
+      CLOSE(90)
+
+!
+!-- Actions for restart runs
+    ELSE
+! ....
+
+    ENDIF
+
+ END SUBROUTINE uvem_init
+
+
+!-----------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Allocate new module arrays and define pointers if required
+!-----------------------------------------------------------------------------!
+ SUBROUTINE uvem_init_arrays
+    
+    USE indices,                                                              &
+        ONLY:  nxlg, nxrg, nyng, nysg
+
+
+    IMPLICIT NONE
+
+!
+!-- Allocate arrays
+    ALLOCATE ( vitd3_exposure(nysg:nyng,nxlg:nxrg) )
+    ALLOCATE ( vitd3_exposure_av(nysg:nyng,nxlg:nxrg) )
+    ALLOCATE ( obstruction_lookup_table(nxlg:nxrg,nysg:nyng,0:44) )
+
+!
+!-- Initialize arrays
+    vitd3_exposure = 0.0_wp
+    vitd3_exposure_av = 0.0_wp
+    obstruction_lookup_table = 0
+
+
+ END SUBROUTINE uvem_init_arrays
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Module-specific routine for new module
+!------------------------------------------------------------------------------!
+ SUBROUTINE uvem_solar_position 
+
+    USE constants,                                                             &
+       ONLY:  pi
+    
+    USE date_and_time_mod,                                                     &
+       ONLY:  calc_date_and_time, day_of_year, time_utc 
+    
+    USE control_parameters,                                                    &
+       ONLY:  latitude, longitude   
+
+    IMPLICIT NONE
+    
+   
+    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) ::  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 calc_date_and_time
+       
+    dtor = pi / 180.0_wp
+    lat = latitude
+    lon = longitude
+!
+!-- calculation of js :
+    js=  72.0_wp * ( day_of_year + ( time_utc / 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 = ( ( time_utc / 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 .LE. 12.0_wp) alpha = pi - acos( sin(thetasr) * sin(lat * dtor) -                           & 
+    sin( declination * dtor ) / ( cos(thetasr) * cos( lat * dtor ) ) )    
+    IF (woz .GT. 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 uvem_calc_exposure
+    
+    USE constants,                                                             &
+        ONLY:  pi
+
+    USE indices,                                                               &
+        ONLY:  nxlg, nxrg, nyng, nysg
+    
+    
+    IMPLICIT NONE   
+    
+    INTEGER(iwp) ::  i   !< running index
+    INTEGER(iwp) ::  j   !< running index
+
+
+    CALL uvem_solar_position
+     
+    IF (sza .GE. 90) THEN
+       vitd3_exposure(:,:) = 0.0_wp
+    ELSE
+       
+!       
+!--    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 ( Turn_to_Sun .EQ. 0 )  startpos_human = orientation_angle / 10.0_wp
+       IF ( Turn_to_Sun .EQ. 1 )  startpos_human = startpos_saa_float        
+       DO  ai = 0, 35
+           xfactor = ( startpos_human ) - INT( startpos_human )
+          DO  zi = 0, 9
+              projection_area(ai,zi) = ( projection_area_temp( ai +     INT( startpos_human ), zi) * &
+                                       (1.0_wp - xfactor ) ) &
+                                      +( projection_area_temp( ai + 1 + INT( startpos_human ), zi) * &
+                                        xfactor)
+          ENDDO
+       ENDDO
+!      
+!--    calculate Projectionarea for direct beam -----------------------------'
+       projection_area_temp( 0:35,:) = projection_area
+       projection_area_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_temp( INT(startpos_saa_float)    ,INT( sza / 10.0_wp ) ) * &
+                                     ( 1.0_wp - xfactor ) * ( 1.0_wp - yfactor ) ) + &
+                                     ( projection_area_temp( INT(startpos_saa_float) + 1,INT(sza/10.0_wp))  *&
+                                     (    xfactor ) * ( 1.0_wp - yfactor ) ) + &
+                                     ( projection_area_temp( INT(startpos_saa_float)    ,INT(sza/10.0_wp)+1)*&
+                                     ( 1.0_wp - xfactor ) * (   yfactor ) ) + &
+                                     ( projection_area_temp( INT(startpos_saa_float) + 1,INT(sza/10.0_wp)+1)*&
+                                     (    xfactor ) * (   yfactor ) )
+                 
+             
+!           
+!--    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  ai = 0, 2            
+           irradiance(ai) = ( irradiance_lookup_table(ai, INT(sza) ) * ( 1.0_wp - xfactor)) + &
+           (irradiance_lookup_table(ai, INT(sza) + 1) * xfactor )
+       ENDDO   
+!         
+!--    interpolate to accurate Solar Azimuth Angle ------------------
+       IF ( saa_in_south .EQ. 0 )  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( ai + INT( startpos_saa_float ), zi ) * &
+                                     (1.0_wp - xfactor)) &
+                                     + ( radiance_array_temp( ai + 1 + INT( startpos_saa_float ), zi ) &
+                                     * xfactor)
+          ENDDO
+       ENDDO 
+
+
+
+                                    
+       DO  i = nxlg, nxrg    
+          DO  j = nysg, nyng
+!            
+!--          extract obstrcution from IBSET-Integer_Array ------------------'
+             IF (consider_obstructions == 1) THEN
+                obstruction_temp1 = obstruction_lookup_table(i,j,:)
+                IF (obstruction_temp1(0) .NE. 9) THEN 
+                   DO  zi = 0, 44 
+                      DO  ai = 0, 7 
+                         IF ( btest( obstruction_temp1(zi), ai ) .EQV. .TRUE.) THEN
+                            obstruction_temp2( ( zi * 8 ) + ai ) = 1
+                         ELSE
+                            obstruction_temp2( ( zi * 8 ) + ai ) = 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 .GE. 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 uvem_calc_exposure
+
+
+
+
+ 
+! ------------------------------------------------------------------------------!
+! Description:
+! ------------
+! > Check parameters routine
+! ------------------------------------------------------------------------------!
+!  SUBROUTINE uvem_check_parameters
+! 
+!     USE control_parameters,                                                    &
+!         ONLY:  message_string
+! 
+!        
+!     IMPLICIT NONE
+! 
+! 
+! --    Checks go here (cf. check_parameters.f90). 
+!            
+!  END SUBROUTINE uvem_check_parameters
+
+
+ 
+! !------------------------------------------------------------------------------!
+! ! Description:
+! ! ------------
+! !> Header output
+! !------------------------------------------------------------------------------!
+!  SUBROUTINE uvem_header ( io )
+! 
+! 
+!     IMPLICIT NONE
+! 
+!  
+!     INTEGER(iwp), INTENT(IN) ::  io   !< Unit of the output file
+!  
+! !
+! !-- Header output goes here
+! !-- ...
+! 
+!  END SUBROUTINE uvem_header
+
+
+
+! !------------------------------------------------------------------------------!
+! ! Description:
+! ! ------------
+! !> This routine reads the respective restart data.
+! !------------------------------------------------------------------------------!
+!  SUBROUTINE uvem_read_restart_data  
+! 
+!     
+!     IMPLICIT NONE
+!        
+!     CHARACTER (LEN=30) ::  variable_chr  !< dummy variable to read string
+!        
+!        
+!     READ ( 13 )  variable_chr
+!     DO  WHILE ( TRIM( variable_chr ) /= '*** end new module ***' )
+! 
+!        SELECT CASE ( TRIM( variable_chr ) )
+!           
+! !           CASE ( 'param1' )
+! !              IF ( .NOT. ALLOCATED( param1 ) )  ALLOCATE( param1(...) )
+! !              READ ( 13 )  param1   
+!           
+!        END SELECT
+!           
+!        READ ( 13 )  variable_chr
+!           
+!     ENDDO
+! 
+!  END SUBROUTINE uvem_read_restart_data  
+    
+
+! !------------------------------------------------------------------------------!
+! ! Description:
+! ! ------------
+! !> This routine writes the respective restart data.
+! !------------------------------------------------------------------------------!
+!  SUBROUTINE uvem_last_actions
+! 
+!     IMPLICIT NONE
+!        
+! !      WRITE ( 14 )  'param1                            '
+! !      WRITE ( 14 )  param1       
+! 
+!        
+!     WRITE ( 14 )  '*** end new module ***            '
+!        
+!  END SUBROUTINE uvem_last_actions   
+
+
+! !------------------------------------------------------------------------------!
+! ! Description:
+! ! ------------
+! !> Skipping of parameters from restart file (binary format).
+! !------------------------------------------------------------------------------!
+!  SUBROUTINE uvem_skip_var_list  
+!            
+!     IMPLICIT NONE
+!        
+!     CHARACTER (LEN=1)  ::  param2         !<
+!     CHARACTER (LEN=30) ::  variable_chr   !<
+!        
+!     READ ( 13 )  variable_chr
+!     DO  WHILE ( TRIM( variable_chr ) /= '*** end new module ***' )
+!        READ ( 13 )  param2
+!     ENDDO    
+!        
+!  END SUBROUTINE uvem_skip_var_list 
+
+
+ END MODULE uv_exposure_model_mod
Index: palm/trunk/SOURCE/vertical_nesting_mod.f90
===================================================================
--- palm/trunk/SOURCE/vertical_nesting_mod.f90	(revision 2689)
+++ palm/trunk/SOURCE/vertical_nesting_mod.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file vertical_nesting_mod.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
@@ -16,4 +16,5 @@
 !
 ! Copyright 1997-2017 Leibniz Universitaet Hannover
+! Copyright 2017-2017 Karlsruhe Institute of Technology
 !------------------------------------------------------------------------------!
 !
@@ -25,4 +26,10 @@
 ! -----------------
 ! $Id$
+! renamed diffusivities to tcm_diffusivities (TG)
+! 
+! 2516 2017-10-04 11:03:04Z suehring
+! Remove tabs
+! 
+! 2514 2017-10-04 09:52:37Z suehring
 ! Remove tabs
 ! 
@@ -186,5 +193,6 @@
         USE surface_mod,                                                        &
             ONLY :  surf_def_h, surf_def_v
-        
+        USE turbulence_closure_mod,                                             &
+            ONLY :  tcm_diffusivities
    
         IMPLICIT NONE
@@ -554,7 +562,7 @@
            !diffusivities required
            IF ( .NOT. humidity ) THEN
-               CALL diffusivities( pt, pt_reference )
+               CALL tcm_diffusivities( pt, pt_reference )
            ELSE
-               CALL diffusivities( vpt, pt_reference )
+               CALL tcm_diffusivities( vpt, pt_reference )
            ENDIF
    
Index: palm/trunk/SOURCE/virtual_flight_mod.f90
===================================================================
--- palm/trunk/SOURCE/virtual_flight_mod.f90	(revision 2689)
+++ palm/trunk/SOURCE/virtual_flight_mod.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file virtual_flights_mod.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/wind_turbine_model_mod.f90
===================================================================
--- palm/trunk/SOURCE/wind_turbine_model_mod.f90	(revision 2689)
+++ palm/trunk/SOURCE/wind_turbine_model_mod.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file wind_turbine_model_mod.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
Index: palm/trunk/SOURCE/write_3d_binary.f90
===================================================================
--- palm/trunk/SOURCE/write_3d_binary.f90	(revision 2689)
+++ palm/trunk/SOURCE/write_3d_binary.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file write_3d_binary.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
@@ -25,4 +25,7 @@
 ! -----------------
 ! $Id$
+! + kh_av, km_av (TG)
+! 
+! 2292 2017-06-20 09:51:42Z schwenkel
 ! Implementation of new microphysic scheme: cloud_scheme = 'morrison' 
 ! includes two more prognostic equations for cloud drop concentration (nc)  
@@ -162,5 +165,5 @@
 !
 !-- Write arrays.
-    binary_version = '4.5'
+    binary_version = '4.6'
 
     WRITE ( 14 )  binary_version
@@ -179,5 +182,11 @@
     WRITE ( 14 )  'iran                ';  WRITE ( 14 )  iran, iran_part
     WRITE ( 14 )  'kh                  ';  WRITE ( 14 )  kh
+    IF ( ALLOCATED( kh_av ) )  THEN
+       WRITE ( 14 )  'kh_av               ';  WRITE ( 14 )  kh_av
+    ENDIF
     WRITE ( 14 )  'km                  ';  WRITE ( 14 )  km
+    IF ( ALLOCATED( km_av ) )  THEN
+       WRITE ( 14 )  'km_av               ';  WRITE ( 14 )  km_av
+    ENDIF
     IF ( ALLOCATED( lpt_av ) )  THEN
        WRITE ( 14 )  'lpt_av              ';  WRITE ( 14 )  lpt_av
Index: palm/trunk/SOURCE/write_var_list.f90
===================================================================
--- palm/trunk/SOURCE/write_var_list.f90	(revision 2689)
+++ palm/trunk/SOURCE/write_var_list.f90	(revision 2696)
@@ -1,5 +1,5 @@
 !> @file write_var_list.f90
 !------------------------------------------------------------------------------!
-! This file is part of PALM.
+! This file is part of the PALM model system.
 !
 ! PALM is free software: you can redistribute it and/or modify it under the
@@ -25,4 +25,9 @@
 ! -----------------
 ! $Id$
+! + rans_mode, turbulence_closure (TG)
+! Implementation of chemistry module (FK)
+! Removal of chemistry module part. It is not needed and causes bugs (FK)
+! 
+! 2576 2017-10-24 13:49:46Z Giersch
 ! The end of the standard parameter list is again marked with *** end *** like 
 ! it was before revision 2563
@@ -256,5 +261,5 @@
 
 
-    binary_version = '4.4'
+    binary_version = '4.5'
 
     WRITE ( 14 )  binary_version
@@ -545,4 +550,6 @@
     WRITE ( 14 )  'random_heatflux               '
     WRITE ( 14 )  random_heatflux
+    WRITE ( 14 )  'rans_mode                     '
+    WRITE ( 14 )  rans_mode
     WRITE ( 14 )  'rayleigh_damping_factor       '
     WRITE ( 14 )  rayleigh_damping_factor
@@ -671,4 +678,6 @@
     WRITE ( 14 )  'tunnel_wall_depth             '
     WRITE ( 14 )  tunnel_wall_depth
+    WRITE ( 14 )  'turbulence_closure            '
+    WRITE ( 14 )  turbulence_closure
     WRITE ( 14 )  'collision_turbulence          '
     WRITE ( 14 )  collision_turbulence
@@ -762,4 +771,8 @@
     WRITE ( 14 )  '*** end ***                   '
 
+!    
+!-- ADD NEW "CALL <module>_skip_var_list" BELOW THE LAST CALL
+!-- (The order of the calls MUST be the same as in parin, and
+!--  read/skip_var_list)!
 !
 !-- If required, write restart data for wind turbine model.
@@ -775,3 +788,4 @@
 
 
+
  END SUBROUTINE write_var_list
