Index: palm/trunk/EXAMPLES/agents/canyon/INPUT/canyon_p3d
===================================================================
--- palm/trunk/EXAMPLES/agents/canyon/INPUT/canyon_p3d	(revision 3159)
+++ palm/trunk/EXAMPLES/agents/canyon/INPUT/canyon_p3d	(revision 3159)
@@ -0,0 +1,70 @@
+&initialization_parameters
+   !-- grid setup
+      nx = 19,
+      ny = 19,
+      nz = 20,
+
+      dx = 2.0,
+      dy = 2.0,
+      dz = 2.0,
+
+   !-- pressure solver
+      fft_method = 'temperton-algorithm',
+    loop_optimization    = 'cache',
+
+   !-- initialization
+      initializing_actions = 'set_constant_profiles',  ! constant vertical profiles are used,
+      pt_surface = 300.,                               ! based on given "*_surface" values
+      ug_surface = 1.0,
+      vg_surface = 0.0, 
+
+   !-- boundary conditions
+      bc_uv_t = 'neumann',                    ! free-slip boundary condition
+      bc_pt_b = 'dirichlet',                  ! surface temperature is calculated by e-balance solver in USM  
+      bc_pt_t = 'neumann',      
+      roughness_length = 0.1,                 ! applies to all surfaces
+
+   !-- topography   
+      topography = 'read_from_file',                ! file: generic_canyon_topo
+      
+   !-- other
+    most_method          = 'newton',
+      /                                       ! end of inipar-namelist
+
+
+ &runtime_parameters
+   !-- simulation time
+      end_time                = 200.0, 
+
+   !-- others
+      create_disturbances = .T.,
+
+      netcdf_data_format = 5,
+      dt_dots = 9999999.,
+                    
+      /                                        ! end of canopy_par-namelist
+
+
+ &agents_par
+    dt_arel                = 3.1,
+    dt_write_agent_data    = .1,
+    dt_agent = 0.02,
+    number_of_agent_groups = 2,
+    adx                    = 1.8,1.8,
+    ady                    = 1.,1.,
+    asl                    = 13.,13.,
+    asr                    = 27.,27.,
+    ass                    = .5,38.,
+    asn                    = 2.,39.5,
+    at_x                   = 20.,20.,
+    at_y                   = 999.,-999.,  ! chosen far out of domain so that agents walk nearly parallel
+
+
+    /
+
+
+
+ &prepro_par
+      tolerance_dp  = 1.41, 1.41,
+
+    /
Index: palm/trunk/EXAMPLES/agents/canyon/INPUT/canyon_topo
===================================================================
--- palm/trunk/EXAMPLES/agents/canyon/INPUT/canyon_topo	(revision 3159)
+++ palm/trunk/EXAMPLES/agents/canyon/INPUT/canyon_topo	(revision 3159)
@@ -0,0 +1,20 @@
+  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0
+ 20.0 20.0 20.0 20.0 20.0 20.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0 20.0 20.0 20.0 20.0 20.0 20.0
+ 20.0 20.0 20.0 20.0 20.0 20.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0 20.0 20.0 20.0 20.0 20.0 20.0
+ 20.0 20.0 20.0 20.0 20.0 20.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0 20.0 20.0 20.0 20.0 20.0 20.0
+ 20.0 20.0 20.0 20.0 20.0 20.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0 20.0 20.0 20.0 20.0 20.0 20.0
+ 20.0 20.0 20.0 20.0 20.0 20.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0 20.0 20.0 20.0 20.0 20.0 20.0
+ 20.0 20.0 20.0 20.0 20.0 20.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0 20.0 20.0 20.0 20.0 20.0 20.0
+ 20.0 20.0 20.0 20.0 20.0 20.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0 20.0 20.0 20.0 20.0 20.0 20.0
+ 20.0 20.0 20.0 20.0 20.0 20.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0 20.0 20.0 20.0 20.0 20.0 20.0
+ 20.0 20.0 20.0 20.0 20.0 20.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0 20.0 20.0 20.0 20.0 20.0 20.0
+ 20.0 20.0 20.0 20.0 20.0 20.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0 20.0 20.0 20.0 20.0 20.0 20.0
+ 20.0 20.0 20.0 20.0 20.0 20.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0 20.0 20.0 20.0 20.0 20.0 20.0
+ 20.0 20.0 20.0 20.0 20.0 20.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0 20.0 20.0 20.0 20.0 20.0 20.0
+ 20.0 20.0 20.0 20.0 20.0 20.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0 20.0 20.0 20.0 20.0 20.0 20.0
+ 20.0 20.0 20.0 20.0 20.0 20.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0 20.0 20.0 20.0 20.0 20.0 20.0
+ 20.0 20.0 20.0 20.0 20.0 20.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0 20.0 20.0 20.0 20.0 20.0 20.0
+ 20.0 20.0 20.0 20.0 20.0 20.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0 20.0 20.0 20.0 20.0 20.0 20.0
+ 20.0 20.0 20.0 20.0 20.0 20.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0 20.0 20.0 20.0 20.0 20.0 20.0
+ 20.0 20.0 20.0 20.0 20.0 20.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0 20.0 20.0 20.0 20.0 20.0 20.0
+  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0
Index: palm/trunk/EXAMPLES/agents/canyon/OUTPUT/ani_agt.py
===================================================================
--- palm/trunk/EXAMPLES/agents/canyon/OUTPUT/ani_agt.py	(revision 3159)
+++ palm/trunk/EXAMPLES/agents/canyon/OUTPUT/ani_agt.py	(revision 3159)
@@ -0,0 +1,85 @@
+#!/usr/bin/env python3
+
+import matplotlib
+import sys
+from matplotlib import colors, ticker, cm
+from matplotlib.backends.backend_pdf import PdfPages
+from netCDF4 import Dataset
+import matplotlib.pyplot as plt
+import numpy as np
+import math
+from matplotlib import animation
+import matplotlib.gridspec as gridspec
+from matplotlib.lines import Line2D
+from matplotlib.collections import PatchCollection
+from matplotlib.patches import Polygon
+matplotlib.rcParams['text.usetex'] = True
+
+
+input_file_name  = './canyon_agt.001.nc'
+
+file_content     = Dataset(input_file_name, mode='r') # load entire netCDF file
+print(file_content)
+time          = file_content.variables['time'][:] # extract variable
+agx           = file_content.variables['ag_x'][:,:]
+agy           = file_content.variables['ag_y'][:,:]
+grp           = file_content.variables['ag_group'][:,:]
+file_content.close() # close netCDF file
+
+input_file_name  = './topo.txt'
+f     = open(input_file_name, mode='r')
+data = []
+building_id = []
+vertex_id = []
+polygon = []
+gons = []
+p_last = 1
+for line in f:
+  line = line.strip()
+  columns = line.split()
+  if (int(columns[0]) > p_last):
+    gons.append(polygon)
+    polygon = []
+  polygon.append([float(columns[2]),float(columns[3])])
+  p_last = int(columns[0])
+gons.append(polygon)
+nop = int(columns[0])
+patches = []
+
+for i in range(nop):
+  poly = Polygon(gons[i-1], True)
+  patches.append(poly)
+p = PatchCollection(patches,facecolors='grey')
+
+Nt = np.shape(time)[0]
+print(Nt)
+Nt = Nt -1
+Nags = np.shape(agx[1,:])
+Nx = 40
+Ny = 40
+
+x = np.linspace(0.0, 40.0, Nx)
+y = np.linspace(0.0, 40.0, Ny)
+X, Y = np.meshgrid(x, y)
+
+fig,ax = plt.subplots()
+fig.set_size_inches(4., 8.)
+xrange = [10, 30]
+yrange = [0, 40]
+
+
+def animate(i):
+    ax.clear()
+    ax.add_collection(p)
+    x = agx[i,:]
+    y = agy[i,:]
+    ax.set_xlim(*xrange)
+    ax.set_ylim(*yrange)
+    ax.scatter(x,y,s=15,c=grp[i,:])
+    plt.title(r'simulated time: %i s' % time[i])
+    k = i/Nt*100.
+    print("Done: %6.2f percent\r" % k, file=sys.stdout, end=" ")
+    return ax,
+
+anim = animation.FuncAnimation(fig, animate, frames=Nt, interval=60, blit=False,save_count=0)
+anim.save('ags.mp4', dpi=200, writer='ffmpeg')
Index: palm/trunk/EXAMPLES/agents/canyon/OUTPUT/topo.txt
===================================================================
--- palm/trunk/EXAMPLES/agents/canyon/OUTPUT/topo.txt	(revision 3159)
+++ palm/trunk/EXAMPLES/agents/canyon/OUTPUT/topo.txt	(revision 3159)
@@ -0,0 +1,8 @@
+      1       1     12.00      2.00
+      1       2     12.00     38.00
+      1       3      0.00     38.00
+      1       4      0.00      2.00
+      2       1     28.00      2.00
+      2       2     40.00      2.00
+      2       3     40.00     38.00
+      2       4     28.00     38.00
Index: palm/trunk/EXAMPLES/agents/corners/INPUT/corners_p3d
===================================================================
--- palm/trunk/EXAMPLES/agents/corners/INPUT/corners_p3d	(revision 3159)
+++ palm/trunk/EXAMPLES/agents/corners/INPUT/corners_p3d	(revision 3159)
@@ -0,0 +1,61 @@
+&initialization_parameters
+   !-- grid setup
+      nx = 19,
+      ny = 19,
+      nz = 30,
+
+      dx = 1.0,
+      dy = 1.0,
+      dz = 1.0,
+
+   !-- pressure solver
+      fft_method = 'temperton-algorithm',
+    loop_optimization    = 'cache',
+
+   !-- initialization
+      initializing_actions = 'set_constant_profiles',  ! constant vertical profiles are used,
+      pt_surface = 300.,                               ! based on given "*_surface" values
+      ug_surface = 1.0,
+      vg_surface = 0.0, 
+
+   !-- boundary conditions
+      bc_uv_t = 'neumann',                    ! free-slip boundary condition
+      bc_pt_b = 'dirichlet',                  ! surface temperature is calculated by e-balance solver in USM  
+      bc_pt_t = 'neumann',      
+      roughness_length = 0.01,                 ! applies to all surfaces
+
+   !-- topography   
+      topography = 'read_from_file',                ! file: generic_canyon_topo
+      
+   !-- other
+    most_method          = 'newton',
+      /                                       ! end of inipar-namelist
+
+
+ &runtime_parameters  
+   !-- simulation time
+      end_time                = 150.0, 
+
+   !-- others
+      create_disturbances = .T.,
+
+      netcdf_data_format = 5,
+      dt_dots            = 9999999.,
+                    
+      /                                        ! end of canopy_par-namelist
+
+
+ &agents_par
+    dt_arel                = 12.,
+    dt_write_agent_data    = .05,
+    number_of_agent_groups = 4,
+    adx                    =   .9,   .9,   4.,   4.,
+    ady                    =   4.,   4.,   .9,   .9,
+    asl                    =   8.,   8.,  1.5,  18.,
+    asr                    =  12.,  12.,   2., 18.5,
+    ass                    =  1.5,  18.,   8.,   8., 
+    asn                    =   2., 18.5,  12.,  12.,
+    at_x                   =  10.,  10.,  16.,   4.,
+    at_y                   =  16.,   4.,  10.,  10.,
+
+    /
Index: palm/trunk/EXAMPLES/agents/corners/INPUT/corners_topo
===================================================================
--- palm/trunk/EXAMPLES/agents/corners/INPUT/corners_topo	(revision 3159)
+++ palm/trunk/EXAMPLES/agents/corners/INPUT/corners_topo	(revision 3159)
@@ -0,0 +1,20 @@
+  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0
+  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0
+  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0
+  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0
+  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0
+  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0
+  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0
+  0.0  0.0  0.0  0.0  0.0  0.0 20.0 20.0 20.0 20.0 20.0 20.0 20.0 20.0 20.0  0.0  0.0  0.0  0.0  0.0
+  0.0  0.0  0.0  0.0  0.0  0.0 20.0 20.0 20.0 20.0 20.0 20.0 20.0 20.0 20.0  0.0  0.0  0.0  0.0  0.0
+  0.0  0.0  0.0  0.0  0.0  0.0 20.0 20.0 20.0 20.0 20.0 20.0 20.0 20.0 20.0  0.0  0.0  0.0  0.0  0.0
+  0.0  0.0  0.0  0.0  0.0  0.0 20.0 20.0 20.0 20.0 20.0 20.0 20.0 20.0 20.0  0.0  0.0  0.0  0.0  0.0
+  0.0  0.0  0.0  0.0  0.0  0.0 20.0 20.0 20.0 20.0 20.0 20.0 20.0 20.0 20.0  0.0  0.0  0.0  0.0  0.0
+  0.0  0.0  0.0  0.0  0.0  0.0 20.0 20.0 20.0 20.0 20.0 20.0 20.0 20.0 20.0  0.0  0.0  0.0  0.0  0.0
+  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0
+  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0
+  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0
+  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0
+  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0
+  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0
+  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0  0.0
Index: palm/trunk/EXAMPLES/agents/corners/OUTPUT/ani_agt.py
===================================================================
--- palm/trunk/EXAMPLES/agents/corners/OUTPUT/ani_agt.py	(revision 3159)
+++ palm/trunk/EXAMPLES/agents/corners/OUTPUT/ani_agt.py	(revision 3159)
@@ -0,0 +1,103 @@
+#!/usr/bin/env python3
+
+import matplotlib
+import sys
+from matplotlib import colors, ticker, cm
+from matplotlib.backends.backend_pdf import PdfPages
+from netCDF4 import Dataset
+import matplotlib.pyplot as plt
+import numpy as np
+import math
+from matplotlib import animation
+import matplotlib.gridspec as gridspec
+from matplotlib.lines import Line2D
+from matplotlib.collections import PatchCollection
+from matplotlib.patches import Polygon
+matplotlib.rcParams['text.usetex'] = True
+
+
+input_file_name  = './corners_agt.059.nc'
+
+file_content     = Dataset(input_file_name, mode='r') # load entire netCDF file
+print(file_content)
+time          = file_content.variables['time'][:] # extract variable
+agx           = file_content.variables['ag_x'][:,:]
+agy           = file_content.variables['ag_y'][:,:]
+group           = file_content.variables['ag_group'][:,:]
+file_content.close() # close netCDF file
+
+input_file_name  = './topo.txt'
+f     = open(input_file_name, mode='r')
+data = []
+building_id = []
+vertex_id = []
+polygon = []
+gons = []
+p_last = 1
+for line in f:
+  line = line.strip()
+  columns = line.split()
+  if (int(columns[0]) > p_last):
+    gons.append(polygon)
+    polygon = []
+  polygon.append([float(columns[2]),float(columns[3])])
+  p_last = int(columns[0])
+gons.append(polygon)
+nop = int(columns[0])
+patches = []
+
+for i in range(nop):
+  poly = Polygon(gons[i-1], True)
+  patches.append(poly)
+p = PatchCollection(patches,facecolors='grey')
+
+input_file_name  = './topo_nav.txt'
+f     = open(input_file_name, mode='r')
+t_x = []
+t_y = []
+
+l_count = 0
+for line in f:
+  l_count = l_count + 1
+  line = line.strip()
+  columns_t = line.split()
+  t_x.append(columns_t[2])
+  t_y.append(columns_t[3])
+
+Nt = np.shape(time)[0]
+print(Nt)
+Nt = Nt -1
+Nags = np.shape(agx[1,:])
+Nx = 20
+Ny = 20
+
+x = np.linspace(0.0, 20.0, Nx)
+y = np.linspace(0.0, 20.0, Ny)
+X, Y = np.meshgrid(x, y)
+
+fig,ax = plt.subplots()
+fig.set_size_inches(7., 7.)
+xrange = [0, 20]
+yrange = [0, 20]
+colors = ['yellow','red','blue']
+
+
+def animate(i):
+    ax.clear()
+    ax.add_collection(p)
+    x = agx[i,:]
+    y = agy[i,:]
+    ax.set_xlim(*xrange)
+    ax.set_ylim(*yrange)
+    ax.scatter(x,y,s=3,c=group[i,:])
+    ax.scatter(t_x,t_y,s=1,c='red')
+    plt.title(r'simulated time: %i s' % time[i])
+    k = i/Nt*100.
+    print("Done: %6.2f percent\r" % k, file=sys.stdout, end=" ")
+    return ax,
+
+anim = animation.FuncAnimation(fig, animate, frames=Nt, interval=60, blit=False,save_count=0)
+anim.save('ags.mp4', dpi=200, writer='ffmpeg')
+#anim.save('basic_animation.gif', fps=1, extra_args=['-vcodec', 'libx264'])
+
+#plt.show()
Index: palm/trunk/EXAMPLES/agents/corners/OUTPUT/topo.txt
===================================================================
--- palm/trunk/EXAMPLES/agents/corners/OUTPUT/topo.txt	(revision 3159)
+++ palm/trunk/EXAMPLES/agents/corners/OUTPUT/topo.txt	(revision 3159)
@@ -0,0 +1,4 @@
+      1       1     15.00     13.00
+      1       2      6.00     13.00
+      1       3      6.00      7.00
+      1       4     15.00      7.00
Index: palm/trunk/SCRIPTS/.palm.iofiles
===================================================================
--- palm/trunk/SCRIPTS/.palm.iofiles	(revision 3157)
+++ palm/trunk/SCRIPTS/.palm.iofiles	(revision 3159)
@@ -6,4 +6,5 @@
 PARIN                    in:tr      d3r      $base_data/$jobname/INPUT          _p3dr*
 PARIN                    in:tr      pcr      $base_data/$jobname/INPUT          _pcr*
+NAVIGATION_DATA          inopt:tr   d3#:d3r  $base_data/$jobname/INPUT          _nav*
 TOPOGRAPHY_DATA          inopt:tr   d3#:d3r  $base_data/$jobname/INPUT          _topo*
 PIDS_STATIC              inopt:tr   d3#:d3r  $base_data/$jobname/INPUT          _static*
@@ -62,4 +63,5 @@
 DATA_MASK_NETCDF*          out:tr   *         $base_data/$jobname/OUTPUT         _masked    nc
 DATA_MASK_AV_NETCDF*       out:tr   *         $base_data/$jobname/OUTPUT         _av_masked nc
+DATA_AGT_NETCDF            out:tr   *         $base_data/$jobname/OUTPUT         _agt       nc
 #
 DATA_PRT_NETCDF*           out:pe   *         $base_data/$jobname/OUTPUT         _prt
Index: palm/trunk/SOURCE/Makefile
===================================================================
--- palm/trunk/SOURCE/Makefile	(revision 3157)
+++ palm/trunk/SOURCE/Makefile	(revision 3159)
@@ -25,4 +25,7 @@
 # -----------------
 # $Id$
+# Added multi agent system
+# 
+# 3130 2018-07-16 11:08:55Z gronemeier
 # add surface_layer_fluxes_mod to turbulence_closure_mod
 # 
@@ -537,4 +540,5 @@
 	mod_particle_attributes.f90 \
 	modules.f90 \
+	multi_agent_system_mod.f90 \
 	netcdf_data_input_mod.f90 \
 	netcdf_interface_mod.f90 \
@@ -1177,4 +1181,11 @@
 modules.o: \
 	mod_kinds.o
+multi_agent_system_mod.o: \
+	chemistry_model_mod.o \
+	cpulog_mod.o \
+	mod_kinds.o \
+	modules.o \
+	netcdf_interface_mod.o \
+	surface_mod.o
 mod_kinds.o: \
 
Index: palm/trunk/SOURCE/check_open.f90
===================================================================
--- palm/trunk/SOURCE/check_open.f90	(revision 3157)
+++ palm/trunk/SOURCE/check_open.f90	(revision 3159)
@@ -25,4 +25,7 @@
 ! -----------------
 ! $Id$
+! Added multi agent system
+! 
+! 3045 2018-05-28 07:55:41Z Giersch
 ! Output case 108 disabled
 ! 
@@ -190,8 +193,9 @@
 
     USE netcdf_interface,                                                      &
-        ONLY:  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, nc_stat, netcdf_create_file, netcdf_data_format,     &
-               netcdf_define_header, netcdf_handle_error, netcdf_open_write_file
+        ONLY:  id_set_agt, id_set_fl, id_set_mask, id_set_pr, id_set_prt,      &
+               id_set_pts, id_set_sp, id_set_ts, id_set_xy, id_set_xz,         &
+               id_set_yz, id_set_3d, nc_stat, netcdf_create_file,              &
+               netcdf_data_format, netcdf_define_header, netcdf_handle_error,  &
+               netcdf_open_write_file
 
     USE particle_attributes,                                                   &
@@ -1077,4 +1081,62 @@
           ENDIF
 
+       CASE ( 118 )
+
+          IF ( myid == 0 )  THEN
+             filename = 'DATA_AGT_NETCDF'
+!
+!--       Inquire, if there is a netCDF file from a previuos run. This should
+!--       be opened for extension, if its variables match the actual run.
+          INQUIRE( FILE=filename, EXIST=netcdf_extend )
+
+!
+!--          Create a new netCDF output file with requested netCDF format
+             CALL netcdf_create_file( filename, id_set_agt, .FALSE., 43 )
+
+!
+!--          Define the header
+             CALL netcdf_define_header( 'ag', netcdf_extend, 0 )
+          ENDIF
+
+!           IF ( netcdf_extend )  THEN
+! !
+! !--          Open an existing netCDF file for output
+!              CALL netcdf_open_write_file( filename, id_set_agt, .FALSE., 41 )
+! !
+! !--          Read header information and set all ids. If there is a mismatch
+! !--          between the previuos and the actual run, netcdf_extend is returned
+! !--          as .FALSE.
+!              CALL netcdf_define_header( 'ag', netcdf_extend, 0 )
+! 
+! !
+! !--          Remove the local file, if it can not be extended
+!              IF ( .NOT. netcdf_extend )  THEN
+!                 nc_stat = NF90_CLOSE( id_set_agt )
+!                 CALL netcdf_handle_error( 'check_open', 42 )
+!                 CALL local_system( 'rm ' // TRIM( filename ) )
+!              ENDIF
+! 
+!           ENDIF
+
+          IF ( .NOT. netcdf_extend )  THEN
+
+!
+! !--          For runs on multiple processors create the subdirectory
+!              IF ( myid_char /= '' )  THEN
+!                 IF ( myid == 0  .AND. .NOT. openfile(file_id)%opened_before )  &
+!                 THEN    ! needs modification in case of non-extendable sets
+!                    CALL local_system( 'mkdir  DATA_PRT_NETCDF' //              &
+!                                        TRIM( coupling_char ) // '/' )
+!                 ENDIF
+! #if defined( __parallel )
+! ! 
+! !--             Set a barrier in order to allow that all other processors in the
+! !--             directory created by PE0 can open their file
+!                 CALL MPI_BARRIER( comm2d, ierr )
+! #endif
+!              ENDIF
+
+          ENDIF
+
 !
 !--    nc-file for virtual flight measurements
Index: palm/trunk/SOURCE/init_3d_model.f90
===================================================================
--- palm/trunk/SOURCE/init_3d_model.f90	(revision 3157)
+++ palm/trunk/SOURCE/init_3d_model.f90	(revision 3159)
@@ -25,4 +25,7 @@
 ! -----------------
 ! $Id$
+! Added multi agent system
+! 
+! 3129 2018-07-16 07:45:13Z gronemeier
 ! Move initialization call for nudging and 1D/3D offline nesting. 
 ! Revise initialization with inifor data.
@@ -506,12 +509,12 @@
     
     USE indices
+    
+    USE kinds
+
+    USE land_surface_model_mod,                                                &
+        ONLY:  lsm_init, lsm_init_arrays
 
     USE lpm_init_mod,                                                          &
         ONLY:  lpm_init
-    
-    USE kinds
-
-    USE land_surface_model_mod,                                                &
-        ONLY:  lsm_init, lsm_init_arrays
   
     USE lsf_nudging_mod,                                                       &
@@ -524,4 +527,7 @@
         ONLY:  e1d, init_1d_model, kh1d, km1d, l1d, rif1d, u1d, us1d, usws1d,  &
                v1d, vsws1d 
+
+    USE multi_agent_system_mod,                                                &
+        ONLY:  agents_active, mas_init
 
     USE netcdf_interface,                                                      &
@@ -2367,4 +2373,8 @@
 
 !
+!-- If required, initialize particles
+    IF ( agents_active )  CALL mas_init
+
+!
 !-- If required, initialize quantities needed for the LSM
     IF ( land_surface )  THEN
Index: palm/trunk/SOURCE/modules.f90
===================================================================
--- palm/trunk/SOURCE/modules.f90	(revision 3157)
+++ palm/trunk/SOURCE/modules.f90	(revision 3159)
@@ -25,4 +25,7 @@
 ! -----------------
 ! $Id$
+! Added multi agent system
+! 
+! 3157 2018-07-19 21:08:49Z maronga
 ! added use_free_convection_scaling
 ! 
@@ -1149,4 +1152,5 @@
     
     INTEGER(iwp) ::  abort_mode = 1                    !< abort condition (nested runs)
+    INTEGER(iwp) ::  agt_time_count = 0                !< number of output intervals for agent data output
     INTEGER(iwp) ::  average_count_pr = 0              !< number of samples in vertical-profile output
     INTEGER(iwp) ::  average_count_3d = 0              !< number of samples in 3d output
@@ -1262,4 +1266,5 @@
     LOGICAL ::  aerosol_c3h4o4 =.FALSE.                          !< malonic acid aerosol for bulk scheme
     LOGICAL ::  aerosol_nh4no3 =.FALSE.                          !< malonic acid aerosol for bulk scheme
+    LOGICAL ::  agent_time_unlimited = .FALSE.                   !< namelist parameter
     LOGICAL ::  air_chemistry = .FALSE.                          !< chemistry model switch
     LOGICAL ::  bc_lr_cyc =.TRUE.                                !< left-right boundary condition cyclic?
@@ -1299,4 +1304,5 @@
     LOGICAL ::  dt_3d_reached_l                                  !< internal timestep for particle advection
     LOGICAL ::  first_call_lpm = .TRUE.                          !< call lpm only once per timestep?
+    LOGICAL ::  first_call_mas = .TRUE.                          !< call mas only once per timestep
     LOGICAL ::  force_print_header = .FALSE.                     !< namelist parameter
     LOGICAL ::  force_bound_l = .FALSE.                          !< flag indicating domain boundary on left side to set forcing boundary conditions
@@ -1436,4 +1442,5 @@
     REAL(wp) ::  dt_run_control = 60.0_wp                      !< namelist parameter
     REAL(wp) ::  dt_spinup = 60.0_wp                           !< namelist parameter
+    REAL(wp) ::  dt_write_agent_data = 9999999.9_wp            !< namelist parameter
     REAL(wp) ::  dt_3d = 0.01_wp                               !< time step
     REAL(wp) ::  dz_max = 1000.0_wp                            !< namelist parameter
Index: palm/trunk/SOURCE/multi_agent_system_mod.f90
===================================================================
--- palm/trunk/SOURCE/multi_agent_system_mod.f90	(revision 3159)
+++ palm/trunk/SOURCE/multi_agent_system_mod.f90	(revision 3159)
@@ -0,0 +1,4524 @@
+!> @file multi_agent_system_mod.f90
+!--------------------------------------------------------------------------------!
+! This file is part of PALM-4U.
+!
+! PALM-4U is free software: you can redistribute it and/or modify it under the 
+! terms of the GNU General Public License as published by the Free Software 
+! Foundation, either version 3 of the License, or (at your option) any later 
+! version.
+!
+! PALM-4U is distributed in the hope that it will be useful, but WITHOUT ANY
+! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along with
+! PALM. If not, see <http://www.gnu.org/licenses/>.
+!
+! Copyright 2016 Leibniz Universitaet Hannover
+!------------------------------------------------------------------------------!
+!
+! Current revisions:
+! ------------------
+! 
+! 
+! Former revisions:
+! -----------------
+! $Id$
+! Initial revision
+!
+! 
+!
+! Authors:
+! --------
+! @author sward
+!
+!
+! Description:
+! ------------
+!> Multi Agent System for the simulation of pedestrian movement in urban
+!> environments
+!------------------------------------------------------------------------------!
+ MODULE multi_agent_system_mod
+
+    USE, INTRINSIC ::  ISO_C_BINDING
+
+    USE constants,                                                             &
+        ONLY:  pi
+
+    USE control_parameters,                                                    &
+        ONLY:  dt_3d, message_string, simulated_time, dt_write_agent_data
+
+    USE cpulog,                                                                &
+        ONLY:  cpu_log, log_point, log_point_s
+
+    USE grid_variables,                                                        &
+        ONLY:  ddx, ddy, dx, dy
+
+    USE indices,                                                               &
+        ONLY:  nx, nxl, nxlg, nxr, nxrg, ny, nyn, nyng, nys, nysg, nzb,        &
+               wall_flags_0
+
+    USE random_function_mod,                                                   &
+        ONLY:  random_function
+
+    USE kinds
+
+    USE pegrid
+
+    CHARACTER(LEN=15) ::  bc_mas_lr = 'absorb'  !< left/right boundary condition
+    CHARACTER(LEN=15) ::  bc_mas_ns = 'absorb'  !< north/south boundary condition
+
+    INTEGER(iwp) ::  deleted_agents = 0          !< number of deleted agents per time step 
+    INTEGER(iwp) ::  heap_count                  !< number of items in binary heap (for pathfinding)
+    INTEGER(iwp) ::  ibc_mas_lr                  !< agent left/right boundary condition dummy
+    INTEGER(iwp) ::  ibc_mas_ns                  !< agent north/south boundary condition dummy
+    INTEGER(iwp) ::  ind_pm10 = -9               !< chemical species index of PM10
+    INTEGER(iwp) ::  ind_pm25 = -9               !< chemical species index of PM2.5
+    INTEGER(iwp) ::  iran_agent = -1234567       !< number for random generator
+    INTEGER(iwp) ::  min_nr_agent = 2            !< namelist parameter (see documentation)
+    INTEGER(iwp) ::  ghla_count_recv             !< number of agents in left ghost layer
+    INTEGER(iwp) ::  ghna_count_recv             !< number of agents in north ghost layer
+    INTEGER(iwp) ::  ghra_count_recv             !< number of agents in right ghost layer
+    INTEGER(iwp) ::  ghsa_count_recv             !< number of agents in south ghost layer
+    INTEGER(iwp) ::  nr_move_north               !< number of agts to move north during exchange_horiz
+    INTEGER(iwp) ::  nr_move_south               !< number of agts to move south during exchange_horiz
+    INTEGER(iwp) ::  number_of_agents = 0        !< number of agents for each grid box (3d array is saved on agt_count)
+    INTEGER(iwp) ::  number_of_agent_groups = 1  !< namelist parameter (see documentation)
+    INTEGER(iwp) ::  sort_count_mas = 0          !< counter for sorting agents
+    INTEGER(iwp) ::  step_dealloc_mas = 100      !< namelist parameter (see documentation)
+    INTEGER(iwp) ::  total_number_of_agents      !< total number of agents in the whole model domain
+
+    INTEGER(iwp), PARAMETER ::  NR_2_direction_move = 10000 !< parameter for agent exchange
+    INTEGER(iwp), PARAMETER ::  PHASE_INIT    = 1           !< phase parameter
+    INTEGER(iwp), PARAMETER ::  PHASE_RELEASE = 2           !< phase parameter
+
+    INTEGER(iwp), PARAMETER ::  max_number_of_agent_groups = 100 !< maximum allowed number of agent groups
+
+    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  agt_count  !< 3d array of number of agents of every grid box
+    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  s_measure_height  !< k-index(s-grid) for measurement
+    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  top_top_s  !< k-index of first s-gridpoint above topography
+    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  top_top_w  !< k-index of first v-gridpoint above topography
+    INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE ::  obstacle_flags  !< flags to identify corners and edges of topography that cannot be crossed by agents
+
+    LOGICAL ::  deallocate_memory_mas = .TRUE.         !< namelist parameter (see documentation)
+    LOGICAL ::  dt_3d_reached_mas                      !< flag: agent timestep has reached model timestep
+    LOGICAL ::  dt_3d_reached_l_mas                    !< flag: agent timestep has reached model timestep
+    LOGICAL ::  agents_active = .FALSE.                !< flag for agent system
+    LOGICAL ::  random_start_position_agents = .TRUE.  !< namelist parameter (see documentation)
+    LOGICAL ::  read_agents_from_restartfile = .TRUE.  !< namelist parameter (see documentation)
+    LOGICAL ::  agent_own_timestep = .FALSE.           !< namelist parameter (see documentation)
+
+    LOGICAL, DIMENSION(max_number_of_agent_groups) ::  a_rand_target = .FALSE. !< namelist parameter (see documentation)
+
+    REAL(wp) ::  agent_maximum_age = 9999999.9_wp    !< namelist parameter (see documentation)
+    REAL(wp) ::  alloc_factor_mas = 20.0_wp          !< namelist parameter (see documentation)
+    REAL(wp) ::  coll_t_0 = 3.                       !< namelist parameter (see documentation)
+    REAL(wp) ::  corner_gate_start = 0.7_wp          !< namelist parameter (see documentation)
+    REAL(wp) ::  corner_gate_width = 1.0_wp          !< namelist parameter (see documentation)    
+    REAL(wp) ::  d_sigma_rep_agent                   !< inverse of sigma_rep_agent
+    REAL(wp) ::  d_sigma_rep_wall                    !< inverse of sigma_rep_wall
+    REAL(wp) ::  d_tau_accel_agent                   !< inverse of tau_accel_agent
+    REAL(wp) ::  desired_speed = 1.2_wp              !< namelist parameter (see documentation)
+    REAL(wp) ::  des_sp_sig = .2_wp                  !< namelist parameter (see documentation)
+    REAL(wp) ::  dist_target_reached = 2.0_wp        !< distance at which target counts as reached
+    REAL(wp) ::  dist_to_int_target = .75_wp         !< namelist parameter (see documentation)
+    REAL(wp) ::  d_sqrt_2 = 1.0_wp/SQRT(2.)          !< 1/sqrt(2)
+    REAL(wp) ::  dt_agent = 0.016_wp                 !< namelist parameter (see documentation)
+    REAL(wp) ::  dt_arel = 9999999.9_wp              !< namelist parameter (see documentation)
+    REAL(wp) ::  end_time_arel = 9999999.9_wp        !< namelist parameter (see documentation)
+    REAL(wp) ::  force_x                             !< dummy value for force on current agent in x-direction
+    REAL(wp) ::  force_y                             !< dummy value for force on current agent in y-direction
+    REAL(wp) ::  max_dist_from_path = 1.0_wp         !< distance from current path at which a new path is calculated
+    REAL(wp) ::  multi_agent_system_start = 0.0_wp   !< namelist parameter (see documentation)
+    REAL(wp) ::  radius_agent = .2_wp                !< namelist parameter (see documentation)
+    REAL(wp) ::  repuls_agent = 1.5_wp               !< namelist parameter (see documentation)
+    REAL(wp) ::  repuls_wall = 7.0_wp                !< namelist parameter (see documentation)
+    REAL(wp) ::  scan_radius_agent = 3.0_wp          !< namelist parameter (see documentation)
+    REAL(wp) ::  scan_radius_wall = 2.0_wp           !< namelist parameter (see documentation)
+    REAL(wp) ::  sigma_rep_agent = 0.3_wp            !< namelist parameter (see documentation)
+    REAL(wp) ::  sigma_rep_wall = 0.2_wp             !< namelist parameter (see documentation)
+    REAL(wp) ::  tau_accel_agent = 0.5_wp            !< namelist parameter (see documentation)
+    REAL(wp) ::  time_arel = 0.0_wp                  !< time for agent release
+    REAL(wp) ::  time_write_agent_data = 0.0_wp      !< write agent data at current time on file
+    REAL(wp) ::  v_max_agent = 1.3_wp                !< namelist parameter (see documentation)
+    
+
+    REAL(wp), DIMENSION(max_number_of_agent_groups) ::  adx = 9999999.9_wp  !< namelist parameter (see documentation)
+    REAL(wp), DIMENSION(max_number_of_agent_groups) ::  ady = 9999999.9_wp  !< namelist parameter (see documentation)
+    REAL(wp), DIMENSION(max_number_of_agent_groups) ::  asl = 9999999.9_wp  !< namelist parameter (see documentation)
+    REAL(wp), DIMENSION(max_number_of_agent_groups) ::  asn = 9999999.9_wp  !< namelist parameter (see documentation)
+    REAL(wp), DIMENSION(max_number_of_agent_groups) ::  asr = 9999999.9_wp  !< namelist parameter (see documentation)
+    REAL(wp), DIMENSION(max_number_of_agent_groups) ::  ass = 9999999.9_wp  !< namelist parameter (see documentation)
+    REAL(wp), DIMENSION(max_number_of_agent_groups) ::  at_x = 9999999.9_wp !< namelist parameter (see documentation)
+    REAL(wp), DIMENSION(max_number_of_agent_groups) ::  at_y = 9999999.9_wp !< namelist parameter (see documentation)
+!
+!-- Type for the definition of an agent
+    TYPE agent_type
+        INTEGER(iwp) ::  block_nr            !< number for sorting
+        INTEGER(iwp) ::  group               !< number of agent group
+        INTEGER(idp) ::  id                  !< particle ID (64 bit integer)
+        INTEGER(iwp) ::  path_counter        !< current target along path (path_x/y)
+        LOGICAL      ::  agent_mask          !< if this parameter is set to false the agent will be deleted
+        REAL(wp)     ::  age                 !< age of agent
+        REAL(wp)     ::  age_m               !< age of agent
+        REAL(wp)     ::  dt_sum              !< sum of agents subtimesteps
+        REAL(wp)     ::  clo                 !< clothing index
+        REAL(wp)     ::  energy_storage      !< energy stored by agent
+        REAL(wp)     ::  force_x             !< force term x-direction
+        REAL(wp)     ::  force_y             !< force term y-direction
+        REAL(wp)     ::  origin_x            !< origin x-position of agent
+        REAL(wp)     ::  origin_y            !< origin y-position of agent
+        REAL(wp)     ::  pm10                !< PM10 concentration at agent position
+        REAL(wp)     ::  pm25                !< PM25 concentration at agent position
+        REAL(wp)     ::  speed_abs           !< absolute value of agent speed
+        REAL(wp)     ::  speed_e_x           !< normalized speed of agent in x
+        REAL(wp)     ::  speed_e_y           !< normalized speed of agent in y
+        REAL(wp)     ::  speed_des           !< agent's desired speed
+        REAL(wp)     ::  speed_x             !< speed of agent in x
+        REAL(wp)     ::  speed_y             !< speed of agent in y
+        REAL(wp)     ::  thermal_index       !< the dynamic thermal index
+        REAL(wp)     ::  windspeed           !< absolute value of windspeed at agent position
+        REAL(wp)     ::  x                   !< x-position
+        REAL(wp)     ::  y                   !< y-position
+        REAL(wp)     ::  t                   !< temperature
+        REAL(wp)     ::  t_x                 !< x-position
+        REAL(wp)     ::  t_y                 !< y-position
+        REAL(wp), DIMENSION(0:15) ::  path_x !< agent path to target (x)
+        REAL(wp), DIMENSION(0:15) ::  path_y !< agent path to target (y)
+    END TYPE agent_type
+
+    TYPE(agent_type), DIMENSION(:), POINTER ::  agents       !< Agent array for this grid cell
+    TYPE(agent_type)                        ::  zero_agent   !< zero agent to avoid weird thing
+    TYPE(agent_type), DIMENSION(:), ALLOCATABLE ::  move_also_north !< for agent exchange between PEs
+    TYPE(agent_type), DIMENSION(:), ALLOCATABLE ::  move_also_south !< for agent exchange between PEs
+    TYPE(agent_type), DIMENSION(:), ALLOCATABLE ::  agt_gh_l !< ghost layer left of pe domain
+    TYPE(agent_type), DIMENSION(:), ALLOCATABLE ::  agt_gh_n !< ghost layer north of pe domain
+    TYPE(agent_type), DIMENSION(:), ALLOCATABLE ::  agt_gh_r !< ghost layer right of pe domain
+    TYPE(agent_type), DIMENSION(:), ALLOCATABLE ::  agt_gh_s !< ghost layer south of pe domain
+!
+!-- Type for 2D grid on which agents are stored
+    TYPE  grid_agent_def
+        INTEGER(iwp), DIMENSION(0:3)            ::  start_index        !< start agent index for current block
+        INTEGER(iwp), DIMENSION(0:3)            ::  end_index          !< end agent index for current block
+        INTEGER(iwp)                            ::  id_counter         !< agent id counter (removeable?)
+        LOGICAL                                 ::  time_loop_done     !< timestep loop for agent advection
+        TYPE(agent_type), POINTER, DIMENSION(:) ::  agents          !< Particle array for this grid cell
+    END TYPE grid_agent_def
+
+    TYPE(grid_agent_def), DIMENSION(:,:), ALLOCATABLE, TARGET ::  grid_agents !< 2D grid on which agents are stored
+!
+!-- Item in a priority queue (binary heap)
+    TYPE heap_item
+       INTEGER(iwp) ::  mesh_id       !< id of the submitted mesh point
+       REAL(wp)     ::  priority      !< priority of the mesh point (= distance so far + heuristic to goal)
+    END TYPE heap_item
+
+    TYPE(heap_item), DIMENSION(:), ALLOCATABLE ::  queue  !< priority queue realized as binary heap
+!
+!-- Type for mesh point in visibility graph
+    TYPE  mesh_point
+        INTEGER(iwp)                            ::  polygon_id          !< Polygon the point belongs to
+        INTEGER(iwp)                            ::  vertex_id           !< Vertex in the polygon
+        INTEGER(iwp)                            ::  noc                 !< number of connections
+        INTEGER(iwp)                            ::  origin_id           !< ID of previous mesh point on path (A*)
+        INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  connected_vertices  !< Index of connected vertices
+        REAL(wp)                                ::  cost_so_far         !< Cost to reach this mesh point (A*)
+        REAL(wp)                                ::  x                   !< x-coordinate
+        REAL(wp)                                ::  y                   !< y-coordinate
+        REAL(wp)                                ::  x_s                 !< corner shifted outward from building by 1m (x)
+        REAL(wp)                                ::  y_s                 !< corner shifted outward from building by 1m (y)
+        REAL(wp), DIMENSION(:), ALLOCATABLE     ::  distance_to_vertex  !< Distance to each vertex
+    END TYPE mesh_point
+
+    TYPE(mesh_point), DIMENSION(:), ALLOCATABLE ::  mesh     !< navigation mesh
+    TYPE(mesh_point), DIMENSION(:), ALLOCATABLE ::  tmp_mesh !< temporary navigation mesh
+!
+!-- Vertex of a polygon
+    TYPE  vertex_type
+        LOGICAL               ::  delete  !< Flag to mark vertex for deletion
+        REAL(wp)              ::  x       !< x-coordinate
+        REAL(wp)              ::  y       !< y-coordinate
+    END TYPE vertex_type
+!
+!-- Polygon containing a number of vertices
+    TYPE  polygon_type
+        INTEGER(iwp)                                 ::  nov       !< Number of vertices in this polygon
+        TYPE(vertex_type), DIMENSION(:), ALLOCATABLE ::  vertices  !< Array of vertices
+    END TYPE polygon_type
+
+    TYPE(polygon_type), DIMENSION(:), ALLOCATABLE ::  polygons  !< Building data in polygon form
+
+    SAVE
+
+    PRIVATE
+!
+!-- Public functions
+    PUBLIC mas_init, mas_parin, multi_agent_system
+
+!
+!-- Public parameters, constants and initial values
+    PUBLIC agents_active, multi_agent_system_start
+
+    INTERFACE mas_parin
+       MODULE PROCEDURE mas_parin
+    END INTERFACE mas_parin
+
+    INTERFACE mas_init
+       MODULE PROCEDURE mas_init
+    END INTERFACE mas_init
+
+    INTERFACE multi_agent_system
+       MODULE PROCEDURE multi_agent_system
+    END INTERFACE multi_agent_system
+
+    CONTAINS
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Multi Agent System:
+!> executes a number of agents sub-timesteps until the model timestep is reached.
+!> The agent timestep is usually smaller than the model timestep
+!------------------------------------------------------------------------------!
+ SUBROUTINE multi_agent_system
+
+!     USE htcm_mod,                                                              &
+!         ONLY:  htcm_dynamic
+
+    IMPLICIT NONE
+
+    INTEGER(iwp)       ::  i                  !< counter
+    INTEGER(iwp)       ::  ie                 !< counter
+    INTEGER(iwp)       ::  is                 !< counter
+    INTEGER(iwp)       ::  j                  !< counter
+    INTEGER(iwp)       ::  je                 !< counter
+    INTEGER(iwp)       ::  js                 !< counter
+    INTEGER(iwp), SAVE ::  mas_count = 0      !< counts the mas-calls
+
+    LOGICAL ::  first_loop_stride   !< flag for first loop stride of agent sub-timesteps
+    LOGICAL ::  first_call = .TRUE. !< first call of mas flag for output
+
+    CALL cpu_log( log_point(9), 'mas', 'start' )
+!
+!-- Initialize variables for the next (sub-) timestep, i.e., for marking
+!-- those agents to be deleted after the timestep
+    deleted_agents = 0
+!
+!-- If necessary, release new set of agents
+    IF ( time_arel >= dt_arel  .AND.  end_time_arel > simulated_time )  THEN
+
+       CALL mas_create_agent(PHASE_RELEASE)
+!
+!--    The MOD function allows for changes in the output interval with
+!--    restart runs.
+       time_arel = MOD( time_arel, MAX( dt_arel, dt_3d ) )
+
+    ENDIF
+
+    first_loop_stride = .TRUE.
+    grid_agents(:,:)%time_loop_done = .TRUE.
+!
+!-- Set timestep variable
+    IF ( .NOT. agent_own_timestep ) dt_agent = dt_3d
+!
+!-- Timestep loop for agent transport.
+!-- This loop has to be repeated until the transport time of every agent
+!-- (within the total domain!) has reached the LES timestep (dt_3d).
+!-- Timestep scheme is Euler-forward
+    DO
+!
+!--    Write agent data at current time on file.
+       time_write_agent_data = time_write_agent_data + dt_agent
+       IF ( time_write_agent_data >= dt_write_agent_data )  THEN
+#if defined( __netcdf )
+          IF ( first_loop_stride ) CALL mas_get_prognostic_quantities
+          CALL mas_data_output_agents ( first_call )
+#else
+          WRITE( message_string, * ) 'NetCDF is needed for agent output. ',    &
+                                     'Set __netcdf in compiler options'
+          CALL message( 'multi_agent_system', 'PA0071', 1, 2, 0, 6, 0 )
+#endif
+          IF(first_call) first_call = .FALSE.
+          time_write_agent_data = time_write_agent_data - dt_write_agent_data
+       ENDIF
+!
+!--    Start logging
+       CALL cpu_log( log_point_s(9), 'mas_transport', 'start' )
+       CALL cpu_log( log_point_s(9), 'mas_transport', 'pause' )
+       CALL cpu_log( log_point_s(16), 'mas_other_agents', 'start' )
+       CALL cpu_log( log_point_s(16), 'mas_other_agents', 'pause' )
+!
+!--    Flag is true by default, will be set to false if an agent has not yet
+!--    reached the model timestep
+       grid_agents(:,:)%time_loop_done = .TRUE.
+
+!
+!--    First part of agent transport:
+!--    Evaluate social forces for all agents at current positions
+       DO  i = nxl, nxr
+          DO  j = nys, nyn
+
+             number_of_agents = agt_count(j,i)
+!
+!--          If grid cell is empty, cycle
+             IF ( number_of_agents <= 0 ) CYCLE
+
+             agents => grid_agents(j,i)%agents(1:number_of_agents)
+!
+!--          Evaluation of social forces
+             CALL mas_timestep_forces_call(i,j)
+
+          ENDDO
+       ENDDO
+!
+!--    Second part of agent transport:
+!--    timestep
+       DO  i = nxl, nxr
+          DO  j = nys, nyn
+
+             number_of_agents = agt_count(j,i)
+!
+!--          If grid cell is empty, flag must be true
+             IF ( number_of_agents <= 0 )  THEN
+                grid_agents(j,i)%time_loop_done = .TRUE.
+                CYCLE
+             ENDIF
+
+             agents => grid_agents(j,i)%agents(1:number_of_agents)
+
+             agents(1:number_of_agents)%agent_mask = .TRUE.
+!
+!--          Initialize the variable storing the total time that an agent
+!--          has advanced within the timestep procedure
+             IF ( first_loop_stride )  THEN
+                agents(1:number_of_agents)%dt_sum = 0.0_wp
+             ENDIF
+!
+!--          Initialize the switch used for the loop exit condition checked
+!--          at the end of this loop. If at least one agent has failed to
+!--          reach the LES timestep, this switch will be set false in 
+!--          mas_transport.
+             dt_3d_reached_l_mas = .TRUE.
+!
+!--          Timestep
+             CALL mas_timestep
+!
+!--          Delete agents that have been simulated longer than allowed
+             CALL mas_boundary_conds( 'max_sim_time' )
+!
+!--          Delete agents that have reached target area
+             CALL mas_boundary_conds( 'target_area' )
+!
+!---         If not all agents of the actual grid cell have reached the 
+!--          LES timestep, this cell has to to another loop iteration. Due to
+!--          the fact that agents can move into neighboring grid cell, 
+!--          these neighbor cells also have to perform another loop iteration
+             IF ( .NOT. dt_3d_reached_l_mas )  THEN
+                js = MAX(nys,j-1)
+                je = MIN(nyn,j+1)
+                is = MAX(nxl,i-1)
+                ie = MIN(nxr,i+1)
+                grid_agents(js:je,is:ie)%time_loop_done = .FALSE.
+             ENDIF
+
+          ENDDO
+       ENDDO
+
+!
+!--    Find out, if all agents on every PE have completed the LES timestep
+!--    and set the switch corespondingly
+       dt_3d_reached_l_mas = ALL(grid_agents(:,:)%time_loop_done)
+#if defined( __parallel )
+       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
+       CALL MPI_ALLREDUCE( dt_3d_reached_l_mas, dt_3d_reached_mas, 1, MPI_LOGICAL, &
+                           MPI_LAND, comm2d, ierr )
+#else
+       dt_3d_reached_mas = dt_3d_reached_l_mas
+#endif
+
+       CALL cpu_log( log_point_s(9), 'mas_transport', 'stop' )
+       CALL cpu_log( log_point_s(16), 'mas_other_agents', 'stop' )
+!
+!--    Increment time since last release
+       IF ( dt_3d_reached_mas )  time_arel = time_arel + dt_3d
+
+!
+!--    Move Agents local to PE to a different grid cell
+       CALL mas_eh_move_agent
+!
+!--    Horizontal boundary conditions including exchange between subdmains
+       CALL mas_eh_exchange_horiz
+!
+!--    Pack agents (eliminate those marked for deletion),
+!--    determine new number of agents
+       CALL mas_ps_sort_in_subboxes
+!
+!--    Initialize variables for the next (sub-) timestep, i.e., for marking
+!--    those agents to be deleted after the timestep
+       deleted_agents = 0
+!
+!--    to be included here: call of human thermal comfort mod (and UV exposure)
+!        DO  i = nxl, nxr
+!           DO  j = nys, nyn
+! 
+!              number_of_agents = agt_count(j,i)
+! !
+! !--          If grid cell gets empty, cycle
+!              IF ( number_of_agents <= 0 ) CYCLE
+! 
+!              agents => grid_agents(j,i)%agents(1:number_of_agents)
+! !
+! !--          Evaluation of social forces
+!              CALL htcm_dynamic(i,j)
+! 
+!           ENDDO
+!        ENDDO
+
+       IF ( dt_3d_reached_mas )  EXIT
+
+       first_loop_stride = .FALSE.
+    ENDDO   ! timestep loop
+
+!
+!-- Deallocate unused memory
+    IF ( deallocate_memory_mas  .AND.  mas_count == step_dealloc_mas )  THEN
+       CALL mas_eh_dealloc_agents_array
+       mas_count = 0
+    ELSEIF ( deallocate_memory_mas )  THEN
+       mas_count = mas_count + 1
+    ENDIF
+
+    CALL cpu_log( log_point(9), 'mas', 'stop' )
+
+ END SUBROUTINE multi_agent_system
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Calculation of the direction vector from each agent to its current
+!> intermittent target
+!------------------------------------------------------------------------------!
+    SUBROUTINE mas_agent_direction
+
+       IMPLICIT NONE
+
+       LOGICAL ::  path_flag !< true if new path must be calculated
+
+       INTEGER(iwp) ::  n  !< loop variable over all agents in a grid box
+       INTEGER(iwp) ::  pc !< agent path counter
+
+       REAL(wp) ::  abs_dir         !< length of direction vector (for normalization)
+       REAL(wp) ::  d_curr_target   !< rounding influence expressed as x speed component
+       REAL(wp) ::  d_prev_target   !< rounding influence expressed as x speed component
+       REAL(wp) ::  dir_x           !< direction of agent (x)
+       REAL(wp) ::  dir_y           !< direction of agent (y)
+       REAL(wp) ::  dist_round = 3. !< distance at which agents start rounding a corner
+       REAL(wp) ::  dtit            !< distance to intermittent target
+       REAL(wp) ::  round_fac  = .2 !< factor for rounding influence
+       REAL(wp) ::  speed_round_x   !< rounding influence expressed as x speed component
+       REAL(wp) ::  speed_round_y   !< rounding influence expressed as x speed component
+
+       CALL cpu_log( log_point_s(9), 'mas_transport', 'continue' )
+!
+!--    loop over all agents in the current grid box
+       DO n = 1, number_of_agents
+          path_flag = .FALSE.
+          pc = agents(n)%path_counter
+!
+!--       If no path was calculated for agent yet, do it
+          IF ( pc >= 999 ) THEN
+
+             agents(n)%path_x(0) = agents(n)%origin_x
+             agents(n)%path_y(0) = agents(n)%origin_y
+             CALL mas_nav_find_path(n)
+             pc = agents(n)%path_counter
+!
+!--       Check if new path must be calculated and if so, do it
+          ELSE
+!
+!--          Case one: Agent has come close enough to intermittent target.
+!--                    -> chose new int target and calculate rest of path if no
+!--                       new intermittent targets are left
+             dtit = SQRT((agents(n)%x - agents(n)%path_x(pc))**2               &
+                       + (agents(n)%y - agents(n)%path_y(pc))**2)
+             IF ( dtit < dist_to_int_target ) THEN
+                agents(n)%path_counter = agents(n)%path_counter + 1
+                pc = agents(n)%path_counter
+!
+!--             Path counter out of scope (each agent can store a maximum of 15
+!--             intermittent targets on the way to her final target); new path
+!--             must be calculated
+                IF ( pc >= SIZE(agents(n)%path_x) ) THEN
+                   path_flag = .TRUE.
+                ENDIF
+!
+!--          Case two: Agent too far from path 
+!--                    -> set flag for new path to be calculated
+             ELSEIF ( dist_point_to_edge(agents(n)%path_x(pc-1),               &
+                                         agents(n)%path_y(pc-1),               &
+                                         agents(n)%path_x(pc),                 &
+                                         agents(n)%path_y(pc),                 &
+                                         agents(n)%x, agents(n)%y)             &
+                      > max_dist_from_path )                                   &
+             THEN
+                path_flag = .TRUE.
+             ENDIF
+!
+!--          If either of the above two cases was true, calculate new path and 
+!--          reset 0th path point. This point (the last target the agent had)
+!--          is needed for the agents rounding of corners and the calculation
+!--          of her deviation from her current path
+             IF ( path_flag ) THEN
+                agents(n)%path_x(0) = agents(n)%path_x(pc-1)
+                agents(n)%path_y(0) = agents(n)%path_y(pc-1)
+                CALL mas_nav_find_path(n)
+                pc = agents(n)%path_counter
+             ENDIF
+          ENDIF
+!
+!--       Normalize direction vector
+          abs_dir             = 1.0d-12
+          dir_x               = agents(n)%path_x(pc) - agents(n)%x
+          dir_y               = agents(n)%path_y(pc) - agents(n)%y
+          abs_dir             = SQRT(dir_x**2 + dir_y**2)+1.0d-12
+!--         needed later for corner rounding
+!           dir_x               = dir_x/abs_dir
+!           dir_y               = dir_y/abs_dir
+!           dir_x               = dir_x + speed_round_x
+!           dir_y               = dir_y + speed_round_y
+!           abs_dir             = SQRT(dir_x**2 + dir_y**2)+1.0d-12
+          agents(n)%speed_e_x = dir_x/abs_dir
+          agents(n)%speed_e_y = dir_y/abs_dir
+       ENDDO
+
+       CALL cpu_log( log_point_s(9), 'mas_transport', 'pause' )
+!
+!-- corner rounding; to be added
+!
+!--       Calculate direction change due to rounding of corners
+
+!           speed_round_x = 0.
+!           speed_round_y = 0.
+!           
+!           d_curr_target = SQRT( (agents(n)%path_x(pc) - agents(n)%x)**2 +      &
+!                                 (agents(n)%path_y(pc) - agents(n)%y)**2 )
+!           d_prev_target = SQRT( (agents(n)%path_x(pc-1) - agents(n)%x)**2 +    &
+!                                 (agents(n)%path_y(pc-1) - agents(n)%y)**2 )
+! !
+! !--       Agent is close to next target and that target is not the final one
+!           IF ( d_curr_target < dist_round .AND. dist_round <                   &
+!                           SQRT( (agents(n)%path_x(pc) - agents(n)%t_x)**2 +    &
+!                                 (agents(n)%path_y(pc) - agents(n)%t_y)**2 ) )  &
+!           THEN
+!              speed_round_x = (agents(n)%path_x(pc+1) - agents(n)%path_x(pc)) / &
+!                              ABS( agents(n)%path_x(pc)                         &
+!                                 - agents(n)%path_x(pc+1)) * round_fac *        &
+!                              SIN( pi/dist_round*d_curr_target )
+!              speed_round_y = (agents(n)%path_y(pc+1) - agents(n)%path_y(pc)) / &
+!                              ABS( agents(n)%path_y(pc)                         &
+!                                 - agents(n)%path_y(pc+1)) * round_fac *        &
+!                              SIN( pi/dist_round*d_curr_target )
+!           ENDIF
+! 
+!           IF ( d_prev_target < dist_round ) THEN
+!              IF ( agents(n)%path_x(pc) /= agents(n)%path_x(pc+1) ) THEN
+!                 speed_round_x = speed_round_x +                                   &
+!                                 (agents(n)%path_x(pc) - agents(n)%path_x(pc+1)) / &
+!                                 ABS( agents(n)%path_x(pc)                         &
+!                                    - agents(n)%path_x(pc+1)) * round_fac *        &
+!                                 SIN( pi/dist_round*d_prev_target )
+!              ENDIF
+!              
+!              IF ( agents(n)%path_y(pc) /= agents(n)%path_y(pc+1) ) THEN
+!                 speed_round_y = speed_round_y +                                   &
+!                              (agents(n)%path_y(pc) - agents(n)%path_y(pc+1)) / &
+!                              ABS( agents(n)%path_y(pc)                         &
+!                                 - agents(n)%path_y(pc+1)) * round_fac *        &
+!                              SIN( pi/dist_round*d_prev_target )
+!              ENDIF
+             
+!           ENDIF
+
+
+    END SUBROUTINE mas_agent_direction
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Boundary conditions for maximum time, target reached and out of domain
+!------------------------------------------------------------------------------!
+    SUBROUTINE mas_boundary_conds( location )
+
+       IMPLICIT NONE
+
+       CHARACTER (LEN=*) ::  location !< Identifier
+
+       INTEGER(iwp) ::  n   !< agent number
+       INTEGER(iwp) ::  grp !< agent group
+
+       REAL(wp) ::  dist_to_target !< distance to target
+
+       IF ( location == 'max_sim_time' )  THEN
+
+!
+!--       Delete agents that have been simulated longer than allowed
+          DO  n = 1, number_of_agents
+
+             IF ( agents(n)%age > agent_maximum_age  .AND.                     &
+                  agents(n)%agent_mask )                                       &
+             THEN
+                agents(n)%agent_mask  = .FALSE.
+                deleted_agents = deleted_agents + 1
+             ENDIF
+
+          ENDDO
+       ENDIF
+
+       IF ( location == 'target_area' )  THEN
+
+!
+!--       Delete agents that entered target region
+          DO  n = 1, number_of_agents
+             grp = agents(n)%group
+             dist_to_target = SQRT((agents(n)%x-at_x(grp))**2                  &
+                                 + (agents(n)%y-at_y(grp))**2)
+             IF ( dist_to_target < dist_target_reached ) THEN
+                agents(n)%agent_mask  = .FALSE.
+                deleted_agents = deleted_agents + 1
+             ENDIF
+
+          ENDDO
+       ENDIF
+
+    END SUBROUTINE mas_boundary_conds
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Release new agents at their respective sources
+!------------------------------------------------------------------------------!
+    SUBROUTINE mas_create_agent (phase)
+
+       IMPLICIT  NONE
+
+       INTEGER(iwp) ::  alloc_size  !< relative increase of allocated memory for agents
+       INTEGER(iwp) ::  i           !< loop variable ( agent groups )
+       INTEGER(iwp) ::  ip          !< index variable along x
+       INTEGER(iwp) ::  j           !< loop variable ( agents per point )
+       INTEGER(iwp) ::  jp          !< index variable along y
+       INTEGER(iwp) ::  loop_stride !< loop variable for initialization
+       INTEGER(iwp) ::  n           !< loop variable ( number of agents )
+       INTEGER(iwp) ::  new_size    !< new size of allocated memory for agents
+       INTEGER(iwp) ::  rn_side     !< index of agent path
+
+       INTEGER(iwp), INTENT(IN) ::  phase       !< mode of inititialization
+
+       INTEGER(iwp), DIMENSION(nysg:nyng,nxlg:nxrg) ::  local_count !< start address of new agent
+       INTEGER(iwp), DIMENSION(nysg:nyng,nxlg:nxrg) ::  local_start !< start address of new agent
+
+       LOGICAL ::  first_stride !< flag for initialization
+
+       REAL(wp) ::  pos_x       !< increment for agent position in x
+       REAL(wp) ::  pos_y       !< increment for agent position in y
+       REAL(wp) ::  rand_contr  !< dummy argument for random position
+       REAL(wp) ::  rn_side_dum !< index of agent path
+
+       TYPE(agent_type),TARGET ::  tmp_agent !< temporary agent used for initialization
+
+!
+!--    Calculate agent positions and store agent attributes, if
+!--    agent is situated on this PE
+       DO  loop_stride = 1, 2
+          first_stride = (loop_stride == 1)
+          IF ( first_stride )   THEN
+             local_count = 0           ! count number of agents
+          ELSE
+             local_count = agt_count   ! Start address of new agents
+          ENDIF
+
+          DO  i = 1, number_of_agent_groups
+
+             pos_y = ass(i)
+
+             DO WHILE ( pos_y <= asn(i) )
+
+                IF ( pos_y >= nys * dy  .AND.                                  &
+                           pos_y <  ( nyn + 1 ) * dy  )                        &
+                THEN
+
+                   pos_x = asl(i)
+
+            xloop: DO WHILE ( pos_x <= asr(i) )
+
+                      IF ( pos_x >= nxl * dx  .AND.                            &
+                                 pos_x <  ( nxr + 1) * dx )                    &
+                      THEN
+
+                         tmp_agent%agent_mask = .TRUE.
+                         tmp_agent%group         = i
+                         tmp_agent%id            = 0_idp
+                         tmp_agent%block_nr      = -1
+                         tmp_agent%path_counter  = 999 !SIZE(tmp_agent%path_x)
+                         tmp_agent%age           = 0.0_wp
+                         tmp_agent%age_m         = 0.0_wp
+                         tmp_agent%dt_sum        = 0.0_wp
+                         tmp_agent%clo           = 99999.0_wp
+                         tmp_agent%energy_storage= 0.0_wp
+                         tmp_agent%force_x       = 0.0_wp
+                         tmp_agent%force_y       = 0.0_wp
+                         tmp_agent%origin_x      = pos_x
+                         tmp_agent%origin_y      = pos_y
+                         tmp_agent%speed_abs     = 0.0_wp
+                         tmp_agent%speed_e_x     = 0.0_wp
+                         tmp_agent%speed_e_y     = 0.0_wp
+                         tmp_agent%speed_des     = random_normal(desired_speed,&
+                                                                 des_sp_sig)
+                         tmp_agent%speed_x       = 0.0_wp
+                         tmp_agent%speed_y       = 0.0_wp
+                         tmp_agent%thermal_index = 99999.0_wp
+                         tmp_agent%x             = pos_x
+                         tmp_agent%y             = pos_y
+                         tmp_agent%path_x        = -1.0_wp
+                         tmp_agent%path_y        = -1.0_wp
+                         tmp_agent%t_x           = - pi
+                         tmp_agent%t_y           = - pi
+!
+!--                      Determine the grid indices of the agent position
+                         ip = tmp_agent%x * ddx
+                         jp = tmp_agent%y * ddy
+!
+!--                      Give each agent its target
+                         IF ( a_rand_target(i) ) THEN
+!
+!--                         Agent shall receive random target just outside 
+!--                         simulated area
+                            rn_side_dum = random_function(iran_agent)
+                            rn_side     = FLOOR(4.*rn_side_dum)
+                            IF ( rn_side < 2 ) THEN
+                               IF ( rn_side == 0 ) THEN
+                                  tmp_agent%t_y = -2*dy
+                               ELSE
+                                  tmp_agent%t_y = (ny+3)*dy
+                               ENDIF
+                               tmp_agent%t_x = random_function(iran_agent) *   &
+                                               (nx+1)*dx
+                            ELSE
+                               IF ( rn_side == 2 ) THEN
+                                  tmp_agent%t_x = -2*dx
+                               ELSE
+                                  tmp_agent%t_x = (nx+3)*dx
+                               ENDIF
+                               tmp_agent%t_y = random_function(iran_agent) *   &
+                                               (ny+1)*dy
+                            ENDIF
+!
+!--                      Agent gets target of her group
+                         ELSE
+                            tmp_agent%t_x = at_x(i)
+                            tmp_agent%t_y = at_y(i)
+                         ENDIF
+
+                         local_count(jp,ip) = local_count(jp,ip) + 1
+
+                         IF ( .NOT. first_stride )  THEN
+                            grid_agents(jp,ip)%agents(local_count(jp,ip))      &
+                                              = tmp_agent
+                         ENDIF
+
+                      ENDIF
+
+                      pos_x = pos_x + adx(i)
+
+                   ENDDO xloop
+
+                ENDIF
+
+                pos_y = pos_y + ady(i)
+
+             ENDDO
+
+          ENDDO
+
+!
+!--       Allocate or reallocate agents array to new size
+          IF ( first_stride )  THEN
+             DO  ip = nxlg, nxrg
+                DO  jp = nysg, nyng
+                   IF ( phase == PHASE_INIT )  THEN
+                      IF ( local_count(jp,ip) > 0 )  THEN
+                         alloc_size = MAX( INT( local_count(jp,ip) *           &
+                            ( 1.0_wp + alloc_factor_mas / 100.0_wp ) ),        &
+                            min_nr_agent )
+                      ELSE
+                         alloc_size = min_nr_agent
+                      ENDIF
+                      ALLOCATE(grid_agents(jp,ip)%agents(1:alloc_size))
+                      DO  n = 1, alloc_size
+                         grid_agents(jp,ip)%agents(n) = zero_agent
+                      ENDDO
+                   ELSEIF ( phase == PHASE_RELEASE )  THEN
+                      IF ( local_count(jp,ip) > 0 )  THEN
+                         new_size   = local_count(jp,ip) + agt_count(jp,ip)
+                         alloc_size = MAX( INT( new_size * ( 1.0_wp +          &
+                            alloc_factor_mas / 100.0_wp ) ), min_nr_agent )
+                         IF( alloc_size > SIZE( grid_agents(jp,ip)%agents) )   &
+                         THEN
+                            CALL mas_eh_realloc_agents_array(ip,jp,alloc_size)
+                         ENDIF
+                      ENDIF
+                   ENDIF
+                ENDDO
+             ENDDO
+          ENDIF
+
+       ENDDO
+
+       local_start = agt_count+1
+       agt_count   = local_count
+
+!
+!--    Calculate agent IDs
+       DO  ip = nxl, nxr
+          DO  jp = nys, nyn
+             number_of_agents = agt_count(jp,ip)
+             IF ( number_of_agents <= 0 )  CYCLE
+             agents => grid_agents(jp,ip)%agents(1:number_of_agents)
+
+             DO  n = local_start(jp,ip), number_of_agents  !only new agents 
+
+                agents(n)%id = 10000_idp**2 * grid_agents(jp,ip)%id_counter +  &
+                               10000_idp * jp + ip
+!
+!--             Count the number of agents that have been released before
+                grid_agents(jp,ip)%id_counter = grid_agents(jp,ip)%id_counter  &
+                                                + 1
+
+             ENDDO
+
+          ENDDO
+       ENDDO
+
+!
+!--    Add random fluctuation to agent positions.
+       IF ( random_start_position_agents )  THEN
+          DO  ip = nxl, nxr
+             DO  jp = nys, nyn
+                number_of_agents = agt_count(jp,ip)
+                IF ( number_of_agents <= 0 )  CYCLE
+                agents => grid_agents(jp,ip)%agents(1:number_of_agents)
+!
+!--             Move only new agents. Moreover, limit random fluctuation 
+!--             in order to prevent that agents move more than one grid box, 
+!--             which would lead to problems concerning agent exchange 
+!--             between processors in case adx/ady are larger than dx/dy, 
+!--             respectively.  
+                DO  n = local_start(jp,ip), number_of_agents
+                   IF ( asl(agents(n)%group) /= asr(agents(n)%group) )  THEN
+                      rand_contr = ( random_function( iran_agent ) - 0.5_wp ) *&
+                                     adx(agents(n)%group)
+                      agents(n)%x = agents(n)%x +                        &
+                              MERGE( rand_contr, SIGN( dx, rand_contr ),       &
+                                     ABS( rand_contr ) < dx                    &
+                                   ) 
+                   ENDIF
+                   IF ( ass(agents(n)%group) /= asn(agents(n)%group) )  THEN
+                      rand_contr = ( random_function( iran_agent ) - 0.5_wp ) *&
+                                     ady(agents(n)%group)
+                      agents(n)%y = agents(n)%y +                        &
+                              MERGE( rand_contr, SIGN( dy, rand_contr ),       &
+                                     ABS( rand_contr ) < dy )
+                   ENDIF
+                ENDDO
+!
+!--             Delete agents that have been simulated longer than allowed
+                CALL mas_boundary_conds( 'max_sim_time' )
+!
+!--             Delete agents that have reached target area
+                CALL mas_boundary_conds( 'target_area' )
+
+             ENDDO
+          ENDDO
+!
+!--       Exchange agents between grid cells and processors
+          CALL mas_eh_move_agent
+          CALL mas_eh_exchange_horiz
+
+       ENDIF
+!
+!--    In case of random_start_position_agents, delete agents identified by 
+!--    mas_eh_exchange_horiz and mas_boundary_conds. Then sort agents into 
+!--    blocks, which is needed for a fast interpolation of the LES fields 
+!--    on the agent position.
+       CALL mas_ps_sort_in_subboxes
+
+!
+!--    Determine the current number of agents
+       number_of_agents = 0
+       DO  ip = nxl, nxr
+          DO  jp = nys, nyn
+             number_of_agents = number_of_agents + agt_count(jp,ip)
+          ENDDO
+       ENDDO
+!
+!--    Calculate the number of agents of the total domain
+#if defined( __parallel )
+       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
+       CALL MPI_ALLREDUCE( number_of_agents, total_number_of_agents, 1, &
+       MPI_INTEGER, MPI_SUM, comm2d, ierr )
+#else
+       total_number_of_agents = number_of_agents
+#endif
+
+       RETURN
+
+    END SUBROUTINE mas_create_agent
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Creates flags that indicate if a gridbox contains edges or corners. These
+!> flags are used for agents to check if obstacles are close to them.
+!------------------------------------------------------------------------------!
+    SUBROUTINE mas_create_obstacle_flags
+
+       USE arrays_3d,                                                          &
+           ONLY:  zw
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  agt_size !< Agent size in bytes
+       INTEGER(iwp) ::  dummy    !< dummy
+       INTEGER(iwp) ::  il
+       INTEGER(iwp) ::  jl
+
+       ALLOCATE(obstacle_flags(nysg:nyng,nxlg:nxrg))
+
+       obstacle_flags = 0
+
+       DO il = nxlg, nxrg
+          DO jl = nysg, nyng
+!
+!--          North edge
+             IF ( jl < nyng ) THEN
+                IF ( ( top_top_s(jl,il) - top_top_s(jl+1,il) ) > 1 .AND.       &
+                     ( zw( top_top_w(jl,il) ) -                                &
+                       zw( top_top_w(jl+1,il) ) ) > .51_wp )                   &
+                THEN
+                   obstacle_flags(jl,il) = IBSET( obstacle_flags(jl,il), 0 )
+                ENDIF
+             ENDIF
+!
+!--          North right corner
+             IF ( jl < nyng .AND. il < nxrg ) THEN
+                IF ( ( top_top_s(jl,il) - top_top_s(jl+1,il) )   > 1 .AND.     &
+                     ( top_top_s(jl,il) - top_top_s(jl+1,il+1) ) > 1 .AND.     &
+                     ( top_top_s(jl,il) - top_top_s(jl,il+1) )   > 1 .AND.     &
+                     ( zw( top_top_w(jl,il) ) -                                &
+                       zw( top_top_w(jl+1,il+1) ) ) > .51_wp )                 &
+                THEN
+                   obstacle_flags(jl,il) = IBSET( obstacle_flags(jl,il), 1 )
+                ENDIF
+             ENDIF
+!
+!--          Right edge
+             IF ( il < nxrg ) THEN
+                IF ( ( top_top_s(jl,il) - top_top_s(jl,il+1) ) > 1 .AND.       &
+                     ( zw( top_top_w(jl,il) ) -                                &
+                       zw( top_top_w(jl,il+1) ) ) > .51_wp )                   &
+                THEN
+                   obstacle_flags(jl,il) = IBSET( obstacle_flags(jl,il), 2 )
+                ENDIF
+             ENDIF
+!
+!--          South right corner
+             IF ( jl > nysg .AND. il < nxrg ) THEN
+                IF ( ( top_top_s(jl,il) - top_top_s(jl,il+1) )   > 1 .AND.     &
+                     ( top_top_s(jl,il) - top_top_s(jl-1,il+1) ) > 1 .AND.     &
+                     ( top_top_s(jl,il) - top_top_s(jl-1,il) )   > 1 .AND.     &
+                     ( zw(top_top_w(jl,il)) -                                  &
+                       zw( top_top_w(jl-1,il+1) ) ) > .51_wp )                 &
+                THEN
+                   obstacle_flags(jl,il) = IBSET( obstacle_flags(jl,il), 3 )
+                ENDIF
+             ENDIF
+!
+!--          South edge
+             IF ( jl > nysg ) THEN
+                IF ( ( top_top_s(jl,il) - top_top_s(jl-1,il) ) > 1 .AND.       &
+                     ( zw( top_top_w(jl,il) ) -                                &
+                       zw( top_top_w(jl-1,il) ) ) > .51_wp )                   &
+                THEN
+                   obstacle_flags(jl,il) = IBSET( obstacle_flags(jl,il), 4 )
+                ENDIF
+             ENDIF
+!
+!--          South left corner
+             IF ( jl > nysg .AND. il > nxlg ) THEN
+                IF ( ( top_top_s(jl,il) - top_top_s(jl-1,il) )   > 1 .AND.     &
+                     ( top_top_s(jl,il) - top_top_s(jl-1,il-1) ) > 1 .AND.     &
+                     ( top_top_s(jl,il) - top_top_s(jl,il-1) )   > 1 .AND.     &
+                     ( zw( top_top_w(jl,il) ) -                                &
+                       zw(top_top_w(jl-1,il-1) ) ) > .51_wp )                  &
+                THEN
+                   obstacle_flags(jl,il) = IBSET( obstacle_flags(jl,il), 5 )
+                ENDIF
+             ENDIF
+!
+!--          Left edge
+             IF ( il > nxlg ) THEN
+                IF ( ( top_top_s(jl,il) - top_top_s(jl,il-1) ) > 1 .AND.       &
+                     ( zw(top_top_w(jl,il) ) -                                 &
+                       zw(top_top_w(jl,il-1) ) ) > .51_wp )                 &
+                THEN
+                   obstacle_flags(jl,il) = IBSET( obstacle_flags(jl,il), 6 )
+                ENDIF
+             ENDIF
+!
+!--          North left corner
+             IF ( jl < nyng .AND. il > nxlg ) THEN
+                IF ( ( top_top_s(jl,il) - top_top_s(jl,il-1) )   > 1 .AND.     &
+                     ( top_top_s(jl,il) - top_top_s(jl+1,il-1) ) > 1 .AND.     &
+                     ( top_top_s(jl,il) - top_top_s(jl+1,il) )   > 1 .AND.     &
+                     ( zw( top_top_w(jl,il) ) -                                &
+                       zw( top_top_w(jl+1,il-1) ) ) > .51_wp )                 &
+                THEN
+                   obstacle_flags(jl,il) = IBSET( obstacle_flags(jl,il), 7 )
+                ENDIF
+             ENDIF
+
+          ENDDO
+       ENDDO
+
+    END SUBROUTINE mas_create_obstacle_flags
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Write agent data in netCDF format 
+!------------------------------------------------------------------------------!
+    SUBROUTINE mas_data_output_agents( ftest )
+
+       USE control_parameters,                                                 &
+           ONLY:  agt_time_count
+
+       USE netcdf_interface,                                                   &
+           ONLY:  nc_stat, id_set_agt, id_var_time_agt, id_var_rnoa_agt,       &
+                  id_var_agt, netcdf_handle_error
+
+       USE pegrid
+
+#if defined( __netcdf )
+       USE NETCDF
+#endif
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  agt_size !< Agent size in bytes
+       INTEGER(iwp) ::  dummy    !< dummy
+       INTEGER(iwp) ::  ip       !< counter (x)
+       INTEGER(iwp) ::  jp       !< counter (y)
+       INTEGER(iwp) ::  n        !< counter (number of PEs)
+       INTEGER(iwp) ::  noa      !< number of agents
+       INTEGER(iwp) ::  noa_rcv  !< received number of agents
+       INTEGER(iwp) ::  out_noa  !< number of agents for output
+       
+       INTEGER(iwp), DIMENSION(0:numprocs-1) ::  noa_arr !< number of agents on each PE
+
+       TYPE(agent_type), DIMENSION(:), ALLOCATABLE, TARGET ::  trf_agents !< all agents on current PE
+       TYPE(agent_type), DIMENSION(:), ALLOCATABLE, TARGET ::  out_agents !< all agents in entire domain
+       LOGICAL, INTENT (INOUT) :: ftest
+
+       CALL cpu_log( log_point_s(17), 'mas_data_output', 'start' )
+!
+!--    Get total number of agents and put all agents on one PE in one array
+       noa = 0
+       DO  ip = nxl, nxr
+          DO  jp = nys, nyn
+             noa  = noa  + agt_count(jp,ip)
+          ENDDO
+       ENDDO
+       IF(noa > 0) THEN
+          ALLOCATE(trf_agents(1:noa))
+          dummy = 1
+          DO  ip = nxl, nxr
+             DO  jp = nys, nyn
+                IF ( agt_count(jp,ip) == 0 ) CYCLE
+                agents => grid_agents(jp,ip)%agents(1:agt_count(jp,ip))
+                trf_agents(dummy:(dummy-1+agt_count(jp,ip))) = agents
+                dummy = dummy + agt_count(jp,ip)
+             ENDDO
+          ENDDO
+       ENDIF
+!
+!--    Gather all agents on PE0 for output
+       CALL MPI_BARRIER( comm2d, ierr )
+       IF ( myid == 0 )  THEN
+          noa_arr(0) = noa
+!
+!--       Receive data from all other PEs.
+          DO  n = 1, numprocs-1
+              CALL MPI_RECV( noa_arr(n), 1, MPI_INTEGER,                       &
+                              n, 0, comm2d, status, ierr )
+          ENDDO
+       ELSE
+          CALL MPI_SEND( noa, 1, MPI_INTEGER, 0, 0, comm2d, ierr )
+       ENDIF
+       CALL MPI_BARRIER( comm2d, ierr )
+       agt_size = C_SIZEOF(zero_agent)
+       IF ( myid == 0 )  THEN
+!
+!--       Receive data from all other PEs.
+          out_noa = SUM(noa_arr)
+          IF ( out_noa > 0 ) THEN
+             ALLOCATE( out_agents(1:out_noa) )
+             IF ( noa > 0 ) THEN
+                out_agents(1:noa) = trf_agents
+             ENDIF
+             noa_rcv = noa
+             DO n = 1, numprocs-1
+                IF ( noa_arr(n) > 0 ) THEN
+                   CALL MPI_RECV( out_agents(noa_rcv+1), noa_arr(n)*agt_size,  &
+                                  MPI_BYTE, n, 0, comm2d, status, ierr )
+                   noa_rcv = noa_rcv + noa_arr(n)
+                ENDIF
+             ENDDO
+          ELSE
+             ALLOCATE( out_agents(1:2) )
+             out_agents = zero_agent
+             out_noa    = 2
+          ENDIF
+       ELSE
+          IF ( noa > 0 ) THEN
+             CALL MPI_SEND( trf_agents(1), noa*agt_size, MPI_BYTE, 0, 0,       &
+                                        comm2d, ierr )
+          ENDIF
+       ENDIF
+!
+!--    A barrier has to be set, because otherwise some PEs may
+!--    proceed too fast so that PE0 may receive wrong data on
+!--    tag 0
+       CALL MPI_BARRIER( comm2d, ierr )
+       IF ( myid == 0 ) THEN
+          agents=>out_agents
+
+
+#if defined( __netcdf )
+
+   !--    Output in netCDF format
+          IF ( ftest ) CALL check_open( 118 )
+
+   !
+   !--    Update the NetCDF time axis
+          agt_time_count = agt_time_count + 1
+
+          nc_stat = NF90_PUT_VAR( id_set_agt, id_var_time_agt, &
+                                  (/ simulated_time /),        &
+                                  start = (/ agt_time_count /), count = (/ 1 /) )
+          CALL netcdf_handle_error( 'mas_data_output_agents', 1 )
+
+   !
+   !--    Output all agent attributes
+          nc_stat = NF90_PUT_VAR( id_set_agt, id_var_agt(1), agents%x,         &
+                                  start = (/ 1, agt_time_count /),             &
+                                  count = (/ out_noa /) )
+          CALL netcdf_handle_error( 'mas_data_output_agents', 3 )
+
+          nc_stat = NF90_PUT_VAR( id_set_agt, id_var_agt(2), agents%y,         &
+                                  start = (/ 1, agt_time_count /),             &
+                                  count = (/ out_noa /) )
+          CALL netcdf_handle_error( 'mas_data_output_agents', 4 )
+
+          nc_stat = NF90_PUT_VAR( id_set_agt, id_var_agt(3), agents%windspeed, &
+                                  start = (/ 1, agt_time_count /),             &
+                                  count = (/ out_noa /) )
+          CALL netcdf_handle_error( 'mas_data_output_agents', 5 )
+
+          nc_stat = NF90_PUT_VAR( id_set_agt, id_var_agt(4), agents%t,         &
+                                  start = (/ 1, agt_time_count /),             &
+                                  count = (/ out_noa /) )
+          CALL netcdf_handle_error( 'mas_data_output_agents', 6 )
+
+          nc_stat = NF90_PUT_VAR( id_set_agt, id_var_agt(5), agents%group,     &
+                                  start = (/ 1, agt_time_count /),             &
+                                  count = (/ out_noa /) )
+          CALL netcdf_handle_error( 'mas_data_output_agents', 7 )
+
+!           nc_stat = NF90_PUT_VAR( id_set_agt, id_var_agt(6), agents%pm10,      &
+!                                   start = (/ 1, agt_time_count /),             &
+!                                   count = (/ out_noa /) )
+!           CALL netcdf_handle_error( 'mas_data_output_agents', 8 )
+! 
+!           nc_stat = NF90_PUT_VAR( id_set_agt, id_var_agt(7), agents%pm25,      &
+!                                   start = (/ 1, agt_time_count /),             &
+!                                   count = (/ out_noa /) )
+!           CALL netcdf_handle_error( 'mas_data_output_agents', 9 )
+! 
+!           nc_stat = NF90_PUT_VAR( id_set_agt, id_var_agt(8), agents%therm_comf,&
+!                                   start = (/ 1, agt_time_count /),             &
+!                                   count = (/ out_noa /) )
+! 
+!           nc_stat = NF90_PUT_VAR( id_set_agt, id_var_agt(9), agents%uv,        &
+!                                   start = (/ 1, agt_time_count /),             &
+!                                   count = (/ out_noa /) )
+          CALL netcdf_handle_error( 'mas_data_output_agents', 10 )
+
+#endif
+
+          DEALLOCATE(out_agents)
+       ENDIF
+
+       CALL cpu_log( log_point_s(17), 'mas_data_output', 'stop' )
+
+    END SUBROUTINE mas_data_output_agents
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> If an agent moves from one processor to another, this subroutine moves 
+!> the corresponding elements from the agent arrays of the old grid cells 
+!> to the agent arrays of the new grid cells.
+!------------------------------------------------------------------------------!
+    SUBROUTINE mas_eh_add_agents_to_gridcell (agent_array)
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  aindex !< dummy argument for new number of agents per grid box
+       INTEGER(iwp) ::  ip     !< grid index (x) of agent
+       INTEGER(iwp) ::  jp     !< grid index (x) of agent
+       INTEGER(iwp) ::  n      !< index variable of agent
+
+       LOGICAL ::  pack_done !< flag to indicate that packing is done
+
+       TYPE(agent_type), DIMENSION(:), INTENT(IN)  ::  agent_array !< new agents in a grid box
+       TYPE(agent_type), DIMENSION(:), ALLOCATABLE ::  temp_ns     !< temporary agent array for reallocation
+
+       pack_done     = .FALSE.
+
+       DO n = 1, SIZE(agent_array)
+
+          IF ( .NOT. agent_array(n)%agent_mask )  CYCLE
+
+          ip = agent_array(n)%x * ddx
+          jp = agent_array(n)%y * ddy
+
+          IF ( ip >= nxl  .AND.  ip <= nxr  .AND.                              &
+               jp >= nys  .AND.  jp <= nyn )  &
+          THEN ! agent stays on processor
+             number_of_agents = agt_count(jp,ip)
+             agents => grid_agents(jp,ip)%agents(1:number_of_agents)
+
+             aindex = agt_count(jp,ip)+1
+             IF( aindex > SIZE(grid_agents(jp,ip)%agents) )  THEN
+                IF ( pack_done )  THEN
+                   CALL mas_eh_realloc_agents_array (ip,jp)
+                ELSE
+                   CALL mas_ps_pack
+                   agt_count(jp,ip) = number_of_agents
+                   aindex = agt_count(jp,ip)+1
+                   IF ( aindex > SIZE(grid_agents(jp,ip)%agents) )  THEN
+                      CALL mas_eh_realloc_agents_array (ip,jp)
+                   ENDIF
+                   pack_done = .TRUE.
+                ENDIF
+             ENDIF
+             grid_agents(jp,ip)%agents(aindex) = agent_array(n)
+             agt_count(jp,ip) = aindex
+          ELSE
+             IF ( jp <= nys - 1 )  THEN
+                nr_move_south = nr_move_south+1
+!
+!--             Before agent information is swapped to exchange-array, check 
+!--             if enough memory is allocated. If required, reallocate exchange
+!--             array.
+                IF ( nr_move_south > SIZE(move_also_south) )  THEN
+!
+!--                At first, allocate further temporary array to swap agent 
+!--                information.
+                   ALLOCATE( temp_ns(SIZE(move_also_south)+NR_2_direction_move))
+                   temp_ns(1:nr_move_south-1) = move_also_south                &
+                                                (1:nr_move_south-1)
+                   DEALLOCATE( move_also_south )
+                   ALLOCATE( move_also_south(SIZE(temp_ns)) )
+                   move_also_south(1:nr_move_south-1) = temp_ns                &
+                                                        (1:nr_move_south-1)
+                   DEALLOCATE( temp_ns )
+
+                ENDIF
+
+                move_also_south(nr_move_south) = agent_array(n)
+
+                IF ( jp == -1 )  THEN
+!
+!--                Apply boundary condition along y
+                   IF ( ibc_mas_ns == 0 )  THEN
+                      move_also_south(nr_move_south)%y =                       &
+                                         move_also_south(nr_move_south)%y      &
+                                       + ( ny + 1 ) * dy
+                      move_also_south(nr_move_south)%origin_y =                &
+                                       move_also_south(nr_move_south)%origin_y &
+                                       + ( ny + 1 ) * dy
+                   ELSEIF ( ibc_mas_ns == 1 )  THEN
+!
+!--                   Agent absorption
+                      move_also_south(nr_move_south)%agent_mask = .FALSE.
+                      deleted_agents = deleted_agents + 1
+
+                   ENDIF
+                ENDIF
+             ELSEIF ( jp >= nyn+1 )  THEN
+                nr_move_north = nr_move_north+1
+!
+!--             Before agent information is swapped to exchange-array, check 
+!--             if enough memory is allocated. If required, reallocate exchange
+!--             array.
+                IF ( nr_move_north > SIZE(move_also_north) )  THEN
+!
+!--                At first, allocate further temporary array to swap agent 
+!--                information.
+                   ALLOCATE( temp_ns(SIZE(move_also_north)+NR_2_direction_move))
+                   temp_ns(1:nr_move_north-1) =                                &
+                                move_also_south(1:nr_move_north-1)
+                   DEALLOCATE( move_also_north )
+                   ALLOCATE( move_also_north(SIZE(temp_ns)) )
+                   move_also_north(1:nr_move_north-1) =                        &
+                               temp_ns(1:nr_move_north-1)
+                   DEALLOCATE( temp_ns )
+
+                ENDIF
+
+                move_also_north(nr_move_north) = agent_array(n)
+                IF ( jp == ny+1 )  THEN
+!
+!--                Apply boundary condition along y
+                   IF ( ibc_mas_ns == 0 )  THEN
+
+                      move_also_north(nr_move_north)%y =                       &
+                         move_also_north(nr_move_north)%y                      &
+                       - ( ny + 1 ) * dy
+                      move_also_north(nr_move_north)%origin_y =                &
+                         move_also_north(nr_move_north)%origin_y               &
+                       - ( ny + 1 ) * dy
+                   ELSEIF ( ibc_mas_ns == 1 )  THEN
+!
+!--                   Agent absorption
+                      move_also_north(nr_move_north)%agent_mask = .FALSE.
+                      deleted_agents = deleted_agents + 1
+
+                   ENDIF
+                ENDIF
+             ENDIF
+          ENDIF
+       ENDDO
+
+       RETURN
+
+    END SUBROUTINE mas_eh_add_agents_to_gridcell
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> After ghost layer agents have been received from neighboring PEs, this
+!> subroutine sorts them into the corresponding grid cells
+!------------------------------------------------------------------------------!
+    SUBROUTINE mas_eh_add_ghost_agents_to_gridcell (agent_array)
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  ip     !< grid index (x) of agent
+       INTEGER(iwp) ::  jp     !< grid index (x) of agent
+       INTEGER(iwp) ::  n      !< index variable of agent
+       INTEGER(iwp) ::  aindex !< dummy argument for new number of agents per grid box
+
+       LOGICAL ::  pack_done !< flag to indicate that packing is done
+
+       TYPE(agent_type), DIMENSION(:), INTENT(IN)  ::  agent_array !< new agents in a grid box
+       TYPE(agent_type), DIMENSION(:), ALLOCATABLE ::  temp_ns     !< temporary agent array for reallocation
+
+       pack_done     = .FALSE.
+
+       DO n = 1, SIZE(agent_array)
+
+          IF ( .NOT. agent_array(n)%agent_mask )  CYCLE
+
+          ip = agent_array(n)%x * ddx
+          jp = agent_array(n)%y * ddy
+
+          IF ( ip < nxl  .OR.  ip > nxr  .OR.  jp < nys  .OR.  jp > nyn ) THEN
+             number_of_agents = agt_count(jp,ip)
+             agents => grid_agents(jp,ip)%agents(1:number_of_agents)
+
+             aindex = agt_count(jp,ip)+1
+             IF( aindex > SIZE(grid_agents(jp,ip)%agents) )  THEN
+                IF ( pack_done )  THEN
+                   CALL mas_eh_realloc_agents_array (ip,jp)
+                ELSE
+                   CALL mas_ps_pack
+                   agt_count(jp,ip) = number_of_agents
+                   aindex = agt_count(jp,ip)+1
+                   IF ( aindex > SIZE(grid_agents(jp,ip)%agents) )  THEN
+                      CALL mas_eh_realloc_agents_array (ip,jp)
+                   ENDIF
+                   pack_done = .TRUE.
+                ENDIF
+             ENDIF
+             grid_agents(jp,ip)%agents(aindex) = agent_array(n)
+             agt_count(jp,ip) = aindex
+          ENDIF
+       ENDDO
+    END SUBROUTINE mas_eh_add_ghost_agents_to_gridcell
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Resizing of agent arrays
+!------------------------------------------------------------------------------!
+    SUBROUTINE mas_eh_dealloc_agents_array
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i         !< grid index (x) of agent
+       INTEGER(iwp) ::  j         !< grid index (y) of agent
+       INTEGER(iwp) ::  old_size  !< old array size
+       INTEGER(iwp) ::  new_size  !< new array size
+       INTEGER(iwp) ::  noa       !< number of agents
+
+       LOGICAL ::  dealloc  !< flag that indicates if reallocation is necessary
+
+       TYPE(agent_type), DIMENSION(10) ::  tmp_agents_s !< temporary static agent array
+
+       TYPE(agent_type), DIMENSION(:), ALLOCATABLE ::  tmp_agents_d !< temporary dynamic agent array
+
+       DO  i = nxlg, nxrg
+          DO  j = nysg, nyng
+!
+!--          Determine number of active agents
+             noa = agt_count(j,i)
+!
+!--          Determine allocated memory size
+             old_size = SIZE( grid_agents(j,i)%agents )
+!
+!--          Check for large unused memory
+             dealloc = ( ( noa < min_nr_agent .AND. old_size  > min_nr_agent ) &
+                    .OR. ( noa > min_nr_agent .AND. old_size - noa *           &
+                         ( 1.0_wp + 0.01_wp * alloc_factor_mas ) > 0.0_wp ) )
+!
+!--          If large unused memory was found, resize the corresponding array
+             IF ( dealloc )  THEN
+                IF ( noa < min_nr_agent )  THEN
+                   new_size = min_nr_agent
+                ELSE 
+                   new_size = INT( noa * ( 1.0_wp +                            &
+                                            0.01_wp * alloc_factor_mas ) )
+                ENDIF
+
+                IF ( noa <= 10 )  THEN
+
+                   tmp_agents_s(1:noa) = grid_agents(j,i)%agents(1:noa)
+
+                   DEALLOCATE(grid_agents(j,i)%agents)
+                   ALLOCATE(grid_agents(j,i)%agents(1:new_size))
+
+                   grid_agents(j,i)%agents(1:noa)          = tmp_agents_s(1:noa)
+                   grid_agents(j,i)%agents(noa+1:new_size) = zero_agent
+
+                ELSE
+
+                   ALLOCATE(tmp_agents_d(noa))
+                   tmp_agents_d(1:noa) = grid_agents(j,i)%agents(1:noa)
+
+                   DEALLOCATE(grid_agents(j,i)%agents)
+                   ALLOCATE(grid_agents(j,i)%agents(new_size))
+
+                   grid_agents(j,i)%agents(1:noa)          = tmp_agents_d(1:noa)
+                   grid_agents(j,i)%agents(noa+1:new_size) = zero_agent
+
+                   DEALLOCATE(tmp_agents_d)
+
+                ENDIF
+
+             ENDIF
+          ENDDO
+       ENDDO
+
+    END SUBROUTINE mas_eh_dealloc_agents_array
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Exchange between subdomains.
+!> As soon as one agent has moved beyond the boundary of the domain, it
+!> is included in the relevant transfer arrays and marked for subsequent
+!> deletion on this PE.
+!> First sweep for crossings in x direction. Find out first the number of
+!> agents to be transferred and allocate temporary arrays needed to store
+!> them.
+!> For a one-dimensional decomposition along y, no transfer is necessary,
+!> because the agent remains on the PE, but the agent coordinate has to
+!> be adjusted.
+!------------------------------------------------------------------------------!
+    SUBROUTINE mas_eh_exchange_horiz
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i                !< grid index (x) of agent positition
+       INTEGER(iwp) ::  ip               !< index variable along x
+       INTEGER(iwp) ::  j                !< grid index (y) of agent positition
+       INTEGER(iwp) ::  jp               !< index variable along y
+       INTEGER(iwp) ::  kp               !< index variable along z
+       INTEGER(iwp) ::  n                !< agent index variable 
+       INTEGER(iwp) ::  par_size         !< Agent size in bytes
+       INTEGER(iwp) ::  trla_count       !< number of agents send to left PE
+       INTEGER(iwp) ::  trla_count_recv  !< number of agents receive from right PE
+       INTEGER(iwp) ::  trna_count       !< number of agents send to north PE
+       INTEGER(iwp) ::  trna_count_recv  !< number of agents receive from south PE
+       INTEGER(iwp) ::  trra_count       !< number of agents send to right PE
+       INTEGER(iwp) ::  trra_count_recv  !< number of agents receive from left PE
+       INTEGER(iwp) ::  trsa_count       !< number of agents send to south PE
+       INTEGER(iwp) ::  trsa_count_recv  !< number of agents receive from north PE
+
+       TYPE(agent_type), DIMENSION(:), ALLOCATABLE ::  rvla  !< agents received from right PE
+       TYPE(agent_type), DIMENSION(:), ALLOCATABLE ::  rvna  !< agents received from south PE
+       TYPE(agent_type), DIMENSION(:), ALLOCATABLE ::  rvra  !< agents received from left PE
+       TYPE(agent_type), DIMENSION(:), ALLOCATABLE ::  rvsa  !< agents received from north PE
+       TYPE(agent_type), DIMENSION(:), ALLOCATABLE ::  trla  !< agents send to left PE
+       TYPE(agent_type), DIMENSION(:), ALLOCATABLE ::  trna  !< agents send to north PE
+       TYPE(agent_type), DIMENSION(:), ALLOCATABLE ::  trra  !< agents send to right PE
+       TYPE(agent_type), DIMENSION(:), ALLOCATABLE ::  trsa  !< agents send to south PE
+
+       CALL cpu_log( log_point_s(18), 'mas_eh_exchange_horiz', 'start' )
+
+#if defined( __parallel )
+
+!
+!--    Exchange between subdomains.
+!--    As soon as one agent has moved beyond the boundary of the domain, it
+!--    is included in the relevant transfer arrays and marked for subsequent
+!--    deletion on this PE.
+!--    First sweep for crossings in x direction. Find out first the number of
+!--    agents to be transferred and allocate temporary arrays needed to store
+!--    them.
+!--    For a one-dimensional decomposition along y, no transfer is necessary,
+!--    because the agent remains on the PE, but the agent coordinate has to
+!--    be adjusted.
+       trla_count  = 0
+       trra_count  = 0
+
+       trla_count_recv   = 0
+       trra_count_recv   = 0
+
+       IF ( pdims(1) /= 1 )  THEN
+!
+!--       First calculate the storage necessary for sending and receiving the data.
+!--       Compute only first (nxl) and last (nxr) loop iterration.
+          DO  ip = nxl, nxr, nxr - nxl
+             DO  jp = nys, nyn
+
+                number_of_agents = agt_count(jp,ip)
+                IF ( number_of_agents <= 0 )  CYCLE
+                agents => grid_agents(jp,ip)%agents(1:number_of_agents)
+                DO  n = 1, number_of_agents
+                   IF ( agents(n)%agent_mask )  THEN
+                      i = agents(n)%x * ddx
+!
+!--                   Above calculation does not work for indices less than zero
+                      IF ( agents(n)%x < 0.0_wp )  i = -1
+
+                      IF ( i < nxl )  THEN
+                         trla_count = trla_count + 1
+                      ELSEIF ( i > nxr )  THEN
+                         trra_count = trra_count + 1
+                      ENDIF
+                   ENDIF
+                ENDDO
+
+             ENDDO
+          ENDDO
+
+          IF ( trla_count  == 0 )  trla_count  = 1
+          IF ( trra_count  == 0 )  trra_count  = 1
+
+          ALLOCATE( trla(trla_count), trra(trra_count) )
+
+          trla = zero_agent
+          trra = zero_agent
+
+          trla_count  = 0
+          trra_count  = 0
+
+       ENDIF
+!
+!--    Compute only first (nxl) and last (nxr) loop iterration
+       DO  ip = nxl, nxr, nxr-nxl
+          DO  jp = nys, nyn
+             number_of_agents = agt_count(jp,ip)
+             IF ( number_of_agents <= 0 ) CYCLE
+             agents => grid_agents(jp,ip)%agents(1:number_of_agents)
+             DO  n = 1, number_of_agents
+!
+!--             Only those agents that have not been marked as 'deleted' may
+!--             be moved.
+                IF ( agents(n)%agent_mask )  THEN
+
+                   i = agents(n)%x * ddx
+!
+!--                Above calculation does not work for indices less than zero
+                   IF ( agents(n)%x < 0.0_wp )  i = -1
+
+                   IF ( i <  nxl )  THEN
+                      IF ( i < 0 )  THEN
+!
+!--                      Apply boundary condition along x
+                         IF ( ibc_mas_lr == 0 )  THEN
+!
+!--                         Cyclic condition
+                            IF ( pdims(1) == 1 )  THEN
+                               agents(n)%x        = ( nx + 1 ) * dx +          &
+                                                    agents(n)%x
+                               agents(n)%origin_x = ( nx + 1 ) * dx +          &
+                                                    agents(n)%origin_x
+                            ELSE
+                               trla_count         = trla_count + 1
+                               trla(trla_count)   = agents(n)
+                               trla(trla_count)%x = ( nx + 1 ) * dx +          &
+                                                    trla(trla_count)%x
+                               trla(trla_count)%origin_x =                     &
+                                                trla(trla_count)%origin_x +    &
+                                                ( nx + 1 ) * dx
+                               agents(n)%agent_mask  = .FALSE.
+                               deleted_agents = deleted_agents + 1
+
+                               IF ( trla(trla_count)%x >=                      &
+                                        (nx + 1)* dx - 1.0E-12_wp )            &
+                               THEN
+                                  trla(trla_count)%x = trla(trla_count)%x -    &
+                                                   1.0E-10_wp
+                                  trla(trla_count)%origin_x =                  &
+                                                   trla(trla_count)%origin_x - 1
+                               ENDIF
+
+                            ENDIF
+
+                         ELSEIF ( ibc_mas_lr == 1 )  THEN
+!
+!--                         Agent absorption
+                            agents(n)%agent_mask = .FALSE.
+                            deleted_agents = deleted_agents + 1
+
+                         ENDIF
+                      ELSE
+!
+!--                      Store agent data in the transfer array, which will be 
+!--                      send to the neighbouring PE
+                         trla_count = trla_count + 1
+                         trla(trla_count) = agents(n)
+                         agents(n)%agent_mask = .FALSE.
+                         deleted_agents = deleted_agents + 1
+
+                      ENDIF
+
+                   ELSEIF ( i > nxr )  THEN
+                      IF ( i > nx )  THEN
+!
+!--                      Apply boundary condition along x
+                         IF ( ibc_mas_lr == 0 )  THEN
+!
+!--                         Cyclic condition
+                            IF ( pdims(1) == 1 )  THEN
+                               agents(n)%x = agents(n)%x - ( nx + 1 ) * dx
+                               agents(n)%origin_x = agents(n)%origin_x - &
+                               ( nx + 1 ) * dx
+                            ELSE
+                               trra_count = trra_count + 1
+                               trra(trra_count) = agents(n)
+                               trra(trra_count)%x = trra(trra_count)%x -       &
+                                                    ( nx + 1 ) * dx
+                               trra(trra_count)%origin_x =                     &
+                                                   trra(trra_count)%origin_x - &
+                                                   ( nx + 1 ) * dx
+                               agents(n)%agent_mask = .FALSE.
+                               deleted_agents = deleted_agents + 1
+
+                            ENDIF
+
+                         ELSEIF ( ibc_mas_lr == 1 )  THEN
+!
+!--                         Agent absorption
+                            agents(n)%agent_mask = .FALSE.
+                            deleted_agents = deleted_agents + 1
+
+                         ENDIF
+                      ELSE
+!
+!--                      Store agent data in the transfer array, which will be send
+!--                      to the neighbouring PE
+                         trra_count = trra_count + 1
+                         trra(trra_count) = agents(n)
+                         agents(n)%agent_mask = .FALSE.
+                         deleted_agents = deleted_agents + 1
+
+                      ENDIF
+
+                   ENDIF
+                ENDIF
+
+             ENDDO
+          ENDDO
+       ENDDO
+
+!
+!--    Allocate arrays required for north-south exchange, as these
+!--    are used directly after agents are exchange along x-direction.
+       ALLOCATE( move_also_north(1:NR_2_direction_move) )
+       ALLOCATE( move_also_south(1:NR_2_direction_move) )
+
+       nr_move_north = 0
+       nr_move_south = 0
+!
+!--    Send left boundary, receive right boundary (but first exchange how many
+!--    and chec if agent storage must be extended)
+       IF ( pdims(1) /= 1 )  THEN
+
+          CALL MPI_SENDRECV( trla_count,      1, MPI_INTEGER, pleft,  0, &
+                             trra_count_recv, 1, MPI_INTEGER, pright, 0, &
+                             comm2d, status, ierr )
+
+          ALLOCATE(rvra(MAX(1,trra_count_recv)))
+!
+!--       This MPI_SENDRECV should work even with odd mixture on 32 and 64 Bit 
+!--       variables in structure agent_type (due to the calculation of par_size)
+          par_size = C_SIZEOF(trla(1))
+          CALL MPI_SENDRECV( trla, max(1,trla_count)*par_size, MPI_BYTE, pleft,&
+                    1, rvra, max(1,trra_count_recv)*par_size, MPI_BYTE, pright,&
+                             1, comm2d, status, ierr )
+
+          IF ( trra_count_recv > 0 ) THEN
+             CALL mas_eh_add_agents_to_gridcell(rvra(1:trra_count_recv))
+          ENDIF
+
+          DEALLOCATE(rvra)
+
+!
+!--       Send right boundary, receive left boundary
+          CALL MPI_SENDRECV( trra_count,      1, MPI_INTEGER, pright, 0,       &
+                             trla_count_recv, 1, MPI_INTEGER, pleft,  0,       &
+                             comm2d, status, ierr )
+
+          ALLOCATE(rvla(MAX(1,trla_count_recv)))
+!
+!--       This MPI_SENDRECV should work even with odd mixture on 32 and 64 Bit 
+!--       variables in structure agent_type (due to the calculation of par_size)
+          par_size = C_SIZEOF(trra(1))
+          CALL MPI_SENDRECV( trra, max(1,trra_count)*par_size, MPI_BYTE,       &
+                             pright, 1, rvla,                                  &
+                             max(1,trla_count_recv)*par_size, MPI_BYTE,        &
+                             pleft, 1, comm2d, status, ierr )
+
+          IF ( trla_count_recv > 0 ) THEN
+             CALL mas_eh_add_agents_to_gridcell(rvla(1:trla_count_recv))
+          ENDIF
+
+          DEALLOCATE( rvla )
+          DEALLOCATE( trla, trra )
+
+       ENDIF
+
+!
+!--    Check whether agents have crossed the boundaries in y direction. Note 
+!--    that this case can also apply to agents that have just been received
+!--    from the adjacent right or left PE.
+!--    Find out first the number of agents to be transferred and allocate
+!--    temporary arrays needed to store them.
+!--    For a one-dimensional decomposition along y, no transfer is necessary,
+!--    because the agent remains on the PE.
+       trsa_count  = nr_move_south
+       trna_count  = nr_move_north
+
+       trsa_count_recv   = 0
+       trna_count_recv   = 0
+
+       IF ( pdims(2) /= 1 )  THEN
+!
+!--       First calculate the storage necessary for sending and receiving the
+!--       data
+          DO  ip = nxl, nxr
+             DO  jp = nys, nyn, nyn-nys    !compute only first (nys) and last (nyn) loop iterration
+                number_of_agents = agt_count(jp,ip)
+                IF ( number_of_agents <= 0 )  CYCLE
+                agents => grid_agents(jp,ip)%agents(1:number_of_agents)
+                DO  n = 1, number_of_agents
+                   IF ( agents(n)%agent_mask )  THEN
+                      j = agents(n)%y * ddy
+!
+!--                   Above calculation does not work for indices less than zero
+                      IF ( agents(n)%y < 0.0_wp )  j = -1
+
+                      IF ( j < nys )  THEN
+                         trsa_count = trsa_count + 1
+                      ELSEIF ( j > nyn )  THEN
+                         trna_count = trna_count + 1
+                      ENDIF
+                   ENDIF
+                ENDDO
+             ENDDO
+          ENDDO
+
+          IF ( trsa_count  == 0 )  trsa_count  = 1
+          IF ( trna_count  == 0 )  trna_count  = 1
+
+          ALLOCATE( trsa(trsa_count), trna(trna_count) )
+
+          trsa = zero_agent
+          trna = zero_agent
+
+          trsa_count  = nr_move_south
+          trna_count  = nr_move_north
+
+          trsa(1:nr_move_south) = move_also_south(1:nr_move_south)
+          trna(1:nr_move_north) = move_also_north(1:nr_move_north)
+
+       ENDIF
+
+       DO  ip = nxl, nxr
+          DO  jp = nys, nyn, nyn-nys ! compute only first (nys) and last (nyn) loop iterration
+             number_of_agents = agt_count(jp,ip)
+             IF ( number_of_agents <= 0 )  CYCLE
+             agents => grid_agents(jp,ip)%agents(1:number_of_agents)
+             DO  n = 1, number_of_agents
+!
+!--             Only those agents that have not been marked as 'deleted' may
+!--             be moved.
+                IF ( agents(n)%agent_mask )  THEN
+
+                   j = agents(n)%y * ddy
+!
+!--                Above calculation does not work for indices less than zero
+                   IF ( agents(n)%y < 0.0_wp * dy )  j = -1
+
+                   IF ( j < nys )  THEN
+                      IF ( j < 0 )  THEN
+!
+!--                      Apply boundary condition along y
+                         IF ( ibc_mas_ns == 0 )  THEN
+!
+!--                         Cyclic condition
+                            IF ( pdims(2) == 1 )  THEN
+                               agents(n)%y = ( ny + 1 ) * dy + agents(n)%y
+                               agents(n)%origin_y = ( ny + 1 ) * dy +          &
+                                                     agents(n)%origin_y
+                            ELSE
+                               trsa_count         = trsa_count + 1
+                               trsa(trsa_count)   = agents(n)
+                               trsa(trsa_count)%y = ( ny + 1 ) * dy +          &
+                                                 trsa(trsa_count)%y
+                               trsa(trsa_count)%origin_y =                     &
+                                                  trsa(trsa_count)%origin_y    &
+                                                + ( ny + 1 ) * dy
+                               agents(n)%agent_mask = .FALSE.
+                               deleted_agents = deleted_agents + 1
+
+                               IF ( trsa(trsa_count)%y >=                      &
+                                                    (ny+1)* dy - 1.0E-12_wp )  &
+                               THEN
+                                  trsa(trsa_count)%y = trsa(trsa_count)%y -    &
+                                                       1.0E-10_wp
+                                  trsa(trsa_count)%origin_y =                  &
+                                                  trsa(trsa_count)%origin_y - 1
+                               ENDIF
+
+                            ENDIF
+
+                         ELSEIF ( ibc_mas_ns == 1 )  THEN
+!
+!--                         Agent absorption
+                            agents(n)%agent_mask = .FALSE.
+                            deleted_agents          = deleted_agents + 1
+
+                         ENDIF
+                      ELSE
+!
+!--                      Store agent data in the transfer array, which will 
+!--                      be send to the neighbouring PE
+                         trsa_count = trsa_count + 1
+                         trsa(trsa_count) = agents(n)
+                         agents(n)%agent_mask = .FALSE.
+                         deleted_agents = deleted_agents + 1
+
+                      ENDIF
+
+                   ELSEIF ( j > nyn )  THEN
+                      IF ( j > ny )  THEN
+!
+!--                      Apply boundary condition along y
+                         IF ( ibc_mas_ns == 0 )  THEN
+!
+!--                         Cyclic condition
+                            IF ( pdims(2) == 1 )  THEN
+                               agents(n)%y        = agents(n)%y -              &
+                                                    ( ny + 1 ) * dy
+                               agents(n)%origin_y = agents(n)%origin_y -       &
+                                                    ( ny + 1 ) * dy
+                            ELSE
+                               trna_count         = trna_count + 1
+                               trna(trna_count)   = agents(n)
+                               trna(trna_count)%y =                            &
+                                          trna(trna_count)%y - ( ny + 1 ) * dy
+                               trna(trna_count)%origin_y =                     &
+                                         trna(trna_count)%origin_y -           &
+                                         ( ny + 1 ) * dy
+                               agents(n)%agent_mask = .FALSE.
+                               deleted_agents          = deleted_agents + 1
+                            ENDIF
+
+                         ELSEIF ( ibc_mas_ns == 1 )  THEN
+!
+!--                         Agent absorption
+                            agents(n)%agent_mask = .FALSE.
+                            deleted_agents = deleted_agents + 1
+
+                         ENDIF
+                      ELSE
+!
+!--                      Store agent data in the transfer array, which will 
+!--                      be send to the neighbouring PE
+                         trna_count = trna_count + 1
+                         trna(trna_count) = agents(n)
+                         agents(n)%agent_mask = .FALSE.
+                         deleted_agents = deleted_agents + 1
+
+                      ENDIF
+
+                   ENDIF
+                ENDIF
+             ENDDO
+          ENDDO
+       ENDDO
+
+!
+!--    Send front boundary, receive back boundary (but first exchange how many
+!--    and chec if agent storage must be extended)
+       IF ( pdims(2) /= 1 )  THEN
+
+          CALL MPI_SENDRECV( trsa_count,      1, MPI_INTEGER, psouth, 0,       &
+                             trna_count_recv, 1, MPI_INTEGER, pnorth, 0,       &
+                             comm2d, status, ierr )
+
+          ALLOCATE(rvna(MAX(1,trna_count_recv)))
+!
+!--       This MPI_SENDRECV should work even with odd mixture on 32 and 64 Bit 
+!--       variables in structure agent_type (due to the calculation of par_size)
+          par_size = C_SIZEOF(trsa(1))
+          CALL MPI_SENDRECV( trsa, trsa_count*par_size, MPI_BYTE,              &
+                             psouth, 1, rvna,                                  &
+                             trna_count_recv*par_size, MPI_BYTE, pnorth, 1,    &
+                             comm2d, status, ierr )
+
+          IF ( trna_count_recv  > 0 ) THEN
+             CALL mas_eh_add_agents_to_gridcell(rvna(1:trna_count_recv))
+          ENDIF
+
+          DEALLOCATE(rvna)
+
+!
+!--       Send back boundary, receive front boundary
+          CALL MPI_SENDRECV( trna_count,      1, MPI_INTEGER, pnorth, 0,       &
+                             trsa_count_recv, 1, MPI_INTEGER, psouth, 0,       &
+                             comm2d, status, ierr )
+
+          ALLOCATE(rvsa(MAX(1,trsa_count_recv)))
+!
+!--       This MPI_SENDRECV should work even with odd mixture on 32 and 64 Bit 
+!--       variables in structure agent_type (due to the calculation of par_size)
+          par_size = C_SIZEOF(trna(1))
+          CALL MPI_SENDRECV( trna, trna_count*par_size, MPI_BYTE,              &
+                             pnorth, 1, rvsa,                                  &
+                             trsa_count_recv*par_size, MPI_BYTE, psouth, 1,    &
+                             comm2d, status, ierr )
+
+          IF ( trsa_count_recv > 0 ) THEN
+             CALL mas_eh_add_agents_to_gridcell(rvsa(1:trsa_count_recv))
+          ENDIF
+
+          DEALLOCATE(rvsa)
+
+          number_of_agents = number_of_agents + trsa_count_recv
+
+          DEALLOCATE( trsa, trna )
+
+       ENDIF
+
+       DEALLOCATE( move_also_north )
+       DEALLOCATE( move_also_south )
+
+#else
+
+       DO  ip = nxl, nxr, nxr-nxl
+          DO  jp = nys, nyn
+             number_of_agents = agt_count(jp,ip)
+             IF ( number_of_agents <= 0 )  CYCLE
+             agents => grid_agents(jp,ip)%agents(1:number_of_agents)
+             DO  n = 1, number_of_agents
+!
+!--             Apply boundary conditions
+                IF ( agents(n)%x < 0.0_wp )  THEN
+
+                   IF ( ibc_mas_lr == 0 )  THEN
+!
+!--                   Cyclic boundary. Relevant coordinate has to be changed.
+                      agents(n)%x = ( nx + 1 ) * dx + agents(n)%x
+                      agents(n)%origin_x = ( nx + 1 ) * dx + &
+                                  agents(n)%origin_x
+                   ELSEIF ( ibc_mas_lr == 1 )  THEN
+!
+!--                   Agent absorption
+                      agents(n)%agent_mask = .FALSE.
+                      deleted_agents = deleted_agents + 1
+                   ENDIF
+
+                ELSEIF ( agents(n)%x >= ( nx + 1 ) * dx )  THEN
+
+                   IF ( ibc_mas_lr == 0 )  THEN
+!
+!--                   Cyclic boundary. Relevant coordinate has to be changed.
+                      agents(n)%x = agents(n)%x - ( nx + 1 ) * dx
+
+                   ELSEIF ( ibc_mas_lr == 1 )  THEN
+!
+!--                   Agent absorption
+                      agents(n)%agent_mask = .FALSE.
+                      deleted_agents = deleted_agents + 1
+                   ENDIF
+
+                ENDIF
+             ENDDO
+          ENDDO
+       ENDDO
+
+       DO  ip = nxl, nxr
+          DO  jp = nys, nyn, nyn-nys
+             number_of_agents = agt_count(jp,ip)
+             IF ( number_of_agents <= 0 )  CYCLE
+             agents => grid_agents(jp,ip)%agents(1:number_of_agents)
+             DO  n = 1, number_of_agents
+
+                IF ( agents(n)%y < 0.0_wp )  THEN
+
+                   IF ( ibc_mas_ns == 0 )  THEN
+!
+!--                   Cyclic boundary. Relevant coordinate has to be changed.
+                      agents(n)%y = ( ny + 1 ) * dy + agents(n)%y
+                      agents(n)%origin_y = ( ny + 1 ) * dy + &
+                           agents(n)%origin_y
+
+                   ELSEIF ( ibc_mas_ns == 1 )  THEN
+!
+!--                   Agent absorption
+                      agents(n)%agent_mask = .FALSE.
+                      deleted_agents = deleted_agents + 1
+                   ENDIF
+
+                ELSEIF ( agents(n)%y >= ( ny + 0.5_wp ) * dy )  THEN
+
+                   IF ( ibc_mas_ns == 0 )  THEN
+!
+!--                   Cyclic boundary. Relevant coordinate has to be changed.
+                      agents(n)%y = agents(n)%y - ( ny + 1 ) * dy
+
+                   ELSEIF ( ibc_mas_ns == 1 )  THEN
+!
+!--                   Agent absorption
+                      agents(n)%agent_mask = .FALSE.
+                      deleted_agents = deleted_agents + 1
+                   ENDIF
+
+                ENDIF
+
+             ENDDO
+          ENDDO
+       ENDDO
+#endif
+
+!
+!--    Accumulate the number of agents transferred between the subdomains
+#if defined( __parallel )
+       CALL mas_eh_ghost_exchange
+#endif
+
+       CALL cpu_log( log_point_s(18), 'mas_eh_exchange_horiz', 'stop' )
+
+    END SUBROUTINE mas_eh_exchange_horiz
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Sends the agents from the three gridcells closest to the 
+!> north/south/left/right border of a PE to the corresponding neighbors ghost
+!> layer (which is three grid boxes deep)
+!------------------------------------------------------------------------------!
+    SUBROUTINE mas_eh_ghost_exchange
+
+       IMPLICIT NONE
+       
+       INTEGER(iwp) ::  i           !< grid index (x) of agent positition
+       INTEGER(iwp) ::  ip          !< index variable along x
+       INTEGER(iwp) ::  j           !< grid index (y) of agent positition
+       INTEGER(iwp) ::  jp          !< index variable along y
+       INTEGER(iwp) ::  agt_size    !< Bit size of agent datatype
+       INTEGER(iwp) ::  ghla_count  !< ghost points left agent
+       INTEGER(iwp) ::  ghna_count  !< ghost points north agent
+       INTEGER(iwp) ::  ghra_count  !< ghost points right agent
+       INTEGER(iwp) ::  ghsa_count  !< ghost points south agent
+
+       LOGICAL ::  ghla_empty      !< ghost points left agent
+       LOGICAL ::  ghla_empty_rcv  !< ghost points left agent
+       LOGICAL ::  ghna_empty      !< ghost points north agent
+       LOGICAL ::  ghna_empty_rcv  !< ghost points north agent
+       LOGICAL ::  ghra_empty      !< ghost points right agent
+       LOGICAL ::  ghra_empty_rcv  !< ghost points right agent
+       LOGICAL ::  ghsa_empty      !< ghost points south agent
+       LOGICAL ::  ghsa_empty_rcv  !< ghost points south agent
+
+       TYPE(agent_type), DIMENSION(:), ALLOCATABLE ::  ghla  !< agents received from right PE
+       TYPE(agent_type), DIMENSION(:), ALLOCATABLE ::  ghna  !< agents received from south PE
+       TYPE(agent_type), DIMENSION(:), ALLOCATABLE ::  ghra  !< agents received from left PE
+       TYPE(agent_type), DIMENSION(:), ALLOCATABLE ::  ghsa  !< agents received from north PE
+
+       ghla_empty = .TRUE.
+       ghna_empty = .TRUE.
+       ghra_empty = .TRUE.
+       ghsa_empty = .TRUE.
+!
+!--    reset ghost layer
+       DO ip = nxlg, nxl-1
+          DO jp = nysg, nyng
+             agt_count(jp,ip) = 0
+          ENDDO
+       ENDDO
+       DO ip = nxr+1, nxrg
+          DO jp = nysg, nyng
+             agt_count(jp,ip) = 0
+          ENDDO
+       ENDDO
+       DO ip = nxl, nxr
+          DO jp = nysg, nys-1
+             agt_count(jp,ip) = 0
+          ENDDO
+       ENDDO
+       DO ip = nxl, nxr
+          DO jp = nyn+1, nyng
+             agt_count(jp,ip) = 0
+          ENDDO
+       ENDDO
+!
+!--    Transfer of agents from left to right and vice versa
+       IF ( pdims(1) /= 1 )  THEN
+!
+!--       Reset left and right ghost layers
+          ghla_count  = 0
+          ghra_count  = 0
+!
+!--       First calculate the storage necessary for sending 
+!--       and receiving the data.
+          ghla_count = SUM(agt_count(nys:nyn,nxl:nxl+2))
+          ghra_count = SUM(agt_count(nys:nyn,nxr-2:nxr))
+!
+!--       No cyclic boundaries for agents
+          IF ( nxl == 0 .OR. ghla_count == 0 ) THEN
+             ghla_count = 1
+          ELSE
+             ghla_empty = .FALSE.
+          ENDIF
+          IF ( nxr == nx .OR. ghra_count == 0 ) THEN
+             ghra_count = 1
+          ELSE
+             ghra_empty = .FALSE.
+          ENDIF
+          ALLOCATE( ghla(1:ghla_count), ghra(1:ghra_count) )
+          ghla = zero_agent
+          ghra = zero_agent
+!
+!--       Get all agents that will be sent left into one array
+          ghla_count = 0
+          IF ( nxl /= 0 ) THEN
+             DO ip = nxl, nxl+2
+                DO jp = nys, nyn
+
+                   number_of_agents = agt_count(jp,ip)
+                   IF ( number_of_agents <= 0 )  CYCLE
+                   ghla(ghla_count+1:ghla_count+number_of_agents)              &
+                       = grid_agents(jp,ip)%agents(1:number_of_agents)
+                   ghla_count = ghla_count + number_of_agents
+
+                ENDDO
+             ENDDO
+          ENDIF
+          IF ( ghla_count == 0 )  ghla_count = 1
+!
+!--       Get all agents that will be sent right into one array
+          ghra_count = 0
+          IF ( nxr /= nx ) THEN
+             DO ip = nxr-2, nxr
+                DO jp = nys, nyn
+
+                   number_of_agents = agt_count(jp,ip)
+                   IF ( number_of_agents <= 0 )  CYCLE
+                   ghra(ghra_count+1:ghra_count+number_of_agents)              &
+                       = grid_agents(jp,ip)%agents(1:number_of_agents)
+                   ghra_count = ghra_count + number_of_agents
+
+                ENDDO
+             ENDDO
+          ENDIF
+          IF ( ghra_count == 0 ) ghra_count = 1
+!
+!--       Send/receive number of agents that 
+!--       will be transferred to/from left/right neighbor
+          CALL MPI_SENDRECV( ghla_count,      1, MPI_INTEGER, pleft,  0,       &
+                             ghra_count_recv, 1, MPI_INTEGER, pright, 0,       &
+                             comm2d, status, ierr )
+          ALLOCATE ( agt_gh_r(1:ghra_count_recv) )
+!
+!--       Send/receive number of agents that 
+!--       will be transferred to/from right/left neighbor
+          CALL MPI_SENDRECV( ghra_count,      1, MPI_INTEGER, pright,  0,      &
+                             ghla_count_recv, 1, MPI_INTEGER, pleft,   0,      &
+                             comm2d, status, ierr )
+!
+!--       Send/receive flag that indicates if there are actually any agents 
+!--       in ghost  layer
+          CALL MPI_SENDRECV( ghla_empty,     1, MPI_LOGICAL, pleft, 1,         &
+                             ghra_empty_rcv, 1, MPI_LOGICAL, pright,1,         &
+                             comm2d, status, ierr )
+          CALL MPI_SENDRECV( ghra_empty,     1, MPI_LOGICAL, pright,1,         &
+                             ghla_empty_rcv, 1, MPI_LOGICAL, pleft, 1,         &
+                             comm2d, status, ierr )
+
+
+          ALLOCATE ( agt_gh_l(1:ghla_count_recv) )
+!
+!--       Get bit size of one agent
+          agt_size = C_SIZEOF(zero_agent)
+!
+!--       Send/receive agents to/from left/right neighbor
+          CALL MPI_SENDRECV( ghla,     ghla_count      * agt_size, MPI_BYTE,   &
+                                pleft, 1,                                      &
+                             agt_gh_r, ghra_count_recv * agt_size, MPI_BYTE,   &
+                                pright,1,                                      &
+                             comm2d, status, ierr )
+!
+!--       Send/receive agents to/from left/right neighbor
+          CALL MPI_SENDRECV( ghra,     ghra_count      * agt_size, MPI_BYTE,   &
+                                pright,1,                                      &
+                             agt_gh_l, ghla_count_recv * agt_size, MPI_BYTE,   &
+                                pleft, 1,                                      &
+                             comm2d, status, ierr )
+!
+!--       If agents were received, add them to the respective ghost layer cells
+          IF ( .NOT. ghra_empty_rcv ) THEN
+             CALL mas_eh_add_ghost_agents_to_gridcell(agt_gh_r)
+          ENDIF
+
+          IF ( .NOT. ghla_empty_rcv ) THEN
+             CALL mas_eh_add_ghost_agents_to_gridcell(agt_gh_l)
+          ENDIF
+
+          DEALLOCATE( ghla, ghra, agt_gh_l, agt_gh_r )
+
+       ENDIF
+
+!
+!--    Transfer of agents from south to north and vice versa
+       IF ( pdims(2) /= 1 )  THEN
+!
+!--       Reset south and north ghost layers
+          ghsa_count  = 0
+          ghna_count  = 0
+!
+!--       First calculate the storage necessary for sending 
+!--       and receiving the data.
+          ghsa_count = SUM(agt_count(nys:nys+2,nxlg:nxrg))
+          ghna_count = SUM(agt_count(nyn-2:nyn,nxlg:nxrg))
+!
+!--       No cyclic boundaries for agents
+          IF ( nys == 0 .OR. ghsa_count == 0 ) THEN
+             ghsa_count = 1
+          ELSE
+             ghsa_empty = .FALSE.
+          ENDIF
+          IF ( nyn == ny .OR. ghna_count == 0 ) THEN
+             ghna_count = 1
+          ELSE
+             ghna_empty = .FALSE.
+          ENDIF
+          ALLOCATE( ghsa(1:ghsa_count), ghna(1:ghna_count) )
+          ghsa = zero_agent
+          ghna = zero_agent
+!
+!--       Get all agents that will be sent south into one array
+          ghsa_count = 0
+          IF ( nys /= 0 ) THEN
+             DO ip = nxlg, nxrg
+                DO jp = nys, nys+2
+
+                   number_of_agents = agt_count(jp,ip)
+                   IF ( number_of_agents <= 0 )  CYCLE
+                   ghsa(ghsa_count+1:ghsa_count+number_of_agents)              &
+                       = grid_agents(jp,ip)%agents(1:number_of_agents)
+                   ghsa_count = ghsa_count + number_of_agents
+
+                ENDDO
+             ENDDO
+          ENDIF
+          IF ( ghsa_count == 0 )  ghsa_count = 1
+!
+!--       Get all agents that will be sent north into one array
+          ghna_count = 0
+          IF ( nyn /= ny ) THEN
+             DO ip = nxlg, nxrg
+                DO jp = nyn-2, nyn
+
+                   number_of_agents = agt_count(jp,ip)
+                   IF ( number_of_agents <= 0 )  CYCLE
+                   ghna(ghna_count+1:ghna_count+number_of_agents)              &
+                       = grid_agents(jp,ip)%agents(1:number_of_agents)
+                   ghna_count = ghna_count + number_of_agents
+
+                ENDDO
+             ENDDO
+          ENDIF
+          IF ( ghna_count == 0 ) ghna_count = 1
+!
+!--       Send/receive number of agents that 
+!--       will be transferred to/from south/north neighbor
+          CALL MPI_SENDRECV( ghsa_count, 1, MPI_INTEGER, psouth, 0,            &
+                             ghna_count_recv,   1, MPI_INTEGER, pnorth, 0,     &
+                             comm2d, status, ierr )
+          ALLOCATE ( agt_gh_n(1:ghna_count_recv) )
+!
+!--       Send/receive number of agents that 
+!--       will be transferred to/from north/south neighbor
+          CALL MPI_SENDRECV( ghna_count, 1, MPI_INTEGER, pnorth, 0,            &
+                             ghsa_count_recv,   1, MPI_INTEGER, psouth, 0,     &
+                             comm2d, status, ierr )
+!
+!--       Send/receive flag that indicates if there are actually any agents 
+!--       in ghost  layer
+          CALL MPI_SENDRECV( ghsa_empty,     1, MPI_LOGICAL, psouth, 1,        &
+                             ghna_empty_rcv, 1, MPI_LOGICAL, pnorth, 1,        &
+                             comm2d, status, ierr )
+          CALL MPI_SENDRECV( ghna_empty,     1, MPI_LOGICAL, pnorth, 1,        &
+                             ghsa_empty_rcv, 1, MPI_LOGICAL, psouth, 1,        &
+                             comm2d, status, ierr )
+
+
+          ALLOCATE ( agt_gh_s(1:ghsa_count_recv) )
+!
+!--       Get bit size of one agent
+          agt_size = C_SIZEOF(zero_agent)
+!
+!--       Send/receive agents to/from south/north neighbor
+          CALL MPI_SENDRECV( ghsa,     ghsa_count      * agt_size, MPI_BYTE,   &
+                                psouth,1,                                      &
+                             agt_gh_n, ghna_count_recv * agt_size, MPI_BYTE,   &
+                                pnorth,1,                                      &
+                             comm2d, status, ierr )
+!
+!--       Send/receive agents to/from south/north neighbor
+          CALL MPI_SENDRECV( ghna,     ghna_count      * agt_size, MPI_BYTE,   &
+                                pnorth,1,                                      &
+                             agt_gh_s, ghsa_count_recv * agt_size, MPI_BYTE,   &
+                                psouth,1,                                      &
+                             comm2d, status, ierr )
+!
+!--       If agents were received, add them to the respective ghost layer cells
+          IF ( .NOT. ghna_empty_rcv ) THEN
+             CALL mas_eh_add_ghost_agents_to_gridcell(agt_gh_n)
+          ENDIF
+
+          IF ( .NOT. ghsa_empty_rcv ) THEN
+             CALL mas_eh_add_ghost_agents_to_gridcell(agt_gh_s)
+          ENDIF
+
+          DEALLOCATE( ghna, ghsa, agt_gh_n, agt_gh_s )
+
+       ENDIF
+
+    END SUBROUTINE mas_eh_ghost_exchange
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> If an agent moves from one grid cell to another (on the current 
+!> processor!), this subroutine moves the corresponding element from the
+!> agent array of the old grid cell to the agent array of the new grid 
+!> cell.
+!------------------------------------------------------------------------------!
+    SUBROUTINE mas_eh_move_agent
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i              !< grid index (x) of agent position
+       INTEGER(iwp) ::  ip             !< index variable along x
+       INTEGER(iwp) ::  j              !< grid index (y) of agent position
+       INTEGER(iwp) ::  jp             !< index variable along y
+       INTEGER(iwp) ::  n              !< index variable for agent array
+       INTEGER(iwp) ::  na_before_move !< number of agents per grid box before moving
+       INTEGER(iwp) ::  aindex         !< dummy argument for number of new agent per grid box
+
+       TYPE(agent_type), DIMENSION(:), POINTER ::  agents_before_move !< agents before moving
+
+       CALL cpu_log( log_point_s(19), 'mas_eh_move_agent', 'start' )
+
+       DO  ip = nxl, nxr
+          DO  jp = nys, nyn
+
+                na_before_move = agt_count(jp,ip)
+                IF ( na_before_move <= 0 )  CYCLE
+                agents_before_move => grid_agents(jp,ip)%agents(1:na_before_move)
+
+                DO  n = 1, na_before_move
+                   i = agents_before_move(n)%x * ddx
+                   j = agents_before_move(n)%y * ddy
+
+!--                For mas_eh_exchange_horiz to work properly agents need to be
+!--                moved to the outermost gridboxes of the respective processor.
+!--                If the agent index is inside the processor the following
+!--                lines will not change the index
+                   i = MIN ( i , nxr )
+                   i = MAX ( i , nxl )
+                   j = MIN ( j , nyn )
+                   j = MAX ( j , nys )
+
+!
+!--                Check if agent has moved to another grid cell.
+                   IF ( i /= ip  .OR.  j /= jp )  THEN
+!
+!--                   If the agent stays on the same processor, the agent
+!--                   will be added to the agent array of the new processor.
+                      number_of_agents = agt_count(j,i)
+                      agents => grid_agents(j,i)%agents(1:number_of_agents)
+
+                      aindex = number_of_agents+1
+                      IF (  aindex > SIZE(grid_agents(j,i)%agents)  )     &
+                      THEN
+                         CALL mas_eh_realloc_agents_array(i,j)
+                      ENDIF
+
+                      grid_agents(j,i)%agents(aindex) = agents_before_move(n)
+                      agt_count(j,i) = aindex
+
+                      agents_before_move(n)%agent_mask = .FALSE.
+                   ENDIF
+                ENDDO
+
+          ENDDO
+       ENDDO
+
+       CALL cpu_log( log_point_s(19), 'mas_eh_move_agent', 'stop' )
+
+       RETURN
+
+    END SUBROUTINE mas_eh_move_agent
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> If the allocated memory for the agent array do not suffice to add arriving
+!> agents from neighbour grid cells, this subrouting reallocates the 
+!> agent array to assure enough memory is available. 
+!------------------------------------------------------------------------------!
+    SUBROUTINE mas_eh_realloc_agents_array (i,j,size_in)
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) :: old_size  !< old array size
+       INTEGER(iwp) :: new_size  !< new array size
+
+       INTEGER(iwp), INTENT(in) ::  i  !< grid index (y)
+       INTEGER(iwp), INTENT(in) ::  j  !< grid index (y)
+
+       INTEGER(iwp), INTENT(in), OPTIONAL ::  size_in  !< size of input array
+
+       TYPE(agent_type), DIMENSION(10) :: tmp_agents_s !< temporary static agent array
+
+       TYPE(agent_type), DIMENSION(:), ALLOCATABLE :: tmp_agents_d !< temporary dynamic agent array
+
+       old_size = SIZE(grid_agents(j,i)%agents)
+
+       IF ( PRESENT(size_in) )   THEN
+          new_size = size_in
+       ELSE
+          new_size = old_size * ( 1.0_wp + alloc_factor_mas / 100.0_wp )
+       ENDIF
+
+       new_size = MAX( new_size, min_nr_agent, old_size + 1 )
+
+       IF ( old_size <= 10 )  THEN
+
+          tmp_agents_s(1:old_size) = grid_agents(j,i)%agents(1:old_size)
+
+          DEALLOCATE(grid_agents(j,i)%agents)
+          ALLOCATE(grid_agents(j,i)%agents(new_size))
+
+          grid_agents(j,i)%agents(1:old_size)         = tmp_agents_s(1:old_size)
+          grid_agents(j,i)%agents(old_size+1:new_size) = zero_agent
+
+       ELSE
+
+          ALLOCATE(tmp_agents_d(new_size))
+          tmp_agents_d(1:old_size) = grid_agents(j,i)%agents
+
+          DEALLOCATE(grid_agents(j,i)%agents)
+          ALLOCATE(grid_agents(j,i)%agents(new_size))
+
+          grid_agents(j,i)%agents(1:old_size)         = tmp_agents_d(1:old_size)
+          grid_agents(j,i)%agents(old_size+1:new_size) = zero_agent
+
+          DEALLOCATE(tmp_agents_d)
+
+       ENDIF
+       agents => grid_agents(j,i)%agents(1:number_of_agents)
+
+       RETURN
+    END SUBROUTINE mas_eh_realloc_agents_array
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Inquires prognostic model quantities at the position of each agent and
+!> stores them in that agent for later output
+!------------------------------------------------------------------------------! 
+    SUBROUTINE mas_get_prognostic_quantities
+
+       USE arrays_3d,                                                          &
+           ONLY:  u, v, pt, hyp
+
+       USE chem_gasphase_mod,                                                  &
+           ONLY:  nvar
+
+       USE chemistry_model_mod,                                                &
+           ONLY:  chem_species
+
+       USE control_parameters,                                                 &
+              ONLY:  air_chemistry
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i_offset  !<  index offset for windspeed measurement
+       INTEGER(iwp) ::  il        !<  x-index
+       INTEGER(iwp) ::  is        !<  subgrid box counter
+       INTEGER(iwp) ::  j_offset  !<  index offset for windspeed measurement
+       INTEGER(iwp) ::  jl        !<  y-index
+       INTEGER(iwp) ::  kl        !<  z-index
+       INTEGER(iwp) ::  nl        !<  agent counter
+       INTEGER(iwp) ::  se        !<  subgrid box end index
+       INTEGER(iwp) ::  si        !<  subgrid box start index
+
+       REAL(wp) ::  u_a  !< windspeed at agent position (x)
+       REAL(wp) ::  v_a  !< windspeed at agent position (y)
+       REAL(wp) ::  x_a  !< agent position (x)
+       REAL(wp) ::  y_a  !< agent position (y)
+
+       DO  il = nxl, nxr
+          DO  jl = nys, nyn
+
+             number_of_agents = agt_count(jl,il)
+!
+!--          If grid cell is empty, cycle
+             IF ( number_of_agents <= 0 ) CYCLE
+             kl = s_measure_height(jl,il)
+
+             agents => grid_agents(jl,il)%agents(1:number_of_agents)
+!
+!--          loop over the four subgrid boxes
+             DO is = 0,3
+!
+!--             Set indices
+                si = grid_agents(jl,il)%start_index(is)
+                se = grid_agents(jl,il)%end_index(is)
+                DO nl = si, se
+!
+!--                Calculate index offset in x-direction:
+!--                Left value if wall right of grid box
+!--                Right value if wall left of grid box
+!--                Else the one that is closer to the agent
+                   IF ( BTEST( obstacle_flags( jl, il+1 ), 6 ) ) THEN
+                      i_offset = 0
+                   ELSEIF ( BTEST( obstacle_flags( jl, il-1 ), 2 ) ) THEN
+                      i_offset = 1
+                   ELSE
+                      i_offset = MERGE( 0, 1, BTEST(is,1) )
+                   ENDIF
+                   u_a = u( kl, jl, il + i_offset )
+!
+!--                Calculate index offset in y-direction:
+!--                South value if wall north of grid box
+!--                North value if wall south of grid box
+!--                Else the one that is closer to the agent
+                   IF ( BTEST( obstacle_flags( jl+1, il ), 4 ) ) THEN
+                      j_offset = 0
+                   ELSEIF ( BTEST( obstacle_flags( jl-1, il ), 0 ) ) THEN
+                      j_offset = 1
+                   ELSE
+                      j_offset = MERGE( 0, 1, BTEST(is,0) )
+                   ENDIF
+                   v_a = v( kl, jl + j_offset, il )
+!
+!--                Calculate windspeed at agent postion
+                   agents(nl)%windspeed = SQRT(u_a**2 + v_a**2)
+!
+!--                Calculate temperature at agent position
+                   agents(nl)%t = pt(kl,jl,il) *                               &
+                                  ( hyp(kl) / 100000.0_wp )**0.286_wp
+! !
+! !--                Get PM10 concentration at agent position, if possible
+!                    IF ( ind_pm10 == -9 ) THEN
+!                       agents(nl)%pm10 = 0.0_wp
+!                    ELSE
+!                       agents(nl)%pm10 = chem_species(ind_pm10)%conc(kl,jl,il)
+!                    ENDIF
+! !
+! !--                Get PM10 concentration at agent position, if possible
+!                    IF ( ind_pm25 == -9 ) THEN
+!                       agents(nl)%pm25 = 0.0_wp
+!                    ELSE
+!                       agents(nl)%pm25 = chem_species(ind_pm25)%conc(kl,jl,il)
+!                    ENDIF
+                ENDDO
+
+             ENDDO
+
+          ENDDO
+       ENDDO
+
+    END SUBROUTINE mas_get_prognostic_quantities
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Adds an item to the priority queue (binary heap) at the correct position
+!------------------------------------------------------------------------------! 
+    SUBROUTINE mas_heap_insert_item( id, priority )
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  cur_pos !< current position
+       INTEGER(iwp) ::  id      !< mesh ID of item
+
+       REAL(wp) ::  priority !< item priority
+
+       TYPE(heap_item) ::  item !< heap item
+
+       item%mesh_id  = id
+       item%priority = priority
+!
+!--    Extend heap, if necessary
+       IF ( heap_count + 1 > SIZE(queue) ) THEN
+          CALL mas_heap_extend
+       ENDIF
+!
+!--    Insert item at first unoccupied postion (highest index) of heap
+       cur_pos = heap_count
+       queue(cur_pos) = item
+!
+!--    Sort while inserted item is not at top of heap
+       DO WHILE ( cur_pos /= 0 )
+!
+!--       If priority < its parent's priority, swap them. 
+!--       Else, sorting is done.
+          IF ( queue(cur_pos)%priority                                         &
+              < queue(FLOOR((cur_pos)/2.))%priority )                          &
+          THEN
+             item = queue(cur_pos)
+             queue(cur_pos) = queue(FLOOR((cur_pos)/2.))
+             queue(FLOOR((cur_pos)/2.)) = item
+             cur_pos = FLOOR((cur_pos)/2.)
+          ELSE
+             EXIT
+          ENDIF
+       ENDDO
+!
+!--    Item was added to heap, so the heap count increases
+       heap_count = heap_count + 1
+
+    END SUBROUTINE mas_heap_insert_item
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Extends the size of the priority queue (binary heap)
+!------------------------------------------------------------------------------! 
+    SUBROUTINE mas_heap_extend
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  soh !< size of heap
+
+       TYPE(heap_item), DIMENSION(:), ALLOCATABLE ::  dummy_heap !< dummy heap
+
+       soh = SIZE(queue)-1
+       ALLOCATE(dummy_heap(0:soh))
+       dummy_heap = queue
+       DEALLOCATE(queue)
+       ALLOCATE(queue(0:2*soh+1))
+       queue(0:soh) = dummy_heap(0:soh)
+
+    END SUBROUTINE mas_heap_extend
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Removes first (smallest) element from the priority queue, reorders the rest
+!> and returns the ID of the removed mesh point
+!------------------------------------------------------------------------------!
+    SUBROUTINE mas_heap_extract_item ( id )
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  id      !< ID of item extracted item
+       INTEGER(iwp) ::  child   !< child of item in heap
+       INTEGER(iwp) ::  cur_pos !< current position of item in heap
+
+       TYPE(heap_item) ::  dummy
+!
+!--    Get ID of mesh point with lowest priority (extracted item: top of heap)
+       id = queue(0)%mesh_id
+!
+!--    Put last item in heap at first position
+       queue(0) = queue(heap_count-1)
+       cur_pos = 0
+       DO
+!
+!--       If current item has no children, sorting is done
+          IF( 2*cur_pos+1 > heap_count - 1 ) THEN
+             EXIT
+!
+!--       If current item has only one child, check if item and its child are
+!--       ordered correctly. Else, swap them.
+          ELSEIF ( 2*cur_pos+2 > heap_count - 1 ) THEN
+             IF ( queue(cur_pos)%priority > queue(2*cur_pos+1)%priority ) THEN
+                dummy = queue(cur_pos)
+                queue(cur_pos) = queue(2*cur_pos+1)
+                queue(2*cur_pos+1) = dummy
+                cur_pos = 2*cur_pos+1
+             ELSE
+                EXIT
+             ENDIF
+          ELSE
+!
+!--          determine the smaller child
+             IF ( queue(2*cur_pos+1)%priority                                  &
+                 >= queue(2*cur_pos+2)%priority )                              &
+             THEN
+                child = 2
+             ELSE
+                child = 1
+             ENDIF
+!
+!--          Check if item and its smaller child are ordered falsely. If so, 
+!--          swap them. Else, sorting is done.
+             IF ( queue(cur_pos)%priority > queue(2*cur_pos+child )%priority ) &
+             THEN
+                dummy = queue(cur_pos)
+                queue(cur_pos) = queue(2*cur_pos+child)
+                queue(2*cur_pos+child) = dummy
+                cur_pos = 2*cur_pos+child
+             ELSE
+                EXIT
+             ENDIF
+          ENDIF
+       ENDDO
+!
+!--    Top item was removed from heap, thus, heap_cout decreases by one
+       heap_count = heap_count-1
+
+    END SUBROUTINE mas_heap_extract_item
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Initialization of Multi Agent System
+!------------------------------------------------------------------------------!
+    SUBROUTINE mas_init
+
+       USE chem_gasphase_mod,                                                  &
+           ONLY:  nspec
+
+       USE chemistry_model_mod,                                                &
+           ONLY:  chem_species
+
+       USE control_parameters,                                                 &
+           ONLY:  air_chemistry, coupling_char, initializing_actions,          &
+                  io_blocks, io_group
+
+       USE surface_mod,                                                        &
+           ONLY:  get_topography_top_index, get_topography_top_index_ji
+
+       USE arrays_3d,                                                          &
+           ONLY:  zu, zw
+
+       USE indices,                                                            &
+           ONLY:  nzt 
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i             !< grid cell (x)
+       INTEGER(iwp) ::  ii            !< io-block counter
+       INTEGER(iwp) ::  il            !< io-block counter
+       INTEGER(iwp) ::  jl            !< io-block counter
+       INTEGER(iwp) ::  kl            !< io-block counter
+       INTEGER(iwp) ::  kdum            !< io-block counter
+       INTEGER(iwp) ::  locdum            !< io-block counter
+       INTEGER(iwp) ::  j             !< grid cell (y)
+       INTEGER(iwp) ::  size_of_mesh  !< temporary value for read
+       INTEGER(iwp) ::  size_of_pols  !< temporary value for read
+       INTEGER(iwp) ::  ioerr         !< IOSTAT flag for IO-commands ( 0 = no error )
+
+       REAL(wp) ::  zdum  !< dummy for measurement height
+       REAL(wp) ::  avg_agt_height = 1.8_wp
+
+       INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  noc !< temp: number of connections in nav_mesh
+
+!
+!--    Check the number of agent groups.
+       IF ( number_of_agent_groups > max_number_of_agent_groups )  THEN
+          WRITE( message_string, * ) 'max_number_of_agent_groups =',      &
+                                     max_number_of_agent_groups ,         &
+                                     '&number_of_agent_groups reset to ', &
+                                     max_number_of_agent_groups
+          CALL message( 'mas_init', 'PA0072', 0, 1, 0, 6, 0 )
+          number_of_agent_groups = max_number_of_agent_groups
+       ENDIF
+
+!
+!--    Set some parameters
+       d_sigma_rep_agent = 1.0_wp/sigma_rep_agent
+       d_sigma_rep_wall  = 1.0_wp/sigma_rep_wall
+       d_tau_accel_agent = 1.0_wp/tau_accel_agent
+       IF ( dt_agent /= 999.0_wp ) THEN
+          agent_own_timestep = .TRUE.
+       ENDIF
+
+!
+!--    Get index of first grid box above topography
+       ALLOCATE( top_top_s(nysg:nyng,nxlg:nxrg),                               &
+                 top_top_w(nysg:nyng,nxlg:nxrg),                               &
+                 s_measure_height(nys:nyn,nxl:nxr) )
+!
+!--    Get first index above topography for scalar grid and last index in
+!--    topography for z-component of wind
+       DO il = nxlg, nxrg
+          DO jl = nysg, nyng
+             top_top_s(jl,il) = get_topography_top_index_ji(jl,il,'s') + 1
+             top_top_w(jl,il) = get_topography_top_index_ji(jl,il,'w')
+          ENDDO
+       ENDDO
+!
+!--    Create 2D array containing the index at which measurements are done by
+!--    agents. The height of this measurement is given by avg_agt_height.
+       DO il = nxl, nxr
+          DO jl = nys, nyn
+
+             kdum = top_top_w(jl,il)
+             zdum = zw(kdum)
+             zdum = zdum + avg_agt_height
+             locdum = 0
+!
+!--          Locate minimum distance from u-grid to measurement height (zdum)
+             DO kl = 1, nzt
+                IF ( ABS(zu(kl)-zdum) < ABS(zu(locdum)-zdum) ) locdum = kl
+             ENDDO
+             s_measure_height(jl,il) = locdum
+
+          ENDDO
+       ENDDO
+! !
+! !--    Get indices of PM10 and PM2.5 species, if active
+!        IF ( air_chemistry ) THEN
+!           DO il = 1, nspec
+! print*,chem_species(il)%name
+! !              IF ( spec_name(1:4) == 'PM10' ) THEN  
+! !                 ind_pm10 = il
+! !              ELSEIF ( spec_name(1:4) == 'PM25' ) THEN
+! !                 ind_pm25 = il
+! !              ENDIF
+! 
+!           ENDDO
+!        ENDIF
+! stop
+       CALL mas_create_obstacle_flags
+
+!
+!--    Set default start positions, if necessary
+       IF ( asl(1) == 9999999.9_wp )  asl(1) = 0.0_wp
+       IF ( asr(1) == 9999999.9_wp )  asr(1) = ( nx + 1 ) * dx
+       IF ( ass(1) == 9999999.9_wp )  ass(1) = 0.0_wp
+       IF ( asn(1) == 9999999.9_wp )  asn(1) = ( ny + 1 ) * dy
+       IF ( adx(1) == 9999999.9_wp .OR. adx(1) == 0.0_wp ) adx(1) = dx
+       IF ( ady(1) == 9999999.9_wp .OR. ady(1) == 0.0_wp ) ady(1) = dy
+
+       DO  j = 2, number_of_agent_groups
+          IF ( asl(j) == 9999999.9_wp )  asl(j) = asl(j-1)
+          IF ( asr(j) == 9999999.9_wp )  asr(j) = asr(j-1)
+          IF ( ass(j) == 9999999.9_wp )  ass(j) = ass(j-1)
+          IF ( asn(j) == 9999999.9_wp )  asn(j) = asn(j-1)
+          IF ( adx(j) == 9999999.9_wp .OR. adx(j) == 0.0_wp ) adx(j) = adx(j-1)
+          IF ( ady(j) == 9999999.9_wp .OR. ady(j) == 0.0_wp ) ady(j) = ady(j-1)
+       ENDDO
+
+!
+!--    Check boundary condition and set internal variables
+       SELECT CASE ( bc_mas_lr )
+
+          CASE ( 'cyclic' )
+             ibc_mas_lr = 0
+
+          CASE ( 'absorb' )
+             ibc_mas_lr = 1
+
+          CASE DEFAULT
+             WRITE( message_string, * ) 'unknown boundary condition ',         &
+                                        'bc_mas_lr = "', TRIM( bc_mas_lr ), '"'
+             CALL message( 'mas_init', 'PA0073', 1, 2, 0, 6, 0 )
+
+       END SELECT
+       SELECT CASE ( bc_mas_ns )
+
+          CASE ( 'cyclic' )
+             ibc_mas_ns = 0
+
+          CASE ( 'absorb' )
+             ibc_mas_ns = 1
+
+          CASE DEFAULT
+             WRITE( message_string, * ) 'unknown boundary condition ',         &
+                                        'bc_mas_ns = "', TRIM( bc_mas_ns ), '"'
+             CALL message( 'mas_init', 'PA0074', 1, 2, 0, 6, 0 )
+
+       END SELECT
+
+!
+!--    For the first model run of a possible job chain initialize the
+!--    agents, otherwise read the agent data from restart file.
+       IF ( TRIM( initializing_actions ) == 'read_restart_data'                &
+            .AND.  read_agents_from_restartfile )  THEN
+
+!           CALL mas_read_restart_file
+
+       ELSE
+!
+!--       Read preprocessed data of navigation mesh and building polygons
+!--       for agent pathfinding
+          DO ii = 0, io_blocks-1
+             IF ( ii == io_group )  THEN
+                OPEN ( 119, FILE='NAVIGATION_DATA'//TRIM( coupling_char ),     &
+                            FORM='UNFORMATTED', IOSTAT=ioerr )
+!
+!--             Read mesh data
+                READ(119) size_of_mesh
+                ALLOCATE( mesh(1:size_of_mesh))
+                DO i = 1, size_of_mesh
+                   READ(119) mesh(i)%polygon_id, mesh(i)%vertex_id,            &
+                             mesh(i)%noc, mesh(i)%origin_id,                   &
+                             mesh(i)%cost_so_far, mesh(i)%x,                   &
+                             mesh(i)%y, mesh(i)%x_s, mesh(i)%y_s
+                   ALLOCATE( mesh(i)%connected_vertices(1:mesh(i)%noc),        &
+                             mesh(i)%distance_to_vertex(1:mesh(i)%noc) )
+                   DO j = 1, mesh(i)%noc
+                      READ(119) mesh(i)%connected_vertices(j),                 &
+                                mesh(i)%distance_to_vertex(j)
+                   ENDDO
+                ENDDO
+!
+!--             Read polygon data
+                READ(119) size_of_pols
+                ALLOCATE( polygons(1:size_of_pols) )
+                DO i = 1, size_of_pols
+                   READ(119) polygons(i)%nov
+                   ALLOCATE( polygons(i)%vertices(0:polygons(i)%nov+1) )
+                   DO j = 0, polygons(i)%nov+1
+                      READ(119) polygons(i)%vertices(j)%delete,                &
+                                polygons(i)%vertices(j)%x,                     &
+                                polygons(i)%vertices(j)%y
+                   ENDDO
+                ENDDO
+                CLOSE(119)
+
+             ENDIF
+#if defined( __parallel ) && ! defined ( __check )
+             CALL MPI_BARRIER( comm2d, ierr )
+#endif
+          ENDDO
+
+!
+!--       Allocate agent arrays and set attributes of the initial set of
+!--       agents, which can be also periodically released at later times.
+          ALLOCATE( agt_count  (nysg:nyng,nxlg:nxrg),                            &
+                    grid_agents(nysg:nyng,nxlg:nxrg) )
+
+          number_of_agents = 0
+          sort_count_mas   = 0
+          agt_count        = 0
+
+!
+!--       initialize counter for agent IDs 
+          grid_agents%id_counter = 1
+
+!
+!--       Initialize all agents with dummy values (otherwise errors may
+!--       occur within restart runs). The reason for this is still not clear
+!--       and may be presumably caused by errors in the respective user-interface.
+          zero_agent%agent_mask = .FALSE.
+          zero_agent%block_nr      = -1
+          zero_agent%group         = 0
+          zero_agent%id            = 0_idp
+          zero_agent%path_counter  = SIZE(zero_agent%path_x)
+          zero_agent%age           = 0.0_wp
+          zero_agent%age_m         = 0.0_wp
+          zero_agent%dt_sum        = 0.0_wp
+          zero_agent%clo           = 0.0_wp
+          zero_agent%energy_storage= 0.0_wp
+          zero_agent%force_x       = 0.0_wp
+          zero_agent%force_y       = 0.0_wp
+          zero_agent%origin_x      = 0.0_wp
+          zero_agent%origin_y      = 0.0_wp
+          zero_agent%speed_abs     = 0.0_wp
+          zero_agent%speed_e_x     = 0.0_wp
+          zero_agent%speed_e_y     = 0.0_wp
+          zero_agent%speed_des     = random_normal(desired_speed, des_sp_sig)
+          zero_agent%speed_x       = 0.0_wp
+          zero_agent%speed_y       = 0.0_wp
+          zero_agent%thermal_index = 0.0_wp
+          zero_agent%x             = 0.0_wp
+          zero_agent%y             = 0.0_wp
+          zero_agent%path_x        = 0.0_wp
+          zero_agent%path_y        = 0.0_wp
+          zero_agent%t_x           = 0.0_wp
+          zero_agent%t_y           = 0.0_wp
+
+!
+!--    Set a seed value for the random number generator to be exclusively
+!--    used for the agent code. The generated random numbers should be
+!--    different on the different PEs.
+          iran_agent = iran_agent + myid
+
+          CALL mas_create_agent (PHASE_INIT)
+
+       ENDIF
+
+!
+!--    To avoid programm abort, assign agents array to the local version of 
+!--    first grid cell
+       number_of_agents = agt_count(nys,nxl)
+       agents => grid_agents(nys,nxl)%agents(1:number_of_agents)
+
+    END SUBROUTINE mas_init
+
+!------------------------------------------------------------------------------! 
+! Description:
+! ------------
+!> Adds a connection between two points of the navigation mesh 
+!> (one-way: in_mp1 to in_mp2)
+!------------------------------------------------------------------------------! 
+    SUBROUTINE mas_nav_add_connection ( in_mp1, id2, in_mp2 )
+
+       IMPLICIT NONE
+
+       LOGICAL ::  connection_established  !< Flag to indicate if connection has already been established
+
+       INTEGER(iwp) ::  id2  !< ID of in_mp2
+       INTEGER(iwp) ::  il   !< local counter
+       INTEGER(iwp) ::  noc1 !< number of connections in in_mp1
+
+       INTEGER, DIMENSION(:), ALLOCATABLE ::  dum_cv !< dummy array for connected_vertices
+
+       REAL(wp) ::  dist  !< Distance between the two points
+
+       REAL(wp), DIMENSION(:), ALLOCATABLE ::  dum_dtv
+
+       TYPE(mesh_point) ::  in_mp1  !< mesh point that gets a new connection
+       TYPE(mesh_point) ::  in_mp2  !< mesh point in_mp1 will be connected to
+
+       connection_established = .FALSE.
+!
+!--    Check if connection has already been established
+       noc1 = SIZE(in_mp1%connected_vertices)
+       DO il = 1, in_mp1%noc
+          IF ( in_mp1%connected_vertices(il) == id2 ) THEN
+             connection_established = .TRUE.
+             EXIT
+          ENDIF
+       ENDDO
+
+       IF ( .NOT. connection_established ) THEN
+!
+!--       Resize arrays, if necessary
+          IF ( in_mp1%noc >= noc1 ) THEN
+             ALLOCATE( dum_cv(1:noc1),dum_dtv(1:noc1) )
+             dum_cv  = in_mp1%connected_vertices
+             dum_dtv = in_mp1%distance_to_vertex
+             DEALLOCATE( in_mp1%connected_vertices, in_mp1%distance_to_vertex )
+             ALLOCATE( in_mp1%connected_vertices(1:2*noc1),                    &
+                       in_mp1%distance_to_vertex(1:2*noc1) )
+             in_mp1%connected_vertices         = -999
+             in_mp1%distance_to_vertex         = -999.
+             in_mp1%connected_vertices(1:noc1) = dum_cv
+             in_mp1%distance_to_vertex(1:noc1) = dum_dtv
+          ENDIF
+
+!
+!--       Add connection
+          in_mp1%noc = in_mp1%noc+1
+          dist = SQRT( (in_mp1%x - in_mp2%x)**2 + (in_mp1%y - in_mp2%y)**2 )
+          in_mp1%connected_vertices(in_mp1%noc) = id2
+          in_mp1%distance_to_vertex(in_mp1%noc) = dist
+       ENDIF
+
+    END SUBROUTINE mas_nav_add_connection
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Adds a vertex (curren position of agent or target) to the existing tmp_mesh
+!------------------------------------------------------------------------------! 
+    SUBROUTINE mas_nav_add_vertex_to_mesh ( in_mp, in_id )
+
+       IMPLICIT NONE
+
+       LOGICAL ::  intersection_found !< flag
+
+       INTEGER(iwp) ::  jl    !< mesh point counter
+       INTEGER(iwp) ::  pl    !< polygon counter
+       INTEGER(iwp) ::  vl    !< vertex counter
+       INTEGER(iwp) ::  pid_t !< polygon id of tested mesh point
+       INTEGER(iwp) ::  vid_t !< vertex id of tested mesh point
+       INTEGER(iwp) ::  in_id !< vertex id of tested mesh point
+
+       REAL(wp) ::  v1x !< x-coordinate of test vertex 1 for intersection test
+       REAL(wp) ::  v1y !< y-coordinate of test vertex 1 for intersection test
+       REAL(wp) ::  v2x !< x-coordinate of test vertex 2 for intersection test
+       REAL(wp) ::  v2y !< y-coordinate of test vertex 2 for intersection test
+       REAL(wp) ::  x   !< x-coordinate of current mesh point
+       REAL(wp) ::  x_t !< x-coordinate of tested mesh point
+       REAL(wp) ::  y   !< y-coordinate of current mesh point
+       REAL(wp) ::  y_t !< y-coordinate of tested mesh point
+
+       TYPE(mesh_point) ::  in_mp !< Input mesh point
+!
+!--
+       x = in_mp%x
+       y = in_mp%y
+       DO jl = 0, SIZE(tmp_mesh)-2
+          IF ( in_id == jl ) CYCLE
+!
+!--       Ignore mesh points with 0 connections
+          IF ( tmp_mesh(jl)%polygon_id /= -1 ) THEN
+             IF ( tmp_mesh(jl)%noc == 0 ) CYCLE
+          ENDIF
+          x_t = tmp_mesh(jl)%x
+          y_t = tmp_mesh(jl)%y
+          pid_t = tmp_mesh(jl)%polygon_id
+          vid_t = tmp_mesh(jl)%vertex_id
+!
+!--       If the connecting line between the target and a mesh point points 
+!--       into the mesh point's polygon, no connection will be 
+!--       established between the two points. This is the case if the 
+!--       previous (next) vertex of the polygon is right of the connecting
+!--       line and the next (previous) vertex of the polygon is left of the
+!--       connecting line.
+          IF ( pid_t > 0 .AND. pid_t <= SIZE(polygons) ) THEN
+             IF ( (((is_left(x,y,x_t,y_t,polygons(pid_t)%vertices(vid_t-1)%x,  &
+                                       polygons(pid_t)%vertices(vid_t-1)%y)    &
+                  .AND. is_right(x,y,x_t,y_t,                                  &
+                                       polygons(pid_t)%vertices(vid_t+1)%x,    &
+                                       polygons(pid_t)%vertices(vid_t+1)%y) )  &
+                  .OR. (is_right(x,y,x_t,y_t,                                  &
+                                       polygons(pid_t)%vertices(vid_t-1)%x,    &
+                                       polygons(pid_t)%vertices(vid_t-1)%y)    &
+                  .AND. is_left(x,y,x_t,y_t,                                   &
+                                       polygons(pid_t)%vertices(vid_t+1)%x,    &
+                                       polygons(pid_t)%vertices(vid_t+1)%y)))))&
+             THEN
+                CYCLE
+             ENDIF
+          ENDIF
+!
+!--       For each edge of each polygon, check if it intersects with the 
+!--       potential connection. If at least one intersection is found,
+!--       no connection can be made
+          intersection_found = .FALSE.
+          DO pl = 1, SIZE(polygons)
+             DO vl = 1, polygons(pl)%nov
+                v1x = polygons(pl)%vertices(vl)%x
+                v1y = polygons(pl)%vertices(vl)%y
+                v2x = polygons(pl)%vertices(vl+1)%x
+                v2y = polygons(pl)%vertices(vl+1)%y
+                intersection_found = intersect(x,y,x_t,y_t,v1x,v1y,v2x,v2y)
+                IF ( intersection_found ) THEN
+                   EXIT
+                ENDIF
+             ENDDO
+             IF ( intersection_found ) EXIT
+          ENDDO
+          IF ( intersection_found ) CYCLE
+!
+!--       If neither of the above two test was true, a connection will be
+!--       established between the two mesh points.
+          CALL mas_nav_add_connection(in_mp,jl, tmp_mesh(jl))
+          CALL mas_nav_add_connection(tmp_mesh(jl),in_id, in_mp)
+       ENDDO
+       CALL mas_nav_reduce_connections(in_mp)
+
+    END SUBROUTINE mas_nav_add_vertex_to_mesh
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Creates a temporary copy of the navigation mesh to be used for pathfinding
+!------------------------------------------------------------------------------!
+    SUBROUTINE mas_nav_create_tmp_mesh( a_x, a_y, t_x, t_y, som )
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  som !< size of mesh
+       INTEGER(iwp) ::  noc !< number of connetions
+       INTEGER(iwp) ::  im  !< local mesh point counter
+
+       REAL(wp) ::  a_x !< x-coordinate agent
+       REAL(wp) ::  a_y !< y-coordinate agent
+       REAL(wp) ::  t_x !< x-coordinate target
+       REAL(wp) ::  t_y !< y-coordinate target
+!
+!--    give tmp_mesh the size of mesh
+       som = SIZE(mesh)+1
+       ALLOCATE(tmp_mesh(0:som))
+!
+!--    give the allocatable variables in tmp_mesh their respctive sizes
+       DO im = 1, som-1
+          noc = mesh(im)%noc
+          ALLOCATE(tmp_mesh(im)%connected_vertices(1:noc))
+          ALLOCATE(tmp_mesh(im)%distance_to_vertex(1:noc))
+       ENDDO
+!
+!--    copy mesh to tmp_mesh
+       tmp_mesh(1:som-1) = mesh(1:som-1)
+!
+!--    Add target point ...
+       CALL mas_nav_init_mesh_point(tmp_mesh(0),-1_iwp,-1_iwp,t_x, t_y)
+       CALL mas_nav_add_vertex_to_mesh(tmp_mesh(0),0_iwp)
+!
+!--    ... and start point to temp mesh
+       CALL mas_nav_init_mesh_point(tmp_mesh(som),-1_iwp,-1_iwp,a_x, a_y)
+       CALL mas_nav_add_vertex_to_mesh(tmp_mesh(som),som)
+
+    END SUBROUTINE mas_nav_create_tmp_mesh
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Finds the shortest path from agent position to target using A*-algorithm
+!------------------------------------------------------------------------------!
+    SUBROUTINE mas_nav_find_path( i_ag )
+
+       IMPLICIT NONE
+
+       LOGICAL ::  target_reached !< flag
+
+       INTEGER(iwp) ::  cur_node     !< current node of binary heap
+       INTEGER(iwp) ::  i_ag         !< agent index
+       INTEGER(iwp) ::  il           !< counter (x)
+       INTEGER(iwp) ::  jl           !< counter (y)
+       INTEGER(iwp) ::  neigh_node   !< neighbor node
+       INTEGER(iwp) ::  node_counter !< binary heap node counter
+       INTEGER(iwp) ::  path_ag      !< index of agent path
+       INTEGER(iwp) ::  som          !< size of mesh
+       INTEGER(iwp) ::  rn_side      !< index of agent path
+       INTEGER(iwp) ::  steps        !< steps along the path
+
+       REAL(wp) ::  a_x          !< x-coordinate agent
+       REAL(wp) ::  a_y          !< y-coordinate agent
+       REAL(wp) ::  new_cost     !< updated cost to reach node
+       REAL(wp) ::  new_priority !< priority of node to be added to queue
+       REAL(wp) ::  rand_nr      !< x-coordinate target
+       REAL(wp) ::  rn_gate      !< random number for corner gate
+       REAL(wp) ::  t_x          !< x-coordinate target
+       REAL(wp) ::  t_y          !< y-coordinate target
+!
+!--    Coordinate Type
+       TYPE coord
+          REAL(wp) ::  x   !< x-coordinate
+          REAL(wp) ::  x_s !< x-coordinate (shifted)
+          REAL(wp) ::  y   !< y-coordinate
+          REAL(wp) ::  y_s !< y-coordinate (shifted)
+       END TYPE coord
+
+       TYPE(coord), DIMENSION(:), ALLOCATABLE, TARGET ::  path     !< path array
+       TYPE(coord), DIMENSION(:), ALLOCATABLE, TARGET ::  tmp_path !< temporary path for resizing
+
+       CALL cpu_log( log_point_s(20), 'mas_nav_find_path', 'start' )
+       node_counter = 0
+       a_x = agents(i_ag)%x
+       a_y = agents(i_ag)%y
+       t_x = agents(i_ag)%t_x
+       t_y = agents(i_ag)%t_y
+
+!
+!--    Create temporary navigation mesh including agent and target positions
+       CALL mas_nav_create_tmp_mesh( a_x, a_y, t_x, t_y, som )
+       tmp_mesh(som)%cost_so_far = 0.0_wp
+!
+!--    Initialize priority queue
+       heap_count = 0_iwp
+       ALLOCATE(queue(0:100))
+       target_reached = .FALSE.
+!
+!--    Add starting point (agent position) to frontier (the frontier consists
+!--    of all the nodes that are to be visited. The node with the smallest
+!--    priority will be visited first. The priority consists of the distance
+!--    from the start node to this node plus a minimal guess (direct distance)
+!--    from this node to the goal). For the starting node, the priority is set
+!--    to 0, as it's the only node thus far
+       CALL mas_heap_insert_item(som,0.0_wp)
+       cur_node = som
+       DO WHILE ( heap_count > 0 )
+!
+!--       Step one: Pick lowest priority item from queue
+          node_counter = node_counter + 1
+          CALL mas_heap_extract_item(cur_node)
+!
+!--       Node 0 is the goal node
+          IF ( cur_node == 0 ) THEN
+             EXIT
+          ENDIF
+!
+!--       Loop over all of cur_node's neighbors
+          DO il = 1, tmp_mesh(cur_node)%noc
+             neigh_node = tmp_mesh(cur_node)%connected_vertices(il)
+!
+!--          Check, if the way from the start node to this neigh_node via
+!--          cur_node is shorter than the previously found shortest path to it.
+!--          If so, replace said cost and add neigh_node to the frontier.
+!--          cost_so_far is initialized as 1.d12 so that all found distances
+!--          should be smaller.
+             new_cost   = tmp_mesh(cur_node)%cost_so_far                       &
+                         + tmp_mesh(cur_node)%distance_to_vertex(il)
+             IF ( new_cost < tmp_mesh(neigh_node)%cost_so_far ) THEN
+                tmp_mesh(neigh_node)%cost_so_far = new_cost
+                tmp_mesh(neigh_node)%origin_id   = cur_node
+!
+!--             Priority in the queue is cost_so_far + heuristic to goal
+                new_priority = new_cost                                        &
+                              + heuristic(tmp_mesh(neigh_node)%x,              &
+                                tmp_mesh(neigh_node)%y, tmp_mesh(0)%x,         &
+                                tmp_mesh(0)%y)
+                CALL mas_heap_insert_item(neigh_node,new_priority)
+             ENDIF
+          ENDDO
+       ENDDO
+!
+!--    Pathfinding is done. Add nodes to a path array, then give the
+!--    first 15 intermittent targets to the agent.
+       DEALLOCATE(queue)
+       cur_node = 0
+       steps = 0
+       ALLOCATE(path(1:100))
+       DO WHILE ( cur_node /= -1 )
+          steps = steps + 1
+!
+!--       Resize path array if necessary
+          IF ( steps > SIZE(path) ) THEN
+             ALLOCATE(tmp_path(1:steps-1))
+             tmp_path(1:steps-1) = path(1:steps-1)
+             DEALLOCATE(path)
+             ALLOCATE(path(1:2*(steps-1)))
+             path(1:steps-1) = tmp_path(1:steps-1)
+             DEALLOCATE(tmp_path)
+          ENDIF
+          path(steps)%x = tmp_mesh(cur_node)%x
+          path(steps)%y = tmp_mesh(cur_node)%y
+          path(steps)%x_s = tmp_mesh(cur_node)%x_s
+          path(steps)%y_s = tmp_mesh(cur_node)%y_s
+          cur_node = tmp_mesh(cur_node)%origin_id
+       ENDDO
+!
+!--    Add calculated intermittent targets to agent path until either the 
+!--    target or the maximum number of intermittent targets is reached.
+!--    Ignore starting point (reduce index by one), it is agent position.
+       path_ag = 1
+       steps = steps - 1
+       DO WHILE( steps > 0 .AND. path_ag < SIZE(agents(i_ag)%path_x) )
+!
+!--       Each target point is randomly chosen along a line target along the
+!--       bisector of the building corner that starts at corner_gate_start
+!--       and has a width of corner_gate_width. This is to avoid clustering
+!--       when opposing agent groups try to reach the same corner target.
+          rn_gate = random_function(iran_agent) * corner_gate_width            &
+                                                + corner_gate_start
+          agents(i_ag)%path_x(path_ag) = path(steps)%x + rn_gate               &
+                                         * (path(steps)%x_s - path(steps)%x)
+          agents(i_ag)%path_y(path_ag) = path(steps)%y + rn_gate               &
+                                         * (path(steps)%y_s - path(steps)%y)
+          steps = steps - 1
+          path_ag = path_ag + 1
+       ENDDO
+!
+!--    Set current intermittent target of this agent
+       agents(i_ag)%path_counter = 1
+       DEALLOCATE(tmp_mesh, path)
+       CALL cpu_log( log_point_s(20), 'mas_nav_find_path', 'stop' )
+
+    END SUBROUTINE mas_nav_find_path
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Reduces the size of connection array to the amount of actual connections
+!> after all connetions were added to a mesh point
+!------------------------------------------------------------------------------!
+    SUBROUTINE mas_nav_reduce_connections ( in_mp )
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  noc  !< number of connections
+
+       INTEGER, DIMENSION(:), ALLOCATABLE ::  dum_cv   !< dummy connected_vertices
+
+       REAL(wp), DIMENSION(:), ALLOCATABLE ::  dum_dtv !< dummy distance_to_vertex
+
+       TYPE(mesh_point) ::  in_mp
+
+       noc = in_mp%noc
+       ALLOCATE( dum_cv(1:noc),dum_dtv(1:noc) )
+       dum_cv  = in_mp%connected_vertices(1:noc)
+       dum_dtv = in_mp%distance_to_vertex(1:noc)
+       DEALLOCATE( in_mp%connected_vertices, in_mp%distance_to_vertex )
+       ALLOCATE( in_mp%connected_vertices(1:noc),                    &
+                 in_mp%distance_to_vertex(1:noc) )
+       in_mp%connected_vertices(1:noc) = dum_cv(1:noc)
+       in_mp%distance_to_vertex(1:noc) = dum_dtv(1:noc)
+
+    END SUBROUTINE mas_nav_reduce_connections
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Initializes a point of the navigation mesh
+!------------------------------------------------------------------------------!
+    SUBROUTINE mas_nav_init_mesh_point ( in_mp, pid, vid, x, y )
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  pid !< polygon ID
+       INTEGER(iwp) ::  vid !< vertex ID
+
+       REAL(wp) ::  x !< x-coordinate
+       REAL(wp) ::  y !< y-coordinate
+
+       TYPE(mesh_point) ::  in_mp !< mesh point to be initialized
+
+       in_mp%origin_id          = -1
+       in_mp%polygon_id         = pid
+       in_mp%vertex_id          = vid
+       in_mp%cost_so_far        = 1.d12
+       in_mp%x                  = x
+       in_mp%y                  = y
+       in_mp%x_s                = x
+       in_mp%y_s                = y
+       ALLOCATE(in_mp%connected_vertices(1:100),                               &
+                in_mp%distance_to_vertex(1:100))
+       in_mp%connected_vertices = -999
+       in_mp%distance_to_vertex = -999.
+       in_mp%noc                = 0
+
+    END SUBROUTINE mas_nav_init_mesh_point
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Reading of namlist from parin file
+!------------------------------------------------------------------------------!
+    SUBROUTINE mas_parin
+
+       USE control_parameters,                                                 &
+           ONLY: agent_time_unlimited
+
+       IMPLICIT NONE
+
+       CHARACTER (LEN=80) ::  line  !<
+
+       NAMELIST /agents_par/  a_rand_target, adx, ady, agent_maximum_age,      &
+                              agent_time_unlimited, alloc_factor_mas, asl, asn,&
+                              asr, ass, at_x, at_y, bc_mas_lr, bc_mas_ns,      &
+                              coll_t_0, corner_gate_start, corner_gate_width,  &
+                              deallocate_memory_mas, dist_to_int_target,       &
+                              dt_agent, dt_arel, dt_write_agent_data,&
+                              end_time_arel, max_dist_from_path, min_nr_agent, &
+                              multi_agent_system_start, number_of_agent_groups,&
+                              radius_agent, random_start_position_agents,      &
+                              read_agents_from_restartfile, repuls_agent,      &
+                              repuls_wall, scan_radius_agent, sigma_rep_agent, &
+                              sigma_rep_wall, step_dealloc_mas, tau_accel_agent
+
+!
+!--    Try to find agent package
+       REWIND ( 11 )
+       line = ' '
+       DO   WHILE ( INDEX( line, '&agents_par' ) == 0 )
+          READ ( 11, '(A)', END=20 )  line
+       ENDDO
+       BACKSPACE ( 11 )
+
+!
+!--    Read user-defined namelist
+       READ ( 11, agents_par )
+
+!
+!--    Set flag that indicates that agents are switched on
+       agents_active = .TRUE.
+
+ 20    CONTINUE
+
+    END SUBROUTINE mas_parin
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Routine for the whole processor
+!> Sort all agents into the 4 respective subgrid boxes
+!------------------------------------------------------------------------------!
+    SUBROUTINE mas_ps_sort_in_subboxes
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  i           !< grid box (x)
+       INTEGER(iwp) ::  ip          !< counter (x)
+       INTEGER(iwp) ::  is          !< box counter
+       INTEGER(iwp) ::  j           !< grid box (y)
+       INTEGER(iwp) ::  jp          !< counter (y)
+       INTEGER(iwp) ::  m           !< sorting index
+       INTEGER(iwp) ::  n           !< agent index
+       INTEGER(iwp) ::  nn          !< agent counter
+       INTEGER(iwp) ::  sort_index  !< sorting index
+
+       INTEGER(iwp), DIMENSION(0:3) ::  sort_count  !< number of agents in one subbox
+
+       TYPE(agent_type), DIMENSION(:,:), ALLOCATABLE ::  sort_agents  !< sorted agent array
+
+       CALL cpu_log( log_point_s(21), 'mas_ps_sort_in_subboxes', 'start' )
+       DO  ip = nxl, nxr
+          DO  jp = nys, nyn
+             number_of_agents = agt_count(jp,ip)
+             IF ( number_of_agents <= 0 )  CYCLE
+             agents => grid_agents(jp,ip)%agents(1:number_of_agents)
+
+             nn = 0
+             sort_count = 0
+             ALLOCATE( sort_agents(number_of_agents, 0:3) )
+
+             DO  n = 1, number_of_agents
+                sort_index = 0
+
+                IF ( agents(n)%agent_mask )  THEN
+                   nn = nn + 1
+!
+!--                Sorting agents with a binary scheme
+!--                sort_index=11_2=3_10 -> agent at the left,south subgridbox
+!--                sort_index=10_2=2_10 -> agent at the left,north subgridbox
+!--                sort_index=01_2=1_10 -> agent at the right,south subgridbox
+!--                sort_index=00_2=0_10 -> agent at the right,north subgridbox
+!--                For this the center of the gridbox is calculated 
+                   i = (agents(n)%x + 0.5_wp * dx) * ddx
+                   j = (agents(n)%y + 0.5_wp * dy) * ddy
+
+                   IF ( i == ip )  sort_index = sort_index + 2
+                   IF ( j == jp )  sort_index = sort_index + 1
+
+                   sort_count(sort_index) = sort_count(sort_index) + 1
+                   m = sort_count(sort_index)
+                   sort_agents(m,sort_index) = agents(n)
+                   sort_agents(m,sort_index)%block_nr = sort_index
+                ENDIF
+             ENDDO
+
+             nn = 0
+             DO is = 0,3
+                grid_agents(jp,ip)%start_index(is) = nn + 1
+                DO n = 1,sort_count(is)
+                   nn = nn + 1
+                   agents(nn) = sort_agents(n,is)
+                ENDDO
+                grid_agents(jp,ip)%end_index(is) = nn
+             ENDDO
+
+             number_of_agents = nn
+             agt_count(jp,ip) = number_of_agents
+             DEALLOCATE(sort_agents)
+          ENDDO
+       ENDDO
+       CALL cpu_log( log_point_s(21), 'mas_ps_sort_in_subboxes', 'stop' )
+
+    END SUBROUTINE mas_ps_sort_in_subboxes
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Move all agents not marked for deletion to lowest indices (packing)
+!------------------------------------------------------------------------------!
+    SUBROUTINE mas_ps_pack
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  n  !< agent counter
+       INTEGER(iwp) ::  nn !< number of agents
+!
+!--    Find out elements marked for deletion and move data from highest index
+!--    values to these free indices
+       nn = number_of_agents
+
+       DO WHILE ( .NOT. agents(nn)%agent_mask )
+          nn = nn-1
+          IF ( nn == 0 )  EXIT
+       ENDDO
+
+       IF ( nn > 0 )  THEN
+          DO  n = 1, number_of_agents
+             IF ( .NOT. agents(n)%agent_mask )  THEN
+                agents(n) = agents(nn)
+                nn = nn - 1
+                DO WHILE ( .NOT. agents(nn)%agent_mask )
+                   nn = nn-1
+                   IF ( n == nn )  EXIT
+                ENDDO
+             ENDIF
+             IF ( n == nn )  EXIT
+          ENDDO
+       ENDIF
+
+!
+!--    The number of deleted agents has been determined in routines
+!--    mas_boundary_conds, mas_droplet_collision, and mas_eh_exchange_horiz
+       number_of_agents = nn
+
+    END SUBROUTINE mas_ps_pack 
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Sort agents in each sub-grid box into two groups: agents that already
+!> completed the LES timestep, and agents that need further timestepping to
+!> complete the LES timestep.
+!------------------------------------------------------------------------------!
+    SUBROUTINE mas_ps_sort_timeloop_done
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) :: end_index     !< agent end index for each sub-box
+       INTEGER(iwp) :: i             !< index of agent grid box in x-direction
+       INTEGER(iwp) :: j             !< index of agent grid box in y-direction
+       INTEGER(iwp) :: n             !< running index for number of agents
+       INTEGER(iwp) :: nb            !< index of subgrid boux
+       INTEGER(iwp) :: nf            !< indices for agents in each sub-box that already finalized their substeps
+       INTEGER(iwp) :: nnf           !< indices for agents in each sub-box that need further treatment
+       INTEGER(iwp) :: num_finalized !< number of agents in each sub-box that already finalized their substeps
+       INTEGER(iwp) :: start_index   !< agent start index for each sub-box
+
+       TYPE(agent_type), DIMENSION(:), ALLOCATABLE :: sort_agents  !< temporary agent array 
+
+       DO  i = nxl, nxr
+          DO  j = nys, nyn
+
+             number_of_agents = agt_count(j,i)
+             IF ( number_of_agents <= 0 )  CYCLE
+
+             agents => grid_agents(j,i)%agents(1:number_of_agents)
+
+             DO  nb = 0, 3
+!
+!--             Obtain start and end index for each subgrid box
+                start_index = grid_agents(j,i)%start_index(nb)
+                end_index   = grid_agents(j,i)%end_index(nb)
+!
+!--             Allocate temporary array used for sorting
+                ALLOCATE( sort_agents(start_index:end_index) )
+!
+!--             Determine number of agents already completed the LES 
+!--             timestep, and write them into a temporary array
+                nf = start_index
+                num_finalized = 0
+                DO  n = start_index, end_index
+                   IF ( dt_3d - agents(n)%dt_sum < 1E-8_wp )  THEN
+                      sort_agents(nf) = agents(n)
+                      nf              = nf + 1
+                      num_finalized   = num_finalized + 1
+                   ENDIF
+                ENDDO
+!
+!--             Determine number of agents that not completed the LES 
+!--             timestep, and write them into a temporary array
+                nnf = nf
+                DO  n = start_index, end_index
+                   IF ( dt_3d - agents(n)%dt_sum > 1E-8_wp )  THEN
+                      sort_agents(nnf) = agents(n)
+                      nnf              = nnf + 1
+                   ENDIF
+                ENDDO
+!
+!--             Write back sorted agents
+                agents(start_index:end_index) =                          &
+                                        sort_agents(start_index:end_index)
+!
+!--             Determine updated start_index, used to masked already 
+!--             completed agents. 
+                grid_agents(j,i)%start_index(nb) =                     &
+                                   grid_agents(j,i)%start_index(nb)    &
+                                 + num_finalized
+!
+!--             Deallocate dummy array
+                DEALLOCATE ( sort_agents )
+!
+!--             Finally, if number of non-completed agents is non zero 
+!--             in any of the sub-boxes, set control flag appropriately. 
+                IF ( nnf > nf )                                             &
+                   grid_agents(j,i)%time_loop_done = .FALSE.
+
+             ENDDO
+          ENDDO
+       ENDDO
+
+    END SUBROUTINE mas_ps_sort_timeloop_done
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Calls social forces calculations
+!------------------------------------------------------------------------------!
+    SUBROUTINE mas_timestep_forces_call ( ip, jp )
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  ip  !< counter, x-direction
+       INTEGER(iwp) ::  jp  !< counter, y-direction
+       INTEGER(iwp) ::  n   !< loop variable over all agents in a grid box
+
+!
+!--    Get direction for all agents in current grid cell
+       CALL mas_agent_direction
+
+       CALL cpu_log( log_point_s(9), 'mas_transport', 'continue' )
+       DO n = 1, number_of_agents
+
+          force_x = 0.0_wp
+          force_y = 0.0_wp
+
+          CALL mas_timestep_social_forces ( 'acceleration', n, ip, jp )
+
+          CALL mas_timestep_social_forces ( 'other_agents', n, ip, jp )
+
+          CALL mas_timestep_social_forces ( 'walls',        n, ip, jp )
+!
+!--       Update forces
+          agents(n)%force_x = force_x
+          agents(n)%force_y = force_y
+       ENDDO
+
+       CALL cpu_log( log_point_s(9), 'mas_transport', 'pause' )
+
+
+    END SUBROUTINE mas_timestep_forces_call
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Euler timestep of agent transport
+!------------------------------------------------------------------------------!
+    SUBROUTINE mas_timestep
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  n !< loop variable over all agents in a grid box
+
+       REAL(wp) ::  abs_v !< absolute value of velocity
+       REAL(wp) ::  abs_f !< absolute value of force
+
+       CALL cpu_log( log_point_s(9), 'mas_transport', 'continue' )
+
+       DO n = 1, number_of_agents
+!
+!--       Limit absolute force to a maximum to prevent unrealistic acceleration
+          abs_f = SQRT((agents(n)%force_x)**2 + (agents(n)%force_y)**2)
+          IF ( abs_f > 20. ) THEN
+             agents(n)%force_x = agents(n)%force_x * 20. / abs_f
+             agents(n)%force_y = agents(n)%force_y * 20. / abs_f
+          ENDIF
+!
+!--       Update agent speed
+          agents(n)%speed_x = agents(n)%speed_x + agents(n)%force_x * dt_agent
+          agents(n)%speed_y = agents(n)%speed_y + agents(n)%force_y * dt_agent
+!
+!--       Reduction of agent speed to maximum agent speed
+          abs_v = SQRT((agents(n)%speed_x)**2 + (agents(n)%speed_y)**2)
+          IF ( abs_v > v_max_agent ) THEN
+             agents(n)%speed_x = agents(n)%speed_x * v_max_agent / abs_v
+             agents(n)%speed_y = agents(n)%speed_y * v_max_agent / abs_v
+          ENDIF
+!
+!--       Update agent position
+          agents(n)%x = agents(n)%x + agents(n)%speed_x * dt_agent
+          agents(n)%y = agents(n)%y + agents(n)%speed_y * dt_agent
+!
+!--       Update absolute value of agent speed
+          agents(n)%speed_abs = abs_v
+!
+!--       Increment the agent age and the total time that the agent
+!--       has advanced within the agent timestep procedure
+          agents(n)%age_m  = agents(n)%age
+          agents(n)%age    = agents(n)%age    + dt_agent
+          agents(n)%dt_sum = agents(n)%dt_sum + dt_agent
+!
+!--       Check whether there is still an agent that has not yet completed 
+!--       the total LES timestep
+          IF ( ( dt_3d - agents(n)%dt_sum ) > 1E-8_wp )  THEN
+             dt_3d_reached_l_mas = .FALSE.
+          ENDIF
+
+       ENDDO
+
+       CALL cpu_log( log_point_s(9), 'mas_transport', 'pause' )
+
+
+    END SUBROUTINE mas_timestep
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Calculates the Social Forces (Helbing and Molnar, 1995) that the agent
+!> experiences due to acceleration towards target and repulsion by obstacles
+!------------------------------------------------------------------------------!
+    SUBROUTINE mas_timestep_social_forces ( mode, nl, ip, jp )
+
+       USE constants,                                                          &
+           ONLY:  pi
+
+       IMPLICIT NONE
+
+       CHARACTER (LEN=*) ::  mode  !< identifier for the mode of calculation
+
+       INTEGER(iwp) ::  ij_dum      !< index of nearest wall
+       INTEGER(iwp) ::  il          !< index variable along x 
+       INTEGER(iwp) ::  ip          !< index variable along x 
+       INTEGER(iwp) ::  jl          !< index variable along y
+       INTEGER(iwp) ::  jp          !< index variable along y
+       INTEGER(iwp) ::  nl          !< loop variable over all agents in a grid box
+       INTEGER(iwp) ::  no          !< loop variable over all agents in a grid box
+       INTEGER(iwp) ::  noa         !< amount of agents in a grid box 
+       INTEGER(iwp) ::  sc_x_end    !< index for scan for topography/other agents
+       INTEGER(iwp) ::  sc_x_start  !< index for scan for topography/other agents
+       INTEGER(iwp) ::  sc_y_end    !< index for scan for topography/other agents
+       INTEGER(iwp) ::  sc_y_start  !< index for scan for topography/other agents
+
+       LOGICAL ::  corner_found  !< flag that indicates a corner has been found near agent
+
+       REAL(wp) ::  a_pl             !< factor for collision avoidance
+       REAL(wp) ::  ax_semimaj       !< semiminor axis of repulsive ellipse
+       REAL(wp) ::  b_pl             !< factor for collision avoidance
+       REAL(wp) ::  c_pl             !< factor for collision avoidance
+       REAL(wp) ::  coll_t           !< time at which the next collision would happen
+       REAL(wp) ::  d_coll_t_0       !< inverse of collision cutoff time
+       REAL(wp) ::  d_pl             !< factor for collision avoidance
+       REAL(wp) ::  ddum_f           !< dummy devisor collision avoidance
+       REAL(wp) ::  dist             !< distance to obstacle
+       REAL(wp) ::  dist_sq          !< distance to obstacle squared
+       REAL(wp) ::  dummy_coll_time  !< dummy for collision time
+       REAL(wp) ::  pos_rel_x        !< relative position of two agents (x)
+       REAL(wp) ::  pos_rel_y        !< relative position of two agents (y)
+       REAL(wp) ::  r_sq             !< y-position
+       REAL(wp) ::  sra              !< scan radius (agents)
+       REAL(wp) ::  srw              !< local variable for scan radius (walls)
+       REAL(wp) ::  v_rel_x          !< relative velocity (x); collision avoidance
+       REAL(wp) ::  v_rel_y          !< relative velocity (y); collision avoidance
+       REAL(wp) ::  x_a              !< x-position
+       REAL(wp) ::  x_wall           !< x-position of wall
+       REAL(wp) ::  y_a              !< y-position
+       REAL(wp) ::  y_wall           !< y-position of wall
+
+       REAL(wp), PARAMETER ::  k_pl = 1.5  !< factor for collision avoidance
+
+       TYPE(agent_type), DIMENSION(:), POINTER ::  l_agts !< agents that repulse current agent
+
+!
+!--    Initialization
+       x_a = agents(nl)%x
+       y_a = agents(nl)%y
+
+       SELECT CASE ( TRIM( mode ) )
+!
+!--       Calculation of force due to agent trying to approach desired velocity
+          CASE ( 'acceleration' )
+
+             force_x = force_x + d_tau_accel_agent                             &
+                          * ( agents(nl)%speed_des*agents(nl)%speed_e_x        &
+                             -agents(nl)%speed_x )
+
+             force_y = force_y + d_tau_accel_agent                             &
+                          * ( agents(nl)%speed_des*agents(nl)%speed_e_y        &
+                             -agents(nl)%speed_y )
+
+!
+!--       Calculation of repulsive forces by other agents in a radius around the
+!--       current one
+          CASE ( 'other_agents' )
+             CALL cpu_log( log_point_s(16), 'mas_other_agents', 'continue' )
+
+             sra = scan_radius_agent
+             d_coll_t_0 = 1./coll_t_0
+!
+!--          Find relevant gridboxes (those that could contain agents within
+!--          scan radius)
+             sc_x_start = FLOOR( (x_a - sra) * ddx )
+             sc_x_end   = FLOOR( (x_a + sra) * ddx )
+             sc_y_start = FLOOR( (y_a - sra) * ddx )
+             sc_y_end   = FLOOR( (y_a + sra) * ddx )
+             IF ( sc_x_start < nxlg ) sc_x_start = nxlg
+             IF ( sc_x_end   > nxrg ) sc_x_end   = nxrg
+             IF ( sc_y_start < nysg ) sc_y_start = nysg
+             IF ( sc_y_end   > nyng ) sc_y_end   = nyng
+
+             sra = sra**2
+!
+!--          Loop over all previously found relevant gridboxes
+             DO il = sc_x_start, sc_x_end
+                DO jl = sc_y_start, sc_y_end
+                   noa = agt_count(jl,il)
+                   IF ( noa <= 0 )  CYCLE
+                   l_agts => grid_agents(jl,il)%agents(1:noa)
+                   DO no = 1, noa
+!
+!--                   Skip self
+                      IF ( jl == jp .AND. il == ip .AND. no == nl ) CYCLE
+                      pos_rel_x = l_agts(no)%x - x_a
+                      pos_rel_y = l_agts(no)%y - y_a
+                      dist_sq = pos_rel_x**2 + pos_rel_y**2
+                      IF ( dist_sq > sra ) CYCLE
+                      r_sq    = (2*radius_agent)**2
+                      v_rel_x   = agents(nl)%speed_x - l_agts(no)%speed_x
+                      v_rel_y   = agents(nl)%speed_y - l_agts(no)%speed_y
+!
+!--                   Collision is already occuring, default to standard
+!--                   social forces
+                      IF ( dist_sq <= r_sq ) THEN
+                         dist = SQRT(dist_sq) + 1.0d-12
+                         ax_semimaj = .5_wp*SQRT( dist )
+
+                         force_x = force_x - 0.125_wp * repuls_agent           &
+                                        * d_sigma_rep_agent / ax_semimaj       &
+                                        * EXP( -ax_semimaj*d_sigma_rep_agent ) &
+                                        * (pos_rel_x/dist)
+
+                         force_y = force_y - 0.125_wp * repuls_agent           &
+                                        * d_sigma_rep_agent / ax_semimaj       &
+                                        * EXP( -ax_semimaj*d_sigma_rep_agent ) &
+                                        * (pos_rel_y/dist)
+!
+!--                   Currently no collision, calculate collision avoidance
+!--                   force according to Karamouzas et al (2014, PRL 113,238701)
+                      ELSE
+!
+!--                     factors
+                         a_pl = v_rel_x**2 +  v_rel_y**2
+                         b_pl = pos_rel_x*v_rel_x + pos_rel_y*v_rel_y
+                         c_pl = dist_sq - r_sq
+                         d_pl = b_pl**2 - a_pl*c_pl
+!
+!--                      If the two agents are moving non-parallel, calculate
+!--                      collision avoidance social force
+                         IF ( d_pl > 0.0_wp .AND.                              &
+                            ( a_pl < -0.00001 .OR. a_pl > 0.00001 ) )          &
+                         THEN
+
+                            d_pl   = SQRT(d_pl)
+                            coll_t = (b_pl - d_pl)/a_pl
+                            IF ( coll_t > 0.0_wp ) THEN
+!
+!--                            Dummy factor
+                               ddum_f = 1. / ( a_pl * coll_t**2 )              &
+                                           * ( 2. / coll_t + 1.0 * d_coll_t_0 )
+!
+!--                            x-component of social force
+                               force_x = force_x - k_pl *                      &
+                                         EXP( -coll_t * d_coll_t_0 ) *         &
+                                         ( v_rel_x -                           &
+                                           ( b_pl * v_rel_x -                  &
+                                             a_pl * pos_rel_x ) / d_pl ) *     &
+                                         ddum_f
+!
+!--                            y-component of social force
+                               force_y = force_y - k_pl *                      &
+                                         EXP( -coll_t * d_coll_t_0 ) *         &
+                                         ( v_rel_y -                           &
+                                           ( b_pl * v_rel_y -                  &
+                                             a_pl * pos_rel_y ) / d_pl ) *     &
+                                         ddum_f
+
+                            ENDIF
+                         ENDIF
+                      ENDIF
+                   ENDDO
+                ENDDO
+             ENDDO
+             CALL cpu_log( log_point_s(16), 'mas_other_agents', 'pause' )
+
+          CASE ( 'walls' )
+
+             srw = scan_radius_wall
+             corner_found = .FALSE.
+!
+!--          find relevant grid boxes (those that could contain topography
+!--          within radius)
+             sc_x_start = (x_a - srw) * ddx
+             sc_x_end   = (x_a + srw) * ddx
+             sc_y_start = (y_a - srw) * ddx
+             sc_y_end   = (y_a + srw) * ddx
+             IF ( sc_x_start < nxlg ) sc_x_start = nxlg
+             IF ( sc_x_end   > nxrg ) sc_x_end   = nxrg
+             IF ( sc_y_start < nysg ) sc_y_start = nysg
+             IF ( sc_y_end   > nyng ) sc_y_end   = nyng
+!
+!--          Find "walls" ( i.e. topography steps (up or down) higher than one
+!--          grid box ) that are perpendicular to the agent within the defined
+!--          search radius. Such obstacles cannot be passed and a social force
+!--          to that effect is applied.
+!--          Walls only apply a force perpendicular to the wall to the agent.
+!--          There is therefore a search for walls directly right, left, south 
+!--          and north of the agent. All other walls are ignored.
+!--
+!--          Check for wall left of current agent
+             ij_dum = 0
+             IF ( sc_x_start < ip ) THEN
+                DO il = ip - 1, sc_x_start, -1
+!
+!--                Going left from the agent, check for a right wall
+                   IF ( BTEST( obstacle_flags(jp,il), 2 ) ) THEN
+!
+!--                   obstacle found in grid box il, wall at right side
+                      x_wall = (il+1)*dx
+!
+!--                   Calculate force of found wall on agent
+                      CALL mas_timestep_wall_corner_force ( nl, x_a, x_wall,   &
+                                                            y_a, y_a )
+!
+!--                   calculate new x starting index for later scan for corners
+                      ij_dum = il + 1
+                      EXIT
+                   ENDIF
+                ENDDO
+             ENDIF
+             IF ( ij_dum /= 0 ) sc_x_start = ij_dum 
+
+!
+!--          Check for wall right of current agent
+             ij_dum = 0
+             IF ( sc_x_end > ip ) THEN
+                DO il = ip + 1, sc_x_end
+!
+!--                Going right from the agent, check for a left wall
+                   IF ( BTEST( obstacle_flags(jp,il), 6 ) ) THEN
+!
+!--                   obstacle found in grid box il, wall at left side
+                      x_wall = il*dx
+!
+!--                   Calculate force of found wall on agent
+                      CALL mas_timestep_wall_corner_force ( nl, x_a, x_wall,   &
+                                                            y_a, y_a )
+!
+!--                   calculate new x end index for later scan for corners
+                      ij_dum = il - 1
+                      EXIT
+                   ENDIF
+                ENDDO
+             ENDIF
+             IF ( ij_dum /= 0 ) sc_x_end = ij_dum 
+
+!
+!--          Check for wall south of current agent
+             ij_dum = 0
+             IF ( sc_y_start < jp ) THEN
+                DO jl = jp - 1, sc_y_start, -1
+!
+!--                Going south from the agent, check for a north wall
+                   IF ( BTEST( obstacle_flags(jl,ip), 0 ) ) THEN
+!
+!--                   obstacle found in grid box jl, wall at left side
+                      y_wall = (jl+1)*dy
+
+                      CALL mas_timestep_wall_corner_force ( nl, x_a, x_a, y_a, &
+                                                            y_wall )
+!
+!--                   calculate new y starting index for later scan for corners
+                      ij_dum = jl + 1
+                      EXIT
+                   ENDIF
+                ENDDO
+             ENDIF
+             IF ( ij_dum /= 0 ) sc_y_start = ij_dum 
+
+!
+!--          Check for wall north of current agent
+             ij_dum = 0
+             IF ( sc_y_end > jp ) THEN
+                DO jl = jp + 1, sc_y_end 
+!
+!--                Going north from the agent, check for a south wall
+                   IF ( BTEST( obstacle_flags(jl,ip), 4 ) ) THEN
+!
+!--                   obstacle found in grid box jl, wall at left side
+                      y_wall = jl*dy
+
+                      CALL mas_timestep_wall_corner_force ( nl, x_a, x_a, y_a, &
+                                                            y_wall )
+!
+!--                   calculate new y end index for later scan for corners
+                      ij_dum = jl - 1
+                   ENDIF
+                ENDDO
+             ENDIF
+             IF ( ij_dum /= 0 ) sc_y_end = ij_dum 
+
+!
+!--          Scan for corners surrounding current agent.
+!--          Only gridcells that are closer than the closest wall in each
+!--          direction (n,s,r,l) are considered in the search since those
+!--          further away would have a significantly smaller resulting force
+!--          than the closer wall. 
+             DO il = sc_x_start, sc_x_end
+                DO jl = sc_y_start, sc_y_end
+                   IF ( il == ip .OR. jl == jp ) CYCLE
+!
+!--                corners left of agent
+                   IF ( il < ip ) THEN
+!
+!--                   south left quadrant: look for north right corner
+                      IF ( jl < jp ) THEN
+                         IF ( BTEST( obstacle_flags(jl,il), 1 ) ) THEN
+!
+!--                         calculate coordinates of the found corner
+                            x_wall = (il+1)*dx
+                            y_wall = (jl+1)*dy
+
+                            CALL mas_timestep_wall_corner_force ( nl, x_a,     &
+                                                           x_wall, y_a, y_wall )
+
+                         ENDIF
+!
+!--                   north left quadrant: look for south right corner
+                      ELSEIF ( jl > jp ) THEN
+                         IF ( BTEST( obstacle_flags(jl,il), 3 ) ) THEN
+!
+!--                         calculate coordinates of the corner of said gridcell
+!--                         that is closest to the current agent
+                            x_wall = (il+1)*dx
+                            y_wall = jl*dy
+
+                            CALL mas_timestep_wall_corner_force ( nl, x_a,     &
+                                                         x_wall, y_a, y_wall )
+
+                         ENDIF
+                      ENDIF
+                   ELSEIF ( il > ip ) THEN
+!
+!--                   south right quadrant: look for north left corner
+                      IF ( jl < jp ) THEN
+                         IF ( BTEST( obstacle_flags(jl,il), 7 ) ) THEN
+!
+!--                         calculate coordinates of the corner of said gridcell
+!--                         that is closest to the current agent
+                            x_wall = il*dx
+                            y_wall = (jl+1)*dy
+
+                            CALL mas_timestep_wall_corner_force ( nl, x_a,     &
+                                                           x_wall, y_a, y_wall )
+
+                         ENDIF
+!
+!--                   north right quadrant: look for south left corner
+                      ELSEIF ( jl > jp ) THEN
+                         IF ( BTEST( obstacle_flags(jl,il), 5 ) ) THEN
+!
+!--                         calculate coordinates of the corner of said gridcell
+!--                         that is closest to the current agent
+                            x_wall = il*dx
+                            y_wall = jl*dy
+
+                            CALL mas_timestep_wall_corner_force ( nl, x_a,     &
+                                                           x_wall, y_a, y_wall )
+
+                         ENDIF
+                      ENDIF
+                   ENDIF
+                ENDDO
+             ENDDO
+
+          CASE DEFAULT
+
+       END SELECT
+
+    END SUBROUTINE mas_timestep_social_forces
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Given a distance to the current agent, calculates the force a found corner
+!> or wall exerts on that agent
+!------------------------------------------------------------------------------!
+    SUBROUTINE mas_timestep_wall_corner_force ( nl, xa, xw, ya, yw )
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  nl !< loop variable over all agents in a grid box
+
+       REAL(wp) ::  dist_l     !< distance to obstacle
+       REAL(wp) ::  force_d_x  !< increment of social force, x-direction
+       REAL(wp) ::  force_d_y  !< increment of social force, x-direction
+       REAL(wp) ::  xa         !< x-position of agent
+       REAL(wp) ::  xw         !< x-position of wall
+       REAL(wp) ::  ya         !< x-position of agent
+       REAL(wp) ::  yw         !< y-position of wall
+
+       force_d_x = 0.0_wp
+       force_d_y = 0.0_wp
+!
+!--    calculate coordinates of corner relative to agent 
+!--    postion and distance between corner and agent
+       xw = xa - xw
+       yw = ya - yw
+       dist_l = SQRT( (xw)**2 + (yw)**2 )
+!
+!--    calculate x and y component of repulsive force 
+!--    induced by previously found corner
+       IF ( dist_l > 0 ) THEN
+          force_d_x = repuls_wall * d_sigma_rep_wall         &
+                      * EXP( -dist_l * d_sigma_rep_wall )      &
+                      * xw / (dist_l)
+          force_d_y = repuls_wall * d_sigma_rep_wall         &
+                      * EXP( -dist_l * d_sigma_rep_wall )      &
+                      * yw / (dist_l)
+       ENDIF
+
+! !--    forces that are located outside of a sight radius of 
+! !--    200Â° (-> COS(100./180.*pi) = COS(.555*pi)) of
+! !--    current agent are considered to have an effect of 50%
+!        IF ( force_d_x * agents(nl)%speed_e_x +               &
+!             force_d_y * agents(nl)%speed_e_y <               &
+!             SQRT(force_d_x**2 + force_d_y**2) *              &
+!             COS( .55555555 * 3.1415 ) )                      &
+!        THEN
+!           force_d_x = force_d_x * .5_wp
+!           force_d_y = force_d_y * .5_wp
+!        ENDIF
+
+!
+!--    add force increment to total force of current agent
+       force_x = force_x + force_d_x
+       force_y = force_y + force_d_y
+
+    END SUBROUTINE mas_timestep_wall_corner_force
+
+!
+!-- Calculates distance of point P to edge (A,B). If A = B, calculates
+!-- point-to-point distance from A/B to P
+    FUNCTION dist_point_to_edge ( a_x, a_y, b_x, b_y, p_x, p_y )
+
+       IMPLICIT NONE
+
+       REAL(wp)  :: ab_x                !< x-coordinate of vector from A to B
+       REAL(wp)  :: ab_y                !< y-coordinate of vector from A to B
+       REAL(wp)  :: ab_d                !< inverse length of vector from A to B
+       REAL(wp)  :: ab_u_x              !< x-coordinate of vector with direction of ab and length 1
+       REAL(wp)  :: ab_u_y              !< y-coordinate of vector with direction of ab and length 1
+       REAL(wp)  :: ba_x                !< x-coordinate of vector from B to A
+       REAL(wp)  :: ba_y                !< y-coordinate of vector from B to A
+       REAL(wp)  :: ap_x                !< x-coordinate of vector from A to P
+       REAL(wp)  :: ap_y                !< y-coordinate of vector from A to P
+       REAL(wp)  :: bp_x                !< x-coordinate of vector from B to P
+       REAL(wp)  :: bp_y                !< y-coordinate of vector from B to P
+       REAL(wp)  :: a_x                 !< x-coordinate of point A of edge
+       REAL(wp)  :: a_y                 !< y-coordinate of point A of edge
+       REAL(wp)  :: b_x                 !< x-coordinate of point B of edge
+       REAL(wp)  :: b_y                 !< y-coordinate of point B of edge
+       REAL(wp)  :: p_x                 !< x-coordinate of point P
+       REAL(wp)  :: p_y                 !< y-coordinate of point P
+       REAL(wp)  :: dist_x              !< x-coordinate of point P
+       REAL(wp)  :: dist_y              !< y-coordinate of point P
+       REAL(wp)  :: dist_point_to_edge  !< y-coordinate of point P
+
+       ab_x = - a_x + b_x
+       ab_y = - a_y + b_y
+       ba_x = - b_x + a_x 
+       ba_y = - b_y + a_y 
+       ap_x = - a_x + p_x
+       ap_y = - a_y + p_y
+       bp_x = - b_x + p_x
+       bp_y = - b_y + p_y
+
+       IF ( ab_x * ap_x + ab_y * ap_y <= 0. ) THEN
+          dist_point_to_edge = SQRT((a_x - p_x)**2 + (a_y - p_y)**2)
+       ELSEIF ( ba_x * bp_x + ba_y * bp_y <= 0. ) THEN
+          dist_point_to_edge = SQRT((b_x - p_x)**2 + (b_y - p_y)**2)
+       ELSE
+          ab_d = 1./SQRT((ab_x)**2+(ab_y)**2)
+          ab_u_x = ab_x*ab_d
+          ab_u_y = ab_y*ab_d
+          dist_x = ap_x - (ap_x*ab_u_x+ap_y*ab_u_y)*ab_u_x
+          dist_y = ap_y - (ap_x*ab_u_x+ap_y*ab_u_y)*ab_u_y
+          dist_point_to_edge = SQRT( dist_x**2 + dist_y**2 )
+       ENDIF
+
+    END FUNCTION dist_point_to_edge
+
+!
+!-- Returns the heuristic between points A and B (currently the straight 
+!-- distance)
+    FUNCTION heuristic ( ax, ay, bx, by )
+
+       IMPLICIT NONE
+
+       REAL(wp)  :: ax           !< x-coordinate of point A
+       REAL(wp)  :: ay           !< y-coordinate of point A
+       REAL(wp)  :: bx           !< x-coordinate of point B
+       REAL(wp)  :: by           !< y-coordinate of point B
+       REAL(wp)  :: heuristic    !< return value
+
+       heuristic = SQRT(( ax - bx )**2 + ( ay - by )**2)
+
+    END FUNCTION heuristic 
+
+!
+!-- Calculates if point P is left of the infinite
+!-- line that contains A and B (direction: A to B) 
+!-- Concept: 2D rotation of two vectors
+    FUNCTION is_left ( ax, ay, bx, by, px, py )
+
+       IMPLICIT NONE
+
+       LOGICAL  :: is_left !< return value; TRUE if P is left of AB
+
+       REAL(wp)  :: ax     !< x-coordinate of point A
+       REAL(wp)  :: ay     !< y-coordinate of point A
+       REAL(wp)  :: bx     !< x-coordinate of point B
+       REAL(wp)  :: by     !< y-coordinate of point B
+       REAL(wp)  :: px     !< x-coordinate of point P
+       REAL(wp)  :: py     !< y-coordinate of point P
+
+       is_left = (bx-ax)*(py-ay)-(px-ax)*(by-ay) > 0
+       IF ( (ABS(ax-px) < .001 .AND. ABS(ay-py) < .001) .OR.                  &
+            (ABS(bx-px) < .001 .AND. ABS(by-py) < .001) )                     &
+       THEN
+          is_left = .FALSE.
+       ENDIF
+
+       RETURN
+
+    END FUNCTION is_left 
+
+!
+!-- Calculates if point P is right of the infinite
+!-- line that contains A and B (direction: A to B) 
+!-- Concept: 2D rotation of two vectors
+    FUNCTION is_right ( ax, ay, bx, by, px, py )
+
+       IMPLICIT NONE
+
+       LOGICAL  :: is_right !< return value; TRUE if P is right of AB
+
+       REAL(wp), INTENT(IN)  :: ax     !< x-coordinate of point A
+       REAL(wp), INTENT(IN)  :: ay     !< y-coordinate of point A
+       REAL(wp), INTENT(IN)  :: bx     !< x-coordinate of point B
+       REAL(wp), INTENT(IN)  :: by     !< y-coordinate of point B
+       REAL(wp), INTENT(IN)  :: px     !< x-coordinate of point P
+       REAL(wp), INTENT(IN)  :: py     !< y-coordinate of point P
+
+       is_right = (bx-ax)*(py-ay)-(px-ax)*(by-ay) < 0
+       IF ( (ABS(ax-px) < .001 .AND. ABS(ay-py) < .001) .OR.                  &
+            (ABS(bx-px) < .001 .AND. ABS(by-py) < .001) )                     &
+       THEN
+          is_right = .FALSE.
+       ENDIF
+
+       RETURN
+
+    END FUNCTION is_right 
+
+!
+!-- Returns true if the line segments AB and PQ share an intersection
+    FUNCTION intersect ( ax, ay, bx, by, px, py, qx, qy )
+
+       IMPLICIT NONE
+
+       LOGICAL  :: intersect !< return value; TRUE if intersection was found
+       LOGICAL  :: la        !< T if a is left of PQ
+       LOGICAL  :: lb        !< T if b is left of PQ
+       LOGICAL  :: lp        !< T if p is left of AB
+       LOGICAL  :: lq        !< T if q is left of AB
+       LOGICAL  :: poss      !< flag that indicates if an intersection is still possible
+       LOGICAL  :: ra        !< T if a is right of PQ
+       LOGICAL  :: rb        !< T if b is right of PQ
+       LOGICAL  :: rp        !< T if p is right of AB
+       LOGICAL  :: rq        !< T if q is right of AB
+
+       REAL(wp)  :: ax     !< x-coordinate of point A
+       REAL(wp)  :: ay     !< y-coordinate of point A
+       REAL(wp)  :: bx     !< x-coordinate of point B
+       REAL(wp)  :: by     !< y-coordinate of point B
+       REAL(wp)  :: px     !< x-coordinate of point P
+       REAL(wp)  :: py     !< y-coordinate of point P
+       REAL(wp)  :: qx     !< x-coordinate of point Q
+       REAL(wp)  :: qy     !< y-coordinate of point Q
+
+       intersect = .FALSE.
+       poss      = .FALSE.
+!
+!--    Intersection is possible only if P and Q are on opposing sides of AB
+       lp = is_left(ax,ay,bx,by,px,py)
+       rq = is_right(ax,ay,bx,by,qx,qy)
+       IF ( lp .AND. rq ) poss = .TRUE.
+       IF ( .NOT. poss ) THEN
+          lq = is_left(ax,ay,bx,by,qx,qy)
+          rp = is_right(ax,ay,bx,by,px,py)
+          IF ( lq .AND. rp ) poss = .TRUE.
+       ENDIF
+!
+!--    Intersection occurs only if above test (poss) was true AND
+!--    A and B are on opposing sides of PQ
+       IF ( poss ) THEN
+          la = is_left(px,py,qx,qy,ax,ay)
+          rb = is_right(px,py,qx,qy,bx,by)
+          IF ( la .AND. rb ) intersect = .TRUE.
+          IF ( .NOT. intersect ) THEN
+             lb = is_left(px,py,qx,qy,bx,by)
+             ra = is_right(px,py,qx,qy,ax,ay)
+             IF ( lb .AND. ra ) intersect = .TRUE.
+          ENDIF
+       ENDIF
+
+       RETURN
+
+    END FUNCTION intersect 
+
+!
+!-- Gives a nuber randomly distributed around an average
+    FUNCTION random_normal ( avg, variation )
+
+       IMPLICIT NONE
+
+       REAL(wp)  :: avg            !< x-coordinate of vector from A to B
+       REAL(wp)  :: variation      !< y-coordinate of vector from A to B
+       REAL(wp)  :: random_normal  !< y-coordinate of vector from A to B
+
+       REAL(wp), DIMENSION(12)  :: random_arr  !< inverse length of vector from A to B
+
+       CALL RANDOM_NUMBER(random_arr)
+       random_normal = avg + variation*(SUM(random_arr)-6.)
+
+    END FUNCTION random_normal
+
+
+ END MODULE multi_agent_system_mod
Index: palm/trunk/SOURCE/netcdf_interface_mod.f90
===================================================================
--- palm/trunk/SOURCE/netcdf_interface_mod.f90	(revision 3157)
+++ palm/trunk/SOURCE/netcdf_interface_mod.f90	(revision 3159)
@@ -25,4 +25,7 @@
 ! -----------------
 ! $Id$
+! Added multi agent system
+! 
+! 3049 2018-05-29 13:52:36Z Giersch
 ! Error messages revised
 ! 
@@ -282,4 +285,18 @@
     PRIVATE
 
+    CHARACTER (LEN=16), DIMENSION(13) ::  agt_var_names =                      &
+          (/ 'ag_x            ', 'ag_y            ', 'ag_wind         ',       &
+             'ag_temp         ', 'ag_group        ', 'PM10            ',       &
+             'PM25            ', 'ag_therm_comf   ', 'ag_uv           ',       &
+             'not_used        ', 'not_used        ', 'not_used        ',       &
+             'not_used        ' /)
+
+    CHARACTER (LEN=16), DIMENSION(13) ::  agt_var_units = &
+          (/ 'meters          ', 'meters          ', 'm/s             ',       &
+             'K               ', 'dim_less        ', 'tbd             ',       &
+             'tbd             ', 'tbd             ', 'tbd             ',       &
+             'not_used        ', 'not_used        ', 'not_used        ',       &
+             'not_used        ' /)
+
     INTEGER(iwp), PARAMETER ::  dopr_norm_num = 7, dopts_num = 29, dots_max = 100
 
@@ -377,11 +394,15 @@
     CHARACTER(LEN=40) ::  netcdf_data_format_string
 
-    INTEGER(iwp) ::  id_dim_prtnum, id_dim_time_fl, id_dim_time_pr, id_dim_time_prt, &
-                     id_dim_time_pts, id_dim_time_sp, id_dim_time_ts, id_dim_x_sp, &
-                     id_dim_y_sp, id_dim_zu_sp, id_dim_zw_sp, id_set_fl, id_set_pr, &
-                     id_set_prt, id_set_pts, id_set_sp, id_set_ts, id_var_time_fl, &
-                     id_var_prtnum, id_var_rnop_prt, id_var_time_pr, id_var_time_prt, &
-                     id_var_time_pts, id_var_time_sp, id_var_time_ts, id_var_x_sp, &
-                     id_var_y_sp, id_var_zu_sp, id_var_zw_sp, nc_stat
+    INTEGER(iwp) ::  id_dim_agtnum, id_dim_prtnum, id_dim_time_agt,            &
+                     id_dim_time_fl, id_dim_time_pr, id_dim_time_prt,          &
+                     id_dim_time_pts, id_dim_time_sp, id_dim_time_ts,          &
+                     id_dim_x_sp, id_dim_y_sp, id_dim_zu_sp, id_dim_zw_sp,     &
+                     id_set_agt, id_set_fl, id_set_pr, id_set_prt, id_set_pts, &
+                     id_set_sp, id_set_ts, id_var_agtnum, id_var_time_agt,     &
+                     id_var_time_fl, id_var_prtnum, id_var_rnoa_agt,           &
+                     id_var_rnop_prt, id_var_time_pr, id_var_time_prt,         &
+                     id_var_time_pts, id_var_time_sp, id_var_time_ts,          &
+                     id_var_x_sp, id_var_y_sp, id_var_zu_sp, id_var_zw_sp,     &
+                     nc_stat
 
 
@@ -413,4 +434,5 @@
     INTEGER(iwp)                 ::  dofl_time_count
     INTEGER(iwp), DIMENSION(10)  ::  id_var_dospx, id_var_dospy
+    INTEGER(iwp), DIMENSION(20)  ::  id_var_agt
     INTEGER(iwp), DIMENSION(20)  ::  id_var_prt
     INTEGER(iwp), DIMENSION(11)  ::  nc_precision
@@ -457,11 +479,12 @@
             dofl_time_count, dofl_unit, domask_unit, dopr_unit, dopts_num,     &
             dots_label, dots_max, dots_num, dots_rad, dots_soil, dots_unit,    &
-            do2d_unit, do3d_unit, fill_value,                                  & 
-            id_set_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,     &
-            id_var_dopts, id_var_dospx, id_var_dospy, id_var_dots, id_var_do2d,&
-            id_var_do3d, id_var_norm_dopr, id_var_time_fl, id_var_time_mask,   &
-            id_var_time_pr, id_var_time_pts, id_var_time_sp, id_var_time_ts,   &
+            do2d_unit, do3d_unit, fill_value, id_set_agt, id_set_fl,           &
+            id_set_mask, id_set_pr, id_set_prt, id_set_pts, id_set_sp,         &
+            id_set_ts, id_set_xy, id_set_xz, id_set_yz, id_set_3d, id_var_agt, &
+            id_var_domask, id_var_dofl, id_var_dopr, id_var_dopts,             &
+            id_var_dospx, id_var_dospy, id_var_dots, id_var_do2d, id_var_do3d, &
+            id_var_norm_dopr, id_var_time_agt, id_var_time_fl,                 &
+            id_var_time_mask, id_var_time_pr, id_var_rnoa_agt, id_var_time_pts,&
+            id_var_time_sp, id_var_time_ts,                                    &
             id_var_time_xy, id_var_time_xz, id_var_time_yz, id_var_time_3d,    &
             id_var_x_fl, id_var_y_fl, id_var_z_fl,  nc_stat,                   &
@@ -515,10 +538,11 @@
 
     USE control_parameters,                                                    &
-        ONLY:  air_chemistry, averaging_interval, averaging_interval_pr,       &
-               data_output_pr, domask, dopr_n,                                 &
+        ONLY:  agent_time_unlimited, air_chemistry, averaging_interval,        &
+               averaging_interval_pr, data_output_pr, domask, dopr_n,          &
                dopr_time_count, dopts_time_count, dots_time_count,             &
                do2d, do2d_at_begin, do2d_xz_time_count, do3d, do3d_at_begin,   &
                do2d_yz_time_count, dt_data_output_av, dt_do2d_xy, dt_do2d_xz,  &
-               dt_do2d_yz, dt_do3d, mask_size, do2d_xy_time_count,             &
+               dt_do2d_yz, dt_do3d, dt_write_agent_data, mask_size,            &
+               do2d_xy_time_count,                                             &
                do3d_time_count, domask_time_count, end_time, land_surface,     &
                mask_size_l, mask_i, mask_i_global, mask_j, mask_j_global,      &
@@ -1922,4 +1946,118 @@
                            '&This file will be extended.'
           CALL message( 'define_netcdf_header', 'PA0248', 0, 0, 0, 6, 0 )
+
+
+       CASE ( 'ag_new' )
+
+!
+!--       Define some global attributes of the dataset
+          nc_stat = NF90_PUT_ATT( id_set_agt, NF90_GLOBAL, 'title', &
+                                  TRIM( run_description_header ) )
+          CALL netcdf_handle_error( 'netcdf_define_header', 330 )
+!
+!--       Switch for unlimited time dimension
+          IF ( agent_time_unlimited ) THEN
+             CALL netcdf_create_dim( id_set_agt, 'time', NF90_UNLIMITED,       &
+                                     id_dim_time_agt, 331 )
+          ELSE
+             CALL netcdf_create_dim( id_set_agt, 'time',                       &
+                                     INT(end_time/dt_write_agent_data*1.2),    &
+                                     id_dim_time_agt, 331 )
+          ENDIF
+
+          CALL netcdf_create_var( id_set_agt, (/ id_dim_time_agt /), 'time',   &
+                                  NF90_DOUBLE, id_var_time_agt, 'seconds', '', &
+                                  332, 333, 000 )
+!
+!--       netCDF4 allows more than one unlimited dimension
+          CALL netcdf_create_dim( id_set_agt, 'agent_number',            &
+                                  NF90_UNLIMITED, id_dim_agtnum, 334 )
+
+          CALL netcdf_create_var( id_set_agt, (/ id_dim_agtnum /),             &
+                                  'agent_number', NF90_DOUBLE,              &
+                                  id_var_agtnum, 'agent number', '', 335,   &
+                                  336, 000 )
+!
+!--       Define variable which contains the real number of agents in use
+          CALL netcdf_create_var( id_set_agt, (/ id_dim_time_agt /),           &
+                                  'real_num_of_agt', NF90_DOUBLE,              &
+                                  id_var_rnoa_agt, 'agent number', '', 337, &
+                                  338, 000 )
+!
+!--       Define the variables
+          DO  i = 1, 5
+             CALL netcdf_create_var( id_set_agt, (/ id_dim_agtnum,             &
+                                     id_dim_time_agt /), agt_var_names(i),     &
+                                     nc_precision(8), id_var_agt(i),           &
+                                     TRIM( agt_var_units(i) ),                 &
+                                     TRIM( agt_var_names(i) ), 339, 340, 341 )
+
+          ENDDO
+!
+!--       Leave netCDF define mode
+          nc_stat = NF90_ENDDEF( id_set_agt )
+          CALL netcdf_handle_error( 'netcdf_define_header', 342 )
+
+
+!        CASE ( 'ag_ext' )
+! !+?agent extend output for restart runs has to be adapted
+! 
+! !
+! !--       Get the id of the time coordinate (unlimited coordinate) and its
+! !--       last index on the file. The next time level is prt..count+1.
+! !--       The current time must be larger than the last output time
+! !--       on the file.
+!           nc_stat = NF90_INQ_VARID( id_set_agt, 'time', id_var_time_agt )
+!           CALL netcdf_handle_error( 'netcdf_define_header', 343 )
+! 
+!           nc_stat = NF90_INQUIRE_VARIABLE( id_set_agt, id_var_time_agt, &
+!                                            dimids = id_dim_time_old )
+!           CALL netcdf_handle_error( 'netcdf_define_header', 344 )
+!           id_dim_time_agt = id_dim_time_old(1)
+! 
+!           nc_stat = NF90_INQUIRE_DIMENSION( id_set_agt, id_dim_time_agt, &
+!                                             len = agt_time_count )
+!           CALL netcdf_handle_error( 'netcdf_define_header', 345 )
+! 
+!           nc_stat = NF90_GET_VAR( id_set_agt, id_var_time_agt,  &
+!                                   last_time_coordinate,         &
+!                                   start = (/ agt_time_count /), &
+!                                   count = (/ 1 /) )
+!           CALL netcdf_handle_error( 'netcdf_define_header', 346 )
+! 
+!           IF ( last_time_coordinate(1) >= simulated_time )  THEN
+!              message_string = 'netCDF file for agents ' //                  &
+!                               'from previous run found,' //                 &
+!                               '&but this file cannot be extended becaus' // &
+!                               'e the current output time' //                &
+!                               '&is less or equal than the last output t' // &
+!                               'ime on this file.' //                        &
+!                               '&New file is created instead.'
+!              CALL message( 'define_netcdf_header', 'PA0265', 0, 1, 0, 6, 0 )
+!              agt_time_count = 0
+!              extend = .FALSE.
+!              RETURN
+!           ENDIF
+! 
+! !
+! !--       Dataset seems to be extendable.
+! !--       Now get the variable ids.
+!           nc_stat = NF90_INQ_VARID( id_set_agt, 'real_num_of_agt', &
+!                                     id_var_rnoa_agt )
+!           CALL netcdf_handle_error( 'netcdf_define_header', 347 )
+! 
+!           DO  i = 1, 17
+! 
+!              nc_stat = NF90_INQ_VARID( id_set_agt, agt_var_names(i), &
+!                                        id_var_prt(i) )
+!              CALL netcdf_handle_error( 'netcdf_define_header', 348 )
+! 
+!           ENDDO
+! 
+!           message_string = 'netCDF file for particles ' // &
+!                            'from previous run found.' //   &
+!                            '&This file will be extended.'
+!           CALL message( 'define_netcdf_header', 'PA0266', 0, 0, 0, 6, 0 )
+          
 
        CASE ( 'xy_new' )
Index: palm/trunk/SOURCE/parin.f90
===================================================================
--- palm/trunk/SOURCE/parin.f90	(revision 3157)
+++ palm/trunk/SOURCE/parin.f90	(revision 3159)
@@ -25,4 +25,7 @@
 ! -----------------
 ! $Id$
+! Added multi agent system
+! 
+! 3157 2018-07-19 21:08:49Z maronga
 ! added use_free_convection_scaling
 ! 
@@ -441,4 +444,7 @@
     USE model_1d_mod,                                                          &
         ONLY:  damp_level_1d, dt_pr_1d, dt_run_control_1d, end_time_1d
+
+    USE multi_agent_system_mod,                                                &
+        ONLY:  mas_parin
 
     USE netcdf_interface,                                                      &
@@ -843,9 +849,13 @@
 !--       Check if gust module is used and read &gust_par if required
           CALL gust_parin
- 
- 
+
+!
+!--       Check if multi agent system is used and read &agents_par if required
+          CALL mas_parin
+
+!
 !--       Check if plant canopy model is used and read &canopy_par if required
           CALL pcm_parin
- 
+
 !
 !--       Read control parameters for optionally used model software packages
Index: palm/trunk/SOURCE/time_integration.f90
===================================================================
--- palm/trunk/SOURCE/time_integration.f90	(revision 3157)
+++ palm/trunk/SOURCE/time_integration.f90	(revision 3159)
@@ -25,4 +25,7 @@
 ! -----------------
 ! $Id$
+! Added multi agent system
+! 
+! 3042 2018-05-25 10:44:37Z schwenkel
 ! Changed the name specific humidity to mixing ratio
 ! 
@@ -375,10 +378,10 @@
                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, forcing, galilei_transformation, humidity,      &
-               intermediate_timestep_count, intermediate_timestep_count_max,   &
-               land_surface, large_scale_forcing,                              &
-               loop_optimization, lsf_surf, lsf_vert, masks,                   &
-               microphysics_morrison, microphysics_seifert, mid, nest_domain,  &
-               neutral, nr_timesteps_this_run, nudging,                        &
+               first_call_lpm, first_call_mas, forcing, galilei_transformation,&
+               humidity, intermediate_timestep_count,                          &
+               intermediate_timestep_count_max, land_surface,                  &
+               large_scale_forcing, loop_optimization, lsf_surf, lsf_vert,     &
+               masks, microphysics_morrison, microphysics_seifert, mid,        &
+               nest_domain, neutral, nr_timesteps_this_run, nudging,           &
                ocean, passive_scalar, prho_reference, pt_reference,            &
                pt_slope_offset, random_heatflux, rans_mode,                    &
@@ -431,4 +434,7 @@
         ONLY: collision_turbulence
 
+    USE multi_agent_system_mod,                                                &
+        ONLY:  agents_active, multi_agent_system, multi_agent_system_start
+
     USE particle_attributes,                                                   &
         ONLY:  particle_advection, particle_advection_start,                   &
@@ -706,4 +712,13 @@
 
 !
+!--       Movement of agents in multi agent system
+          IF ( agents_active  .AND.                                            &
+               simulated_time >= multi_agent_system_start  .AND.               &
+               intermediate_timestep_count == 1 )  THEN
+             CALL multi_agent_system
+             first_call_mas = .FALSE.
+          ENDIF
+
+!
 !--       Exchange of ghost points (lateral boundary conditions)
           CALL cpu_log( log_point(26), 'exchange-horiz-progn', 'start' )
Index: palm/trunk/UTIL/nav_mesh/README
===================================================================
--- palm/trunk/UTIL/nav_mesh/README	(revision 3159)
+++ palm/trunk/UTIL/nav_mesh/README	(revision 3159)
@@ -0,0 +1,137 @@
+Author: Simon Ward, IMUK, Date: 2018-03-23
+
+AN UPDATE WILL FOLLOW SOON
+
+This document serves as a preliminary documentation for the MultiAgentSystem 
+(MAS). For any questions, please do not hesitate to contact me at 
+ward@muk.uni-hannover.de
+
+Find the description of some test setups at the bottom of this document.
+
+The MAS is a tool implemented in PALM that serves the purpose of simulating the
+movement of pedestrians through an (urban) environment. The encompasses
+
+  1. The navigation of agents through static obstacles towards their respective
+     targets,
+  2. the interaction of agents with static obstacles to avoid collision and
+  3. the interaction of agents with each other, i.e. to anticipate potential 
+     collisions and avoiding them. 
+
+For (1), a navigation mesh (NavMesh) is used. It consists of a set of meshpoints
+that agents can walk towards on the way to their ultimate goal. These meshpoints
+also contain information about all other meshpoints they are connected to. 
+E.g., no connection will be made between to points, if the direct line between
+them crosses through a building. 
+The points in the NavMesh consist of the convex corners of the simplified
+polygons (see parameter tolerance_dp for more information) that describe the
+PALM building topography.
+
+The NavMesh is created during a preprocessing step which currently has to be
+executed manually. For this, FORTRAN program nav_mesh.f90 has to be compiled
+(preferably ifort, if gfortran has to be used, comment lines 1327 and 1399-1411)
+and run from the INPUT folder of the current simulation. So:
+ifort nav_mesh.f90
+./a.out 
+This will create a binary file named <run_identifier>_nav in the INPUT folder, 
+that will in turn be read by PALM during the run. It contains all necessary 
+NavMesh information. Each agent uses this information to find the shortes way throug the NavMesh to her target, using the A* (A-Star) algorithm. Her path then consists of a number of intermittent targets that she will walk toward on the way to her final goal, each time walking towards the next intermittent target once the current one is reached.
+
+The nav_mesh.f90 program *DOES NOT* support NetCDF building data!
+It only reads ASCII files in the format (X,nx*(F5.1)), e.g.:
+  0.0  0.0  0.0  0.0
+  8.0  8.0  8.0  8.0
+ 17.2 17.2 17.2 17.2
+ 20.0 20.0 20.0 20.0
+Support for other formats will follow shortly. If you wish to modify the format
+manually, take a look at line 366 of nav_mesh.f90.
+
+To use the nav_mesh program, a NAMELIST prepro_par has to be added to the
+<run_identifier>_p3d file.
+It MUST contain the following variables and they MUST be the same as in the
+inipar namelist:
+nx, ny, dx, dy
+It CAN, additionally, contain the following variables:
+
+Name          Type Dim Default    Description
+--------------------------------------------------------------------------------
+tolerance_dp     R   5    2.99    
+                          1.99    
+                          1.41    
+                          0.7     
+                          0.35   A polygon structure is used to store buildinginformation. Each building initially consists of all inner and outer corner of the original PALM gridded building topography. The Douglas-Peucker-algorithm is used to simplify the polygons. A line segment between to vertices of the polygon is used to approximate a segment of the polygon. If the maximum distance of any vertex between the two is smaller than tolerance_dp, the segment is  accepted. If not, the segment is split in two at that vertex, leaving two line segements that recursively go through the same  procedure.  If the algorithm using tolerance_dp(0) leaves a polygon with less than 4 vertices, it is reverted to its original state and the process starts again with tolerance_dp(1) and so on. 
+--------------------------------------------------------------------------------                                
+corner_offset    R   1    0.5     To avoid the collision of agents with corners of buildings, the navigation points are shifted outward from the corners by this distance in meters.
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+PLEASE NOTE: To enable PALM to read the <run_identifier>_nav file, please add
+             the following lines to your .palm.iofiles in the appropriate places
+             and place your .palm.iofiles in your current_version folder:
+#-------------------------------------------------------------------------------------------
+# List of input-files
+#-------------------------------------------------------------------------------------------
+...
+...
+NAVIGATION_DATA          inopt:tr   d3#:d3r  $base_data/$jobname/INPUT          _nav*
+...
+
+ALSO:        Add the following for propper copying of netcdf output:
+#-------------------------------------------------------------------------------------------
+# List of output-files
+#-------------------------------------------------------------------------------------------
+...
+...
+DATA_AGT_NETCDF            out:tr   *         $base_data/$jobname/OUTPUT         _agt       nc
+
+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
+
+For (2) and (3), a Social Forces aproach based on the ideas of Helbig (1995) and
+using the concept of a power law by Karamouzas (2014) for pedestrian
+interactions is used. The idea is that ostacles will exert a repulsive force on
+pedestrians. The sum of these forces added to the attractive force toward the
+target determines the acceleration of each pedestrian.
+
+To steer the MAS in PALM, use the following parameters in the 
+NAMELIST agents_par:
+
+Name                          Type Dim   Default    Description
+--------------------------------------------------------------------------------
+a_rand_target                    L 100         .F.  If .T., each agent in that group will have a random target just outside the model domain.
+adx                              R 100   9999999.9  Distance along x between agents within an agent source (in m). 
+ady                              R 100   9999999.9  Distance along y between agents within an agent source (in m). 
+agent_maximum_age                R 100   9999999.9  If agent is older than this value, it will be deleted
+alloc_factor_mas                 R   1        20.0  Factor (in percent) describing the memory allocated additionally to the memory needed for initial agents at a given grid cell.
+asl                              R 100   9999999.9  Left edge of a agent source (in m). NOTE: Agent sources are defined as point sources in an area. asl, asn, asr, ass, describe the edge of this source. adx and ady describe the distance betwee two sources starting at the left south edge. To randomize the starting positions within a threshold, see random_start_position_agents.
+asn                              R 100   9999999.9  North edge of a agent source (in m). 
+asr                              R 100   9999999.9  Right edge of a agent source (in m). 
+ass                              R 100   9999999.9  South edge of a agent source (in m). 
+at_x                             R 100   9999999.9  x-coordinate of agent group target (in m). NOTE: this is superseeded if a_rand_target == .T. for that group
+at_y                             R 100   9999999.9  y-coordinate of agent group target (in m).
+bc_mas_lr                        C  15    'absorb'  Boundary condition for agents along x. Default is recommended. 'cyclic' is also possible.
+bc_mas_ns                        C  15    'absorb'  Boundary condition for agents along y. Default is recommended. 'cyclic' is also possible.
+deallocate_memory_mas            L   1         .T.  Parameter to enable deallocation of unused memory. If the number of agents in a grid box exceeds the allocated memory, new memory is allocated. However, in case the number of agents per grid box in only temporarily high, most of the memory remains unused. If deallocate_memory = .T., the allocated memory used for agents will be dynamically adjusted with respect to the current number of agents every step_dealloc_mas's timestep. 
+dist_to_int_target               R   1        0.4  Distance to the current intermittent target at which the agent will count this target as reached an will begin walking towards the next one. 
+dt_agent                         R   1      0.016  Agent timestep. The default value is recommended, as this is about the time scale at which humans perceive and react to their environment. No guaratees can be given that agent behavior remains realistic at larger timesteps. This has no effect on the PALM timestep, as the agent model will be called multiple times during each model timestep.
+dt_doats                         R   1  9999999.9  Output timestep for timeseries. So far, no timeseries functionality.
+dt_arel                          R   1  9999999.9  Time interval (in s) that defines the release of new agents starting at multi_agent_system_start for each agent group in the source areas defined by asl, asn, asr and ass. 
+dt_write_agent_data              R   1  9999999.9  Time interval (in s) at which agent data is output. By default, agent data is output to one NetCDF file with two unlimited dimensions (time and agent number). This (requires netcdf_data_format = 3 or 5) This data includes an ID, position, speed, group and others. Before each output, all agents from all PEs are gathered into one array and then written to the NetCDF file without beeing sorted before. The reason being, that some agents might be deleted during the simulation, while others are created after the simulation start. The slots for these agents would thus have to be filled with placeholders, increasing the already high memory usage. If an individual based agent analysis is wished during postprocessing, the sorting by id will have to be done manually. This state is not very desirable, please contact me with any suggenstions that would improve it.
+end_time_arel                    R   1  9999999.9  Time at which release of agents will stop.
+max_dist_from_path               R   1        0.3  If an agents deviates further than this value from her currently calculated path, a new path will be calculated.
+min_nr_agent                     R   1          2  Minimum number of agents for which memory is allocated at every grid cell.
+multi_agent_system_start         R   1  9999999.9  Time (in s) at which agent release starts.
+number_of_agent_groups           I   1          1  Number of agent groups.
+radius_agent                     R   1        0.3  For collision calculation purposes, agents are assumed to occupy a circular area with a radius of radius_agent.
+random_start_position_agents     L   1        .T.  By default, a small random fluctuation is added to the starting postion of each agent (as defined by adx, ady, asl, asn, asr and ass). Turn this off by setting this parameter to .F.
+read_agents_from_restartfile     L   1        .F.  Restart functionality not implemented so far.
+repuls_agent                     R   1        1.5  Defines the strength of the repulsive force two already colliding agents exert on each other. May be removed going forward.
+repuls_wall                      R   1       10.0  Defines the strength of the repulsive force a wall in proximity to an agent exerts on that agent. Value taken from Helbig (1995).
+scan_radius_agent                R   1        3.0  Radius in which each agent scans for other agents that she could potentially collide with. NOTE: Due to the ghost layers between PEs only consisting of 3 grid cells, this value should be smaller than 3*MIN(dx,dy) it can be larger, but then, the scan radius will be smaller at subdomain boundaries than in the rest of the domain. ALSO NOTE: The agent model can get very computationally expensive due to the small timestep in combination with the interaction between agents. A smaller value here will increase performance at the cost of realistic collision avoidance.
+step_dealloc_mas                 I   1        100  Number of timesteps after which agent memory is deallocated.
+tau_accel_agent                  R   1        0.5  Relaxation time for the agent to accelerate to her desired velocity.
+
+################################################################################
+Currently, three test setups are provided under EXAMPLES/agents.
+(1) canyon : A simple street canyon with two groups of agents moving in opposite directions along the canyon. Demonstrates collision avoidance.
+
+(2) nav_test: A simple generic building setup with two agent groups with intersecting paths. Demonstrates collision avoidance, repellance by buildings and pathfinding.
+
+(3) urban_test: A sample urban test case with a 200 m * 300 m test area in Berlin and 9 agent groups with variing targets. Primarily demonstrates pathfinding in complex areas. Simulation setup tested for 20*10 cores
Index: palm/trunk/UTIL/nav_mesh/nav_mesh.f90
===================================================================
--- palm/trunk/UTIL/nav_mesh/nav_mesh.f90	(revision 3159)
+++ palm/trunk/UTIL/nav_mesh/nav_mesh.f90	(revision 3159)
@@ -0,0 +1,2832 @@
+!> @nav_mesh.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-2018 Leibniz Universitaet Hannover
+!------------------------------------------------------------------------------!
+!
+! Current revisions:
+! ------------------
+! 
+! 
+! Former revisions:
+! -----------------!
+!
+! Initial revision
+! 
+! 
+!
+! Description:
+! ------------
+!> Reads topography and building data and converts this information into a
+!> navigation mesh (NavMesh, a visibility graph). This mesh is necessary for
+!> the use of the Multi Agent System in PALM for the agents to navigate in
+!> complex (urban) terrain.
+!------------------------------------------------------------------------------!
+
+ MODULE kinds
+
+    IMPLICIT NONE
+
+!
+!-- Floating point kinds
+    INTEGER, PARAMETER ::  sp = 4           !< single precision (32 bit)
+    INTEGER, PARAMETER ::  dp = 8           !< double precision (64 bit)
+
+!
+!-- Integer kinds
+    INTEGER, PARAMETER ::  isp = SELECTED_INT_KIND(  9 )   !< single precision (32 bit)
+    INTEGER, PARAMETER ::  idp = SELECTED_INT_KIND( 14 )   !< double precision (64 bit)
+
+!
+!-- Set kinds to be used as defaults
+    INTEGER, PARAMETER ::   wp =  dp          !< default real kind
+    INTEGER, PARAMETER ::  iwp = isp          !< default integer kind
+
+    SAVE
+
+ END MODULE kinds
+
+ MODULE variables
+
+    USE kinds
+
+    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=128) ::  runname                  !< Run name
+    
+    LOGICAL ::  internal_buildings = .FALSE.  !< Flag that indicates whether buildings within closed courtyards should be deleted
+
+    INTEGER(iwp) ::  i                          !< Index along x
+    INTEGER(iwp) ::  j                          !< Index along y
+    INTEGER(iwp) ::  nx = 99999                 !< Number of grid points in x-direction
+    INTEGER(iwp) ::  ny = 99999                 !< Number of grid points in x-direction
+    INTEGER(iwp) ::  nov                        !< Number of vertices
+    INTEGER(iwp) ::  polygon_counter            !< Iterator for the number of building polygons
+    INTEGER(iwp) ::  number_of_connections = 0  !< Counter for number of connections in mesh
+    INTEGER(iwp) ::  i_cn                       !< Min number of corners left in polygons after Douglas Poiker algorithm
+    INTEGER(iwp) ::  i_sc                       !< Cycle number for Douglas-Peucker algorithm
+    INTEGER(iwp) ::  nc_stat                    !< return value of nf90 function call
+    INTEGER(iwp) ::  vertex_counter             !< Counter: total number of vertices
+
+    INTEGER, DIMENSION(:,:), ALLOCATABLE ::  wall_flags_0  !< Bit-array containing surface information
+    INTEGER, DIMENSION(:,:), ALLOCATABLE ::  polygon_id    !< Identifies each grid point as part of exactly one building
+
+    REAL(wp)    ::  ddx              !< inverse of dx
+    REAL(wp)    ::  ddy              !< inverse of dy
+    REAL(wp)    ::  dx = 99999.9_wp  !< grid spacing in x-direction
+    REAL(wp)    ::  dy = 99999.9_wp  !< grid spacing in x-direction
+    REAL(wp)    ::  dz = 99999.9_wp  !< grid spacing in x-direction
+    REAL(wp)    ::  finish           !< variable for CPU time measurement
+    REAL(wp)    ::  start            !< variable for CPU time measurement
+
+    REAL(wp), DIMENSION(0:4) ::  tolerance_dp  !< tolerance in Douglas-Poicker algorithm
+
+    REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  obstacle_height  !< height of obstacles
+
+!
+!-- Define data structure where the dimension and type of the input depends 
+!-- on the given level of detail. 
+!-- For buildings, the input is either 2D float, or 3d byte. 
+       TYPE build_in
+          INTEGER(iwp)    ::  lod = 1                                  !< level of detail                  
+          INTEGER(KIND=1) ::  fill2 = -127                             !< fill value for lod = 2
+          INTEGER(iwp)    ::  nz                                       !< number of vertical layers in file
+          INTEGER(KIND=1), DIMENSION(:,:,:), ALLOCATABLE ::  var_3d    !< 3d variable (lod = 2)
+          REAL(wp), DIMENSION(:), ALLOCATABLE ::  z                    !< vertical coordinate for 3D building, used for consistency check
+          LOGICAL ::  from_file = .FALSE.                              !< flag indicating whether an input variable is available and read from file or default values are used  
+          REAL(wp)                              ::  fill1 = -9999.9_wp !< fill values for lod = 1
+          REAL(wp), DIMENSION(:,:), ALLOCATABLE ::  var_2d             !< 2d variable (lod = 1)
+       END TYPE build_in
+
+!
+!-- Topography grid point
+    TYPE  grid_point
+        LOGICAL      ::  checked     !< Flag to indicate whether this grid point has been evaluated already
+        INTEGER(iwp) ::  i           !< x-index
+        INTEGER(iwp) ::  j           !< y-index
+        INTEGER(iwp) ::  polygon_id  !< ID of the polygon this grid point belongs to
+    END TYPE grid_point
+
+!
+!-- Node in the visibility graph navigation mesh
+    TYPE  mesh_point
+        INTEGER(iwp)                            ::  polygon_id          !< Polygon the point belongs to
+        INTEGER(iwp)                            ::  vertex_id           !< Vertex in the polygon
+        INTEGER(iwp)                            ::  noc                 !< number of connections
+        INTEGER(iwp)                            ::  origin_id           !< ID of previous mesh point on path (A*)
+        REAL(wp)                                ::  cost_so_far         !< Cost to reach this mesh point (A*)
+        REAL(wp)                                ::  x                   !< x-coordinate
+        REAL(wp)                                ::  y                   !< y-coordinate
+        REAL(wp)                                ::  x_s                 !< corner shifted outward from building by 1m (x)
+        REAL(wp)                                ::  y_s                 !< corner shifted outward from building by 1m (y)
+        INTEGER(iwp), DIMENSION(:), ALLOCATABLE ::  connected_vertices  !< Index of connected vertices
+        REAL(wp), DIMENSION(:), ALLOCATABLE     ::  distance_to_vertex  !< Distance to each vertex
+    END TYPE mesh_point
+
+!
+!-- Polygon containing a number of vertices
+    TYPE  polygon_type
+        INTEGER(iwp)                                 ::  nov       !< Number of vertices in this polygon
+        TYPE(vertex_type), DIMENSION(:), ALLOCATABLE ::  vertices  !< Array of vertices
+    END TYPE polygon_type
+
+!
+!-- 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
+!
+!-- Vertex of a polygon
+    TYPE  vertex_type
+        LOGICAL               ::  delete  !< Flag to mark vertex for deletion
+        REAL(wp)              ::  x       !< x-coordinate
+        REAL(wp)              ::  y       !< y-coordinate
+    END TYPE vertex_type
+
+    TYPE(grid_point), DIMENSION(:,:), ALLOCATABLE ::  grid  !< 2d Topography grid
+
+    TYPE(mesh_point), DIMENSION(:), ALLOCATABLE, TARGET ::  mesh  !< Navigation mesh
+
+    TYPE(real_2d) ::  terrain_height_f       !< input variable for terrain height
+
+    TYPE(vertex_type) ::  dummy_vertex  !< placeholder vertex used for data copying
+    TYPE(vertex_type) ::  null_vertex   !< placeholder vertex used for initialisation
+
+    TYPE(vertex_type), DIMENSION(:), ALLOCATABLE ::  dummy_v_list  !< Dummy for reallocation of polygon array
+
+    TYPE(polygon_type), POINTER ::  polygon  !< Current polygon
+
+    TYPE(polygon_type), DIMENSION(:), ALLOCATABLE, TARGET ::  polygons  !< Building polygons
+
+    TYPE(build_in) ::  buildings_f  !< input variable for buildings
+
+
+ END MODULE variables
+ 
+ MODULE data_input
+
+    USE kinds
+    USE variables
+
+#if defined ( __netcdf )
+    USE NETCDF
+#endif
+
+    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
+    
+    CONTAINS
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Reads orography and building information.
+!------------------------------------------------------------------------------!
+    SUBROUTINE netcdf_data_input_topo ( input_trunk )
+
+       IMPLICIT NONE
+
+       CHARACTER(LEN=*) ::  input_trunk       !< run path
+       CHARACTER(LEN=200) ::  input_filename  !< filename
+
+       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) ::  k_head       !< minimum k index for agents to walk underneath overhanging buildings
+       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
+
+       LOGICAL ::  netcdf_flag = .FALSE.     !< indicates whether netcdf file is used for input
+       LOGICAL ::  lod_flag = .FALSE.        !< true if 3d building data is used
+       LOGICAL ::  topo_file_flag = .FALSE.  !< true if 3d building data is used
+
+       REAL(wp) ::  dum  !< dummy variable to skip columns while reading topography file   
+
+       WRITE(*,'((X,A,/))') 'Looking for topography/building information'
+       INQUIRE( FILE = TRIM( input_trunk )//'_static', EXIST = netcdf_flag )
+
+       IF ( netcdf_flag ) THEN
+          input_filename = TRIM( input_trunk )//'_static'
+          WRITE(*,'(2(3X,A,/))') 'Topography/building data will be used from', & 
+          TRIM( input_trunk )//'_static'
+       ELSE
+          WRITE(*,'(2(3X,A,/))') 'No static driver was found.',                &
+                      'Trying to read building data from _topo file.'
+          input_filename = TRIM( input_trunk )//'_topo'
+          INQUIRE( FILE = TRIM( input_filename ), EXIST = topo_file_flag )
+          IF ( .NOT. topo_file_flag ) THEN
+             WRITE(*,'(6(3X,A,/))')                                            &
+                 'No ASCII topography file was found in INPUT directory.',     &
+                 'Make sure you provided building data in the form of either', &
+                 '   (A) a static driver (<runname>_static) or',               &
+                 '   (B) an ASCII topography file (<runname>_topo).',          &
+                 NEW_LINE('A')//'Aborting nav_mesh program...'
+             STOP
+          ENDIF
+          WRITE(*,'(2(3X,A,/))') 'Topography/building data will be used from', & 
+          TRIM( input_trunk )//'_topo'
+       ENDIF
+
+!
+!--    Input via palm-input data standard 
+       IF ( netcdf_flag )  THEN
+#if defined ( __netcdf )
+!
+!--       Open file in read-only mode
+          CALL open_read_file( TRIM(input_filename) , id_topo )
+
+!
+!--       At first, inquire all variable names. 
+!--       This will be used to check whether an input variable exist or not. 
+          nc_stat = NF90_INQUIRE( id_topo, NVARIABLES = num_vars )
+          CALL handle_error( 'inquire_num_variables', 534 )
+!
+!--       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(0:ny,0:nx)  )
+             DO  i = 0, nx
+                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(0:ny,0:nx) )
+                DO  i = 0, nx
+                   CALL get_variable( id_topo, 'buildings_2D',                 &
+                                      i, buildings_f%var_2d(:,i) ) 
+                ENDDO
+             ELSE 
+                WRITE(*,'(A)') 'NetCDF attribute lod ' //                      &
+                                 '(level of detail) is not set properly.'
+             ENDIF
+          ENDIF
+!
+!--       If available, also read 3D building information. If both are
+!--       available, use 3D information.
+          IF ( check_existence( var_names, 'buildings_3D' ) )  THEN
+             lod_flag = .TRUE.
+             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%z(0:buildings_f%nz-1) )
+                CALL get_variable( id_topo, 'z', buildings_f%z )
+
+                ALLOCATE( buildings_f%var_3d(0:buildings_f%nz-1,               &
+                                             0:ny,0:nx) )
+                buildings_f%var_3d = 0
+!
+!--                Read data PE-wise. Read yz-slices.
+                DO  i = 0, nx
+                   DO  j = 0, ny
+                      CALL get_variable( id_topo, 'buildings_3D',              &
+                                         i, j,                                 &
+                                         buildings_f%var_3d(:,j,i) )
+                   ENDDO
+                ENDDO
+             ELSE 
+                WRITE(*,'(A)') 'NetCDF attribute lod ' //                      &
+                                 '(level of detail) is not set properly.'
+             ENDIF
+          ENDIF
+
+!
+!--       Close topography input file
+          CALL close_input_file( id_topo )
+#endif
+!
+!--    ASCII input
+       ELSE
+
+          OPEN( 90, FILE= input_filename,                                      &
+                STATUS='OLD', FORM='FORMATTED' )
+!
+!--             Read data from nyn to nys and nxl to nxr. Therefore, skip 
+!--             column until nxl-1 is reached
+          ALLOCATE ( buildings_f%var_2d(0:ny,0:nx) )
+          DO  j = ny, 0, -1
+             READ( 90, *, ERR=11, END=11 )                                     &
+                             ( buildings_f%var_2d(j,i), i = 0, nx )
+          ENDDO
+
+          GOTO 12
+
+11             WRITE(*,'(2A)') 'errors in file ',input_filename
+
+12             CLOSE( 90 )
+          buildings_f%from_file = .TRUE.
+
+       ENDIF
+!
+!--    In case no terrain height is provided by static input file, allocate 
+!--    array nevertheless and set terrain height to 0, which simplifies 
+!--    topography initialization.
+       IF ( .NOT. terrain_height_f%from_file )  THEN
+          ALLOCATE ( terrain_height_f%var(0:ny,0:nx) )
+          terrain_height_f%var = 0.0_wp
+       ENDIF
+
+!
+!--    Transfer read data to uniform format: For agents the only relevant 
+!--    information is whether they can walk or not at ground level.
+       k_head = CEILING(2./dz)
+       IF ( buildings_f%from_file ) THEN
+          IF ( lod_flag ) THEN
+             obstacle_height(0:nx,0:ny) = 1.
+             DO j = 0, ny
+                DO i = 0, nx
+!
+!--                For this purpose, an overhanging structure that an angent
+!--                can walk beneath (e.g. a doorway) is not considered an
+!--                obstacle.
+                   IF ( ALL( buildings_f%var_3d(0:k_head,j,i) == 0 ) ) THEN
+                      obstacle_height(i,j) = 0.
+                   ENDIF
+                ENDDO
+             ENDDO
+          ELSE
+             DO j = 0, ny
+                DO i = 0, nx
+                   obstacle_height(i,j) = buildings_f%var_2d(j,i)
+                ENDDO
+             ENDDO
+          ENDIF
+       ELSE
+          WRITE(*,*) 'No building data was read from file. There will be no' //&
+                     'navigation data available to agents.'
+       ENDIF
+       
+    END SUBROUTINE netcdf_data_input_topo
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Checks if a given variables is on file
+!------------------------------------------------------------------------------!
+    FUNCTION check_existence( vars_in_file, var_name )
+
+       IMPLICIT NONE
+
+       CHARACTER(LEN=*) ::  var_name                   !< variable to be checked
+       CHARACTER(LEN=*), DIMENSION(:) ::  vars_in_file !< list of variables in file
+
+       INTEGER(iwp) ::  i                              !< loop variable
+
+       LOGICAL ::  check_existence                     !< flag indicating whether a variable exist or not - actual return value
+
+       i = 1
+       check_existence = .FALSE.
+       DO  WHILE ( i <= SIZE( vars_in_file ) )
+          check_existence = TRIM( vars_in_file(i) ) == TRIM( var_name )  .OR.  &
+                            check_existence
+          i = i + 1
+       ENDDO
+
+       RETURN
+
+    END FUNCTION check_existence
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Closes an existing netCDF file.
+!------------------------------------------------------------------------------!
+    SUBROUTINE close_input_file( id )
+#if defined( __netcdf )
+
+       IMPLICIT NONE
+
+       INTEGER(iwp), INTENT(INOUT)        ::  id        !< file id
+
+       nc_stat = NF90_CLOSE( id )
+       CALL handle_error( 'close', 537 )
+#endif
+    END SUBROUTINE close_input_file
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Opens an existing netCDF file for reading only and returns its id.
+!------------------------------------------------------------------------------!
+    SUBROUTINE open_read_file( filename, id )
+#if defined( __netcdf )
+
+       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 )
+       WRITE(*,'(A,X,A)') 'Reading from file', filename
+
+       CALL handle_error( 'open_read_file', 536 )
+
+#endif
+    END SUBROUTINE open_read_file
+
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Get dimension array for a given dimension
+!------------------------------------------------------------------------------!
+     SUBROUTINE get_dimension_length( id, dim_len, variable_name )
+#if defined( __netcdf )
+
+       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 )
+
+       IMPLICIT NONE
+
+       CHARACTER(LEN=*)            ::  variable_name    !< variable name 
+
+       INTEGER(iwp), INTENT(IN)    ::  id               !< file id
+       INTEGER(iwp)                ::  id_var           !< dimension id
+
+       INTEGER(iwp), DIMENSION(:), INTENT(INOUT) ::  var  !< variable to be read
+#if defined( __netcdf )
+
+!
+!--    First, inquire variable ID
+       nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
+       CALL handle_error( 'get_variable_1d_int', 527 )
+!
+!--    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 )
+
+       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
+#if defined( __netcdf )
+
+!
+!--    First, inquire variable ID
+       nc_stat = NF90_INQ_VARID( id, TRIM( variable_name ), id_var )
+       CALL handle_error( 'get_variable_1d_real', 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 )
+
+       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(0:ny), INTENT(INOUT) ::  var  !< variable to be read
+#if defined( __netcdf )
+!
+!--    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:ny),                          &
+                               start = (/ i+1, 1 /),                           &
+                               count = (/ 1, ny + 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 )
+
+       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(0:ny), INTENT(INOUT) ::  var  !< variable to be read
+#if defined( __netcdf )
+!
+!--    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:ny),                          &
+                               start = (/ i+1, 1 /),                           &
+                               count = (/ 1, ny + 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 )
+
+       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(0:ny), INTENT(INOUT) ::  var  !< variable to be read
+#if defined( __netcdf )
+!
+!--    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:ny),                          &
+                               start = (/ i+1, 1 /),                           &
+                               count = (/ 1, ny + 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 )
+
+       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(0:buildings_f%nz-1), INTENT(INOUT) ::  var  !< variable to be read
+#if defined( __netcdf )
+
+!
+!--    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 )
+
+       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
+#if defined( __netcdf )
+
+!
+!--    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 )
+
+       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
+#if defined( __netcdf )
+
+!
+!--    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:
+! ------------
+!> Prints out a text message corresponding to the current status.
+!------------------------------------------------------------------------------!
+    SUBROUTINE handle_error( routine_name, errno )
+
+       IMPLICIT NONE
+
+       CHARACTER(LEN=6) ::  message_identifier
+       CHARACTER(LEN=*) ::  routine_name
+       CHARACTER(LEN=100) ::  message_string
+
+       INTEGER(iwp) ::  errno
+#if defined( __netcdf )
+
+       IF ( nc_stat /= NF90_NOERR )  THEN
+
+          WRITE( message_identifier, '(''NC'',I4.4)' )  errno
+          
+          message_string = TRIM( NF90_STRERROR( nc_stat ) )
+
+          WRITE(*,*) routine_name,'  ', message_identifier,'  ', TRIM(message_string)
+          WRITE(*,*) 'Aborting NavMesh-tool'
+
+       ENDIF
+
+#endif
+    END SUBROUTINE handle_error
+
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Inquires the variable names belonging to a file. 
+!------------------------------------------------------------------------------!
+    SUBROUTINE inquire_variable_names( id, var_names )
+
+       IMPLICIT NONE
+
+       CHARACTER(LEN=*), DIMENSION(:), INTENT(INOUT) ::  var_names   !< return variable - variable names
+       INTEGER(iwp)                                  ::  i           !< loop variable
+       INTEGER(iwp), INTENT(IN)                      ::  id          !< file id
+       INTEGER(iwp)                                  ::  num_vars    !< number of variables (unused return parameter)
+       INTEGER(iwp), DIMENSION(:), ALLOCATABLE       ::  varids      !< dummy array to strore variable ids temporarily
+#if defined( __netcdf )
+
+       ALLOCATE( varids(1:SIZE(var_names)) )
+       nc_stat = NF90_INQ_VARIDS( id, NVARS = num_vars, VARIDS = varids )
+       CALL handle_error( 'inquire_variable_names', 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:
+! ------------
+!> Reads global or variable-related attributes of type INTEGER (32-bit)
+!------------------------------------------------------------------------------!
+     SUBROUTINE get_attribute_int32( id, attribute_name, value, global,        &
+                                     variable_name )
+
+       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
+#if defined( __netcdf )
+
+!
+!--    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 )
+
+       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
+#if defined( __netcdf )
+
+!
+!--    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 )
+
+       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
+#if defined( __netcdf )
+
+
+!
+!-- 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 )
+
+       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
+#if defined( __netcdf )
+
+!
+!--    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
+
+ END MODULE
+
+ MODULE mod_functions
+
+    USE kinds
+
+    PRIVATE
+    PUBLIC dist_point_to_edge, intersect, is_left, is_right
+
+    CONTAINS
+
+!
+!-- Calculates distance of point P to edge (A,B). If A = B, calculates
+!-- point-to-point distance from A/B to P
+    FUNCTION dist_point_to_edge ( a_x, a_y, b_x, b_y, p_x, p_y )
+
+       IMPLICIT NONE
+
+       REAL(wp)  :: ab_x                !< x-coordinate of vector from A to B
+       REAL(wp)  :: ab_y                !< y-coordinate of vector from A to B
+       REAL(wp)  :: ab_d                !< inverse length of vector from A to B
+       REAL(wp)  :: ab_u_x              !< x-coordinate of vector with direction of ab and length 1
+       REAL(wp)  :: ab_u_y              !< y-coordinate of vector with direction of ab and length 1
+       REAL(wp)  :: ba_x                !< x-coordinate of vector from B to A
+       REAL(wp)  :: ba_y                !< y-coordinate of vector from B to A
+       REAL(wp)  :: ap_x                !< x-coordinate of vector from A to P
+       REAL(wp)  :: ap_y                !< y-coordinate of vector from A to P
+       REAL(wp)  :: bp_x                !< x-coordinate of vector from B to P
+       REAL(wp)  :: bp_y                !< y-coordinate of vector from B to P
+       REAL(wp)  :: a_x                 !< x-coordinate of point A of edge
+       REAL(wp)  :: a_y                 !< y-coordinate of point A of edge
+       REAL(wp)  :: b_x                 !< x-coordinate of point B of edge
+       REAL(wp)  :: b_y                 !< y-coordinate of point B of edge
+       REAL(wp)  :: p_x                 !< x-coordinate of point P
+       REAL(wp)  :: p_y                 !< y-coordinate of point P
+       REAL(wp)  :: dist_x              !< x-coordinate of point P
+       REAL(wp)  :: dist_y              !< y-coordinate of point P
+       REAL(wp)  :: dist_point_to_edge  !< y-coordinate of point P
+
+       ab_x = - a_x + b_x
+       ab_y = - a_y + b_y
+       ba_x = - b_x + a_x 
+       ba_y = - b_y + a_y 
+       ap_x = - a_x + p_x
+       ap_y = - a_y + p_y
+       bp_x = - b_x + p_x
+       bp_y = - b_y + p_y
+
+       IF ( ab_x * ap_x + ab_y * ap_y <= 0. ) THEN
+          dist_point_to_edge = SQRT((a_x - p_x)**2 + (a_y - p_y)**2)
+       ELSEIF ( ba_x * bp_x + ba_y * bp_y <= 0. ) THEN
+          dist_point_to_edge = SQRT((b_x - p_x)**2 + (b_y - p_y)**2)
+       ELSE
+          ab_d = 1./SQRT((ab_x)**2+(ab_y)**2)
+          ab_u_x = ab_x*ab_d
+          ab_u_y = ab_y*ab_d
+          dist_x = ap_x - (ap_x*ab_u_x+ap_y*ab_u_y)*ab_u_x
+          dist_y = ap_y - (ap_x*ab_u_x+ap_y*ab_u_y)*ab_u_y
+          dist_point_to_edge = SQRT( dist_x**2 + dist_y**2 )
+       ENDIF
+
+       RETURN
+
+    END FUNCTION dist_point_to_edge
+
+!
+!-- Returns true if the line segments AB and PQ share an intersection
+    FUNCTION intersect ( ax, ay, bx, by, px, py, qx, qy )
+
+       IMPLICIT NONE
+
+       LOGICAL  :: intersect !< return value; TRUE if intersection was found
+       LOGICAL  :: la        !< T if a is left of PQ
+       LOGICAL  :: lb        !< T if b is left of PQ
+       LOGICAL  :: lp        !< T if p is left of AB
+       LOGICAL  :: lq        !< T if q is left of AB
+       LOGICAL  :: poss      !< flag that indicates if an intersection is still possible
+       LOGICAL  :: ra        !< T if a is right of PQ
+       LOGICAL  :: rb        !< T if b is right of PQ
+       LOGICAL  :: rp        !< T if p is right of AB
+       LOGICAL  :: rq        !< T if q is right of AB
+
+       REAL(wp)  :: ax     !< x-coordinate of point A
+       REAL(wp)  :: ay     !< y-coordinate of point A
+       REAL(wp)  :: bx     !< x-coordinate of point B
+       REAL(wp)  :: by     !< y-coordinate of point B
+       REAL(wp)  :: px     !< x-coordinate of point P
+       REAL(wp)  :: py     !< y-coordinate of point P
+       REAL(wp)  :: qx     !< x-coordinate of point Q
+       REAL(wp)  :: qy     !< y-coordinate of point Q
+
+       intersect = .FALSE.
+       poss      = .FALSE.
+!
+!--    Intersection is possible only if P and Q are on opposing sides of AB
+       lp = is_left(ax,ay,bx,by,px,py)
+       rq = is_right(ax,ay,bx,by,qx,qy)
+       IF ( lp .AND. rq ) poss = .TRUE.
+       IF ( .NOT. poss ) THEN
+          lq = is_left(ax,ay,bx,by,qx,qy)
+          rp = is_right(ax,ay,bx,by,px,py)
+          IF ( lq .AND. rp ) poss = .TRUE.
+       ENDIF
+!
+!--    Intersection occurs only if above test (poss) was true AND
+!--    A and B are on opposing sides of PQ
+       IF ( poss ) THEN
+          la = is_left(px,py,qx,qy,ax,ay)
+          rb = is_right(px,py,qx,qy,bx,by)
+          IF ( la .AND. rb ) intersect = .TRUE.
+          IF ( .NOT. intersect ) THEN
+             lb = is_left(px,py,qx,qy,bx,by)
+             ra = is_right(px,py,qx,qy,ax,ay)
+             IF ( lb .AND. ra ) intersect = .TRUE.
+          ENDIF
+       ENDIF
+
+       RETURN
+
+    END FUNCTION intersect 
+
+!
+!-- Calculates if point P is left of the infinite
+!-- line that contains A and B (direction: A to B) 
+!-- Concept: 2D rotation of two vectors
+    FUNCTION is_left ( ax, ay, bx, by, px, py )
+
+       IMPLICIT NONE
+
+       LOGICAL  :: is_left !< return value; TRUE if P is left of AB
+
+       REAL(wp)  :: ax     !< x-coordinate of point A
+       REAL(wp)  :: ay     !< y-coordinate of point A
+       REAL(wp)  :: bx     !< x-coordinate of point B
+       REAL(wp)  :: by     !< y-coordinate of point B
+       REAL(wp)  :: px     !< x-coordinate of point P
+       REAL(wp)  :: py     !< y-coordinate of point P
+!
+!--    2D-rotation
+       is_left = (bx-ax)*(py-ay)-(px-ax)*(by-ay) > 0
+!
+!--    False if the point is on the line (or very close)
+       IF ( (ABS(ax-px) < .001 .AND. ABS(ay-py) < .001) .OR.                  &
+            (ABS(bx-px) < .001 .AND. ABS(by-py) < .001) )                     &
+       THEN
+          is_left = .FALSE.
+       ENDIF
+
+       RETURN
+
+    END FUNCTION is_left 
+
+!
+!-- Calculates if point P is right of the infinite
+!-- line that contains A and B (direction: A to B) 
+!-- Concept: 2D rotation of two vectors
+    FUNCTION is_right ( ax, ay, bx, by, px, py )
+
+       IMPLICIT NONE
+
+       LOGICAL  :: is_right !< return value; TRUE if P is right of AB
+
+       REAL(wp), INTENT(IN)  :: ax     !< x-coordinate of point A
+       REAL(wp), INTENT(IN)  :: ay     !< y-coordinate of point A
+       REAL(wp), INTENT(IN)  :: bx     !< x-coordinate of point B
+       REAL(wp), INTENT(IN)  :: by     !< y-coordinate of point B
+       REAL(wp), INTENT(IN)  :: px     !< x-coordinate of point P
+       REAL(wp), INTENT(IN)  :: py     !< y-coordinate of point P
+
+!
+!--    2D-rotation
+       is_right = (bx-ax)*(py-ay)-(px-ax)*(by-ay) < 0
+!
+!--    False if the point is on the line (or very close)
+       IF ( (ABS(ax-px) < .001 .AND. ABS(ay-py) < .001) .OR.                  &
+            (ABS(bx-px) < .001 .AND. ABS(by-py) < .001) )                     &
+       THEN
+          is_right = .FALSE.
+       ENDIF
+
+       RETURN
+
+    END FUNCTION is_right 
+
+ END MODULE mod_functions
+ 
+ MODULE polygon_creation
+
+    USE kinds
+
+    USE mod_functions
+
+    USE variables
+
+    USE data_input
+
+    CONTAINS
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Initialisation, allocation, and reading of some input
+!------------------------------------------------------------------------------!
+    SUBROUTINE init
+
+       IMPLICIT NONE
+
+       CHARACTER(LEN=20)  ::  FMT
+       CHARACTER(LEN=200) ::  dirname
+       CHARACTER(LEN=200) ::  rundir
+       CHARACTER(LEN=200) ::  input_trunk
+       CHARACTER (LEN=80) ::  line  !<
+       
+       CHARACTER(LEN=2),DIMENSION(1:5) ::  run_pars
+
+       INTEGER(iwp) ::  status
+       INTEGER(iwp) ::  getcwd
+       INTEGER(iwp) ::  ie
+       INTEGER(iwp) ::  is
+
+       LOGICAL ::  p3d_flag = .FALSE.  !< indicates whether p3d file was found
+
+       NAMELIST /prepro_par/  tolerance_dp, internal_buildings
+
+       WRITE(*,'(X,A)')                                                        &
+                 "o----------------------------------------------o",           &
+                 "| o------------------------------------------o |",           &
+                 "| |    o   o           o   o         o       | |",           &
+                 "| |    |\  |           |\ /|         |       | |",           &
+                 "| |    | \ |  oo o   o | o | o-o o-o o--o    | |",           &
+                 "| |    |  \| | |  \ /  |   | |-o  \  |  |    | |",           &
+                 "| |    o   o o-o-  o   o   o o-o o-o o  o    | |",           &
+                 "| |                                          | |",           &
+                 "| |      Starting NavMesh-tool for PALM      | |",           &
+                 "| o------------------------------------------o |",           &
+                 "o----------------------------------------------o"
+!
+!--    Remove module files
+       CALL SYSTEM('rm -f *.mod')
+       WRITE(*,'((/,X,A,/))') 'Looking for input files'
+!
+!--    Identify run name and Input files
+       status = getcwd( dirname )
+       IF ( status /= 0 ) STOP 'getcwd: error'
+       ie = INDEX(dirname, '/', BACK=.TRUE.)
+       is = INDEX(dirname(1:ie-1), '/', BACK=.TRUE.)
+       runname = TRIM(ADJUSTL(dirname(is+1:ie-1)))
+       rundir  = TRIM(ADJUSTL(dirname(1:ie)))
+       input_trunk = TRIM(rundir)//'INPUT/'//TRIM(runname)
+!
+!--    Check for parameter file
+       INQUIRE( FILE = TRIM( input_trunk )//'_p3d', EXIST = p3d_flag )
+       IF ( .NOT. p3d_flag ) THEN
+          WRITE(*,'(3(3X,A,/))') 'No _p3d file was found. Aborting.',          &
+                                 'I was looking for the file',                 &
+                                 TRIM( input_trunk )//'_p3d'
+          STOP
+       ELSE
+          WRITE(*,'(2(3X,A,/))') 'The following input file will be used:',     & 
+                                  TRIM( input_trunk )//'_p3d'
+       ENDIF
+
+!
+!--    Read run parameters from run parameter file (_p3d), though not from
+!--    namelist.
+       run_pars = (/'dx','dy','dz','nx','ny'/)
+       OPEN ( 11, FILE=TRIM(input_trunk)//'_p3d', FORM='FORMATTED',    &
+                     STATUS='OLD' )
+       DO i = 1, SIZE(run_pars)
+          REWIND ( 11 )
+          line = ' '
+          DO   WHILE ( INDEX( line, run_pars(i) ) == 0 )
+             READ ( 11, '(A)', END=10 )  line
+             IF ( INDEX(line, '!') /= 0 ) THEN
+                IF ( INDEX(line, run_pars(i)) > INDEX(line, '!' ) ) THEN
+                   line = ' '
+                   CYCLE
+                ENDIF
+             ENDIF
+          ENDDO
+          line = TRIM(ADJUSTL(line(INDEX(line,'=')+1:INDEX(line,',')-1)))
+          SELECT CASE (i)
+             CASE(1)
+                READ(line,*) dx
+             CASE(2) 
+                READ(line,*) dy
+             CASE(3) 
+                READ(line,*) dz
+             CASE(4) 
+                READ(line,*) nx
+             CASE(5) 
+                READ(line,*) ny
+             CASE DEFAULT
+          END SELECT
+       ENDDO
+10     CONTINUE
+
+!
+!--    Try to find prepro package
+       REWIND ( 11 )
+       line = ' '
+       DO   WHILE ( INDEX( line, '&prepro_par' ) == 0 )
+          READ ( 11, '(A)', END=20 )  line
+       ENDDO
+       BACKSPACE ( 11 )
+
+!
+!--    Read user-defined namelist
+       READ ( 11, prepro_par )
+
+ 20    CONTINUE
+       CLOSE( 11 )
+
+!
+!--    If tolerance_dp was not set, put in default values
+       IF ( tolerance_dp(0) == 999999.0_wp ) tolerance_dp(0) = SQRT(dx*dy)*2.99
+       IF ( tolerance_dp(1) == 999999.0_wp ) tolerance_dp(1) = SQRT(dx*dy)*1.99
+       IF ( tolerance_dp(2) == 999999.0_wp ) tolerance_dp(2) = SQRT(dx*dy)*1.41
+       IF ( tolerance_dp(3) == 999999.0_wp ) tolerance_dp(3) = SQRT(dx*dy)*.7
+       IF ( tolerance_dp(4) == 999999.0_wp ) tolerance_dp(4) = SQRT(dx*dy)*.35
+!
+!--    Allocate arrays
+       ALLOCATE(obstacle_height(-3:nx+3,-3:ny+3), polygon_id(-3:nx+3,-3:ny+3), &
+                wall_flags_0(-3:nx+3,-3:ny+3), grid(-3:nx+3,-3:ny+3))
+!
+!--    Set null_vertex
+       CALL set_vertex(null_vertex,0_iwp,0.0_wp,0.0_wp)
+!
+!--    Some initializations
+       ddx = 1./dx
+       ddy = 1./dy
+
+       polygon_id                = 0
+       obstacle_height           = 0.
+
+       grid%checked              = .FALSE.
+       grid(-3:-1,:)%checked     = .TRUE.
+       grid(nx+1:nx+3,:)%checked = .TRUE.
+       grid(:,-3:-1)%checked     = .TRUE.
+       grid(:,ny+1:ny+3)%checked = .TRUE.
+       grid%polygon_id           = 0
+!
+!--    Open files and topography/building data
+       CALL netcdf_data_input_topo ( TRIM(input_trunk) )
+
+    END SUBROUTINE init
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Identifies all grid boxes that belong to a building and assigns a building
+!> number to each grid box.
+!> Method: Scans each grid point. If a grid point was not previously checked
+!>         and contains a building, it is added to a new polygon and marked as
+!>         checked. Then, all its neighbors that also contain a building are
+!>         added to the same polygon and marked as checked. All neighbors of
+!>         neighbors are subsequently found, added and checked until none are
+!>         left. Then, the initial scan continues, skipping already checked
+!>         grid points. Once a grid point with a new building is found, the
+!>         polygon_id increases and the grid point and all others that belong
+!>         to the same building are added as described above.
+!> NOTE:   This procedure will identify grid points that are only connected
+!>         diagonally (share only one point with each other) as connected and
+!>         have them belonging to the same building. This is necessary, as an
+!>         agent will not be able to traverse between these grid points and the
+!>         navigation mesh will therefore have to make him circumvent this
+!>         point.
+!------------------------------------------------------------------------------!
+    SUBROUTINE identify_polygons
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  ii    !< local counter
+       INTEGER(iwp) ::  il    !< local counter
+       INTEGER(iwp) ::  jj    !< local counter
+       INTEGER(iwp) ::  jl    !< local counter
+       INTEGER(iwp) ::  gpil  !< number of grid points in list
+       INTEGER(iwp) ::  gpta  !< number of grid points to add to grid_list
+
+       TYPE(grid_point), DIMENSION(1:7) ::  add_to_grid_list !< grid points to be added to the list
+
+       TYPE(grid_point), DIMENSION(:), ALLOCATABLE ::  dummy_grid_list !< dummy for reallocation of grid_list
+       TYPE(grid_point), DIMENSION(:), ALLOCATABLE ::  grid_list       !< list of grid points that belong to the current building but whose neighbors have not been checked yet
+
+!
+!--    Initialize wall_flags array: 1 where no buildings, 0 where buildings
+       wall_flags_0 = 1
+       DO i = 0, nx
+          DO j = 0, ny
+             IF ( obstacle_height(i,j) > 0 ) THEN
+                wall_flags_0(i,j) = 0
+             ENDIF
+          ENDDO
+       ENDDO
+       DEALLOCATE(obstacle_height)
+       polygon_counter = 0
+       gpil = 0
+       gpta = 0
+       ALLOCATE(grid_list(1:100))
+!
+!--    Declare all grid points that contain no buildings as already checked.
+!--    This way, these points will be skipped in the following calculation and
+!--    will have polygon_id = 0
+       DO i = 0, nx
+          DO j = 0, ny
+             IF ( BTEST( wall_flags_0(i,j), 0 ) ) THEN
+                grid(i,j)%checked = .TRUE.
+             ENDIF
+          ENDDO
+       ENDDO
+!
+!--    Check all grid points and process them
+       DO i = 0, nx
+          DO j = 0, ny
+!
+!--          If the current grid point has not been checked, mark it as checked.
+!--          As it is the first point belonging to a new building, increase the
+!--          polygon_id counter and associate the grid point with that id.
+             IF ( .NOT. grid(i,j)%checked ) THEN
+                polygon_counter = polygon_counter + 1
+                grid(i,j)%polygon_id = polygon_counter
+                grid(i,j)%checked = .TRUE.
+!
+!--             Check if any neighbors of the found grid point are part of a 
+!--             building too. If so, add them to the list of grid points
+!--             that have to be checked and associate them with the same polygon
+                gpta = 0
+                DO ii = i-1, i+1
+                   DO jj = j-1, j+1
+                      IF ( ii == i .AND. jj == j ) CYCLE
+                      IF ( .NOT. grid(ii,jj)%checked ) THEN
+                         gpta = gpta + 1
+                         add_to_grid_list(gpta)%i = ii
+                         add_to_grid_list(gpta)%j = jj
+                      ENDIF
+                   ENDDO
+                ENDDO
+
+!
+!--             Change size of grid_list if it becomes too small
+                IF ( gpil + gpta > SIZE(grid_list) ) THEN
+                   ALLOCATE(dummy_grid_list(1:gpil))
+                   dummy_grid_list = grid_list(1:gpil)
+                   DEALLOCATE(grid_list)
+                   ALLOCATE(grid_list(1:2*(gpil+gpta)))
+                   grid_list(1:gpil) = dummy_grid_list(1:gpil)
+                   DEALLOCATE(dummy_grid_list)
+                ENDIF
+!
+!--             If there are grid points to add to grid_list, add them
+                IF ( gpta > 0 ) THEN
+                   grid_list(gpil+1:gpil+gpta) = add_to_grid_list(1:gpta)
+                   gpil = gpil + gpta
+                ENDIF
+!
+!--             Handle all grid points in grid_list until there are none left
+                DO WHILE (gpil>0)
+                   il = grid_list(gpil)%i
+                   jl = grid_list(gpil)%j
+                   grid(il,jl)%polygon_id = polygon_counter
+                   grid(il,jl)%checked = .TRUE.
+!
+!--                this grid point in the list is processed, so the number of
+!--                grid points in the list can be reduced by one
+                   gpil = gpil - 1
+                   gpta = 0
+!
+!--                For the current grid point, check if any unchecked
+!--                neighboring grid points also contain a building. All such
+!--                grid points are added to the list of grid points to be
+!--                handled in this loop
+                   DO ii = il-1, il+1
+                      DO jj = jl-1, jl+1
+                         IF ( jj == jl .AND. ii == il ) CYCLE
+                         IF ( .NOT. grid(ii,jj)%checked )                      &
+                         THEN
+                            gpta = gpta + 1
+                            add_to_grid_list(gpta)%i = ii
+                            add_to_grid_list(gpta)%j = jj
+                         ENDIF
+                      ENDDO
+                   ENDDO
+!
+!--                Change size of grid list if it becomes too small
+                   IF ( gpil + gpta > SIZE(grid_list) ) THEN
+                      ALLOCATE(dummy_grid_list(1:gpil))
+                      dummy_grid_list = grid_list(1:gpil)
+                      DEALLOCATE(grid_list)
+                      ALLOCATE(grid_list(1:2*(gpil+gpta)))
+                      grid_list(1:gpil) = dummy_grid_list(1:gpil)
+                      DEALLOCATE(dummy_grid_list)
+                   ENDIF
+!
+!--                If there are grid points to add to list, add them
+                   IF ( gpta > 0 ) THEN
+                      grid_list(gpil+1:gpil+gpta) = add_to_grid_list(1:gpta)
+                      gpil = gpil + gpta
+                   ENDIF
+                ENDDO
+             ENDIF
+          ENDDO
+       ENDDO
+       DEALLOCATE(grid_list)
+!
+!--    Set size of polygon array and initialize
+       ALLOCATE(polygons(1:polygon_counter))
+       polygons%nov = 0
+
+    END SUBROUTINE identify_polygons
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Identifies the corners of the PALM building topography and adds them to
+!> a specific polygon for each building as vertices. This converts the gridded
+!> building data into one polygon per building that contains the coordinates of
+!> each inner and outer corner of that building as vertices.
+!> A grid point contains an outer corner if it's part of a building and exactly
+!>   one of its horizontal and one of its vertical neighbors is also part of a
+!>   building (4 cases).
+!> A grid point contains an inner corner if it's not part of a building and
+!>   exactly one of its horizontal, one of its diagonal and one of its vertical
+!>   neighbors are each part of a building and in turn neighbors
+!>   to each other (4 cases).
+!------------------------------------------------------------------------------!
+    SUBROUTINE identify_corners
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  il    !< local counter
+       INTEGER(iwp) ::  p_id  !< current polygon_id
+!
+!--    For all grid points, check whether it contains one or more corners
+       DO i = 0, nx
+          DO j = 0, ny
+!
+!--          First, check if grid contains topography and has a corner.
+             IF ( .NOT. BTEST( wall_flags_0(i,j), 0 ) ) THEN
+!
+!--             Corner at south left edge of grid cell
+                IF ( BTEST( wall_flags_0(i-1,j), 0 ) .AND.                     &
+                     BTEST( wall_flags_0(i,j-1), 0 ))                          &
+                THEN
+                   p_id = grid(i,j)%polygon_id
+                   polygons(p_id)%nov = polygons(p_id)%nov + 1
+                   nov = polygons(p_id)%nov
+                   CALL set_vertex(dummy_vertex, p_id, i*dx, j*dy)
+                   CALL add_vertex_to_polygon(dummy_vertex, p_id, nov)
+                ENDIF
+!
+!--             Corner at north left edge of grid cell
+                IF ( BTEST( wall_flags_0(i-1,j), 0 ) .AND.                     &
+                     BTEST( wall_flags_0(i,j+1), 0 ))                          &
+                THEN
+                   p_id = grid(i,j)%polygon_id
+                   polygons(p_id)%nov = polygons(p_id)%nov + 1
+                   nov = polygons(p_id)%nov
+                   CALL set_vertex(dummy_vertex, p_id, i*dx, (j+1)*dy)
+                   CALL add_vertex_to_polygon(dummy_vertex, p_id, nov)
+                ENDIF
+!
+!--             Corner at north right edge of grid cell
+                IF ( BTEST( wall_flags_0(i+1,j), 0 ) .AND.                     &
+                     BTEST( wall_flags_0(i,j+1), 0 ))                          &
+                THEN
+                   p_id = grid(i,j)%polygon_id
+                   polygons(p_id)%nov = polygons(p_id)%nov + 1
+                   nov = polygons(p_id)%nov
+                   CALL set_vertex(dummy_vertex, p_id, (i+1)*dx, (j+1)*dy)
+                   CALL add_vertex_to_polygon(dummy_vertex, p_id, nov)
+                ENDIF
+!
+!--             Corner at south right edge of grid cell
+                IF ( BTEST( wall_flags_0(i+1,j), 0 ) .AND.                     &
+                     BTEST( wall_flags_0(i,j-1), 0 ))                          &
+                THEN
+                   p_id = grid(i,j)%polygon_id
+                   polygons(p_id)%nov = polygons(p_id)%nov + 1
+                   nov = polygons(p_id)%nov
+                   CALL set_vertex(dummy_vertex, p_id, (i+1)*dx, j*dy)
+                   CALL add_vertex_to_polygon(dummy_vertex, p_id, nov)
+                ENDIF
+!
+!--          Second, check if grid contains no topography and has a corner.
+             ELSE
+!
+!--             Corner at south left edge of grid cell
+                IF ( .NOT. BTEST( wall_flags_0(i-1,j), 0 ) .AND.               &
+                     .NOT. BTEST( wall_flags_0(i,j-1), 0 ) .AND.               &
+                     .NOT. BTEST( wall_flags_0(i-1,j-1), 0 ) )                 &
+                THEN
+                   p_id = grid(i-1,j-1)%polygon_id
+                   polygons(p_id)%nov = polygons(p_id)%nov + 1
+                   nov = polygons(p_id)%nov
+                   CALL set_vertex(dummy_vertex, p_id, i*dx, j*dy)
+                   CALL add_vertex_to_polygon(dummy_vertex, p_id, nov)
+                ENDIF
+!
+!--             Corner at north left edge of grid cell
+                IF ( .NOT. BTEST( wall_flags_0(i-1,j), 0 ) .AND.               &
+                     .NOT. BTEST( wall_flags_0(i,j+1), 0 ) .AND.               &
+                     .NOT. BTEST( wall_flags_0(i-1,j+1), 0 ) )                 &
+                THEN
+                   p_id = grid(i-1,j+1)%polygon_id
+                   polygons(p_id)%nov = polygons(p_id)%nov + 1
+                   nov = polygons(p_id)%nov
+                   CALL set_vertex(dummy_vertex, p_id, i*dx, (j+1)*dy)
+                   CALL add_vertex_to_polygon(dummy_vertex, p_id, nov)
+                ENDIF
+!
+!--             Corner at north right edge of grid cell
+                IF ( .NOT. BTEST( wall_flags_0(i+1,j), 0 ) .AND.               &
+                     .NOT. BTEST( wall_flags_0(i,j+1), 0 ) .AND.               &
+                     .NOT. BTEST( wall_flags_0(i+1,j+1), 0 ) )                 &
+                THEN
+                   p_id = grid(i+1,j+1)%polygon_id
+                   polygons(p_id)%nov = polygons(p_id)%nov + 1
+                   nov = polygons(p_id)%nov
+                   CALL set_vertex(dummy_vertex, p_id, (i+1)*dx, (j+1)*dy)
+                   CALL add_vertex_to_polygon(dummy_vertex, p_id, nov)
+                ENDIF
+!
+!--             Corner at south right edge of grid cell
+                IF ( .NOT. BTEST( wall_flags_0(i+1,j), 0 ) .AND.               &
+                     .NOT. BTEST( wall_flags_0(i,j-1), 0 ) .AND.               &
+                     .NOT. BTEST( wall_flags_0(i+1,j-1), 0 ) )                 &
+                THEN
+                   p_id = grid(i+1,j-1)%polygon_id
+                   polygons(p_id)%nov = polygons(p_id)%nov + 1
+                   nov = polygons(p_id)%nov
+                   CALL set_vertex(dummy_vertex, p_id, (i+1)*dx, j*dy)
+                   CALL add_vertex_to_polygon(dummy_vertex, p_id, nov)
+                ENDIF
+             ENDIF
+          ENDDO
+       ENDDO
+
+    END SUBROUTINE identify_corners
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Initializes a vertex
+!------------------------------------------------------------------------------!
+    SUBROUTINE set_vertex (in_vertex, p_id, x, y)
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  p_id  !< polygon ID
+
+       REAL(wp) ::  x  !< x-coordinate of vertex position
+       REAL(wp) ::  y  !< y-coordinate of vertex position
+
+       TYPE(vertex_type) ::  in_vertex  !< vertex to be set
+
+       in_vertex%delete             = .FALSE.
+       in_vertex%x                  = x
+       in_vertex%y                  = y
+
+    END SUBROUTINE set_vertex
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Adds an existing vertex to the polygon with ID p_id at position in_nov
+!------------------------------------------------------------------------------!
+    SUBROUTINE add_vertex_to_polygon ( in_vertex, p_id, in_nov)
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  in_nov  !< counter of vertex being added to polygon
+       INTEGER(iwp) ::  p_id    !< polygon ID
+       INTEGER(iwp) ::  sop     !< size of vertices array
+
+       TYPE(vertex_type) ::  in_vertex  !< vertex to be added
+
+       TYPE(vertex_type), DIMENSION(:), ALLOCATABLE ::  dummy_v_list  !< for reallocation
+
+       polygon => polygons(p_id)
+!
+!--    Allocate and initialize the vertex array of the polygon, if necessary
+       IF ( .NOT. ALLOCATED(polygon%vertices) ) THEN
+          ALLOCATE(polygon%vertices(1:100))
+          polygon%vertices = null_vertex
+       ENDIF
+!
+!--    Adjust size of polygon, if necessary
+       sop = SIZE(polygon%vertices)
+       IF ( in_nov > sop ) THEN
+          ALLOCATE(dummy_v_list(1:sop))
+          dummy_v_list(1:sop) = polygon%vertices(1:sop)
+          DEALLOCATE(polygon%vertices)
+          ALLOCATE(polygon%vertices(1:2*sop))
+          polygon%vertices = null_vertex
+          polygon%vertices(1:sop) = dummy_v_list(1:sop)
+          DEALLOCATE(dummy_v_list)
+       ENDIF
+       polygon%vertices(in_nov) = in_vertex
+    END SUBROUTINE add_vertex_to_polygon
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Sorts the vertices of a polygon in a counter-clockwise fashion. During this
+!> process, all vertices that are not part of the hull of the building
+!> (inner courtyards) are deleted.
+!------------------------------------------------------------------------------!
+    SUBROUTINE sort_polygon(i_p)
+
+       IMPLICIT NONE
+
+       LOGICAL :: starting_vertex_found
+
+       INTEGER(iwp) ::  counter       !< counter for potential starting vertices
+       INTEGER(iwp) ::  id_neighbor   !< final ID of neighboring vertex
+       INTEGER(iwp) ::  id_neighbor1  !< ID of first potential neighbor
+       INTEGER(iwp) ::  id_neighbor2  !< ID of second potential neighbor
+       INTEGER(iwp) ::  il            !< local counter
+       INTEGER(iwp) ::  i_p           !< index of the current polygon
+       INTEGER(iwp) ::  noc           !< number of candidates
+       INTEGER(iwp) ::  nosv          !< number of sorted vertices
+       INTEGER(iwp) ::  xe            !< x-end-index for building search
+       INTEGER(iwp) ::  xs            !< x-start-index for building search
+       INTEGER(iwp) ::  ye            !< y-end-index for building search
+       INTEGER(iwp) ::  ys            !< y-start-index for building search
+
+       INTEGER, DIMENSION(:), ALLOCATABLE ::  candidate_id  !< ID of the potential neighbors stored in 'candidates'
+       INTEGER, DIMENSION(:), ALLOCATABLE ::  dummy_id_arr  !< used for resizing
+
+       REAL(wp) ::  dist  !< distance of one vertex to its neighbor
+       REAL(wp) ::  m_x   !< min/max x-value of polygon used for starting vertex
+       REAL(wp) ::  m_y   !< min/max y-value of polygon used for starting vertex
+
+       TYPE(vertex_type) ::  current_v     !< current vertex
+       TYPE(vertex_type) ::  dummy_vertex  !< dummy vertex for reordering
+
+       TYPE(vertex_type), DIMENSION(:), ALLOCATABLE ::  candidates        !< potential neighbors of the current vertex 
+       TYPE(vertex_type), DIMENSION(:), ALLOCATABLE ::  dummy_vertex_arr  !< used for resizing
+       TYPE(vertex_type), DIMENSION(:), ALLOCATABLE ::  sorted_p          !< vertices that have been sorted
+
+       starting_vertex_found = .FALSE.
+       ALLOCATE(sorted_p(1:nov))
+       sorted_p(1:nov) = polygon%vertices(1:nov)
+!
+!--    Identify a vertex that is certainly a part of the outer hull of the 
+!--    current polygon: Get rightmost border of polygon (or if that 
+!--    coincides with model border, leftmost) border. Then of those points,
+!--    get northmost (or if that coincides with model domain border, southmost).
+!--    This identifies exactly one point that is then set to the first index.
+       counter = 0
+       IF ( MAXVAL(sorted_p%x) < nx*dx ) THEN
+          m_x = MAXVAL(sorted_p%x)
+       ELSE
+          m_x = MINVAL(sorted_p%x)
+       ENDIF
+       DO il = 1, nov
+          IF ( sorted_p(il)%x == m_x ) THEN
+             counter = counter + 1
+             dummy_vertex = sorted_p(il)
+             sorted_p(il) = sorted_p(counter)
+             sorted_p(counter) = dummy_vertex
+          ENDIF
+       ENDDO
+       IF ( MAXVAL(sorted_p(1:counter)%y) < ny*dy ) THEN
+          m_y = MAXVAL(sorted_p(1:counter)%y)
+       ELSE
+          m_y = MINVAL(sorted_p(1:counter)%y)
+       ENDIF
+       DO il = 1, counter
+          IF ( sorted_p(il)%y == m_y ) THEN
+             dummy_vertex = sorted_p(il)
+             sorted_p(il) = sorted_p(1)
+             sorted_p(1) = dummy_vertex
+             starting_vertex_found = .TRUE.
+             EXIT
+          ENDIF
+       ENDDO
+!
+!--    If no starting vertex was found for the current polygon, it will be
+!--    deleted and an error message thrown
+       IF ( .NOT. starting_vertex_found ) THEN
+          WRITE(*,'(A,/,A,X,I6,/,A)')                                          &
+                     'An error occured during polygon sorting:',               &
+                     'no starting vertex could be found for polygon',          &
+                     i_p, 'This polygon contains the following vertices (x/y)'
+          DO il = 1, nov
+             WRITE(*,'(4X,F8.1,X,F8.1)')                                       &
+                         polygon%vertices(il)%x, polygon%vertices(il)%x
+          ENDDO
+          WRITE(*,'(A,/,A)')                                                   &
+                     'This polygon will be skipped during sorting and deleted',&
+                     'For details on the procedure, see SUBROUTINE sort_polygon.'
+          polygon%vertices%delete = .TRUE.
+          polygons(i_p)%nov = 0
+          CALL delete_empty_polygons
+!
+!--    Find the unique neighbor of the current vertex. For this, first
+!--    determine all possible candidates. Of those, keep only the ones that
+!--    are connected to the current vertex along a building edge (the polygon
+!--    is sorted counter-clockwise. Therefore, the building is always on the 
+!--    left-hand side of the connecting line from the current vertex to its
+!--    potential neighbor). This leaves a maximum of two possible neighbors.
+!--    This is only the case if the current vertex is the point that diagonally
+!--    connects two parts of the same building. In that case, the vertex that
+!--    lies to the right of the connecting line between the previous and
+!--    current vertex is the neighbor.
+       ELSE
+          DO nosv = 1, nov
+             current_v = sorted_p(nosv)
+             noc = 0
+             ALLOCATE(candidates(1:100), candidate_id(1:100))
+!
+!--          Find all candidates that could be neighbors of current vertex:
+!--          these are those vertices that share the same x- or y-coordinate
+!--          with the current vertex, as the vertices are all inner and outer
+!--          corners of the gridded building data
+             IF ( nosv < nov ) THEN
+                DO il = nosv+1, nov
+                   IF ( current_v%x == sorted_p(il)%x .OR.                  &
+                        current_v%y == sorted_p(il)%y)                      &
+                   THEN
+!
+!--                   If necessary, resize arrays for candidates
+                      IF ( noc >= SIZE(candidates) ) THEN
+                         ALLOCATE(dummy_vertex_arr(1:noc), dummy_id_arr(1:noc))
+                         dummy_vertex_arr(1:noc) = candidates(1:noc)
+                         dummy_id_arr(1:noc)   = candidate_id(1:noc)
+                         DEALLOCATE(candidates, candidate_id)
+                         ALLOCATE(candidates(1:2*noc), candidate_id(1:2*noc))
+                         candidates(1:noc)   = dummy_vertex_arr(1:noc)
+                         candidate_id(1:noc) = dummy_id_arr(1:noc)
+                         DEALLOCATE(dummy_vertex_arr, dummy_id_arr)
+                      ENDIF
+                      noc               = noc +1
+                      candidates(noc)   = sorted_p(il)
+                      candidate_id(noc) = il
+                   ENDIF
+                ENDDO
+             ENDIF
+!
+!--          Check which one of the candidates is the neighbor of the current
+!--          vertex. This is done by several tests that would exclude the
+!--          candidate from being the neighbor. Each successful test will
+!--          therefore result in a cycle to the next candidate. Only if all
+!--          all tests fail, is the candidate one of a maximum of two possible
+!--          neighbors.
+             id_neighbor1 = -999
+             id_neighbor2 = -999
+             DO il = 1, noc
+!
+!--             Exclude the possibility of a vertex with the same coordinates
+!--             being chosen as the neighbor. (dist < .9*dx)
+!--             NOTE: this could happen, if part of a building is only connected
+!--                   to the rest of the building diagonally. In that case, the
+!--                   same point is added to the polygon twice. This is necessary
+!--                   and not redundant! Two such points can never be neighbors.
+!--                   Example: the north right corner of grid point i,j
+!--                        AND the south left corner of grid point i+1,j+1.
+!--                   See SUBROUTINE identify_corners for the identification
+!--                   method.
+!--             Also, exclude a connection back to the coordinates of the 
+!--             previous vertex.
+                dist = SQRT( (candidates(il)%x - current_v%x)**2 +             &
+                                     (candidates(il)%y - current_v%y)**2 )
+                IF ( nosv > 1 ) THEN
+                   IF ( dist < .9*dx .OR.                                      &
+                        (sorted_p(nosv-1)%x == candidates(il)%x .AND.          &
+                         sorted_p(nosv-1)%y == candidates(il)%y) )             &
+                   THEN
+                      CYCLE
+                   ENDIF
+                ENDIF
+!
+!--             Check if there is a building all along only the left-hand side
+!--             of the connecting line from current vertex to potential neighbor
+!--             (4 cases)
+!--             First: for vertical connection
+                IF ( candidates(il)%x == current_v%x ) THEN
+                   xs = NINT(current_v%x*ddx)-1
+                   xe = xs + 1
+ !
+!--                Case 1: ys < ye, edge from south to north, building must be
+!--                        exclusively in all grid cells left of the edge
+                   IF ( current_v%y < candidates(il)%y ) THEN
+                      ys = NINT(current_v%y*ddy)
+                      ye = NINT(candidates(il)%y*ddy)-1
+                      IF ( .NOT.( ALL( .NOT. BTEST( wall_flags_0(xs,ys:ye), 0))&
+                           .AND.( ALL( BTEST( wall_flags_0(xe,ys:ye), 0 ) ) )))&
+                      THEN
+                         CYCLE
+                      ENDIF
+ !
+!--                Case 2: ys > ye, edge from north to south, building must be
+!--                        exclusively in all grid cells right of the edge
+                   ELSEIF ( current_v%y > candidates(il)%y ) THEN
+                      ys = NINT(current_v%y*ddy)-1
+                      ye = NINT(candidates(il)%y*ddy)
+                      IF ( .NOT.( ALL( .NOT. BTEST( wall_flags_0(xe,ye:ys), 0))&
+                           .AND.( ALL( BTEST( wall_flags_0(xs,ye:ys), 0 ) ) )))&
+                      THEN
+                         CYCLE
+                      ENDIF
+                   ENDIF
+!
+!--             Horizontal connection
+                ELSEIF ( candidates(il)%y == current_v%y ) THEN
+
+                   ys = NINT(current_v%y*ddy)-1
+                   ye = ys + 1
+!
+!--                Case 3: xs > xe, edge from right to left, building must be
+!--                        exclusively in all grid cells south of the edge
+                   IF ( current_v%x > candidates(il)%x ) THEN
+                      xs = NINT(current_v%x*ddx)-1
+                      xe = NINT(candidates(il)%x*ddx)
+                      IF ( .NOT.( ALL( .NOT. BTEST( wall_flags_0(xe:xs,ys), 0))&
+                           .AND.( ALL( BTEST( wall_flags_0(xe:xs,ye), 0 ) ) )))&
+                      THEN
+                         CYCLE
+                      ENDIF
+!
+!--                Case 4: xs < xe, edge from left to right, building must be
+!--                        exclusively in all grid cells north of the edge
+                   ELSEIF ( current_v%x < candidates(il)%x ) THEN
+                      xs = NINT(current_v%x*ddx)
+                      xe = NINT(candidates(il)%x*ddx)-1
+                      IF ( .NOT.( ALL( .NOT. BTEST( wall_flags_0(xs:xe,ye), 0))&
+                           .AND.( ALL( BTEST( wall_flags_0(xs:xe,ys), 0 ) ) )))&
+                      THEN
+                         CYCLE
+                      ENDIF
+                   ENDIF
+                ENDIF
+!
+!--             After the tests, only two potential neighbors are possible. The
+!--             one found first will get id_neighbor1, the possible 2nd one will
+!--             get id_neighbor2
+                IF ( id_neighbor1 ==  -999 ) THEN
+                   id_neighbor1 = candidate_id(il)
+                ELSEIF ( id_neighbor1 /=  -999 .AND.                           &
+                       ( sorted_p(id_neighbor1)%x /= candidates(il)%x ) .OR.   &
+                       ( sorted_p(id_neighbor1)%y /= candidates(il)%y ) )      &
+                THEN
+                   id_neighbor2 = candidate_id(il)
+                ENDIF
+             ENDDO
+!
+!--          If two potential neighbors were found, determine the one that is on 
+!--          the right hand side of the line connecting the current and previous 
+!--          vertex. It is the real neighbor.
+             IF ( id_neighbor2 /= -999 .AND. nosv > 1 ) THEN
+                IF ( is_right(sorted_p(nosv-1)%x,sorted_p(nosv-1)%y,           &
+                           current_v%x,current_v%y,                            &
+                           sorted_p(id_neighbor1)%x,sorted_p(id_neighbor1)%y) )&
+                THEN
+                   id_neighbor = id_neighbor1
+                ELSEIF ( is_right(sorted_p(nosv-1)%x,sorted_p(nosv-1)%y,       &
+                           current_v%x,current_v%y,                            &
+                           sorted_p(id_neighbor2)%x,sorted_p(id_neighbor2)%y) )&
+                THEN
+                   id_neighbor = id_neighbor2
+                ENDIF
+             ELSE
+                id_neighbor = id_neighbor1
+             ENDIF
+!
+!--          Put the found neighbor at next index in sorted array and move the
+!--          unsorted vertices back one index. This way, only yet unsorted
+!--          vertices are eligible to be candidates during the next iteration.
+             IF (id_neighbor /= nosv + 1 .AND. id_neighbor /= -999) THEN
+                dummy_vertex = sorted_p(id_neighbor)
+                sorted_p(nosv+2:id_neighbor) = sorted_p(nosv+1:id_neighbor-1)
+                sorted_p(nosv+1) = dummy_vertex
+!
+!--          If no neighbor was found, sorting is done for this polygon
+             ELSEIF ( id_neighbor == -999 ) THEN
+                DEALLOCATE(candidates,candidate_id)
+                EXIT
+             ENDIF
+             DEALLOCATE(candidates,candidate_id)
+          ENDDO
+!
+!--       Sorting is done. Reduce size (which means get rid of vertices
+!--       that are not part of the outer hull of the building: holes)
+!--       of sorted polygon and put it back in polygon%vertices.
+!--       Also add first vertex to the end of polygon and last vertex 
+!--       before the beginning of polygon.
+          DEALLOCATE(polygon%vertices)
+          ALLOCATE(polygon%vertices(0:nosv+1))
+          polygon%vertices(1:nosv) = sorted_p(1:nosv)
+          polygon%vertices(0) = sorted_p(nosv)
+          polygon%vertices(nosv+1) = sorted_p(1)
+          polygons(i_p)%nov = nosv
+          nov = polygons(i_p)%nov
+          DEALLOCATE(sorted_p)
+       ENDIF
+
+    END SUBROUTINE sort_polygon
+
+!------------------------------------------------------------------------------! 
+! Description:
+! ------------
+!> Reduces the number of vertices in a polygon using the 
+!> Douglas-Poiker-Algorithm (1973)
+!------------------------------------------------------------------------------! 
+    RECURSIVE SUBROUTINE simplify_polygon( id_s, id_e, tol )
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  max_dist_ind  !< Index of vertex with maximum distance
+       INTEGER(iwp) ::  il            !< counter
+       INTEGER(iwp) ::  id_s          !< End index in polygon
+       INTEGER(iwp) ::  id_e          !< End index in polygon
+
+       REAL(wp) ::  max_dist  !< Maximum distance from line
+       REAL(wp) ::  dum_dist  !< Distance from line: dummy
+       REAL(wp) ::  tol       !< factor that determines how far a vertex can be from the polygon approximation so that the approximation is still accepted
+
+       max_dist = 0.
+       max_dist_ind = -999999
+!
+!--    Find vertex with max distance to id_s and id_e
+       DO il = id_s + 1, id_e -1
+          dum_dist = dist_point_to_edge(polygon%vertices(id_s)%x,         &
+                                        polygon%vertices(id_s)%y,         &
+                                        polygon%vertices(id_e)%x,         &
+                                        polygon%vertices(id_e)%y,         &
+                                        polygon%vertices(il)%x,           &
+                                        polygon%vertices(il)%y)
+          IF ( dum_dist > max_dist ) THEN
+             max_dist     = dum_dist
+             max_dist_ind = il
+          ENDIF
+       ENDDO
+
+       IF ( max_dist > tol ) THEN
+          CALL simplify_polygon( id_s, max_dist_ind, tol )
+          CALL simplify_polygon( max_dist_ind, id_e, tol )
+       ELSE
+          polygon%vertices(id_s+1:id_e-1)%delete = .TRUE.
+       ENDIF
+
+    END SUBROUTINE simplify_polygon
+
+!------------------------------------------------------------------------------! 
+! Description:
+! ------------
+!> Checks if a vertex of a polygon is inside another polygon and if so, deletes
+!> it. The check is done using the crossing number algorithm. If a straight
+!> ray starting at a point crosses the borders of one polygon an odd
+!> number of times, the point is inside that polygon.
+!> This algorithm detects buildings that are completely surrounded by
+!> another building. They can be deleted since they can never be navigated.
+!> TODO: Maybe add a flag to turn this off and on as it might not be needed.
+!>       also, if the domain has buildings at all boundary points, there would
+!>       only be one giant building and everything in it deleted. So nothing
+!>       could be navigated. relevant?!
+!------------------------------------------------------------------------------! 
+    SUBROUTINE inside_other_polygon( i_p )
+
+       IMPLICIT NONE
+
+       LOGICAL ::  exit_flag  !< flag to exit loops if an odd crossing number was found for any of a polygons vertices
+
+       INTEGER(iwp) ::  cn         !< number of crossings
+       INTEGER(iwp) ::  i_p        !< index of current polygon
+       INTEGER(iwp) ::  il         !< index of tested polygon
+       INTEGER(iwp) ::  nov_test   !< no. of vertices of test-polygon
+       INTEGER(iwp) ::  ref_vert   !< vertex currently being tested if it is inside another polygon
+       INTEGER(iwp) ::  test_edge  !< index of edge being tested
+
+       REAL(wp) ::  px  !< x-coord of the point at the crossing of the ray and the vertex
+       REAL(wp) ::  xe  !< x-coordinate of end point of edge
+       REAL(wp) ::  xr  !< x-coordinate of reference point
+       REAL(wp) ::  xs  !< x-coordinate of start point of edge
+       REAL(wp) ::  ye  !< y-coordinate of end point of edge
+       REAL(wp) ::  yr  !< y-coordinate of reference point
+       REAL(wp) ::  ys  !< y-coordinate of start point of edge
+
+       TYPE(polygon_type), POINTER ::  test_pol  !< Polygon to be tested
+
+       exit_flag = .FALSE.
+!
+!--    Loop over all polygons other than the one being tested
+       DO il = 1, polygon_counter
+          IF ( il == i_p ) CYCLE
+          test_pol => polygons(il)
+          nov_test = polygons(il)%nov
+!
+!--       Inclusion test is done for every vertex of the polygon
+          DO ref_vert = 1, nov
+             cn = 0
+             xr = polygon%vertices(ref_vert)%x
+             yr = polygon%vertices(ref_vert)%y
+!
+!--          All edges of the every polygon il is tested for ray crossing
+             DO test_edge = 1, nov_test
+
+!--             It is tested wether the current edge crosses a ray that extends
+!--             from the current point to the right indefinitely.
+!--             Check if start point of edge is lower than end point. If they
+!--             are the same, ignore, since horizontal edges are excluded
+                IF ( test_pol%vertices(test_edge)%y <                          &
+                     test_pol%vertices(test_edge+1)%y )                        &
+                THEN
+                   xs = test_pol%vertices(test_edge)%x
+                   xe = test_pol%vertices(test_edge+1)%x
+                   ys = test_pol%vertices(test_edge)%y
+                   ye = test_pol%vertices(test_edge+1)%y
+                ELSEIF ( test_pol%vertices(test_edge)%y >                      &
+                         test_pol%vertices(test_edge+1)%y )                    &
+                THEN
+                   xs = test_pol%vertices(test_edge+1)%x
+                   xe = test_pol%vertices(test_edge)%x
+                   ys = test_pol%vertices(test_edge+1)%y
+                   ye = test_pol%vertices(test_edge)%y
+                ELSE
+                   CYCLE
+                ENDIF
+!
+!--             Only such edges where the starting point of the edge is south of
+!--             (or equal to) the reference point and the end point is north of
+!--             it are relevant. Note: an edge includes its southern endpoint
+!--             and excludes its northern endpoint.
+                IF ( .NOT. (ys <= yr .AND. ye > yr )) CYCLE
+!
+!--             Only edges that are crossed on the right side of the reference 
+!--             point are relevant, those on the left are ignored
+                IF ( xs <= xr .AND. xe <= xr ) CYCLE
+                IF ( ( xs <= xr .AND. xe >= xr ) .OR.                          &
+                     ( xs >= xr .AND. xe <= xr ) )                             &
+                THEN
+                   px = xe - (xe-xs)*(ye-yr)/(ye-ys)
+                   IF ( px <= xr ) CYCLE
+                ENDIF
+!
+!--             If none of the previous if clauses were true, a crossing with 
+!--             an eligible edge was found and the count increases
+                cn = cn + 1
+             ENDDO
+!
+!--          If the number of crossings is odd, the point is inside another 
+!--          polyon. The polygon associated with the point will be deleted
+             IF (  MOD(cn, 2) /= 0 ) THEN
+                exit_flag = .TRUE.
+                EXIT
+             ENDIF
+          ENDDO
+          IF ( exit_flag ) EXIT
+       ENDDO
+       IF ( exit_flag ) polygon%vertices%delete = .TRUE.
+
+    END SUBROUTINE inside_other_polygon
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Deletes thoses vertices that are marked for deletion (%delete flag) and
+!> resizes the polygon
+!------------------------------------------------------------------------------!
+    SUBROUTINE delete_extra_vertices (i_p)
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  il        !< local counter
+       INTEGER(iwp) ::  vcounter  !< vertex counter
+       INTEGER(iwp) ::  i_p       !< polygon ID
+
+       TYPE(vertex_type), DIMENSION(:), ALLOCATABLE ::  dummy_pol !< Temporarily stores non-deleted vertices
+
+       ALLOCATE(dummy_pol(1:nov))
+       vcounter = 0
+!
+!--    Check all vertices and only keep those not marked for deletion
+       DO il = 1, nov
+          IF ( .NOT. polygon%vertices(il)%delete ) THEN
+             vcounter = vcounter + 1
+             dummy_pol(vcounter) = polygon%vertices(il)
+          ENDIF
+       ENDDO
+!
+!--    Set new number of vertices in the polygon
+       nov = vcounter
+       polygons(i_p)%nov = nov
+!
+!--    Resize
+       DEALLOCATE(polygon%vertices)
+       ALLOCATE(polygon%vertices(0:nov+1))
+       polygon%vertices(1:nov) = dummy_pol(1:nov)
+       polygon%vertices(0) = polygon%vertices(nov)
+       polygon%vertices(nov+1) = polygon%vertices(1)
+       DEALLOCATE(dummy_pol)
+
+    END SUBROUTINE delete_extra_vertices
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Deletes polygons that contain no vertices (happens for those polygons that
+!> were entirely encompassed by another polygon)
+!------------------------------------------------------------------------------!
+    SUBROUTINE delete_empty_polygons
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  il  !< local counter
+       INTEGER(iwp) ::  pc  !< number of nonempty polygons
+       INTEGER(iwp) ::  sv  !< size of vertex array
+
+       TYPE(polygon_type), DIMENSION(:), ALLOCATABLE ::  dummy_polygons  !< temporarily stores non-deletd polygons
+
+       pc = 0
+       sv = 0
+       ALLOCATE( dummy_polygons(1:polygon_counter) )
+!
+!--    Keep only those polygons that contain any vertices, skip the rest
+       DO il = 1, polygon_counter
+          IF ( polygons(il)%nov > 0 ) THEN
+             pc = pc + 1
+             sv = SIZE(polygons(il)%vertices)
+             ALLOCATE(dummy_polygons(pc)%vertices(0:sv-1))
+             dummy_polygons(pc) = polygons(il)
+          ENDIF
+       ENDDO
+       polygon_counter = pc
+!
+!--    Resize polygon array
+       DEALLOCATE(polygons)
+       ALLOCATE(polygons(1:polygon_counter))
+       DO il = 1, polygon_counter
+!
+!--       give each %vertices array the correct size and information
+          sv = SIZE(dummy_polygons(il)%vertices)
+          polygons(il)%nov = sv - 2
+          ALLOCATE(polygons(il)%vertices(0:sv-1))
+          polygons(il) = dummy_polygons(il)
+       ENDDO
+       DEALLOCATE(dummy_polygons)
+
+    END SUBROUTINE delete_empty_polygons
+
+ END MODULE polygon_creation 
+
+ MODULE mesh_creation
+
+    USE kinds
+
+    USE mod_functions
+
+    USE variables
+
+    CONTAINS
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Creates the navigation mesh:
+!>      1) Finds eligible vertices (those that are locally convex)
+!>      2) Adds them to the mesh
+!>      3) Adds connections between mesh points if they are in line of sight
+!>         of each other and the connecting line does not point into either of
+!>         the originating polygons (this is known as a visibility graph)
+!------------------------------------------------------------------------------!
+    SUBROUTINE create_nav_mesh
+
+       IMPLICIT NONE
+
+       LOGICAL ::  add                 !< flag for second cycle of add loop
+       LOGICAL ::  intersection_found  !< flag to indicate a found intersection
+
+       INTEGER(iwp) ::  cmp    !< counter: current mesh point
+       INTEGER(iwp) ::  il     !< local counter
+       INTEGER(iwp) ::  jl     !< local counter
+       INTEGER(iwp) ::  pid    !< polygon id of current mesh point
+       INTEGER(iwp) ::  pid_t  !< polygon id of tested mesh point
+       INTEGER(iwp) ::  pl     !< polygon counter
+       INTEGER(iwp) ::  vid    !< vertex id of current mesh point
+       INTEGER(iwp) ::  vid_t  !< vertex id of tested mesh point
+       INTEGER(iwp) ::  vl     !< vertex counter
+       
+       REAL(wp) ::  left          !< counter: current mesh point
+       REAL(wp) ::  v1x           !< x-coordinate of test vertex 1 for intersection test
+       REAL(wp) ::  v1y           !< y-coordinate of test vertex 1 for intersection test
+       REAL(wp) ::  v2x           !< x-coordinate of test vertex 2 for intersection test
+       REAL(wp) ::  v2y           !< y-coordinate of test vertex 2 for intersection test
+       REAL(wp) ::  x             !< x-coordinate of current mesh point
+       REAL(wp) ::  x_t           !< x-coordinate of tested mesh point
+       REAL(wp) ::  y             !< y-coordinate of current mesh point
+       REAL(wp) ::  y_t           !< y-coordinate of tested mesh point
+       REAL(wp) ::  corner_x      !< x-coordinate of shifted corner
+       REAL(wp) ::  corner_x_e    !< x-coordinate of end of corner gate
+       REAL(wp) ::  corner_y      !< y-coordinate of shifted corner
+       REAL(wp) ::  corner_y_e    !< y-coordinate of end of corner gate
+       REAL(wp) ::  t_start       !< CPU measure: start
+       REAL(wp) ::  t_inter       !< CPU measure: output test time
+       REAL(wp) ::  t_inter1      !< CPU measure: output test time
+       REAL(wp) ::  t_end         !< CPU measure: end
+       REAL(wp) ::  t_left        !< CPU measure: estimate for time left
+       REAL(wp) ::  t_done        !< CPU measure: elapsed time
+       REAL(wp) ::  percent_done  !< CPU measure: proportion of mesh points checked
+
+!
+!--    Add all convex vertices to the mesh.
+!--    DO loop will be executed twice. Once to count the mesh points to be
+!--    added and allocate the mesh point array, the second time (add == .TRUE.)
+!--    to fill the mesh point array.
+       WRITE(*,'(X,A)') 'Adding polygon vertices to mesh ...'
+       add = .FALSE.
+       DO
+          cmp = 0
+          DO il = 1, polygon_counter
+             polygon => polygons(il)
+             nov = polygons(il)%nov
+             DO jl = 1, nov
+!
+!--             In a polygon that is sorted counter-clockwise, if the next vertex
+!--             is left of the line connecting the previous and the current vertex,
+!--             the current vertex is locally convex.
+                IF ( is_left(polygon%vertices(jl-1)%x,polygon%vertices(jl-1)%y,   &
+                             polygon%vertices(jl)%x,polygon%vertices(jl)%y,       &
+                             polygon%vertices(jl+1)%x,polygon%vertices(jl+1)%y) ) &
+                THEN
+
+                   corner_x = polygon%vertices(jl)%x
+                   corner_y = polygon%vertices(jl)%y
+!
+!--                Create end point for corner navigation
+                   IF ( add ) THEN
+                      CALL shift_corner_outward(                               &
+                            polygon%vertices(jl-1)%x, polygon%vertices(jl-1)%y,&
+                            polygon%vertices(jl+1)%x, polygon%vertices(jl+1)%y,&
+                            polygon%vertices(jl)%x,   polygon%vertices(jl)%y,  &
+                            corner_x_e, corner_y_e, 1._wp )
+                   ENDIF
+!
+!--                Disregard corners outside of the domain
+                   IF ( corner_x<=(nx+1)*dx .AND. corner_x>=0 .AND.            &
+                        corner_y<=(ny+1)*dy .AND. corner_y>=0)                 &
+                   THEN
+                      cmp = cmp + 1
+                      IF ( add ) THEN
+                         CALL set_mesh_point( mesh(cmp), il, jl,               &
+                                                      corner_x, corner_y,      &
+                                                      corner_x_e, corner_y_e )
+                      ENDIF
+                   ENDIF
+                ENDIF
+             ENDDO
+          ENDDO
+          IF ( add ) EXIT
+          add = .TRUE.
+          ALLOCATE( mesh(1:cmp) )
+       ENDDO
+       WRITE(*,'(6X,A,X,I10,X,A,/)')  'Done. Added',cmp,'vertices to mesh.'
+       WRITE(*,'(X,A)') 'Establishing connections in mesh ...'
+!
+!--    CPU measurement
+       CALL CPU_TIME(t_start)
+       CALL CPU_TIME(t_inter)
+       DO il = 1, cmp
+!--       Output status of processing
+          CALL CPU_TIME(t_inter1)
+          IF ( t_inter1 - t_inter > 4. ) THEN
+             t_done       = (t_inter1-t_start)/60.
+             percent_done = REAL(il)/cmp*100.
+             t_left       = t_done/percent_done*(100-percent_done)
+             WRITE(*,'(3X,2(A,I8),A,F6.2,2(A,F7.1),A,I10)')                    &
+                   'Mesh point ',il,' of '                ,cmp,                &
+                   ': '                                   ,percent_done,       &
+                   ' % || elapsed time : '                ,t_done,             &
+                   ' min || ETA: '                        ,t_left,             &
+                   ' min || number of connections found: ',number_of_connections
+             CALL CPU_TIME(t_inter)
+          ENDIF
+          x = mesh(il)%x
+          y = mesh(il)%y
+          pid = mesh(il)%polygon_id
+          vid = mesh(il)%vertex_id
+          DO jl = 1, cmp
+!
+!--          No mesh point can be connected to itself
+             IF ( il == jl ) CYCLE
+             x_t = mesh(jl)%x
+             y_t = mesh(jl)%y
+             pid_t = mesh(jl)%polygon_id
+             vid_t = mesh(jl)%vertex_id
+!
+!--          Cycle, if a connection had already been established
+             IF ( ANY(mesh(jl)%connected_vertices == il) ) CYCLE
+!
+!--          If the distance between two nodes is larger than 600 m,
+!--          no connection will be made since there will typically no be such
+!--          long, straight ways in a city that a pedestrian will walk
+             IF ( SQRT((x_t-x)**2 +(y_t-y)**2) > 400. ) CYCLE
+!
+!--          If the connecting line between two mesh points points into either
+!--          or both of the corresponding polygons, no connection will be 
+!--          established between the two points. This is the case if the 
+!--          previous (next) vertex of the polygon is right of the connecting
+!--          line and the next (previous) vertex of the polygon is left of the
+!--          connecting line. This is checked for both polygons.
+             IF ( ((is_left(x_t,y_t,x,y,polygons(pid)%vertices(vid-1)%x,       &
+                                       polygons(pid)%vertices(vid-1)%y)        &
+                  .AND. is_right(x_t,y_t,x,y,polygons(pid)%vertices(vid+1)%x,  &
+                                       polygons(pid)%vertices(vid+1)%y) )      &
+                  .OR. (is_right(x_t,y_t,x,y,polygons(pid)%vertices(vid-1)%x,  &
+                                       polygons(pid)%vertices(vid-1)%y)        &
+                  .AND. is_left(x_t,y_t,x,y,polygons(pid)%vertices(vid+1)%x,   &
+                                       polygons(pid)%vertices(vid+1)%y)) )     &
+                  .OR. ((is_left(x,y,x_t,y_t,polygons(pid_t)%vertices(vid_t-1)%x, &
+                                       polygons(pid_t)%vertices(vid_t-1)%y)        &
+                  .AND. is_right(x,y,x_t,y_t,polygons(pid_t)%vertices(vid_t+1)%x,  &
+                                       polygons(pid_t)%vertices(vid_t+1)%y) )      &
+                  .OR. (is_right(x,y,x_t,y_t,polygons(pid_t)%vertices(vid_t-1)%x,  &
+                                       polygons(pid_t)%vertices(vid_t-1)%y)        &
+                  .AND. is_left(x,y,x_t,y_t,polygons(pid_t)%vertices(vid_t+1)%x,   &
+                                       polygons(pid_t)%vertices(vid_t+1)%y)) ) )   &
+             THEN
+                CYCLE
+             ENDIF
+!
+!--          For each edge of each polygon, check if it intersects with the 
+!--          potential connection. If so, no connection can be made
+!--          THIS IS THE BOTTLENECK OF THE PROGRAM
+             intersection_found = .FALSE.
+             DO pl = pid, polygon_counter
+                DO vl = 1, polygons(pl)%nov
+                   v1x = polygons(pl)%vertices(vl)%x
+                   v1y = polygons(pl)%vertices(vl)%y
+                   v2x = polygons(pl)%vertices(vl+1)%x
+                   v2y = polygons(pl)%vertices(vl+1)%y
+                   intersection_found = intersect(x,y,x_t,y_t,v1x,v1y,v2x,v2y)
+                   IF ( intersection_found ) EXIT
+                ENDDO
+                IF ( intersection_found ) EXIT
+             ENDDO
+             IF ( intersection_found ) CYCLE
+             DO pl = pid, 1, -1
+                IF ( pl == pid ) CYCLE
+                DO vl = 1, polygons(pl)%nov
+                   v1x = polygons(pl)%vertices(vl)%x
+                   v1y = polygons(pl)%vertices(vl)%y
+                   v2x = polygons(pl)%vertices(vl+1)%x
+                   v2y = polygons(pl)%vertices(vl+1)%y
+                   intersection_found = intersect(x,y,x_t,y_t,v1x,v1y,v2x,v2y)
+                   IF ( intersection_found ) EXIT
+                ENDDO
+                IF ( intersection_found ) EXIT
+             ENDDO
+             IF ( intersection_found ) CYCLE
+!
+!--       If neither of the above two test was true, a connection will be
+!--       established between the two mesh points.
+          number_of_connections = number_of_connections + 1
+          CALL add_connection(mesh(il),jl, mesh(jl))
+          CALL add_connection(mesh(jl),il, mesh(il))
+          ENDDO
+       ENDDO
+!
+!--    Adapt connected_vertices arrays
+       DO il = 1, cmp
+          CALL reduce_connections(mesh(il))
+       ENDDO
+       CALL CPU_TIME(t_end)
+!
+!--    Output to terminal
+       WRITE(*,'(6X,A,I10,A)') 'Done. Established ',number_of_connections,     &
+                               ' connections in mesh'
+       WRITE(*,'(6X,A,F10.1,A)') 'Time needed for calculation: ',              &
+                                 t_end-t_start,' seconds'
+       WRITE(*,'(2(6X,A,X,F12.3,X,A,/))') 'Size of Mesh data on disk:   ',     &
+                                        SIZEOF(mesh)/1048576.,"MB",            &
+                                        'Size of Polygon data on disk:',       &
+                                        SIZEOF(polygons)/1048576.,"MB"
+    END SUBROUTINE create_nav_mesh
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Initializes a point of the navigation mesh
+!------------------------------------------------------------------------------!
+    SUBROUTINE set_mesh_point (in_mp,pid,vid,x,y,x_s,y_s)
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  pid  !< polygon ID
+       INTEGER(iwp) ::  vid  !< vertex ID
+
+       REAL(wp) ::  x    !< x-value of mesh point for path calculation
+       REAL(wp) ::  x_s  !< x-value shifted outward from corner
+       REAL(wp) ::  y    !< y-value of mesh point for path calculation
+       REAL(wp) ::  y_s  !< y-value shifted outward from corner
+
+       TYPE(mesh_point) ::  in_mp  !< mesh point to be created
+
+       in_mp%origin_id          = -1
+       in_mp%polygon_id         = pid
+       in_mp%vertex_id          = vid
+       in_mp%cost_so_far        = 1.d12
+       in_mp%x                  = x
+       in_mp%y                  = y
+       in_mp%x_s                = x_s
+       in_mp%y_s                = y_s
+       in_mp%noc                = 0
+
+       ALLOCATE(in_mp%connected_vertices(1:100),                               &
+                in_mp%distance_to_vertex(1:100))
+
+       in_mp%connected_vertices = -999
+       in_mp%distance_to_vertex = -999.
+
+    END SUBROUTINE set_mesh_point
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Shifts a corner (middle one of three consecutive points a, b and p) outward
+!> by a given length along the angle bisector. Stores the result to res_x/res_y
+!------------------------------------------------------------------------------!
+    SUBROUTINE shift_corner_outward ( a_x, a_y, b_x, b_y, p_x, p_y, res_x,     &
+                                      res_y, shift )
+
+       IMPLICIT NONE
+
+       REAL(wp) ::  a_x     !< x-value of point A
+       REAL(wp) ::  a_y     !< y-value of point A
+       REAL(wp) ::  abs_ap  !< distance from A to P
+       REAL(wp) ::  abs_bp  !< distance from B to P
+       REAL(wp) ::  abs_co  !< length of angle bisector
+       REAL(wp) ::  b_x     !< x-value of point B
+       REAL(wp) ::  b_y     !< y-value of point B
+       REAL(wp) ::  eap_x   !< x-value of unit vector from A to P
+       REAL(wp) ::  eap_y   !< y-value of unit vector from A to P
+       REAL(wp) ::  ebp_x   !< x-value of unit vector from B to P
+       REAL(wp) ::  ebp_y   !< y-value of unit vector from B to P
+       REAL(wp) ::  p_x     !< x-value of point P
+       REAL(wp) ::  p_y     !< y-value of point P
+       REAL(wp) ::  res_x   !< x-value of result
+       REAL(wp) ::  res_y   !< y-value of result
+       REAL(wp) ::  shift   !< distance of shift in meters
+
+!
+!--    Get unit vector from previous to current vertex
+       eap_x  = p_x - a_x
+       eap_y  = p_y - a_y
+       abs_ap = SQRT(eap_x**2+eap_y**2)
+       eap_x  = eap_x/abs_ap
+       eap_y  = eap_y/abs_ap
+!
+!--    Get unit vector from next to current vertex
+       ebp_x  = p_x - b_x
+       ebp_y  = p_y - b_y
+       abs_bp = SQRT(ebp_x**2+ebp_y**2)
+       ebp_x  = ebp_x/abs_bp
+       ebp_y  = ebp_y/abs_bp
+!
+!--    Add previous two vectors to get angle bisector of corner.
+!--    Then, set its length to shift and add to original vertex
+!--    vector to shift it outward
+       res_x   = eap_x + ebp_x
+       res_y   = eap_y + ebp_y
+       abs_co  = SQRT(res_x**2+res_y**2)
+       res_x   = shift*res_x/abs_co + p_x
+       res_y   = shift*res_y/abs_co + p_y
+
+    END SUBROUTINE shift_corner_outward
+
+!------------------------------------------------------------------------------! 
+! Description:
+! ------------
+!> Adds a connection between two points of the navigation mesh 
+!> (one-way: in_mp1 to in_mp2)
+!------------------------------------------------------------------------------! 
+    SUBROUTINE add_connection (in_mp1,id2,in_mp2)
+
+       IMPLICIT NONE
+
+       LOGICAL ::  connection_established  !< Flag to indicate if connection has already been established
+
+       INTEGER(iwp) ::  id2  !< ID of in_mp2
+       INTEGER(iwp) ::  il   !< local counter
+       INTEGER(iwp) ::  noc1 !< number of connections in in_mp1
+
+       INTEGER, DIMENSION(:), ALLOCATABLE ::  dum_cv !< dummy array for connected_vertices
+
+       REAL(wp) ::  dist  !< Distance between the two points
+
+       REAL(wp), DIMENSION(:), ALLOCATABLE ::  dum_dtv
+
+       TYPE(mesh_point) ::  in_mp1  !< mesh point that gets a new connection
+       TYPE(mesh_point) ::  in_mp2  !< mesh point in_mp1 will be connected to
+
+       connection_established = .FALSE.
+!
+!--    Check if connection has already been established
+       noc1 = SIZE(in_mp1%connected_vertices)
+       DO il = 1, in_mp1%noc
+          IF ( in_mp1%connected_vertices(il) == id2 ) THEN
+             connection_established = .TRUE.
+             EXIT
+          ENDIF
+       ENDDO
+
+       IF ( .NOT. connection_established ) THEN
+!
+!--       Resize arrays, if necessary
+          IF ( in_mp1%noc >= noc1 ) THEN
+             ALLOCATE( dum_cv(1:noc1),dum_dtv(1:noc1) )
+             dum_cv  = in_mp1%connected_vertices
+             dum_dtv = in_mp1%distance_to_vertex
+             DEALLOCATE( in_mp1%connected_vertices, in_mp1%distance_to_vertex )
+             ALLOCATE( in_mp1%connected_vertices(1:2*noc1),                    &
+                       in_mp1%distance_to_vertex(1:2*noc1) )
+             in_mp1%connected_vertices         = -999
+             in_mp1%distance_to_vertex         = -999.
+             in_mp1%connected_vertices(1:noc1) = dum_cv
+             in_mp1%distance_to_vertex(1:noc1) = dum_dtv
+          ENDIF
+
+!
+!--    Add connection
+          in_mp1%noc = in_mp1%noc+1
+          dist = SQRT( (in_mp1%x - in_mp2%x)**2 + (in_mp1%y - in_mp2%y)**2 )
+          in_mp1%connected_vertices(in_mp1%noc) = id2
+          in_mp1%distance_to_vertex(in_mp1%noc) = dist
+       ENDIF
+
+    END SUBROUTINE add_connection
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Reduces the size of connection array to the amount of actual connections
+!> after all connetions were added
+!------------------------------------------------------------------------------!
+    SUBROUTINE reduce_connections (in_mp)
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  il  !< Local counter
+       INTEGER(iwp) ::  noc !< Number of connections
+
+       INTEGER, DIMENSION(:), ALLOCATABLE ::  dum_cv !< dummy: connected_vertices
+
+       REAL(wp), DIMENSION(:), ALLOCATABLE ::  dum_dtv !< dummy: distance_to_vertex
+
+       TYPE(mesh_point) ::  in_mp !< Input mesh point
+
+       noc = in_mp%noc
+       ALLOCATE( dum_cv(1:noc),dum_dtv(1:noc) )
+       dum_cv  = in_mp%connected_vertices(1:noc)
+       dum_dtv = in_mp%distance_to_vertex(1:noc)
+       DEALLOCATE( in_mp%connected_vertices, in_mp%distance_to_vertex )
+       ALLOCATE( in_mp%connected_vertices(1:noc),                              &
+                 in_mp%distance_to_vertex(1:noc) )
+       in_mp%connected_vertices(1:noc) = dum_cv(1:noc)
+       in_mp%distance_to_vertex(1:noc) = dum_dtv(1:noc)
+
+    END SUBROUTINE reduce_connections
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> Writes all NavMesh information into binary file and building data to ASCII
+!------------------------------------------------------------------------------!
+    SUBROUTINE bin_out_mesh
+
+       IMPLICIT NONE
+
+       INTEGER(iwp) ::  il           !< local counter
+       INTEGER(iwp) ::  jl           !< local counter
+       INTEGER(iwp) ::  size_of_mesh !< size of mesh
+       INTEGER(iwp) ::  size_of_pols !< size of polygon
+
+       WRITE(*,'(X,A)') 'Writing binary output data ...'
+
+       OPEN ( 14, FILE= TRIM(runname)//'_nav', FORM='UNFORMATTED', STATUS='replace' )
+!
+!--    Output of mesh data
+       size_of_mesh = SIZE(mesh)
+       WRITE(14) size_of_mesh
+       DO il = 1, size_of_mesh
+          WRITE(14) mesh(il)%polygon_id, mesh(il)%vertex_id, mesh(il)%noc,     &
+                    mesh(il)%origin_id, mesh(il)%cost_so_far, mesh(il)%x,      &
+                    mesh(il)%y, mesh(il)%x_s, mesh(il)%y_s
+          DO jl = 1, mesh(il)%noc
+             WRITE(14) mesh(il)%connected_vertices(jl),                        &
+                       mesh(il)%distance_to_vertex(jl)
+          ENDDO
+       ENDDO
+!
+!--    Output of building polygon data
+       size_of_pols = SIZE(polygons)
+       WRITE(14) size_of_pols
+       DO il = 1, size_of_pols
+          WRITE(14) polygons(il)%nov
+          DO jl = 0, polygons(il)%nov+1
+             WRITE(14) polygons(il)%vertices(jl)%delete,                       &
+                       polygons(il)%vertices(jl)%x, polygons(il)%vertices(jl)%y
+          ENDDO
+       ENDDO
+       CLOSE(14)
+!
+!--    Output building data to ASCII file
+       OPEN(UNIT=7,FILE='topo.txt',STATUS='replace',ACTION='write')
+       DO i = 1, polygon_counter
+       IF (polygons(i)%nov == 0) CYCLE
+          DO j = 1, polygons(i)%nov
+             WRITE(7,150) i,j,polygons(i)%vertices(j)%x,                       &
+                              polygons(i)%vertices(j)%y
+          ENDDO
+       ENDDO
+       CLOSE(7)
+
+       WRITE(*,'(6X,A)')  'Done, tool terminating.', '  ',                     &
+                          'Before starting your PALM run, please check the',   &
+                          'ASCII file topo.txt to see if you are satisfied',   &
+                          'with the polygon representation of the building',   &
+                          'data. If not, consider adjusting the parameter',    &
+                          'tolerance_dp accordingly.', '  ', 'Bye, Bye!', ' '
+       CALL CPU_TIME(finish)
+       WRITE(*,'(X,A,F10.4,A)') 'Total runtime: ', finish-start, ' seconds'
+
+       150 FORMAT (2(I7,X),2(F9.2,X) )
+
+    END SUBROUTINE bin_out_mesh
+
+ END MODULE mesh_creation
+
+ PROGRAM nav_mesh
+
+    USE mesh_creation
+    USE polygon_creation
+    USE variables
+    IMPLICIT NONE
+
+
+!
+!-- Start CPU mesurement
+    CALL CPU_TIME(start)
+!
+!-- Initialization
+    CALL init
+
+    WRITE(*,*) "Converting building data to polygons ..."
+!
+!-- Convert gridded building data to polygons
+    CALL identify_polygons
+!
+!-- Find corners in topography and add them to polygons
+    CALL identify_corners
+!
+!-- Sort polygons counter-clockwise, then simplify them
+    DO i = 1, polygon_counter
+       polygon => polygons(i)
+       nov = polygons(i)%nov
+       CALL sort_polygon(i)
+!
+!--    Simplify each polygon using douglas-peucker algorithm. If the number
+!--    of vertices would fall below 4 due to this procedure, the tolerance
+!--    for the algorithm is reduced and it is run again. 
+       DO i_sc = 0, 4
+          CALL simplify_polygon(1,nov+1,tolerance_dp(i_sc))
+          i_cn = 0
+          DO j = 1, nov
+             IF ( .NOT. polygon%vertices(j)%delete ) i_cn = i_cn + 1
+          ENDDO
+          IF ( i_cn > 3 ) THEN
+             EXIT
+          ELSE
+             polygon%vertices(:)%delete = .FALSE.
+          ENDIF
+       ENDDO
+       CALL delete_extra_vertices(i)
+    ENDDO
+!
+!-- Remove buildings that are surrounded by another building
+    IF ( .NOT. internal_buildings ) THEN
+       DO i = 1, polygon_counter
+          polygon => polygons(i)
+          nov = polygons(i)%nov
+          CALL inside_other_polygon(i)
+       ENDDO
+    ENDIF
+!
+!-- Delete vertices that are marked for deletion
+    DO i = 1, polygon_counter
+       polygon => polygons(i)
+       nov = polygons(i)%nov
+       CALL delete_extra_vertices(i)
+    ENDDO
+!
+!-- Count number of vertices
+    vertex_counter = 0
+    DO i = 1, polygon_counter
+       polygon => polygons(i)
+       nov = polygons(i)%nov
+       vertex_counter = vertex_counter + nov
+    ENDDO
+!
+!-- Delete polygons with no vertices
+    CALL delete_empty_polygons
+    WRITE(*,'(2(6X,A,I10,X,A,/))')                                             &
+                  'Done. Created a total of', polygon_counter, 'polygon(s)',   &
+                  '         with a total of', vertex_counter, 'vertices'
+!
+!-- Crate Navigation mesh from polygon data
+    CALL create_nav_mesh
+!
+!-- Binary mesh output
+    CALL bin_out_mesh
+
+ END PROGRAM nav_mesh
