Index: palm/trunk/SOURCE/lpm.f90
===================================================================
--- palm/trunk/SOURCE/lpm.f90	(revision 2798)
+++ palm/trunk/SOURCE/lpm.f90	(revision 2801)
@@ -1,2 +1,4 @@
+MODULE lpm_mod
+
 !> @file lpm.f90
 !------------------------------------------------------------------------------!
@@ -25,4 +27,8 @@
 ! -----------------
 ! $Id$
+! Changed lpm from subroutine to module.
+! Introduce particle transfer in nested models.
+! 
+! 2718 2018-01-02 08:49:38Z maronga
 ! Corrected "Former revisions" section
 ! 
@@ -139,5 +145,4 @@
 !> Particle advection
 !------------------------------------------------------------------------------!
- SUBROUTINE lpm
  
 
@@ -163,6 +168,5 @@
         ONLY: lpm_create_particle, PHASE_RELEASE
 
-    USE lpm_pack_and_sort_mod,                                                   &
-        ONLY:  lpm_sort_in_subboxes, lpm_sort_timeloop_done
+    USE lpm_pack_and_sort_mod
 
     USE particle_attributes,                                                   &
@@ -179,4 +183,24 @@
     USE pegrid
 
+ USE pmc_particle_interface,                                                &
+     ONLY: pmcp_c_get_particle_from_parent, pmcp_p_fill_particle_win,       &
+           pmcp_c_send_particle_to_parent, pmcp_p_empty_particle_win,       &
+           pmcp_p_delete_particles_in_fine_grid_area
+
+    USE pmc_interface,                                                      &
+       ONLY: nested_run
+
+ IMPLICIT NONE
+ PRIVATE
+ SAVE
+
+ INTERFACE lpm
+    MODULE PROCEDURE lpm
+ END INTERFACE lpm
+
+ PUBLIC lpm
+
+CONTAINS
+ SUBROUTINE lpm
     IMPLICIT NONE
 
@@ -424,12 +448,15 @@
 !--    Horizontal boundary conditions including exchange between subdmains
        CALL lpm_exchange_horiz
-!
-!--    Pack particles (eliminate those marked for deletion),
-!--    determine new number of particles
-       CALL lpm_sort_in_subboxes
-!
-!--    Initialize variables for the next (sub-) timestep, i.e., for marking 
-!--    those particles to be deleted after the timestep
-       deleted_particles = 0
+
+       IF ( .NOT. dt_3d_reached .OR. .NOT. nested_run )   THEN    ! IF .FALSE., lpm_sort_in_subboxes is done inside pcmp
+!
+!--       Pack particles (eliminate those marked for deletion),
+!--       determine new number of particles
+          CALL lpm_sort_in_subboxes
+!
+!--       Initialize variables for the next (sub-) timestep, i.e., for marking
+!--       those particles to be deleted after the timestep
+          deleted_particles = 0
+       ENDIF
 
        IF ( dt_3d_reached )  EXIT
@@ -437,4 +464,15 @@
        first_loop_stride = .FALSE.
     ENDDO   ! timestep loop
+!    
+!-- in case of nested runs do the transfer of particles after every full model time step
+    IF ( nested_run )   THEN
+       CALL particles_from_parent_to_child
+       CALL particles_from_child_to_parent
+       CALL pmcp_p_delete_particles_in_fine_grid_area
+
+       CALL lpm_sort_in_subboxes
+
+       deleted_particles = 0
+    ENDIF
 
 !
@@ -469,2 +507,23 @@
 
  END SUBROUTINE lpm
+
+ SUBROUTINE particles_from_parent_to_child
+    IMPLICIT NONE
+
+    CALL pmcp_c_get_particle_from_parent                         ! Child actions
+    CALL pmcp_p_fill_particle_win                                ! Parent actions
+
+    RETURN
+ END SUBROUTINE particles_from_parent_to_child
+
+ SUBROUTINE particles_from_child_to_parent
+    IMPLICIT NONE
+
+    CALL pmcp_c_send_particle_to_parent                         ! Child actions
+    CALL pmcp_p_empty_particle_win                              ! Parent actions
+
+    RETURN
+ END SUBROUTINE particles_from_child_to_parent
+
+
+END MODULE lpm_mod
Index: palm/trunk/SOURCE/lpm_boundary_conds.f90
===================================================================
--- palm/trunk/SOURCE/lpm_boundary_conds.f90	(revision 2798)
+++ palm/trunk/SOURCE/lpm_boundary_conds.f90	(revision 2801)
@@ -25,4 +25,7 @@
 ! -----------------
 ! $Id$
+! Introduce particle transfer in nested models.
+! 
+! 2718 2018-01-02 08:49:38Z maronga
 ! Corrected "Former revisions" section
 ! 
@@ -230,8 +233,9 @@
           ENDIF
 
-          IF ( particles(n)%z >= zu(nz)  .AND.  particles(n)%particle_mask )  THEN
+          IF ( particles(n)%z >= zw(nz)  .AND.  particles(n)%particle_mask )  THEN
              IF ( ibc_par_t == 1 )  THEN
 !
 !--             Particle absorption
+                WRITE(9,*) 'particle absorption'
                 particles(n)%particle_mask  = .FALSE.
                 deleted_particles = deleted_particles + 1
@@ -239,5 +243,5 @@
 !
 !--             Particle reflection
-                particles(n)%z       = 2.0_wp * zu(nz) - particles(n)%z
+                particles(n)%z       = 2.0_wp * zw(nz) - particles(n)%z
                 particles(n)%speed_z = -particles(n)%speed_z
                 IF ( use_sgs_for_particles  .AND. &
Index: palm/trunk/SOURCE/lpm_exchange_horiz.f90
===================================================================
--- palm/trunk/SOURCE/lpm_exchange_horiz.f90	(revision 2798)
+++ palm/trunk/SOURCE/lpm_exchange_horiz.f90	(revision 2801)
@@ -25,4 +25,7 @@
 ! -----------------
 ! $Id$
+! Introduce particle transfer in nested models.
+! 
+! 2718 2018-01-02 08:49:38Z maronga
 ! Corrected "Former revisions" section
 ! 
@@ -1175,5 +1178,5 @@
                       'Particle violated CFL-criterion: particle with id ',    &
                       particles(n)%id,' will be deleted!'   
-                      CALL message( 'lpm_check_cfl', 'PA0475', 0, 1, 0, 6, 0 )
+                      CALL message( 'lpm_check_cfl', 'PA0475', 0, 1, -1, 6, 0 )
                       particles(n)%particle_mask= .FALSE.
                    ENDIF
Index: palm/trunk/SOURCE/lpm_init.f90
===================================================================
--- palm/trunk/SOURCE/lpm_init.f90	(revision 2798)
+++ palm/trunk/SOURCE/lpm_init.f90	(revision 2801)
@@ -25,4 +25,7 @@
 ! -----------------
 ! $Id$
+! Introduce particle transfer in nested models.
+! 
+! 2718 2018-01-02 08:49:38Z maronga
 ! Corrected "Former revisions" section
 ! 
@@ -250,4 +253,7 @@
         ONLY:  get_topography_top_index_ji, surf_def_h, surf_lsm_h, surf_usm_h
 
+    USE pmc_particle_interface,                                                &
+        ONLY:  pmcp_g_init
+
     IMPLICIT NONE
 
@@ -460,4 +466,7 @@
        CASE ( 'reflect' )
           ibc_par_t = 2
+          
+       CASE ( 'nested' )
+          ibc_par_t = 3
 
        CASE DEFAULT
@@ -477,4 +486,7 @@
        CASE ( 'reflect' )
           ibc_par_lr = 2
+          
+       CASE ( 'nested' )
+          ibc_par_lr = 3
 
        CASE DEFAULT
@@ -494,4 +506,7 @@
        CASE ( 'reflect' )
           ibc_par_ns = 2
+          
+       CASE ( 'nested' )
+          ibc_par_ns = 3
 
        CASE DEFAULT
@@ -621,4 +636,6 @@
 
     ENDIF
+
+    CALL pmcp_g_init
 
 !
Index: palm/trunk/SOURCE/lpm_pack_arrays.f90
===================================================================
--- palm/trunk/SOURCE/lpm_pack_arrays.f90	(revision 2798)
+++ palm/trunk/SOURCE/lpm_pack_arrays.f90	(revision 2801)
@@ -25,4 +25,7 @@
 ! -----------------
 ! $Id$
+! Introduce particle transfer in nested models.
+! 
+! 2718 2018-01-02 08:49:38Z maronga
 ! Corrected "Former revisions" section
 ! 
@@ -207,5 +210,4 @@
        ENDDO
        CALL cpu_log( log_point_s(51), 'lpm_sort_in_subboxes', 'stop' )
-       RETURN
 
     END SUBROUTINE lpm_sort_in_subboxes
Index: palm/trunk/SOURCE/lpm_write_exchange_statistics.f90
===================================================================
--- palm/trunk/SOURCE/lpm_write_exchange_statistics.f90	(revision 2798)
+++ palm/trunk/SOURCE/lpm_write_exchange_statistics.f90	(revision 2801)
@@ -25,4 +25,7 @@
 ! -----------------
 ! $Id$
+! Introduce particle transfer in nested models.
+! 
+! 2718 2018-01-02 08:49:38Z maronga
 ! Corrected "Former revisions" section
 ! 
@@ -69,4 +72,5 @@
  SUBROUTINE lpm_write_exchange_statistics
  
+    USE MPI
 
     USE control_parameters,                                                    &
@@ -82,4 +86,7 @@
                trsp_count_sum, trsp_count_recv_sum
 
+    USE pmc_particle_interface,                                                &
+        ONLY:  pmcp_g_print_number_of_particles
+
     USE pegrid
 
@@ -89,4 +96,7 @@
     INTEGER(iwp) :: jp         !<
     INTEGER(iwp) :: kp         !<
+    INTEGER(iwp) :: tot_number_of_particles
+
+
 
 !
@@ -110,9 +120,22 @@
                         trsp_count_recv_sum, pnorth, trnp_count_sum,     &
                         trnp_count_recv_sum
-    CALL close_file( 80 )
 #else
     WRITE ( 80, 8000 )  current_timestep_number+1, simulated_time+dt_3d, &
                         number_of_particles
 #endif
+    CALL close_file( 80 )
+
+    IF ( number_of_particles > 0 ) THEN
+        WRITE(9,*) 'number_of_particles ', number_of_particles, current_timestep_number + 1, simulated_time + dt_3d
+    ENDIF
+
+#if defined( __parallel )
+    CALL MPI_ALLREDUCE( number_of_particles, tot_number_of_particles, 1, MPI_INTEGER,      &
+                                    MPI_SUM, comm2d, ierr)
+#else
+    tot_number_of_particles = number_of_particles
+#endif
+
+    CALL pmcp_g_print_number_of_particles (simulated_time+dt_3d, tot_number_of_particles)
 
 !
Index: palm/trunk/SOURCE/palm.f90
===================================================================
--- palm/trunk/SOURCE/palm.f90	(revision 2798)
+++ palm/trunk/SOURCE/palm.f90	(revision 2801)
@@ -25,4 +25,8 @@
 ! -----------------
 ! $Id$
+! Changed lpm from subroutine to module.
+! Introduce particle transfer in nested models.
+! 
+! 2766 2018-01-22 17:17:47Z kanani
 ! Removed preprocessor directive __chem
 ! 
@@ -250,4 +254,7 @@
                pmci_modelconfiguration, pmci_parent_initialize,                &
                pmci_ensure_nest_mass_conservation
+
+    USE pmc_particle_interface,                                                 &
+        ONLY: pmcp_g_alloc_win
 
     USE radiation_model_mod,                                                   &
@@ -431,4 +438,5 @@
        ENDIF
 
+       CALL pmcp_g_alloc_win                    ! Must be called after pmci_child_initialize and pmci_parent_initialize
     ENDIF
 
Index: palm/trunk/SOURCE/pmc_child_mod.f90
===================================================================
--- palm/trunk/SOURCE/pmc_child_mod.f90	(revision 2798)
+++ palm/trunk/SOURCE/pmc_child_mod.f90	(revision 2801)
@@ -26,4 +26,7 @@
 ! -----------------
 ! $Id$
+! Introduce particle transfer in nested models.
+! 
+! 2718 2018-01-02 08:49:38Z maronga
 ! Corrected "Former revisions" section
 ! 
@@ -84,5 +87,5 @@
 !
 ! Child part of Palm Model Coupler
-!-------------------------------------------------------------------------------!
+!------------------------------------------------------------------------------!
 
 #if defined( __parallel )
@@ -97,12 +100,12 @@
 
     USE kinds
-    USE pmc_general,                                                            &
-        ONLY:  arraydef, childdef, da_desclen, da_namedef, da_namelen, pedef,   &
+    USE pmc_general,                                                           &
+        ONLY:  arraydef, childdef, da_desclen, da_namedef, da_namelen, pedef,  &
                pmc_da_name_err,  pmc_g_setname, pmc_max_array, pmc_status_ok
 
-    USE pmc_handle_communicator,                                                &
+    USE pmc_handle_communicator,                                               &
         ONLY:  m_model_comm, m_model_npes, m_model_rank, m_to_parent_comm
 
-    USE pmc_mpi_wrapper,                                                        &
+    USE pmc_mpi_wrapper,                                                       &
         ONLY:  pmc_alloc_mem, pmc_bcast, pmc_inter_bcast, pmc_time
 
@@ -112,8 +115,8 @@
     SAVE
 
-    TYPE(childdef) ::  me   !<
-
-    INTEGER ::  myindex = 0         !< counter and unique number for data arrays
-    INTEGER ::  next_array_in_list = 0   !<
+    TYPE(childdef), PUBLIC ::  me   !<
+
+    INTEGER(iwp) ::  myindex = 0         !< counter and unique number for data arrays
+    INTEGER(iwp) ::  next_array_in_list = 0   !<
 
 
@@ -149,4 +152,5 @@
         MODULE PROCEDURE pmc_c_set_dataarray_2d
         MODULE PROCEDURE pmc_c_set_dataarray_3d
+        MODULE PROCEDURE pmc_c_set_dataarray_ip2d
     END INTERFACE pmc_c_set_dataarray
 
@@ -157,6 +161,6 @@
 
 
-    PUBLIC pmc_childinit, pmc_c_clear_next_array_list, pmc_c_getbuffer,         &
-           pmc_c_getnextarray, pmc_c_putbuffer, pmc_c_setind_and_allocmem,      &
+    PUBLIC pmc_childinit, pmc_c_clear_next_array_list, pmc_c_getbuffer,        &
+           pmc_c_getnextarray, pmc_c_putbuffer, pmc_c_setind_and_allocmem,     &
            pmc_c_set_dataarray, pmc_set_dataarray_name, pmc_c_get_2d_index_list
 
@@ -169,6 +173,6 @@
      IMPLICIT NONE
 
-     INTEGER ::  i        !<
-     INTEGER ::  istat    !<
+     INTEGER(iwp) ::  i        !<
+     INTEGER(iwp) ::  istat    !<
 
 !
@@ -197,5 +201,5 @@
 
 
- SUBROUTINE pmc_set_dataarray_name( parentarraydesc, parentarrayname,           &
+ SUBROUTINE pmc_set_dataarray_name( parentarraydesc, parentarrayname,          &
                                     childarraydesc, childarrayname, istat )
 
@@ -207,11 +211,11 @@
     CHARACTER(LEN=*), INTENT(IN) ::  childarraydesc   !<
 
-    INTEGER, INTENT(OUT) ::  istat  !<
+    INTEGER(iwp), INTENT(OUT) ::  istat  !<
 !
 !-- Local variables
     TYPE(da_namedef) ::  myname  !<
 
-    INTEGER ::  mype  !<
-    INTEGER ::  my_addiarray = 0  !<
+    INTEGER(iwp) ::  mype  !<
+    INTEGER(iwp) ::  my_addiarray = 0  !<
 
 
@@ -219,5 +223,5 @@
 !
 !-- Check length of array names
-    IF ( LEN( TRIM( parentarrayname) ) > da_namelen  .OR.                       &
+    IF ( LEN( TRIM( parentarrayname) ) > da_namelen  .OR.                      &
          LEN( TRIM( childarrayname) ) > da_namelen )  THEN
        istat = pmc_da_name_err
@@ -235,5 +239,7 @@
 !
 !-- Broadcast to all child processes
-!-- TODO: describe what is broadcast here and why it is done
+!
+!-- The complete description of an transfer names array is broadcasted
+
     CALL pmc_bcast( myname%couple_index, 0, comm=m_model_comm )
     CALL pmc_bcast( myname%parentdesc,   0, comm=m_model_comm )
@@ -243,5 +249,7 @@
 !
 !-- Broadcast to all parent processes
-!-- TODO: describe what is broadcast here and why it is done
+!-- The complete description of an transfer array names is broadcasted als to all parent processe
+!   Only the root PE of the broadcasts to parent using intra communicator
+
     IF ( m_model_rank == 0 )  THEN
         mype = MPI_ROOT
@@ -290,8 +298,8 @@
     IMPLICIT NONE
 
-    INTEGER :: dummy               !<
-    INTEGER :: i, ierr, i2, j, nr  !<
-    INTEGER :: indwin              !< MPI window object
-    INTEGER :: indwin2             !< MPI window object
+    INTEGER(iwp) :: dummy               !<
+    INTEGER(iwp) :: i, ierr, i2, j, nr  !<
+    INTEGER(iwp) :: indwin              !< MPI window object
+    INTEGER(iwp) :: indwin2             !< MPI window object
 
     INTEGER(KIND=MPI_ADDRESS_KIND) :: win_size !< Size of MPI window 1 (in bytes)
@@ -307,17 +315,19 @@
 
     win_size = C_SIZEOF( dummy )
-    CALL MPI_WIN_CREATE( dummy, win_size, iwp, MPI_INFO_NULL, me%intra_comm,    &
+    CALL MPI_WIN_CREATE( dummy, win_size, iwp, MPI_INFO_NULL, me%intra_comm,   &
                          indwin, ierr )
 !
-!-- Open window on parent side
-!-- TODO: why is the next MPI routine called twice??
+!-- Close window on child side and open on parent side
     CALL MPI_WIN_FENCE( 0, indwin, ierr )
-!
+
+!   Between the two MPI_WIN_FENCE calls, the parent can fill the RMA window
+
 !-- Close window on parent side and open on child side
+
     CALL MPI_WIN_FENCE( 0, indwin, ierr )
 
     DO  i = 1, me%inter_npes
        disp = me%model_rank * 2
-       CALL MPI_GET( nrele((i-1)*2+1), 2, MPI_INTEGER, i-1, disp, 2,            &
+       CALL MPI_GET( nrele((i-1)*2+1), 2, MPI_INTEGER, i-1, disp, 2,           &
                      MPI_INTEGER, indwin, ierr )
     ENDDO
@@ -347,11 +357,14 @@
 !-- Here, we use a dummy for the MPI window because the parent processes do 
 !-- not access the RMA window via MPI_GET or MPI_PUT
-    CALL MPI_WIN_CREATE( dummy, winsize, iwp, MPI_INFO_NULL, me%intra_comm,     &
+    CALL MPI_WIN_CREATE( dummy, winsize, iwp, MPI_INFO_NULL, me%intra_comm,    &
                          indwin2, ierr )
 !
 !-- MPI_GET is non-blocking -> data in nrele is not available until MPI_FENCE is
 !-- called
-!-- TODO: as before: why is this called twice??
+
     CALL MPI_WIN_FENCE( 0, indwin2, ierr )
+
+!   Between the two MPI_WIN_FENCE calls, the parent can fill the RMA window
+
     CALL MPI_WIN_FENCE( 0, indwin2, ierr )
 
@@ -362,5 +375,5 @@
           disp = nrele(2*(i-1)+1)
           CALL MPI_WIN_LOCK( MPI_LOCK_SHARED , i-1, 0, indwin2, ierr )
-          CALL MPI_GET( myind, 2*nr, MPI_INTEGER, i-1, disp, 2*nr,              &
+          CALL MPI_GET( myind, 2*nr, MPI_INTEGER, i-1, disp, 2*nr,             &
                         MPI_INTEGER, indwin2, ierr )
           CALL MPI_WIN_UNLOCK( i-1, indwin2, ierr )
@@ -424,10 +437,10 @@
     myname = ar%name
 !
-!-- Return true if legal array
-!-- TODO: the case of a non-legal array does not seem to appear, so why is this
-!-- setting required at all?
+!-- Return true if annother array
+!-- If all array have been processed, the RETURN statement a couple of lines above is active
+
     pmc_c_getnextarray = .TRUE.
 
- END function pmc_c_getnextarray
+ END FUNCTION pmc_c_getnextarray
 
 
@@ -439,7 +452,7 @@
     REAL(wp), INTENT(IN) , DIMENSION(:,:), POINTER ::  array  !<
 
-    INTEGER                 ::  i       !<
-    INTEGER                 ::  nrdims  !<
-    INTEGER, DIMENSION(4)   ::  dims    !<
+    INTEGER(iwp)               ::  i       !<
+    INTEGER(iwp)               ::  nrdims  !<
+    INTEGER(iwp), DIMENSION(4) ::  dims    !<
 
     TYPE(C_PTR)             ::  array_adr
@@ -459,4 +472,5 @@
        ar  => ape%array_list(next_array_in_list)
        ar%nrdims = nrdims
+       ar%dimkey = nrdims
        ar%a_dim  = dims
        ar%data   = array_adr
@@ -465,5 +479,35 @@
  END SUBROUTINE pmc_c_set_dataarray_2d
 
-
+ SUBROUTINE pmc_c_set_dataarray_ip2d( array )
+
+    IMPLICIT NONE
+
+    INTEGER(idp), INTENT(IN) , DIMENSION(:,:), POINTER ::  array  !<
+
+    INTEGER(iwp)               ::  i       !<
+    INTEGER(iwp)               ::  nrdims  !<
+    INTEGER(iwp), DIMENSION(4) ::  dims    !<
+
+    TYPE(C_PTR)             ::  array_adr
+    TYPE(arraydef), POINTER ::  ar
+    TYPE(pedef), POINTER    ::  ape
+
+    dims    = 1
+    nrdims  = 2
+    dims(1) = SIZE( array, 1 )
+    dims(2) = SIZE( array, 2 )
+
+    array_adr = C_LOC( array )
+
+    DO  i = 1, me%inter_npes
+       ape => me%pes(i)
+       ar  => ape%array_list(next_array_in_list)
+       ar%nrdims = nrdims
+       ar%dimkey = 22
+       ar%a_dim  = dims
+       ar%data   = array_adr
+    ENDDO
+
+ END SUBROUTINE pmc_c_set_dataarray_ip2d
 
  SUBROUTINE pmc_c_set_dataarray_3d (array)
@@ -473,7 +517,8 @@
     REAL(wp), INTENT(IN), DIMENSION(:,:,:), POINTER ::  array  !<
 
-    INTEGER                 ::  i
-    INTEGER                 ::  nrdims
-    INTEGER, DIMENSION (4)  ::  dims
+    INTEGER(iwp)                ::  i
+    INTEGER(iwp)                ::  nrdims
+    INTEGER(iwp), DIMENSION (4) ::  dims
+    
     TYPE(C_PTR)             ::  array_adr
     TYPE(pedef), POINTER    ::  ape
@@ -493,4 +538,5 @@
        ar  => ape%array_list(next_array_in_list)
        ar%nrdims = nrdims
+       ar%dimkey = nrdims
        ar%a_dim  = dims
        ar%data   = array_adr
@@ -512,19 +558,19 @@
     CHARACTER(LEN=da_namelen) ::  myname  !<
 
-    INTEGER ::  arlen    !<
-    INTEGER ::  myindex  !<
-    INTEGER ::  i        !<
-    INTEGER ::  ierr     !<
-    INTEGER ::  istat    !<
-    INTEGER ::  j        !<
-    INTEGER ::  rcount   !<
-    INTEGER ::  tag      !<
-
-    INTEGER, PARAMETER ::  noindex = -1  !<
+    INTEGER(iwp) ::  arlen    !<
+    INTEGER(iwp) ::  myindex  !<
+    INTEGER(iwp) ::  i        !<
+    INTEGER(iwp) ::  ierr     !<
+    INTEGER(iwp) ::  istat    !<
+    INTEGER(iwp) ::  j        !<
+    INTEGER(iwp) ::  rcount   !<
+    INTEGER(iwp) ::  tag      !<
+
+    INTEGER(iwp), PARAMETER ::  noindex = -1  !<
 
     INTEGER(idp)                   ::  bufsize  !< size of MPI data window
     INTEGER(KIND=MPI_ADDRESS_KIND) ::  winsize  !<
 
-    INTEGER,DIMENSION(1024) ::  req  !<
+    INTEGER(iwp),DIMENSION(1024) ::  req  !<
 
     REAL(wp), DIMENSION(:), POINTER, SAVE ::  base_array_pc  !< base array
@@ -549,11 +595,12 @@
 !--       Receive index from child
           tag = tag + 1
-          CALL MPI_RECV( myindex, 1, MPI_INTEGER, i-1, tag, me%inter_comm,      &
+          CALL MPI_RECV( myindex, 1, MPI_INTEGER, i-1, tag, me%inter_comm,     &
                          MPI_STATUS_IGNORE, ierr )
           ar%recvindex = myindex
 !
 !--       Determine max, because child buffer is allocated only once
-!--       TODO: give a more meaningful comment
-          IF( ar%nrdims == 3 )  THEN
+!--       All 2D and 3d arrays use the same buffer
+
+          IF ( ar%nrdims == 3 )  THEN
              bufsize = MAX( bufsize, ar%a_dim(1)*ar%a_dim(2)*ar%a_dim(3) )
           ELSE
@@ -588,5 +635,5 @@
        DO  j = 1, ape%nr_arrays
           ar => ape%array_list(j)
-          IF( ar%nrdims == 2 )  THEN
+          IF ( ar%nrdims == 2 )  THEN
              arlen = ape%nrele
           ELSEIF( ar%nrdims == 3 )  THEN
@@ -596,16 +643,18 @@
           rcount = rcount + 1
           IF ( ape%nrele > 0 )  THEN
-             CALL MPI_ISEND( myindex, 1, MPI_INTEGER, i-1, tag, me%inter_comm,  &
+             CALL MPI_ISEND( myindex, 1, MPI_INTEGER, i-1, tag, me%inter_comm, &
                              req(rcount), ierr )
              ar%sendindex = myindex
           ELSE
-             CALL MPI_ISEND( noindex, 1, MPI_INTEGER, i-1, tag, me%inter_comm,  &
+             CALL MPI_ISEND( noindex, 1, MPI_INTEGER, i-1, tag, me%inter_comm, &
                              req(rcount), ierr )
              ar%sendindex = noindex
           ENDIF
 !
-!--       Maximum of 1024 outstanding requests
-!--       TODO: explain where this maximum comes from (arbitrary?).
-!--       Outstanding = pending? 
+!--       Maximum of 1024 pending requests
+!         1024 is an arbitrary value just to make sure the number of pending 
+!         requests is getting too large. It is possible that this value has to 
+!         be adjusted in case of running the model on large number of cores. 
+
           IF ( rcount == 1024 )  THEN
              CALL MPI_WAITALL( rcount, req, MPI_STATUSES_IGNORE, ierr )
@@ -640,5 +689,5 @@
     winSize = me%totalbuffersize
 
-    CALL MPI_WIN_CREATE( base_array_cp, winsize, wp, MPI_INFO_NULL,             &
+    CALL MPI_WIN_CREATE( base_array_cp, winsize, wp, MPI_INFO_NULL,            &
                          me%intra_comm, me%win_parent_child, ierr )
     CALL MPI_WIN_FENCE( 0, me%win_parent_child, ierr )
@@ -657,6 +706,6 @@
 !--                the message-routine
              IF ( ar%sendindex+ar%sendsize > bufsize )  THEN
-                WRITE( 0,'(a,i4,4i7,1x,a)') 'Child buffer too small ', i,       &
-                          ar%sendindex, ar%sendsize, ar%sendindex+ar%sendsize,  &
+                WRITE( 0,'(a,i4,4i7,1x,a)') 'Child buffer too small ', i,      &
+                          ar%sendindex, ar%sendsize, ar%sendindex+ar%sendsize, &
                           bufsize, TRIM( ar%name )
                 CALL MPI_ABORT( MPI_COMM_WORLD, istat, ierr )
@@ -670,19 +719,22 @@
 
 
- SUBROUTINE pmc_c_getbuffer( waittime )
+ SUBROUTINE pmc_c_getbuffer( waittime, particle_transfer )
 
     IMPLICIT NONE
 
     REAL(wp), INTENT(OUT), OPTIONAL ::  waittime  !<
+    LOGICAL, INTENT(IN), OPTIONAL   ::  particle_transfer  !<
 
     CHARACTER(LEN=da_namelen) ::  myname  !<
-
-    INTEGER                        ::  ierr     !<
-    INTEGER                        ::  ij       !<
-    INTEGER                        ::  ip       !<
-    INTEGER                        ::  j        !<
-    INTEGER                        ::  myindex  !<
-    INTEGER                        ::  nr       !< number of elements to get
-                                                !< from parent
+    
+    LOGICAL                        ::  lo_ptrans!<
+    
+    INTEGER(iwp)                        ::  ierr    !<
+    INTEGER(iwp)                        ::  ij      !<
+    INTEGER(iwp)                        ::  ip      !<
+    INTEGER(iwp)                        ::  j       !<
+    INTEGER(iwp)                        ::  myindex !<
+    INTEGER(iwp)                        ::  nr      !< number of elements to get
+                                                    !< from parent
     INTEGER(KIND=MPI_ADDRESS_KIND) ::  target_disp
     INTEGER,DIMENSION(1)           ::  buf_shape
@@ -696,4 +748,6 @@
     TYPE(pedef), POINTER                ::  ape
     TYPE(arraydef), POINTER             ::  ar
+    INTEGER(idp), POINTER, DIMENSION(:)     ::  ibuf      !<
+    INTEGER(idp), POINTER, DIMENSION(:,:)   ::  idata_2d  !<
 
 !
@@ -701,4 +755,10 @@
 !-- Therefore the RMA window can be filled without
 !-- sychronization at this point and a barrier is not necessary.
+
+!-- In case waittime is present, the following barrier is necessary to
+!-- insure the same number of barrier calls on parent and child
+!-- This means, that here on child side two barriers are call successively
+!-- The parent is filling its buffer between the two barrier calls
+
 !-- Please note that waittime has to be set in pmc_s_fillbuffer AND
 !-- pmc_c_getbuffer
@@ -709,10 +769,16 @@
        waittime = t2 - t1
     ENDIF
+
+    lo_ptrans = .FALSE.
+    IF ( PRESENT( particle_transfer))    lo_ptrans = particle_transfer
+
 !
 !-- Wait for buffer is filled.
-!-- TODO: explain in more detail what is happening here. The barrier seems to
-!-- contradict what is said a few lines before (i.e. that no barrier is necessary)
-!-- TODO: In case of PRESENT( waittime ) the barrrier would be calles twice. Why?
-!-- Shouldn't it be done the same way as in pmc_putbuffer?
+!
+!-- The parent side (in pmc_s_fillbuffer) is filling the buffer in the MPI RMA window
+!-- When the filling is complet, a MPI_BARRIER is called.
+!-- The child is not allowd to access the parent-buffer before it is completely filled
+!-- therefore the following barrier is required.
+
     CALL MPI_BARRIER( me%intra_comm, ierr )
 
@@ -721,24 +787,40 @@
        DO  j = 1, ape%nr_arrays
           ar => ape%array_list(j)
-          IF ( ar%nrdims == 2 )  THEN
+
+          IF ( ar%dimkey == 2 .AND. .NOT.lo_ptrans)  THEN
              nr = ape%nrele
-          ELSEIF ( ar%nrdims == 3 )  THEN
+          ELSEIF ( ar%dimkey == 3 .AND. .NOT.lo_ptrans)  THEN
              nr = ape%nrele * ar%a_dim(1)
+          ELSE IF ( ar%dimkey == 22 .AND. lo_ptrans)  THEN
+             nr = ape%nrele
+          ELSE
+             CYCLE                    ! Particle array ar not transferd here
           ENDIF
           buf_shape(1) = nr
-          CALL C_F_POINTER( ar%recvbuf, buf, buf_shape )
+          IF ( lo_ptrans )   THEN
+             CALL C_F_POINTER( ar%recvbuf, ibuf, buf_shape )
+          ELSE
+             CALL C_F_POINTER( ar%recvbuf, buf, buf_shape )
+          ENDIF
 !
 !--       MPI passive target RMA
-!--       TODO: explain the above comment
+!--       One data array is fetcht from MPI RMA window on parent
+
           IF ( nr > 0 )  THEN
              target_disp = ar%recvindex - 1
-             CALL MPI_WIN_LOCK( MPI_LOCK_SHARED , ip-1, 0,                      &
+             CALL MPI_WIN_LOCK( MPI_LOCK_SHARED , ip-1, 0,                     &
                                 me%win_parent_child, ierr )
-             CALL MPI_GET( buf, nr, MPI_REAL, ip-1, target_disp, nr, MPI_REAL,  &
-                                me%win_parent_child, ierr )
+             IF ( lo_ptrans )   THEN
+                CALL MPI_GET( ibuf, nr*8, MPI_BYTE, ip-1, target_disp, nr*8, MPI_BYTE,  &               !There is no MPI_INTEGER8 datatype
+                                   me%win_parent_child, ierr )
+             ELSE
+                CALL MPI_GET( buf, nr, MPI_REAL, ip-1, target_disp, nr,        &
+                              MPI_REAL, me%win_parent_child, ierr )
+             ENDIF
              CALL MPI_WIN_UNLOCK( ip-1, me%win_parent_child, ierr )
           ENDIF
           myindex = 1
-          IF ( ar%nrdims == 2 )  THEN
+          IF ( ar%dimkey == 2 .AND. .NOT.lo_ptrans)  THEN
+
              CALL C_F_POINTER( ar%data, data_2d, ar%a_dim(1:2) )
              DO  ij = 1, ape%nrele
@@ -746,11 +828,22 @@
                 myindex = myindex + 1
              ENDDO
-          ELSEIF ( ar%nrdims == 3 )  THEN
+
+          ELSEIF ( ar%dimkey == 3 .AND. .NOT.lo_ptrans)  THEN
+
              CALL C_F_POINTER( ar%data, data_3d, ar%a_dim(1:3) )
              DO  ij = 1, ape%nrele
-                data_3d(:,ape%locind(ij)%j,ape%locind(ij)%i) =                  &
+                data_3d(:,ape%locind(ij)%j,ape%locind(ij)%i) =                 &
                                               buf(myindex:myindex+ar%a_dim(1)-1)
                 myindex = myindex+ar%a_dim(1)
              ENDDO
+
+          ELSEIF ( ar%dimkey == 22 .AND. lo_ptrans)  THEN
+             CALL C_F_POINTER( ar%data, idata_2d, ar%a_dim(1:2) )
+
+             DO  ij = 1, ape%nrele
+                idata_2d(ape%locind(ij)%j,ape%locind(ij)%i) = ibuf(myindex)
+                myindex = myindex + 1
+             ENDDO
+
           ENDIF
        ENDDO
@@ -761,40 +854,51 @@
 
 
- SUBROUTINE pmc_c_putbuffer( waittime )
+ SUBROUTINE pmc_c_putbuffer( waittime , particle_transfer )
 
     IMPLICIT NONE
 
     REAL(wp), INTENT(OUT), OPTIONAL ::  waittime  !<
+    LOGICAL, INTENT(IN), OPTIONAL   ::  particle_transfer  !<
 
     CHARACTER(LEN=da_namelen) ::  myname  !<
-
-    INTEGER                        ::  ierr         !<
-    INTEGER                        ::  ij           !<
-    INTEGER                        ::  ip           !<
-    INTEGER                        ::  j            !<
-    INTEGER                        ::  myindex      !<
-    INTEGER                        ::  nr           !< number of elements to get
-                                                    !< from parent
+    
+    LOGICAL ::  lo_ptrans!<
+    
+    INTEGER(iwp) ::  ierr         !<
+    INTEGER(iwp) ::  ij           !<
+    INTEGER(iwp) ::  ip           !<
+    INTEGER(iwp) ::  j            !<
+    INTEGER(iwp) ::  myindex      !<
+    INTEGER(iwp) ::  nr           !< number of elements to get from parent
+    
     INTEGER(KIND=MPI_ADDRESS_KIND) ::  target_disp  !<
-
-    INTEGER, DIMENSION(1)          ::  buf_shape    !<
+    
+
+    INTEGER(iwp), DIMENSION(1) ::  buf_shape    !<
 
     REAL(wp) ::  t1  !<
     REAL(wp) ::  t2  !<
 
-    REAL(wp), POINTER, DIMENSION(:)     ::  buf      !<
-    REAL(wp), POINTER, DIMENSION(:,:)   ::  data_2d  !<
-    REAL(wp), POINTER, DIMENSION(:,:,:) ::  data_3d  !<
-
-    TYPE(pedef), POINTER               ::  ape  !<
-    TYPE(arraydef), POINTER            ::  ar   !<
+    REAL(wp), POINTER, DIMENSION(:)         ::  buf      !<
+    REAL(wp), POINTER, DIMENSION(:,:)       ::  data_2d  !<
+    REAL(wp), POINTER, DIMENSION(:,:,:)     ::  data_3d  !<
+    
+    INTEGER(idp), POINTER, DIMENSION(:)     ::  ibuf      !<
+    INTEGER(idp), POINTER, DIMENSION(:,:)   ::  idata_2d  !<
+
+    TYPE(pedef), POINTER                    ::  ape  !<
+    TYPE(arraydef), POINTER                 ::  ar   !<
 
 !
 !-- Wait for empty buffer
-!-- TODO: explain what is done here
+!-- Switch RMA epoche
+
     t1 = pmc_time()
     CALL MPI_BARRIER( me%intra_comm, ierr )
     t2 = pmc_time()
     IF ( PRESENT( waittime ) )  waittime = t2 - t1
+
+    lo_ptrans = .FALSE.
+    IF ( PRESENT( particle_transfer))    lo_ptrans = particle_transfer
 
     DO  ip = 1, me%inter_npes
@@ -803,5 +907,7 @@
           ar => aPE%array_list(j)
           myindex = 1
-          IF ( ar%nrdims == 2 )  THEN
+
+          IF ( ar%dimkey == 2 .AND. .NOT.lo_ptrans )  THEN
+
              buf_shape(1) = ape%nrele
              CALL C_F_POINTER( ar%sendbuf, buf,     buf_shape     )
@@ -811,5 +917,7 @@
                 myindex = myindex + 1
              ENDDO
-          ELSEIF ( ar%nrdims == 3 )  THEN
+
+          ELSEIF ( ar%dimkey == 3 .AND. .NOT.lo_ptrans )  THEN
+
              buf_shape(1) = ape%nrele*ar%a_dim(1)
              CALL C_F_POINTER( ar%sendbuf, buf,     buf_shape     )
@@ -820,13 +928,23 @@
                 myindex = myindex + ar%a_dim(1)
              ENDDO
+
+          ELSE IF ( ar%dimkey == 22 .AND. lo_ptrans)  THEN
+
+             buf_shape(1) = ape%nrele
+             CALL C_F_POINTER( ar%sendbuf, ibuf,     buf_shape     )
+             CALL C_F_POINTER( ar%data,    idata_2d, ar%a_dim(1:2) )
+
+             DO  ij = 1, ape%nrele
+                ibuf(myindex) = idata_2d(ape%locind(ij)%j,ape%locind(ij)%i)
+                myindex = myindex + 1
+             ENDDO
+
           ENDIF
        ENDDO
     ENDDO
 !
-!-- TODO: Fence might do it, test later
-!-- Call MPI_WIN_FENCE( 0, me%win_parent_child, ierr)      !
-!
 !-- Buffer is filled
-!-- TODO: explain in more detail what is happening here
+!-- Switch RMA epoche
+
     CALL MPI_Barrier(me%intra_comm, ierr)
 
Index: palm/trunk/SOURCE/pmc_general_mod.f90
===================================================================
--- palm/trunk/SOURCE/pmc_general_mod.f90	(revision 2798)
+++ palm/trunk/SOURCE/pmc_general_mod.f90	(revision 2801)
@@ -26,4 +26,7 @@
 ! -----------------
 ! $Id$
+! Introduce particle transfer in nested models.
+! 
+! 2718 2018-01-02 08:49:38Z maronga
 ! Corrected "Former revisions" section
 ! 
@@ -88,22 +91,23 @@
     SAVE
 
-    INTEGER, PARAMETER, PUBLIC :: da_desclen       =  8  !<
-    INTEGER, PARAMETER, PUBLIC :: da_namelen       = 16  !<
-    INTEGER, PARAMETER, PUBLIC :: pmc_da_name_err  = 10  !<
-    INTEGER, PARAMETER, PUBLIC :: pmc_max_array    = 32  !< max # of arrays which can be coupled
-    INTEGER, PARAMETER, PUBLIC :: pmc_max_models   = 64  !<
-    INTEGER, PARAMETER, PUBLIC :: pmc_status_ok    =  0  !<
-    INTEGER, PARAMETER, PUBLIC :: pmc_status_error = -1  !<
+    INTEGER(iwp), PARAMETER, PUBLIC :: da_desclen       =  8  !<
+    INTEGER(iwp), PARAMETER, PUBLIC :: da_namelen       = 16  !<
+    INTEGER(iwp), PARAMETER, PUBLIC :: pmc_da_name_err  = 10  !<
+    INTEGER(iwp), PARAMETER, PUBLIC :: pmc_max_array    = 32  !< max # of arrays which can be coupled
+    INTEGER(iwp), PARAMETER, PUBLIC :: pmc_max_models   = 64  !<
+    INTEGER(iwp), PARAMETER, PUBLIC :: pmc_status_ok    =  0  !<
+    INTEGER(iwp), PARAMETER, PUBLIC :: pmc_status_error = -1  !<
 
 
     TYPE, PUBLIC :: xy_ind  !< pair of indices in horizontal plane
-       INTEGER ::  i
-       INTEGER ::  j
+       INTEGER(iwp) ::  i
+       INTEGER(iwp) ::  j
     END TYPE
 
     TYPE, PUBLIC ::  arraydef
-       INTEGER                   :: coupleindex  !<
-       INTEGER                   :: nrdims       !< number of dimensions
-       INTEGER, DIMENSION(4)     :: a_dim        !< size of dimensions
+       INTEGER(iwp)                   :: coupleindex  !<
+       INTEGER(iwp)                   :: nrdims       !< number of dimensions
+       INTEGER(iwp)                   :: dimkey       !< key for NR dimensions and array type
+       INTEGER(iwp), DIMENSION(4)     :: a_dim        !< size of dimensions
        TYPE(C_PTR)               :: data         !< pointer of data in parent space
        TYPE(C_PTR), DIMENSION(2) :: po_data      !< base pointers,
@@ -112,6 +116,6 @@
        INTEGER(idp)              :: SendIndex    !< index in send buffer
        INTEGER(idp)              :: RecvIndex    !< index in receive buffer
-       INTEGER                   :: SendSize     !< size in send buffer
-       INTEGER                   :: RecvSize     !< size in receive buffer
+       INTEGER(iwp)              :: SendSize     !< size in send buffer
+       INTEGER(iwp)              :: RecvSize     !< size in receive buffer
        TYPE(C_PTR)               :: SendBuf      !< data pointer in send buffer
        TYPE(C_PTR)               :: RecvBuf      !< data pointer in receive buffer
@@ -123,6 +127,6 @@
 
     TYPE, PUBLIC ::  pedef
-       INTEGER :: nr_arrays = 0  !< number of arrays which will be transfered
-       INTEGER :: nrele          !< number of elements, same for all arrays
+       INTEGER(iwp) :: nr_arrays = 0  !< number of arrays which will be transfered
+       INTEGER(iwp) :: nrele          !< number of elements, same for all arrays
        TYPE(xy_ind), POINTER, DIMENSION(:)   ::  locInd      !< xy index local array for remote PE
        TYPE(arraydef), POINTER, DIMENSION(:) ::  array_list  !< list of data arrays to be transfered
@@ -131,17 +135,17 @@
     TYPE, PUBLIC ::  childdef
        INTEGER(idp) ::  totalbuffersize    !<
-       INTEGER      ::  model_comm         !< communicator of this model
-       INTEGER      ::  inter_comm         !< inter communicator model and child
-       INTEGER      ::  intra_comm         !< intra communicator model and child
-       INTEGER      ::  model_rank         !< rank of this model
-       INTEGER      ::  model_npes         !< number of PEs this model
-       INTEGER      ::  inter_npes         !< number of PEs child model
-       INTEGER      ::  intra_rank         !< rank within intra_comm
-       INTEGER      ::  win_parent_child   !< MPI RMA for preparing data on parent AND child side
+       INTEGER(iwp) ::  model_comm         !< communicator of this model
+       INTEGER(iwp) ::  inter_comm         !< inter communicator model and child
+       INTEGER(iwp) ::  intra_comm         !< intra communicator model and child
+       INTEGER(iwp) ::  model_rank         !< rank of this model
+       INTEGER(iwp) ::  model_npes         !< number of PEs this model
+       INTEGER(iwp) ::  inter_npes         !< number of PEs child model
+       INTEGER(iwp) ::  intra_rank         !< rank within intra_comm
+       INTEGER(iwp) ::  win_parent_child   !< MPI RMA for preparing data on parent AND child side
        TYPE(pedef), DIMENSION(:), POINTER ::  pes  !< list of all child PEs
     END TYPE childdef
 
     TYPE, PUBLIC ::  da_namedef  !< data array name definition
-       INTEGER                   ::  couple_index  !< unique number of array
+       INTEGER(iwp)              ::  couple_index  !< unique number of array
        CHARACTER(LEN=da_desclen) ::  parentdesc    !< parent array description
        CHARACTER(LEN=da_namelen) ::  nameonparent  !< name of array within parent
@@ -168,9 +172,9 @@
     IMPLICIT NONE
 
-    CHARACTER(LEN=*)               ::  aname         !<
-    INTEGER, INTENT(IN)            ::  couple_index  !<
-    TYPE(childdef), INTENT(INOUT)  ::  mychild       !<
-
-    INTEGER ::  i  !<
+    CHARACTER(LEN=*)              ::  aname         !<
+    INTEGER(iwp), INTENT(IN)      ::  couple_index  !<
+    TYPE(childdef), INTENT(INOUT) ::  mychild       !<
+
+    INTEGER(iwp) ::  i  !<
 
     TYPE(arraydef), POINTER ::  ar   !<
@@ -195,12 +199,12 @@
     IMPLICIT NONE
 
-    INTEGER, INTENT(IN)                    ::  sort_ind
-    INTEGER, DIMENSION(:,:), INTENT(INOUT) ::  array
-
-    INTEGER ::  i  !<
-    INTEGER ::  j  !<
-    INTEGER ::  n  !<
-
-    INTEGER, DIMENSION(SIZE(array,1)) ::  tmp  !<
+    INTEGER(iwp), INTENT(IN)                    ::  sort_ind
+    INTEGER(iwp), DIMENSION(:,:), INTENT(INOUT) ::  array
+
+    INTEGER(iwp) ::  i  !<
+    INTEGER(iwp) ::  j  !<
+    INTEGER(iwp) ::  n  !<
+
+    INTEGER(iwp), DIMENSION(SIZE(array,1)) ::  tmp  !<
 
     n = SIZE(array,2)
Index: palm/trunk/SOURCE/pmc_handle_communicator_mod.f90
===================================================================
--- palm/trunk/SOURCE/pmc_handle_communicator_mod.f90	(revision 2798)
+++ palm/trunk/SOURCE/pmc_handle_communicator_mod.f90	(revision 2801)
@@ -25,4 +25,7 @@
 ! -----------------
 ! $Id$
+! Introduce particle transfer in nested models.
+! 
+! 2718 2018-01-02 08:49:38Z maronga
 ! Corrected "Former revisions" section
 ! 
@@ -142,9 +145,9 @@
 
     INTEGER ::  m_world_comm  !< global nesting communicator
-    INTEGER ::  m_my_cpl_id   !< coupler id of this modelfortran return
+    INTEGER ::  m_my_cpl_id   !< coupler id of this model
     INTEGER ::  m_parent_id   !< coupler id of parent of this model
     INTEGER ::  m_ncpl        !< number of couplers given in nestpar namelist
 
-    TYPE(pmc_layout), DIMENSION(pmc_max_models) ::  m_couplers  !< information of all couplers
+    TYPE(pmc_layout), PUBLIC, DIMENSION(pmc_max_models) ::  m_couplers  !< information of all couplers
 
     INTEGER, PUBLIC ::  m_model_comm          !< communicator of this model
@@ -221,5 +224,5 @@
        THEN
 !
-!--       Determine the first process id of each model
+!--       Calculate start PE of every model
           start_pe(1) = 0
           DO  i = 2, m_ncpl+1
Index: palm/trunk/SOURCE/pmc_interface_mod.f90
===================================================================
--- palm/trunk/SOURCE/pmc_interface_mod.f90	(revision 2798)
+++ palm/trunk/SOURCE/pmc_interface_mod.f90	(revision 2801)
@@ -25,4 +25,7 @@
 ! -----------------
 ! $Id$
+! Introduce particle transfer in nested models.
+! 
+! 2795 2018-02-07 14:48:48Z hellstea
 ! Bugfix in computation of the anterpolation under-relaxation functions. 
 ! 
@@ -214,6 +217,9 @@
 !       routine
 ! @todo Data transfer of qc and nc is prepared but not activated
-!-------------------------------------------------------------------------------!
+!------------------------------------------------------------------------------!
  MODULE pmc_interface
+
+    USE ISO_C_BINDING
+
 
 #if defined( __nopointer )
@@ -228,10 +234,10 @@
 #endif
 
-    USE control_parameters,                                                     &
-        ONLY:  air_chemistry, cloud_physics, coupling_char, dt_3d, dz, humidity,&
-               message_string, microphysics_morrison, microphysics_seifert,     &
-               nest_bound_l, nest_bound_r, nest_bound_s, nest_bound_n,          &
-               nest_domain, neutral, passive_scalar, roughness_length,          &
-               simulated_time, topography, volume_flow
+    USE control_parameters,                                                    &
+        ONLY:  air_chemistry, cloud_physics, coupling_char, dt_3d, dz,         &
+               humidity, message_string, microphysics_morrison,                &
+               microphysics_seifert, nest_bound_l, nest_bound_r, nest_bound_s, &
+               nest_bound_n, nest_domain, neutral, passive_scalar,             & 
+               roughness_length, simulated_time, topography, volume_flow
 
     USE chem_modules,                                                          &
@@ -250,4 +256,7 @@
         ONLY:  nbgp, nx, nxl, nxlg, nxlu, nxr, nxrg, ny, nyn, nyng, nys, nysg, &
                nysv, nz, nzb, nzt, wall_flags_0
+
+    USE particle_attributes,                                                   &
+        ONLY:  particle_advection
 
     USE kinds
@@ -275,5 +284,5 @@
     USE pmc_handle_communicator,                                               &
         ONLY:  pmc_get_model_info, pmc_init_model, pmc_is_rootmodel,           &
-               pmc_no_namelist_found, pmc_parent_for_child
+               pmc_no_namelist_found, pmc_parent_for_child, m_couplers
 
     USE pmc_mpi_wrapper,                                                       &
@@ -297,60 +306,64 @@
 !
 !-- Constants
-    INTEGER(iwp), PARAMETER ::  child_to_parent = 2   !:
-    INTEGER(iwp), PARAMETER ::  parent_to_child = 1   !:
+    INTEGER(iwp), PARAMETER ::  child_to_parent = 2   !<
+    INTEGER(iwp), PARAMETER ::  parent_to_child = 1   !<
 !
 !-- Coupler setup
-    INTEGER(iwp), SAVE      ::  comm_world_nesting     !:
-    INTEGER(iwp), SAVE      ::  cpl_id  = 1            !:
-    CHARACTER(LEN=32), SAVE ::  cpl_name               !:
-    INTEGER(iwp), SAVE      ::  cpl_npe_total          !:
-    INTEGER(iwp), SAVE      ::  cpl_parent_id          !:
+    INTEGER(iwp), SAVE      ::  comm_world_nesting    !<
+    INTEGER(iwp), SAVE      ::  cpl_id  = 1           !<
+    CHARACTER(LEN=32), SAVE ::  cpl_name              !<
+    INTEGER(iwp), SAVE      ::  cpl_npe_total         !<
+    INTEGER(iwp), SAVE      ::  cpl_parent_id         !<
 !
 !-- Control parameters, will be made input parameters later
-    CHARACTER(LEN=7), SAVE ::  nesting_datatransfer_mode = 'mixed'  !: steering
-                                                         !: parameter for data-
-                                                         !: transfer mode
-    CHARACTER(LEN=8), SAVE ::  nesting_mode = 'two-way'  !: steering parameter
-                                                         !: for 1- or 2-way nesting
-
-    LOGICAL, SAVE ::  nested_run = .FALSE.  !: general switch
-
-    REAL(wp), SAVE ::  anterp_relax_length_l = -1.0_wp   !:
-    REAL(wp), SAVE ::  anterp_relax_length_r = -1.0_wp   !:
-    REAL(wp), SAVE ::  anterp_relax_length_s = -1.0_wp   !:
-    REAL(wp), SAVE ::  anterp_relax_length_n = -1.0_wp   !:
-    REAL(wp), SAVE ::  anterp_relax_length_t = -1.0_wp   !:
+    CHARACTER(LEN=7), SAVE ::  nesting_datatransfer_mode = 'mixed'  !< steering
+                                                         !< parameter for data-
+                                                         !< transfer mode
+    CHARACTER(LEN=8), SAVE ::  nesting_mode = 'two-way'  !< steering parameter
+                                                         !< for 1- or 2-way nesting
+
+    LOGICAL, SAVE ::  nested_run = .FALSE.  !< general switch
+
+    REAL(wp), SAVE ::  anterp_relax_length_l = -1.0_wp   !<
+    REAL(wp), SAVE ::  anterp_relax_length_r = -1.0_wp   !<
+    REAL(wp), SAVE ::  anterp_relax_length_s = -1.0_wp   !<
+    REAL(wp), SAVE ::  anterp_relax_length_n = -1.0_wp   !<
+    REAL(wp), SAVE ::  anterp_relax_length_t = -1.0_wp   !<
 !
 !-- Geometry
-    REAL(wp), SAVE                            ::  area_t               !:
-    REAL(wp), SAVE, DIMENSION(:), ALLOCATABLE ::  coord_x              !:
-    REAL(wp), SAVE, DIMENSION(:), ALLOCATABLE ::  coord_y              !:
-    REAL(wp), SAVE                            ::  lower_left_coord_x   !:
-    REAL(wp), SAVE                            ::  lower_left_coord_y   !:
+    REAL(wp), SAVE                                    ::  area_t             !<
+    REAL(wp), SAVE, DIMENSION(:), ALLOCATABLE, PUBLIC ::  coord_x            !<
+    REAL(wp), SAVE, DIMENSION(:), ALLOCATABLE, PUBLIC ::  coord_y            !<
+    REAL(wp), SAVE, PUBLIC                            ::  lower_left_coord_x !<
+    REAL(wp), SAVE, PUBLIC                            ::  lower_left_coord_y !<
+
 !
 !-- Child coarse data arrays
-    INTEGER(iwp), DIMENSION(5)                  ::  coarse_bound   !:
-
-    REAL(wp), SAVE                              ::  xexl           !:
-    REAL(wp), SAVE                              ::  xexr           !:
-    REAL(wp), SAVE                              ::  yexs           !:
-    REAL(wp), SAVE                              ::  yexn           !:
-    REAL(wp), SAVE, DIMENSION(:,:), ALLOCATABLE ::  tkefactor_l    !:
-    REAL(wp), SAVE, DIMENSION(:,:), ALLOCATABLE ::  tkefactor_n    !:
-    REAL(wp), SAVE, DIMENSION(:,:), ALLOCATABLE ::  tkefactor_r    !:
-    REAL(wp), SAVE, DIMENSION(:,:), ALLOCATABLE ::  tkefactor_s    !:
-    REAL(wp), SAVE, DIMENSION(:,:), ALLOCATABLE ::  tkefactor_t    !:
-
-    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ec   !:
-    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ptc  !:
-    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  uc   !:
-    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  vc   !:
-    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  wc   !:
-    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  q_c  !:
-    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  qcc  !:
-    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  qrc  !:
-    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  nrc  !:
-    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ncc  !:
-    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  sc   !:
+    INTEGER(iwp), DIMENSION(5),PUBLIC           ::  coarse_bound   !<
+
+    REAL(wp), SAVE                              ::  xexl           !<
+    REAL(wp), SAVE                              ::  xexr           !<
+    REAL(wp), SAVE                              ::  yexs           !<
+    REAL(wp), SAVE                              ::  yexn           !<
+    REAL(wp), SAVE, DIMENSION(:,:), ALLOCATABLE ::  tkefactor_l    !<
+    REAL(wp), SAVE, DIMENSION(:,:), ALLOCATABLE ::  tkefactor_n    !<
+    REAL(wp), SAVE, DIMENSION(:,:), ALLOCATABLE ::  tkefactor_r    !<
+    REAL(wp), SAVE, DIMENSION(:,:), ALLOCATABLE ::  tkefactor_s    !<
+    REAL(wp), SAVE, DIMENSION(:,:), ALLOCATABLE ::  tkefactor_t    !<
+
+    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ec   !<
+    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ptc  !<
+    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  uc   !<
+    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  vc   !<
+    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  wc   !<
+    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  q_c  !<
+    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  qcc  !<
+    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  qrc  !<
+    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  nrc  !<
+    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ncc  !<
+    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  sc   !<
+    INTEGER(idp), SAVE, DIMENSION(:,:), ALLOCATABLE, TARGET, PUBLIC ::  nr_partc    !<
+    INTEGER(idp), SAVE, DIMENSION(:,:), ALLOCATABLE, TARGET, PUBLIC ::  part_adrc   !<
+
 
     REAL(wp), SAVE, DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  chem_spec_c   !< child coarse data array for chemical species 
@@ -359,122 +372,144 @@
 !-- Child interpolation coefficients and child-array indices to be 
 !-- precomputed and stored.
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  ico    !:
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  icu    !:
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  jco    !:
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  jcv    !:
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  kco    !:
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  kcw    !:
-    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r1xo   !:
-    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r2xo   !:
-    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r1xu   !:
-    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r2xu   !:
-    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r1yo   !:
-    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r2yo   !:
-    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r1yv   !:
-    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r2yv   !:
-    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r1zo   !:
-    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r2zo   !:
-    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r1zw   !:
-    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r2zw   !:
+    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  ico    !<
+    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  icu    !<
+    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  jco    !<
+    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  jcv    !<
+    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  kco    !<
+    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  kcw    !<
+    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r1xo   !<
+    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r2xo   !<
+    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r1xu   !<
+    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r2xu   !<
+    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r1yo   !<
+    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r2yo   !<
+    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r1yv   !<
+    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r2yv   !<
+    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r1zo   !<
+    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r2zo   !<
+    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r1zw   !<
+    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r2zw   !<
 !
 !-- Child index arrays and log-ratio arrays for the log-law near-wall
 !-- corrections. These are not truly 3-D arrays but multiple 2-D arrays.
-    INTEGER(iwp), SAVE :: ncorr  !: 4th dimension of the log_ratio-arrays
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_u_l   !:
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_u_n   !:
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_u_r   !:
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_u_s   !:
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_v_l   !:
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_v_n   !:
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_v_r   !:
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_v_s   !:
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_w_l   !:
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_w_n   !:
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_w_r   !:
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_w_s   !:
-    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_u_l   !:
-    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_u_n   !:
-    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_u_r   !:
-    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_u_s   !:
-    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_v_l   !:
-    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_v_n   !:
-    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_v_r   !:
-    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_v_s   !:
-    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_w_l   !:
-    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_w_n   !:
-    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_w_r   !:
-    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_w_s   !:
+    INTEGER(iwp), SAVE :: ncorr  !< 4th dimension of the log_ratio-arrays
+    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_u_l   !<
+    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_u_n   !<
+    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_u_r   !<
+    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_u_s   !<
+    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_v_l   !<
+    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_v_n   !<
+    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_v_r   !<
+    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_v_s   !<
+    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_w_l   !<
+    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_w_n   !<
+    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_w_r   !<
+    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_w_s   !<
+    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_u_l   !<
+    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_u_n   !<
+    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_u_r   !<
+    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_u_s   !<
+    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_v_l   !<
+    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_v_n   !<
+    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_v_r   !<
+    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_v_s   !<
+    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_w_l   !<
+    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_w_n   !<
+    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_w_r   !<
+    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_w_s   !<
 !
 !-- Upper bounds for k in anterpolation.
-    INTEGER(iwp), SAVE ::  kctu   !:
-    INTEGER(iwp), SAVE ::  kctw   !:
+    INTEGER(iwp), SAVE ::  kctu   !<
+    INTEGER(iwp), SAVE ::  kctw   !<
 !
 !-- Upper bound for k in log-law correction in interpolation.
-    INTEGER(iwp), SAVE ::  nzt_topo_nestbc_l   !:
-    INTEGER(iwp), SAVE ::  nzt_topo_nestbc_n   !:
-    INTEGER(iwp), SAVE ::  nzt_topo_nestbc_r   !:
-    INTEGER(iwp), SAVE ::  nzt_topo_nestbc_s   !:
+    INTEGER(iwp), SAVE ::  nzt_topo_nestbc_l   !<
+    INTEGER(iwp), SAVE ::  nzt_topo_nestbc_n   !<
+    INTEGER(iwp), SAVE ::  nzt_topo_nestbc_r   !<
+    INTEGER(iwp), SAVE ::  nzt_topo_nestbc_s   !<
 !
 !-- Number of ghost nodes in coarse-grid arrays for i and j in anterpolation.
-    INTEGER(iwp), SAVE ::  nhll   !:
-    INTEGER(iwp), SAVE ::  nhlr   !:
-    INTEGER(iwp), SAVE ::  nhls   !:
-    INTEGER(iwp), SAVE ::  nhln   !:
+    INTEGER(iwp), SAVE ::  nhll   !<
+    INTEGER(iwp), SAVE ::  nhlr   !<
+    INTEGER(iwp), SAVE ::  nhls   !<
+    INTEGER(iwp), SAVE ::  nhln   !<
 !
 !-- Spatial under-relaxation coefficients for anterpolation.
-    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) ::  frax   !:
-    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) ::  fray   !:
-    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) ::  fraz   !:
+    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) ::  frax   !<
+    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) ::  fray   !<
+    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) ::  fraz   !<
 !
 !-- Child-array indices to be precomputed and stored for anterpolation.
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  iflu   !:
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  ifuu   !:
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  iflo   !:
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  ifuo   !:
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  jflv   !:
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  jfuv   !:
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  jflo   !:
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  jfuo   !:
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  kflw   !:
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  kfuw   !:
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  kflo   !:
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  kfuo   !:
+    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  iflu   !<
+    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  ifuu   !<
+    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  iflo   !<
+    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  ifuo   !<
+    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  jflv   !<
+    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  jfuv   !<
+    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  jflo   !<
+    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  jfuo   !<
+    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  kflw   !<
+    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  kfuw   !<
+    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  kflo   !<
+    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  kfuo   !<
 !
 !-- Number of fine-grid nodes inside coarse-grid ij-faces
 !-- to be precomputed for anterpolation.
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:) ::  ijfc_u        !:
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:) ::  ijfc_v        !:
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:) ::  ijfc_s        !:
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:)   ::  kfc_w         !:
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:)   ::  kfc_s         !:
+    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:) ::  ijfc_u        !<
+    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:) ::  ijfc_v        !<
+    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:) ::  ijfc_s        !<
+    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:)   ::  kfc_w         !<
+    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:)   ::  kfc_s         !<
     
-    INTEGER(iwp), DIMENSION(3)          ::  parent_grid_info_int    !:
-    REAL(wp), DIMENSION(7)              ::  parent_grid_info_real   !:
+    INTEGER(iwp), DIMENSION(3)          ::  parent_grid_info_int    !<
+    REAL(wp), DIMENSION(7)              ::  parent_grid_info_real   !<
+    REAL(wp), DIMENSION(2)              ::  zmax_coarse             !<
 
     TYPE coarsegrid_def
-       INTEGER(iwp)                        ::  nx
-       INTEGER(iwp)                        ::  ny
-       INTEGER(iwp)                        ::  nz
-       REAL(wp)                            ::  dx
-       REAL(wp)                            ::  dy
-       REAL(wp)                            ::  dz
-       REAL(wp)                            ::  lower_left_coord_x
-       REAL(wp)                            ::  lower_left_coord_y
-       REAL(wp)                            ::  xend
-       REAL(wp)                            ::  yend
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  coord_x
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  coord_y
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  dzu       
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  dzw       
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  zu        
-       REAL(wp), DIMENSION(:), ALLOCATABLE ::  zw        
+       INTEGER(iwp)                        ::  nx                 !<
+       INTEGER(iwp)                        ::  ny                 !<
+       INTEGER(iwp)                        ::  nz                 !<
+       REAL(wp)                            ::  dx                 !<
+       REAL(wp)                            ::  dy                 !<
+       REAL(wp)                            ::  dz                 !<
+       REAL(wp)                            ::  lower_left_coord_x !<
+       REAL(wp)                            ::  lower_left_coord_y !<
+       REAL(wp)                            ::  xend               !<
+       REAL(wp)                            ::  yend               !<
+       REAL(wp), DIMENSION(:), ALLOCATABLE ::  coord_x            !<
+       REAL(wp), DIMENSION(:), ALLOCATABLE ::  coord_y            !<
+       REAL(wp), DIMENSION(:), ALLOCATABLE ::  dzu                !<
+       REAL(wp), DIMENSION(:), ALLOCATABLE ::  dzw                !<
+       REAL(wp), DIMENSION(:), ALLOCATABLE ::  zu                 !<
+       REAL(wp), DIMENSION(:), ALLOCATABLE ::  zw                 !<
     END TYPE coarsegrid_def
-                                          
-    TYPE(coarsegrid_def), SAVE ::  cg   !:
-
+
+    TYPE(coarsegrid_def), SAVE, PUBLIC     ::  cg   !<
+
+!-  Variables for particle coupling
+
+    TYPE, PUBLIC :: childgrid_def
+       INTEGER(iwp)                        ::  nx                   !<
+       INTEGER(iwp)                        ::  ny                   !<
+       INTEGER(iwp)                        ::  nz                   !<
+       REAL(wp)                            ::  dx                   !<
+       REAL(wp)                            ::  dy                   !<
+       REAL(wp)                            ::  dz                   !<
+       REAL(wp)                            ::  lx_coord, lx_coord_b !<
+       REAL(wp)                            ::  rx_coord, rx_coord_b !<
+       REAL(wp)                            ::  sy_coord, sy_coord_b !<
+       REAL(wp)                            ::  ny_coord, ny_coord_b !<
+       REAL(wp)                            ::  uz_coord, uz_coord_b !<
+    END TYPE childgrid_def
+
+    TYPE(childgrid_def), SAVE, ALLOCATABLE, DIMENSION(:), PUBLIC :: childgrid !<
+
+    INTEGER(idp),ALLOCATABLE,DIMENSION(:,:),PUBLIC,TARGET    :: nr_part  !<
+    INTEGER(idp),ALLOCATABLE,DIMENSION(:,:),PUBLIC,TARGET    :: part_adr !<
+    
     INTERFACE pmci_boundary_conds
        MODULE PROCEDURE pmci_boundary_conds
     END INTERFACE pmci_boundary_conds
-
+    
     INTERFACE pmci_check_setting_mismatches
        MODULE PROCEDURE pmci_check_setting_mismatches
@@ -509,12 +544,29 @@
     END INTERFACE
 
+    INTERFACE get_number_of_childs
+       MODULE PROCEDURE get_number_of_childs
+    END  INTERFACE get_number_of_childs
+
+    INTERFACE get_childid
+       MODULE PROCEDURE get_childid
+    END  INTERFACE get_childid
+
+    INTERFACE get_child_edges
+       MODULE PROCEDURE get_child_edges
+    END  INTERFACE get_child_edges
+
+    INTERFACE get_child_gridspacing
+       MODULE PROCEDURE get_child_gridspacing
+    END  INTERFACE get_child_gridspacing
+
+
     INTERFACE pmci_set_swaplevel
        MODULE PROCEDURE pmci_set_swaplevel
     END INTERFACE pmci_set_swaplevel
 
-    PUBLIC anterp_relax_length_l, anterp_relax_length_r,                        &
-           anterp_relax_length_s, anterp_relax_length_n,                        &
-           anterp_relax_length_t, child_to_parent, comm_world_nesting,          &
-           cpl_id, nested_run, nesting_datatransfer_mode, nesting_mode,         &
+    PUBLIC anterp_relax_length_l, anterp_relax_length_r,                       &
+           anterp_relax_length_s, anterp_relax_length_n,                       &
+           anterp_relax_length_t, child_to_parent, comm_world_nesting,         &
+           cpl_id, nested_run, nesting_datatransfer_mode, nesting_mode,        &
            parent_to_child
 
@@ -528,4 +580,6 @@
     PUBLIC pmci_synchronize
     PUBLIC pmci_set_swaplevel
+    PUBLIC get_number_of_childs, get_childid, get_child_edges, get_child_gridspacing
+
 
 
@@ -535,19 +589,19 @@
  SUBROUTINE pmci_init( world_comm )
 
-    USE control_parameters,                                                     &
+    USE control_parameters,                                                    &
         ONLY:  message_string
 
     IMPLICIT NONE
 
-    INTEGER, INTENT(OUT) ::  world_comm   !:
+    INTEGER(iwp), INTENT(OUT) ::  world_comm   !<
 
 #if defined( __parallel )
 
-    INTEGER(iwp)         ::  ierr         !:
-    INTEGER(iwp)         ::  istat        !:
-    INTEGER(iwp)         ::  pmc_status   !:
-
-
-    CALL pmc_init_model( world_comm, nesting_datatransfer_mode, nesting_mode,   &
+    INTEGER(iwp)         ::  ierr         !<
+    INTEGER(iwp)         ::  istat        !<
+    INTEGER(iwp)         ::  pmc_status   !<
+
+
+    CALL pmc_init_model( world_comm, nesting_datatransfer_mode, nesting_mode,  &
                          pmc_status )
 
@@ -564,7 +618,7 @@
 !
 !-- Check steering parameter values
-    IF ( TRIM( nesting_mode ) /= 'one-way'  .AND.                               &
-         TRIM( nesting_mode ) /= 'two-way'  .AND.                               &
-         TRIM( nesting_mode ) /= 'vertical' )                                   &                 
+    IF ( TRIM( nesting_mode ) /= 'one-way'  .AND.                              &
+         TRIM( nesting_mode ) /= 'two-way'  .AND.                              &
+         TRIM( nesting_mode ) /= 'vertical' )                                  &                 
     THEN
        message_string = 'illegal nesting mode: ' // TRIM( nesting_mode )
@@ -572,9 +626,9 @@
     ENDIF
 
-    IF ( TRIM( nesting_datatransfer_mode ) /= 'cascade'  .AND.                  &
-         TRIM( nesting_datatransfer_mode ) /= 'mixed'    .AND.                  &
-         TRIM( nesting_datatransfer_mode ) /= 'overlap' )                       &
+    IF ( TRIM( nesting_datatransfer_mode ) /= 'cascade'  .AND.                 &
+         TRIM( nesting_datatransfer_mode ) /= 'mixed'    .AND.                 &
+         TRIM( nesting_datatransfer_mode ) /= 'overlap' )                      &
     THEN
-       message_string = 'illegal nesting datatransfer mode: '                   &
+       message_string = 'illegal nesting datatransfer mode: '                  &
                         // TRIM( nesting_datatransfer_mode )
        CALL message( 'pmci_init', 'PA0418', 3, 2, 0, 6, 0 )
@@ -586,8 +640,8 @@
 !-- Get some variables required by the pmc-interface (and in some cases in the
 !-- PALM code out of the pmci) out of the pmc-core
-    CALL pmc_get_model_info( comm_world_nesting = comm_world_nesting,           &
-                             cpl_id = cpl_id, cpl_parent_id = cpl_parent_id,    &
-                             cpl_name = cpl_name, npe_total = cpl_npe_total,    &
-                             lower_left_x = lower_left_coord_x,                 &
+    CALL pmc_get_model_info( comm_world_nesting = comm_world_nesting,          &
+                             cpl_id = cpl_id, cpl_parent_id = cpl_parent_id,   &
+                             cpl_name = cpl_name, npe_total = cpl_npe_total,   &
+                             lower_left_x = lower_left_coord_x,                &
                              lower_left_y = lower_left_coord_y )
 !
@@ -661,40 +715,42 @@
 
     CHARACTER(LEN=32) ::  myname
-
-    INTEGER(iwp) ::  child_id         !:
-    INTEGER(iwp) ::  ierr             !:
-    INTEGER(iwp) ::  i                !:
-    INTEGER(iwp) ::  j                !:
-    INTEGER(iwp) ::  k                !:
-    INTEGER(iwp) ::  m                !:
-    INTEGER(iwp) ::  mm               !:
+    
+    INTEGER(iwp) ::  child_id         !<
+    INTEGER(iwp) ::  ierr             !<
+    INTEGER(iwp) ::  i                !<
+    INTEGER(iwp) ::  j                !<
+    INTEGER(iwp) ::  k                !<
+    INTEGER(iwp) ::  m                !<
+    INTEGER(iwp) ::  mid              !<
+    INTEGER(iwp) ::  mm               !<
     INTEGER(iwp) ::  n = 1            !< running index for chemical species
-    INTEGER(iwp) ::  nest_overlap     !:
-    INTEGER(iwp) ::  nomatch          !:
-    INTEGER(iwp) ::  nx_cl            !:
-    INTEGER(iwp) ::  ny_cl            !:
-    INTEGER(iwp) ::  nz_cl            !:
-
-    INTEGER(iwp), DIMENSION(5) ::  val    !:
-
-
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  ch_xl   !:
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  ch_xr   !:    
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  ch_ys   !:
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  ch_yn   !:
-    REAL(wp) ::  cl_height        !: 
-    REAL(wp) ::  dx_cl            !:
-    REAL(wp) ::  dy_cl            !:
-    REAL(wp) ::  left_limit       !:
-    REAL(wp) ::  north_limit      !:
-    REAL(wp) ::  right_limit      !:
-    REAL(wp) ::  south_limit      !:
-    REAL(wp) ::  xez              !:
-    REAL(wp) ::  yez              !:
-
-    REAL(wp), DIMENSION(1) ::  fval             !:
-
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  cl_coord_x   !:
-    REAL(wp), DIMENSION(:), ALLOCATABLE ::  cl_coord_y   !:
+    INTEGER(iwp) ::  nest_overlap     !<
+    INTEGER(iwp) ::  nomatch          !<
+    INTEGER(iwp) ::  nx_cl            !<
+    INTEGER(iwp) ::  ny_cl            !<
+    INTEGER(iwp) ::  nz_cl            !<
+
+    INTEGER(iwp), DIMENSION(5) ::  val    !<
+
+
+    REAL(wp), DIMENSION(:), ALLOCATABLE ::  ch_xl   !<
+    REAL(wp), DIMENSION(:), ALLOCATABLE ::  ch_xr   !<    
+    REAL(wp), DIMENSION(:), ALLOCATABLE ::  ch_ys   !<
+    REAL(wp), DIMENSION(:), ALLOCATABLE ::  ch_yn   !<
+    REAL(wp) ::  cl_height        !< 
+    REAL(wp) ::  dx_cl            !<
+    REAL(wp) ::  dy_cl            !<
+    REAL(wp) ::  dz_cl            !<
+    REAL(wp) ::  left_limit       !<
+    REAL(wp) ::  north_limit      !<
+    REAL(wp) ::  right_limit      !<
+    REAL(wp) ::  south_limit      !<
+    REAL(wp) ::  xez              !<
+    REAL(wp) ::  yez              !<
+
+    REAL(wp), DIMENSION(5) ::  fval             !<
+
+    REAL(wp), DIMENSION(:), ALLOCATABLE ::  cl_coord_x   !<
+    REAL(wp), DIMENSION(:), ALLOCATABLE ::  cl_coord_y   !<
 
 !
@@ -709,4 +765,8 @@
        ALLOCATE( ch_yn(1:SIZE( pmc_parent_for_child ) - 1) )
     ENDIF
+    IF ( ( SIZE( pmc_parent_for_child ) - 1 > 0 ) )  THEN
+       ALLOCATE( childgrid(1:SIZE( pmc_parent_for_child ) - 1) )
+    ENDIF
+
 !
 !-- Get coordinates from all children
@@ -719,9 +779,11 @@
           CALL pmc_recv_from_child( child_id, fval, size(fval), 0, 124, ierr )
          
-          nx_cl = val(1)
-          ny_cl = val(2)
-          dx_cl = val(4)
-          dy_cl = val(5)
+          nx_cl     = val(1)
+          ny_cl     = val(2)
+          dx_cl     = fval(3)
+          dy_cl     = fval(4)
+          dz_cl     = fval(5)
           cl_height = fval(1)
+
           nz_cl = nz
 !
@@ -734,4 +796,8 @@
              ENDIF
           ENDDO
+
+          zmax_coarse = fval(1:2)
+          cl_height   = fval(1)
+
 !    
 !--       Get absolute coordinates from the child
@@ -739,7 +805,7 @@
           ALLOCATE( cl_coord_y(-nbgp:ny_cl+nbgp) )
          
-          CALL pmc_recv_from_child( child_id, cl_coord_x, SIZE( cl_coord_x ),   &
+          CALL pmc_recv_from_child( child_id, cl_coord_x, SIZE( cl_coord_x ),  &
                0, 11, ierr )
-          CALL pmc_recv_from_child( child_id, cl_coord_y, SIZE( cl_coord_y ),   &
+          CALL pmc_recv_from_child( child_id, cl_coord_y, SIZE( cl_coord_y ),  &
                0, 12, ierr )
          
@@ -761,5 +827,5 @@
              right_limit = parent_grid_info_real(5)
              north_limit = parent_grid_info_real(6)
-             IF ( ( cl_coord_x(nx_cl+1) /= right_limit ) .OR.                   &
+             IF ( ( cl_coord_x(nx_cl+1) /= right_limit ) .OR.                  &
                   ( cl_coord_y(ny_cl+1) /= north_limit ) )  THEN
                 nomatch = 1
@@ -774,7 +840,7 @@
              south_limit = lower_left_coord_y + yez
              north_limit = parent_grid_info_real(6) - yez
-             IF ( ( cl_coord_x(0) < left_limit )        .OR.                    &
-                  ( cl_coord_x(nx_cl+1) > right_limit ) .OR.                    &
-                  ( cl_coord_y(0) < south_limit )       .OR.                    &
+             IF ( ( cl_coord_x(0) < left_limit )        .OR.                   &
+                  ( cl_coord_x(nx_cl+1) > right_limit ) .OR.                   &
+                  ( cl_coord_y(0) < south_limit )       .OR.                   &
                   ( cl_coord_y(ny_cl+1) > north_limit ) )  THEN
                 nomatch = 1
@@ -785,4 +851,5 @@
 !--       that the top ghost layer of the child grid does not exceed 
 !--       the parent domain top boundary.
+
           IF ( cl_height > zw(nz) ) THEN
              nomatch = 1
@@ -798,10 +865,15 @@
 
              IF ( m > 1 )  THEN
-                DO mm = 1, m-1
-                   IF ( ( ch_xl(m) < ch_xr(mm) .OR.                             &
-                          ch_xr(m) > ch_xl(mm) )  .AND.                         &
-                        ( ch_ys(m) < ch_yn(mm) .OR.                             &
-                          ch_yn(m) > ch_ys(mm) ) )  THEN                        
-                      nest_overlap = 1
+                DO mm = 1, m - 1
+                   mid = pmc_parent_for_child(mm)
+!
+!--                Check Only different nest level
+                   IF (m_couplers(child_id)%parent_id /= m_couplers(mid)%parent_id)  THEN
+                      IF ( ( ch_xl(m) < ch_xr(mm) .OR.                         &
+                             ch_xr(m) > ch_xl(mm) )  .AND.                     &
+                           ( ch_ys(m) < ch_yn(mm) .OR.                         &
+                             ch_yn(m) > ch_ys(mm) ) )  THEN
+                         nest_overlap = 1
+                      ENDIF
                    ENDIF
                 ENDDO
@@ -809,18 +881,20 @@
           ENDIF
 
+          CALL set_child_edge_coords
+
           DEALLOCATE( cl_coord_x )
           DEALLOCATE( cl_coord_y )
 !
 !--       Send coarse grid information to child
-          CALL pmc_send_to_child( child_id, parent_grid_info_real,              &
-                                   SIZE( parent_grid_info_real ), 0, 21,        &
+          CALL pmc_send_to_child( child_id, parent_grid_info_real,             &
+                                   SIZE( parent_grid_info_real ), 0, 21,       &
                                    ierr )
-          CALL pmc_send_to_child( child_id, parent_grid_info_int,  3, 0,        &
+          CALL pmc_send_to_child( child_id, parent_grid_info_int,  3, 0,       &
                                    22, ierr )
 !
 !--       Send local grid to child
-          CALL pmc_send_to_child( child_id, coord_x, nx+1+2*nbgp, 0, 24,        &
+          CALL pmc_send_to_child( child_id, coord_x, nx+1+2*nbgp, 0, 24,       &
                                    ierr )
-          CALL pmc_send_to_child( child_id, coord_y, ny+1+2*nbgp, 0, 25,        &
+          CALL pmc_send_to_child( child_id, coord_y, ny+1+2*nbgp, 0, 25,       &
                                    ierr )
 !
@@ -835,5 +909,5 @@
        CALL MPI_BCAST( nomatch, 1, MPI_INTEGER, 0, comm2d, ierr )
        IF ( nomatch /= 0 )  THEN
-          WRITE ( message_string, * )  'nested child domain does ',             &
+          WRITE ( message_string, * )  'nested child domain does ',            &
                                        'not fit into its parent domain'
           CALL message( 'pmci_setup_parent', 'PA0425', 3, 2, 0, 6, 0 )
@@ -847,4 +921,6 @@
       
        CALL MPI_BCAST( nz_cl, 1, MPI_INTEGER, 0, comm2d, ierr )
+       CALL MPI_BCAST( childgrid(m), c_sizeof(childgrid(1)), MPI_BYTE, 0, comm2d, ierr )
+
 !
 !--    TO_DO: Klaus: please give a comment what is done here
@@ -852,5 +928,8 @@
 !
 !--    Include couple arrays into parent content
-!--    TO_DO: Klaus: please give a more meaningful comment
+!--    The adresses of the PALM 2D or 3D array (here server coarse grid) which are candidates
+!--    for coupling are stored once into the pmc context. While data transfer, the array do not
+!--    have to be specified again
+
        CALL pmc_s_clear_next_array_list
        DO  WHILE ( pmc_s_getnextarray( child_id, myname ) )
@@ -881,24 +960,24 @@
        IMPLICIT NONE
 
-       INTEGER(iwp) ::  i                  !:
-       INTEGER(iwp) ::  ic                 !:
-       INTEGER(iwp) ::  ierr               !:
-       INTEGER(iwp) ::  j                  !:
-       INTEGER(iwp) ::  k                  !:
-       INTEGER(iwp) ::  m                  !:
-       INTEGER(iwp) ::  n                  !:
-       INTEGER(iwp) ::  npx                !:
-       INTEGER(iwp) ::  npy                !:
-       INTEGER(iwp) ::  nrx                !:
-       INTEGER(iwp) ::  nry                !:
-       INTEGER(iwp) ::  px                 !:
-       INTEGER(iwp) ::  py                 !:
-       INTEGER(iwp) ::  parent_pe          !:
-
-       INTEGER(iwp), DIMENSION(2) ::  scoord             !:
-       INTEGER(iwp), DIMENSION(2) ::  size_of_array      !:
-
-       INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE  ::  coarse_bound_all   !:
-       INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE  ::  index_list         !:
+       INTEGER(iwp) ::  i                  !<
+       INTEGER(iwp) ::  ic                 !<
+       INTEGER(iwp) ::  ierr               !<
+       INTEGER(iwp) ::  j                  !<
+       INTEGER(iwp) ::  k                  !<
+       INTEGER(iwp) ::  m                  !<
+       INTEGER(iwp) ::  n                  !<
+       INTEGER(iwp) ::  npx                !<
+       INTEGER(iwp) ::  npy                !<
+       INTEGER(iwp) ::  nrx                !<
+       INTEGER(iwp) ::  nry                !<
+       INTEGER(iwp) ::  px                 !<
+       INTEGER(iwp) ::  py                 !<
+       INTEGER(iwp) ::  parent_pe          !<
+
+       INTEGER(iwp), DIMENSION(2) ::  scoord             !<
+       INTEGER(iwp), DIMENSION(2) ::  size_of_array      !<
+
+       INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE  ::  coarse_bound_all   !<
+       INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE  ::  index_list         !<
 
        IF ( myid == 0 )  THEN
@@ -907,5 +986,5 @@
           CALL pmc_recv_from_child( child_id, size_of_array, 2, 0, 40, ierr )
           ALLOCATE( coarse_bound_all(size_of_array(1),size_of_array(2)) )
-          CALL pmc_recv_from_child( child_id, coarse_bound_all,                 &
+          CALL pmc_recv_from_child( child_id, coarse_bound_all,                &
                                     SIZE( coarse_bound_all ), 0, 41, ierr )
 !
@@ -983,4 +1062,37 @@
      END SUBROUTINE pmci_create_index_list
 
+     SUBROUTINE set_child_edge_coords
+        IMPLICIT  NONE
+
+        INTEGER(iwp) :: nbgp_lpm = 1
+
+        nbgp_lpm = min(nbgp_lpm, nbgp)
+
+        childgrid(m)%nx = nx_cl
+        childgrid(m)%ny = ny_cl
+        childgrid(m)%nz = nz_cl
+        childgrid(m)%dx = dx_cl
+        childgrid(m)%dy = dy_cl
+        childgrid(m)%dz = dz_cl
+
+        childgrid(m)%lx_coord   = cl_coord_x(0)
+        childgrid(m)%lx_coord_b = cl_coord_x(-nbgp_lpm)
+        childgrid(m)%rx_coord   = cl_coord_x(nx_cl)+dx_cl
+        childgrid(m)%rx_coord_b = cl_coord_x(nx_cl+nbgp_lpm)+dx_cl
+        childgrid(m)%sy_coord   = cl_coord_y(0)
+        childgrid(m)%sy_coord_b = cl_coord_y(-nbgp_lpm)
+        childgrid(m)%ny_coord   = cl_coord_y(ny_cl)+dy_cl
+        childgrid(m)%ny_coord_b = cl_coord_y(ny_cl+nbgp_lpm)+dy_cl
+        childgrid(m)%uz_coord   = zmax_coarse(2)
+        childgrid(m)%uz_coord_b = zmax_coarse(1)
+
+        WRITE(9,*)                 'edge coordinates for child id ',child_id,m
+        WRITE(9,*)                 'Number of Boundray cells lpm  ',nbgp_lpm
+        WRITE(9,'(a,3i7,2f10.2)') ' model size                    ', nx_cl, ny_cl, nz_cl, dx_cl, dy_cl
+        WRITE(9,'(a,5f10.2)')     ' model edge                    ', childgrid(m)%lx_coord, childgrid(m)%rx_coord, childgrid(m)%sy_coord, childgrid(m)%ny_coord,childgrid(m)%uz_coord
+        WRITE(9,'(a,4f10.2)')     ' model edge with Boundary      ', childgrid(m)%lx_coord_b, childgrid(m)%rx_coord_b, childgrid(m)%sy_coord_b, childgrid(m)%ny_coord_b
+
+     END SUBROUTINE set_child_edge_coords
+
 #endif
  END SUBROUTINE pmci_setup_parent
@@ -1005,16 +1117,17 @@
     INTEGER(iwp) ::  n          !< running index for number of chemical species
 
-    INTEGER(iwp), DIMENSION(5) ::  val        !:
+    INTEGER(iwp), DIMENSION(5) ::  val        !<
     
-    REAL(wp) ::  xcs        !:
-    REAL(wp) ::  xce        !:
-    REAL(wp) ::  ycs        !:
-    REAL(wp) ::  yce        !:
-
-    REAL(wp), DIMENSION(1) ::  fval       !:
+    REAL(wp) ::  xcs        !<
+    REAL(wp) ::  xce        !<
+    REAL(wp) ::  ycs        !<
+    REAL(wp) ::  yce        !<
+
+    REAL(wp), DIMENSION(5) ::  fval       !<
                                              
 !
-!-- TO_DO: describe what is happening in this if-clause
-!-- Root model does not have a parent and is not a child
+!-- Child setup
+!-- Root model does not have a parent and is not a child, therefore no child setup on root model
+
     IF ( .NOT. pmc_is_rootmodel() )  THEN
 
@@ -1057,4 +1170,9 @@
        ENDIF
 
+       IF( particle_advection )  THEN
+          CALL pmc_set_dataarray_name( 'coarse', 'nr_part'  ,'fine', 'nr_part',  ierr )
+          CALL pmc_set_dataarray_name( 'coarse', 'part_adr'  ,'fine', 'part_adr',  ierr )
+       ENDIF
+       
        IF ( air_chemistry )  THEN
           DO  n = 1, nspec
@@ -1078,4 +1196,8 @@
        val(5)  = dy
        fval(1) = zw(nzt+1)
+       fval(2) = zw(nzt)
+       fval(3) = dx
+       fval(4) = dy
+       fval(5) = dz
 
        IF ( myid == 0 )  THEN
@@ -1087,23 +1209,23 @@
 !
 !--       Receive Coarse grid information.
-          CALL pmc_recv_from_parent( parent_grid_info_real,                     &
+          CALL pmc_recv_from_parent( parent_grid_info_real,                    &
                                      SIZE(parent_grid_info_real), 0, 21, ierr )
           CALL pmc_recv_from_parent( parent_grid_info_int,  3, 0, 22, ierr )
 !
 !--        Debug-printouts - keep them
-!          WRITE(0,*) 'Coarse grid from parent '
-!          WRITE(0,*) 'startx_tot    = ',parent_grid_info_real(1)
-!          WRITE(0,*) 'starty_tot    = ',parent_grid_info_real(2)
-!          WRITE(0,*) 'endx_tot      = ',parent_grid_info_real(5)
-!          WRITE(0,*) 'endy_tot      = ',parent_grid_info_real(6)
-!          WRITE(0,*) 'dx            = ',parent_grid_info_real(3)
-!          WRITE(0,*) 'dy            = ',parent_grid_info_real(4)
-!          WRITE(0,*) 'dz            = ',parent_grid_info_real(7)
-!          WRITE(0,*) 'nx_coarse     = ',parent_grid_info_int(1)
-!          WRITE(0,*) 'ny_coarse     = ',parent_grid_info_int(2)
-!          WRITE(0,*) 'nz_coarse     = ',parent_grid_info_int(3)
-       ENDIF
-
-       CALL MPI_BCAST( parent_grid_info_real, SIZE(parent_grid_info_real),      &
+!           WRITE(0,*) 'Coarse grid from parent '
+!           WRITE(0,*) 'startx_tot    = ',parent_grid_info_real(1)
+!           WRITE(0,*) 'starty_tot    = ',parent_grid_info_real(2)
+!           WRITE(0,*) 'endx_tot      = ',parent_grid_info_real(5)
+!           WRITE(0,*) 'endy_tot      = ',parent_grid_info_real(6)
+!           WRITE(0,*) 'dx            = ',parent_grid_info_real(3)
+!           WRITE(0,*) 'dy            = ',parent_grid_info_real(4)
+!           WRITE(0,*) 'dz            = ',parent_grid_info_real(7)
+!           WRITE(0,*) 'nx_coarse     = ',parent_grid_info_int(1)
+!           WRITE(0,*) 'ny_coarse     = ',parent_grid_info_int(2)
+!           WRITE(0,*) 'nz_coarse     = ',parent_grid_info_int(3)
+       ENDIF
+
+       CALL MPI_BCAST( parent_grid_info_real, SIZE(parent_grid_info_real),     &
                        MPI_REAL, 0, comm2d, ierr )
        CALL MPI_BCAST( parent_grid_info_int, 3, MPI_INTEGER, 0, comm2d, ierr )
@@ -1158,5 +1280,5 @@
        n = 1
        DO  WHILE ( pmc_c_getnextarray( myname ) )
-!--       Note that cg%nz is not th eoriginal nz of parent, but the highest
+!--       Note that cg%nz is not the original nz of parent, but the highest
 !--       parent-grid level needed for nesting.
 !--       Please note, in case of chemical species an additional parameter
@@ -1186,5 +1308,5 @@
 !--    Precompute the index arrays and relaxation functions for the
 !--    anterpolation
-       IF ( TRIM( nesting_mode ) == 'two-way' .OR.                              &
+       IF ( TRIM( nesting_mode ) == 'two-way' .OR.                             &
                   nesting_mode == 'vertical' )  THEN
           CALL pmci_init_anterp_tophat
@@ -1206,11 +1328,11 @@
        IMPLICIT NONE
 
-       INTEGER(iwp), DIMENSION(5,numprocs) ::  coarse_bound_all   !:
-       INTEGER(iwp), DIMENSION(2)          ::  size_of_array      !:
+       INTEGER(iwp), DIMENSION(5,numprocs) ::  coarse_bound_all   !<
+       INTEGER(iwp), DIMENSION(2)          ::  size_of_array      !<
                                               
-       REAL(wp) ::  loffset     !:
-       REAL(wp) ::  noffset     !:
-       REAL(wp) ::  roffset     !:
-       REAL(wp) ::  soffset     !:
+       REAL(wp) ::  loffset     !<
+       REAL(wp) ::  noffset     !<
+       REAL(wp) ::  roffset     !<
+       REAL(wp) ::  soffset     !<
 
 !
@@ -1283,5 +1405,5 @@
 !--    Note that MPI_Gather receives data from all processes in the rank order
 !--    TO_DO: refer to the line where this fact becomes important
-       CALL MPI_GATHER( coarse_bound, 5, MPI_INTEGER, coarse_bound_all, 5,      &
+       CALL MPI_GATHER( coarse_bound, 5, MPI_INTEGER, coarse_bound_all, 5,     &
                         MPI_INTEGER, 0, comm2d, ierr )
 
@@ -1290,5 +1412,5 @@
           size_of_array(2) = SIZE( coarse_bound_all, 2 )
           CALL pmc_send_to_parent( size_of_array, 2, 0, 40, ierr )
-          CALL pmc_send_to_parent( coarse_bound_all, SIZE( coarse_bound_all ),  &
+          CALL pmc_send_to_parent( coarse_bound_all, SIZE( coarse_bound_all ), &
                                    0, 41, ierr )
        ENDIF
@@ -1306,27 +1428,27 @@
        IMPLICIT NONE
 
-       INTEGER(iwp) ::  i       !:
-       INTEGER(iwp) ::  i1      !:
-       INTEGER(iwp) ::  j       !:
-       INTEGER(iwp) ::  j1      !:
-       INTEGER(iwp) ::  k       !:
-       INTEGER(iwp) ::  kc      !:
-       INTEGER(iwp) ::  kdzo    !:
-       INTEGER(iwp) ::  kdzw    !:       
-
-       REAL(wp) ::  xb          !:
-       REAL(wp) ::  xcsu        !:
-       REAL(wp) ::  xfso        !:
-       REAL(wp) ::  xcso        !:
-       REAL(wp) ::  xfsu        !:
-       REAL(wp) ::  yb          !:
-       REAL(wp) ::  ycso        !:
-       REAL(wp) ::  ycsv        !:
-       REAL(wp) ::  yfso        !:
-       REAL(wp) ::  yfsv        !:
-       REAL(wp) ::  zcso        !:
-       REAL(wp) ::  zcsw        !:
-       REAL(wp) ::  zfso        !:
-       REAL(wp) ::  zfsw        !:
+       INTEGER(iwp) ::  i       !<
+       INTEGER(iwp) ::  i1      !<
+       INTEGER(iwp) ::  j       !<
+       INTEGER(iwp) ::  j1      !<
+       INTEGER(iwp) ::  k       !<
+       INTEGER(iwp) ::  kc      !<
+       INTEGER(iwp) ::  kdzo    !<
+       INTEGER(iwp) ::  kdzw    !<       
+
+       REAL(wp) ::  xb          !<
+       REAL(wp) ::  xcsu        !<
+       REAL(wp) ::  xfso        !<
+       REAL(wp) ::  xcso        !<
+       REAL(wp) ::  xfsu        !<
+       REAL(wp) ::  yb          !<
+       REAL(wp) ::  ycso        !<
+       REAL(wp) ::  ycsv        !<
+       REAL(wp) ::  yfso        !<
+       REAL(wp) ::  yfsv        !<
+       REAL(wp) ::  zcso        !<
+       REAL(wp) ::  zcsw        !<
+       REAL(wp) ::  zfso        !<
+       REAL(wp) ::  zfsw        !<
       
 
@@ -1391,11 +1513,4 @@
           kcw(k) = kc - 1
           
-          !if ( myid == 0 .and. nx==191 )  then
-          !   write(162,*)nx, nzt+1, k, zw(k), cg%nz+1, kcw(k), cg%zw(kcw(k))
-          !endif
-          !if ( myid == 0 .and. nx==383 )  then
-          !   write(163,*)nx, nzt+1, k, zw(k), cg%nz+1, kcw(k), cg%zw(kcw(k))
-          !endif
-
           DO kc = 0, cg%nz+1
              IF ( cg%zu(kc) > zfso )  EXIT
@@ -1945,5 +2060,5 @@
                       inc        = 1
                       wall_index = j
-                      CALL pmci_define_loglaw_correction_parameters( lc, lcr,   &
+                      CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
                           k, j, inc, wall_index, z0_topo, kb, direction, ncorr )
 !
@@ -2188,23 +2303,23 @@
        IMPLICIT NONE
 
-       INTEGER(iwp), INTENT(IN)  ::  direction                 !:
-       INTEGER(iwp), INTENT(IN)  ::  ij                        !:
-       INTEGER(iwp), INTENT(IN)  ::  inc                       !:
-       INTEGER(iwp), INTENT(IN)  ::  k                         !:
-       INTEGER(iwp), INTENT(IN)  ::  kb                        !:
-       INTEGER(iwp), INTENT(OUT) ::  lc                        !:
-       INTEGER(iwp), INTENT(IN)  ::  ncorr                     !:
-       INTEGER(iwp), INTENT(IN)  ::  wall_index                !:
-
-       INTEGER(iwp) ::  alcorr       !:
-       INTEGER(iwp) ::  corr_index   !:
-       INTEGER(iwp) ::  lcorr        !:
-
-       LOGICAL      ::  more         !:
-
-       REAL(wp), DIMENSION(0:ncorr-1), INTENT(OUT) ::  lcr     !:
-       REAL(wp), INTENT(IN)      ::  z0_l                      !:
+       INTEGER(iwp), INTENT(IN)  ::  direction  !<
+       INTEGER(iwp), INTENT(IN)  ::  ij         !<
+       INTEGER(iwp), INTENT(IN)  ::  inc        !<
+       INTEGER(iwp), INTENT(IN)  ::  k          !<
+       INTEGER(iwp), INTENT(IN)  ::  kb         !<
+       INTEGER(iwp), INTENT(OUT) ::  lc         !<
+       INTEGER(iwp), INTENT(IN)  ::  ncorr      !<
+       INTEGER(iwp), INTENT(IN)  ::  wall_index !<
+
+       INTEGER(iwp) ::  alcorr       !<
+       INTEGER(iwp) ::  corr_index   !<
+       INTEGER(iwp) ::  lcorr        !<
+
+       LOGICAL      ::  more         !<
+
+       REAL(wp), DIMENSION(0:ncorr-1), INTENT(OUT) ::  lcr     !<
+       REAL(wp), INTENT(IN)      ::  z0_l                      !<
       
-       REAL(wp)     ::  logvelc1     !:
+       REAL(wp)     ::  logvelc1     !<
       
 
@@ -2296,14 +2411,14 @@
        IMPLICIT NONE
 
-       INTEGER(iwp), INTENT(IN)  ::  kb   !:
-       INTEGER(iwp), INTENT(OUT) ::  lc   !:
-
-       INTEGER(iwp) ::  kbc    !:
-       INTEGER(iwp) ::  k1     !:
-
-       REAL(wp), INTENT(OUT) ::  logzc1     !:
-       REAL(wp), INTENT(IN) ::  z0_l       !:
-
-       REAL(wp) ::  zuc1   !:
+       INTEGER(iwp), INTENT(IN)  ::  kb   !<
+       INTEGER(iwp), INTENT(OUT) ::  lc   !<
+
+       INTEGER(iwp) ::  kbc    !<
+       INTEGER(iwp) ::  k1     !<
+
+       REAL(wp), INTENT(OUT) ::  logzc1     !<
+       REAL(wp), INTENT(IN) ::  z0_l       !<
+
+       REAL(wp) ::  zuc1   !<
 
 
@@ -2335,15 +2450,15 @@
        IMPLICIT NONE
 
-       INTEGER(iwp), INTENT(IN)  ::  inc    !:  increment must be 1 or -1.
-       INTEGER(iwp), INTENT(IN)  ::  j      !:
-       INTEGER(iwp), INTENT(IN)  ::  jw     !:
-       INTEGER(iwp), INTENT(OUT) ::  lc     !:
-
-       INTEGER(iwp) ::  j1       !:
-
-       REAL(wp), INTENT(IN) ::  z0_l   !:
-
-       REAL(wp) ::  logyc1   !:
-       REAL(wp) ::  yc1      !:
+       INTEGER(iwp), INTENT(IN)  ::  inc    !<  increment must be 1 or -1.
+       INTEGER(iwp), INTENT(IN)  ::  j      !<
+       INTEGER(iwp), INTENT(IN)  ::  jw     !<
+       INTEGER(iwp), INTENT(OUT) ::  lc     !<
+
+       INTEGER(iwp) ::  j1       !<
+
+       REAL(wp), INTENT(IN) ::  z0_l   !<
+
+       REAL(wp) ::  logyc1   !<
+       REAL(wp) ::  yc1      !<
        
 !
@@ -2376,15 +2491,15 @@
        IMPLICIT NONE
 
-       INTEGER(iwp), INTENT(IN)  ::  i      !:
-       INTEGER(iwp), INTENT(IN)  ::  inc    !: increment must be 1 or -1.
-       INTEGER(iwp), INTENT(IN)  ::  iw     !:
-       INTEGER(iwp), INTENT(OUT) ::  lc     !:
-
-       INTEGER(iwp) ::  i1       !:
-
-       REAL(wp), INTENT(IN) ::  z0_l   !:
-
-       REAL(wp) ::  logxc1   !:
-       REAL(wp) ::  xc1      !:
+       INTEGER(iwp), INTENT(IN)  ::  i      !<
+       INTEGER(iwp), INTENT(IN)  ::  inc    !< increment must be 1 or -1.
+       INTEGER(iwp), INTENT(IN)  ::  iw     !<
+       INTEGER(iwp), INTENT(OUT) ::  lc     !<
+
+       INTEGER(iwp) ::  i1       !<
+
+       REAL(wp), INTENT(IN) ::  z0_l   !<
+
+       REAL(wp) ::  logxc1   !<
+       REAL(wp) ::  xc1      !<
 
 !
@@ -2417,20 +2532,20 @@
        IMPLICIT NONE
 
-       INTEGER(iwp) ::  i        !: Fine-grid index
-       INTEGER(iwp) ::  ifc_o    !:
-       INTEGER(iwp) ::  ifc_u    !:
-       INTEGER(iwp) ::  ii       !: Coarse-grid index
-       INTEGER(iwp) ::  istart   !:
-       INTEGER(iwp) ::  ir       !:
-       INTEGER(iwp) ::  j        !: Fine-grid index
-       INTEGER(iwp) ::  jj       !: Coarse-grid index
-       INTEGER(iwp) ::  jstart   !:
-       INTEGER(iwp) ::  jr       !:
-       INTEGER(iwp) ::  k        !: Fine-grid index
-       INTEGER(iwp) ::  kk       !: Coarse-grid index
-       INTEGER(iwp) ::  kstart   !:
-       REAL(wp)     ::  xi       !:
-       REAL(wp)     ::  eta      !:
-       REAL(wp)     ::  zeta     !:
+       INTEGER(iwp) ::  i        !< Fine-grid index
+       INTEGER(iwp) ::  ifc_o    !<
+       INTEGER(iwp) ::  ifc_u    !<
+       INTEGER(iwp) ::  ii       !< Coarse-grid index
+       INTEGER(iwp) ::  istart   !<
+       INTEGER(iwp) ::  ir       !<
+       INTEGER(iwp) ::  j        !< Fine-grid index
+       INTEGER(iwp) ::  jj       !< Coarse-grid index
+       INTEGER(iwp) ::  jstart   !<
+       INTEGER(iwp) ::  jr       !<
+       INTEGER(iwp) ::  k        !< Fine-grid index
+       INTEGER(iwp) ::  kk       !< Coarse-grid index
+       INTEGER(iwp) ::  kstart   !<
+       REAL(wp)     ::  xi       !<
+       REAL(wp)     ::  eta      !<
+       REAL(wp)     ::  zeta     !<
      
 !
@@ -2490,5 +2605,5 @@
        DO  ii = icl, icr-1
           i = istart
-          DO  WHILE ( ( coord_x(i) < cg%coord_x(ii) - 0.5_wp * cg%dx )  .AND.   &
+          DO  WHILE ( ( coord_x(i) < cg%coord_x(ii) - 0.5_wp * cg%dx )  .AND.  &
                       ( i < nxrg ) )
              i  = i + 1
@@ -2496,5 +2611,5 @@
           iflu(ii) = MIN( MAX( i, nxlg ), nxrg )
           ir = i
-          DO  WHILE ( ( coord_x(ir) <= cg%coord_x(ii) + 0.5_wp * cg%dx )  .AND. &
+          DO  WHILE ( ( coord_x(ir) <= cg%coord_x(ii) + 0.5_wp * cg%dx )  .AND.&
                       ( i < nxrg+1 ) )
              i  = i + 1
@@ -2512,5 +2627,5 @@
        DO  ii = icl, icr-1
           i = istart
-          DO  WHILE ( ( coord_x(i) + 0.5_wp * dx < cg%coord_x(ii) )  .AND.      &
+          DO  WHILE ( ( coord_x(i) + 0.5_wp * dx < cg%coord_x(ii) )  .AND.     &
                       ( i < nxrg ) )
              i  = i + 1
@@ -2518,5 +2633,5 @@
           iflo(ii) = MIN( MAX( i, nxlg ), nxrg )
           ir = i
-          DO  WHILE ( ( coord_x(ir) + 0.5_wp * dx <= cg%coord_x(ii) + cg%dx )   &
+          DO  WHILE ( ( coord_x(ir) + 0.5_wp * dx <= cg%coord_x(ii) + cg%dx )  &
                       .AND.  ( i < nxrg+1 ) )
              i  = i + 1
@@ -2534,5 +2649,5 @@
        DO  jj = jcs, jcn-1
           j = jstart
-          DO  WHILE ( ( coord_y(j) < cg%coord_y(jj) - 0.5_wp * cg%dy )  .AND.   &
+          DO  WHILE ( ( coord_y(j) < cg%coord_y(jj) - 0.5_wp * cg%dy )  .AND.  &
                       ( j < nyng ) )
              j  = j + 1
@@ -2540,5 +2655,5 @@
           jflv(jj) = MIN( MAX( j, nysg ), nyng )
           jr = j
-          DO  WHILE ( ( coord_y(jr) <= cg%coord_y(jj) + 0.5_wp * cg%dy )  .AND. &
+          DO  WHILE ( ( coord_y(jr) <= cg%coord_y(jj) + 0.5_wp * cg%dy )  .AND.&
                       ( j < nyng+1 ) )
              j  = j + 1
@@ -2556,5 +2671,5 @@
        DO  jj = jcs, jcn-1
           j = jstart
-          DO  WHILE ( ( coord_y(j) + 0.5_wp * dy < cg%coord_y(jj) )  .AND.      &
+          DO  WHILE ( ( coord_y(j) + 0.5_wp * dy < cg%coord_y(jj) )  .AND.     &
                       ( j < nyng ) )
              j  = j + 1
@@ -2562,5 +2677,5 @@
           jflo(jj) = MIN( MAX( j, nysg ), nyng )
           jr = j
-          DO  WHILE ( ( coord_y(jr) + 0.5_wp * dy <= cg%coord_y(jj) + cg%dy )   &
+          DO  WHILE ( ( coord_y(jr) + 0.5_wp * dy <= cg%coord_y(jj) + cg%dy )  &
                       .AND.  ( j < nyng+1 ) )
              j  = j + 1
@@ -2636,10 +2751,10 @@
           DO  ii = icl, icr
              IF ( ifuu(ii) < ( nx + 1 ) / 2 )  THEN   
-                xi = ( MAX( 0.0_wp, ( cg%coord_x(ii) -                          &
+                xi = ( MAX( 0.0_wp, ( cg%coord_x(ii) -                         &
                      lower_left_coord_x ) ) / anterp_relax_length_l )**4
                 frax(ii) = xi / ( 1.0_wp + xi )
              ELSE
-                xi = ( MAX( 0.0_wp, ( lower_left_coord_x + ( nx + 1 ) * dx -    &
-                                      cg%coord_x(ii) ) ) /                      &
+                xi = ( MAX( 0.0_wp, ( lower_left_coord_x + ( nx + 1 ) * dx -   &
+                                      cg%coord_x(ii) ) ) /                     &
                        anterp_relax_length_r )**4
                 frax(ii) = xi / ( 1.0_wp + xi )                
@@ -2650,10 +2765,10 @@
           DO  jj = jcs, jcn
              IF ( jfuv(jj) < ( ny + 1 ) / 2 )  THEN 
-                eta = ( MAX( 0.0_wp, ( cg%coord_y(jj) -                         &
+                eta = ( MAX( 0.0_wp, ( cg%coord_y(jj) -                        &
                      lower_left_coord_y ) ) / anterp_relax_length_s )**4
                 fray(jj) = eta / ( 1.0_wp + eta )
              ELSE
-                eta = ( MAX( 0.0_wp, ( lower_left_coord_y + ( ny + 1 ) * dy -   &
-                                       cg%coord_y(jj)) ) /                      &
+                eta = ( MAX( 0.0_wp, ( lower_left_coord_y + ( ny + 1 ) * dy -  &
+                                       cg%coord_y(jj)) ) /                     &
                         anterp_relax_length_n )**4
                 fray(jj) = eta / ( 1.0_wp + eta )
@@ -2683,17 +2798,17 @@
        IMPLICIT NONE
 
-       INTEGER(iwp)        ::  k                     !: index variable along z
-       INTEGER(iwp)        ::  k_wall                !: topography-top index along z
-       INTEGER(iwp)        ::  kc                    !:
-
-       REAL(wp), PARAMETER ::  cfw = 0.2_wp          !:
-       REAL(wp), PARAMETER ::  c_tkef = 0.6_wp       !:
-       REAL(wp)            ::  fw                    !:
-       REAL(wp), PARAMETER ::  fw0 = 0.9_wp          !:
-       REAL(wp)            ::  glsf                  !:
-       REAL(wp)            ::  glsc                  !:
-       REAL(wp)            ::  height                !:
-       REAL(wp), PARAMETER ::  p13 = 1.0_wp/3.0_wp   !:
-       REAL(wp), PARAMETER ::  p23 = 2.0_wp/3.0_wp   !:        
+       INTEGER(iwp)        ::  k                     !< index variable along z
+       INTEGER(iwp)        ::  k_wall                !< topography-top index along z
+       INTEGER(iwp)        ::  kc                    !<
+
+       REAL(wp), PARAMETER ::  cfw = 0.2_wp          !<
+       REAL(wp), PARAMETER ::  c_tkef = 0.6_wp       !<
+       REAL(wp)            ::  fw                    !<
+       REAL(wp), PARAMETER ::  fw0 = 0.9_wp          !<
+       REAL(wp)            ::  glsf                  !<
+       REAL(wp)            ::  glsc                  !<
+       REAL(wp)            ::  height                !<
+       REAL(wp), PARAMETER ::  p13 = 1.0_wp/3.0_wp   !<
+       REAL(wp), PARAMETER ::  p23 = 2.0_wp/3.0_wp   !<        
 
        IF ( nest_bound_l )  THEN
@@ -2711,5 +2826,5 @@
                 height = zu(k) - zu(k_wall)
                 fw     = EXP( -cfw * height / glsf )
-                tkefactor_l(k,j) = c_tkef * ( fw0 * fw + ( 1.0_wp - fw ) *      &
+                tkefactor_l(k,j) = c_tkef * ( fw0 * fw + ( 1.0_wp - fw ) *     &
                                               ( glsf / glsc )**p23 )
              ENDDO
@@ -2732,5 +2847,5 @@
                 height = zu(k) - zu(k_wall)
                 fw     = EXP( -cfw * height / glsf )
-                tkefactor_r(k,j) = c_tkef * ( fw0 * fw + ( 1.0_wp - fw ) *      &
+                tkefactor_r(k,j) = c_tkef * ( fw0 * fw + ( 1.0_wp - fw ) *     &
                                               ( glsf / glsc )**p23 )
              ENDDO
@@ -2753,5 +2868,5 @@
                 height = zu(k) - zu(k_wall)
                 fw     = EXP( -cfw*height / glsf )
-                tkefactor_s(k,i) = c_tkef * ( fw0 * fw + ( 1.0_wp - fw ) *      &
+                tkefactor_s(k,i) = c_tkef * ( fw0 * fw + ( 1.0_wp - fw ) *     &
                      ( glsf / glsc )**p23 )
              ENDDO
@@ -2812,6 +2927,6 @@
     IMPLICIT NONE
 
-    INTEGER(iwp) ::  i   !:
-    INTEGER(iwp) ::  j   !:
+    INTEGER(iwp) ::  i   !<
+    INTEGER(iwp) ::  j   !<
 
 !
@@ -2838,22 +2953,25 @@
     IMPLICIT NONE
 
-    INTEGER, INTENT(IN)          ::  child_id    !:
-    INTEGER, INTENT(IN)          ::  nz_cl       !:
-    INTEGER, INTENT(IN),OPTIONAL ::  n           !< index of chemical species
-
-    CHARACTER(LEN=*), INTENT(IN) ::  name        !:
+    INTEGER(iwp), INTENT(IN)          ::  child_id    !<
+    INTEGER(iwp), INTENT(IN)          ::  nz_cl       !<
+    INTEGER(iwp), INTENT(IN),OPTIONAL ::  n           !< index of chemical species
+
+    CHARACTER(LEN=*), INTENT(IN) ::  name        !<
 
 #if defined( __parallel )
-    INTEGER(iwp) ::  ierr        !:
-    INTEGER(iwp) ::  istat       !:
-
-    REAL(wp), POINTER, DIMENSION(:,:)   ::  p_2d        !:
-    REAL(wp), POINTER, DIMENSION(:,:)   ::  p_2d_sec    !:
-    REAL(wp), POINTER, DIMENSION(:,:,:) ::  p_3d        !:
-    REAL(wp), POINTER, DIMENSION(:,:,:) ::  p_3d_sec    !:
+    INTEGER(iwp) ::  ierr        !<
+    INTEGER(iwp) ::  istat       !<
+
+    REAL(wp), POINTER, DIMENSION(:,:)     ::  p_2d        !<
+    REAL(wp), POINTER, DIMENSION(:,:)     ::  p_2d_sec    !<
+    REAL(wp), POINTER, DIMENSION(:,:,:)   ::  p_3d        !<
+    REAL(wp), POINTER, DIMENSION(:,:,:)   ::  p_3d_sec    !<
+    INTEGER(idp), POINTER, DIMENSION(:,:) ::  i_2d        !<
 
 
     NULLIFY( p_3d )
     NULLIFY( p_2d )
+    NULLIFY( i_2d )
+
 !
 !-- List of array names, which can be coupled.
@@ -2870,4 +2988,6 @@
     IF ( TRIM(name) == "nc" )  p_3d => nc
     IF ( TRIM(name) == "s"  )  p_3d => s
+    IF ( TRIM(name) == "nr_part"  )   i_2d => nr_part
+    IF ( TRIM(name) == "part_adr"  )  i_2d => part_adr
     IF ( INDEX( TRIM(name), "chem_" ) /= 0 )  p_3d => chem_species(n)%conc
 
@@ -2882,4 +3002,6 @@
     ELSEIF ( ASSOCIATED( p_2d ) )  THEN
        CALL pmc_s_set_dataarray( child_id, p_2d )
+    ELSEIF ( ASSOCIATED( i_2d ) )  THEN
+       CALL pmc_s_set_dataarray( child_id, i_2d )
     ELSE
 !
@@ -2887,5 +3009,5 @@
        IF ( myid == 0  .AND.  cpl_id == 1 )  THEN
 
-          message_string = 'pointer for array "' // TRIM( name ) //             &
+          message_string = 'pointer for array "' // TRIM( name ) //            &
                            '" can''t be associated'
           CALL message( 'pmci_set_array_pointer', 'PA0117', 3, 2, 0, 6, 0 )
@@ -2911,8 +3033,10 @@
 
     IF ( ASSOCIATED( p_3d ) )  THEN
-       CALL pmc_s_set_dataarray( child_id, p_3d, nz_cl, nz,                     &
+       CALL pmc_s_set_dataarray( child_id, p_3d, nz_cl, nz,                    &
                                  array_2 = p_3d_sec )
     ELSEIF ( ASSOCIATED( p_2d ) )  THEN
        CALL pmc_s_set_dataarray( child_id, p_2d )
+    ELSEIF ( ASSOCIATED( i_2d ) )  THEN
+       CALL pmc_s_set_dataarray( child_id, i_2d )
     ELSE
 !
@@ -2920,5 +3044,5 @@
        IF ( myid == 0  .AND.  cpl_id == 1 )  THEN
 
-          message_string = 'pointer for array "' // TRIM( name ) //             &
+          message_string = 'pointer for array "' // TRIM( name ) //            &
                            '" can''t be associated'
           CALL message( 'pmci_set_array_pointer', 'PA0117', 3, 2, 0, 6, 0 )
@@ -2933,32 +3057,91 @@
 
 #endif
- END SUBROUTINE pmci_set_array_pointer
-
-
-
- SUBROUTINE pmci_create_child_arrays( name, is, ie, js, je, nzc, n )
+END SUBROUTINE pmci_set_array_pointer
+
+INTEGER FUNCTION get_number_of_childs ()
+   IMPLICIT NONE
+
+   get_number_of_childs = SIZE( pmc_parent_for_child ) - 1
+
+   RETURN
+END FUNCTION get_number_of_childs
+
+INTEGER FUNCTION get_childid (id_index)
+   IMPLICIT NONE
+
+   INTEGER,INTENT(IN)                 :: id_index
+
+   get_childid = pmc_parent_for_child(id_index)
+
+   RETURN
+END FUNCTION get_childid
+
+SUBROUTINE  get_child_edges (m, lx_coord, lx_coord_b, rx_coord, rx_coord_b,    &
+                               sy_coord, sy_coord_b, ny_coord, ny_coord_b,     &
+                               uz_coord, uz_coord_b)
+   IMPLICIT NONE
+   INTEGER,INTENT(IN)             ::  m
+   REAL(wp),INTENT(OUT)           ::  lx_coord, lx_coord_b
+   REAL(wp),INTENT(OUT)           ::  rx_coord, rx_coord_b
+   REAL(wp),INTENT(OUT)           ::  sy_coord, sy_coord_b
+   REAL(wp),INTENT(OUT)           ::  ny_coord, ny_coord_b
+   REAL(wp),INTENT(OUT)           ::  uz_coord, uz_coord_b
+
+   lx_coord = childgrid(m)%lx_coord
+   rx_coord = childgrid(m)%rx_coord
+   sy_coord = childgrid(m)%sy_coord
+   ny_coord = childgrid(m)%ny_coord
+   uz_coord = childgrid(m)%uz_coord
+
+   lx_coord_b = childgrid(m)%lx_coord_b
+   rx_coord_b = childgrid(m)%rx_coord_b
+   sy_coord_b = childgrid(m)%sy_coord_b
+   ny_coord_b = childgrid(m)%ny_coord_b
+   uz_coord_b = childgrid(m)%uz_coord_b
+
+END SUBROUTINE get_child_edges
+
+SUBROUTINE  get_child_gridspacing (m, dx,dy,dz)
+
+   IMPLICIT NONE
+   INTEGER,INTENT(IN)             ::  m
+   REAL(wp),INTENT(OUT)           ::  dx,dy
+   REAL(wp),INTENT(OUT),OPTIONAL  ::  dz
+
+   dx = childgrid(m)%dx
+   dy = childgrid(m)%dy
+   IF(PRESENT(dz))   THEN
+      dz = childgrid(m)%dz
+   ENDIF
+
+END SUBROUTINE get_child_gridspacing
+
+SUBROUTINE pmci_create_child_arrays( name, is, ie, js, je, nzc,n  )
 
     IMPLICIT NONE
 
-    CHARACTER(LEN=*), INTENT(IN) ::  name    !:
-
-    INTEGER(iwp), INTENT(IN) ::  ie      !:
-    INTEGER(iwp), INTENT(IN) ::  is      !:
-    INTEGER(iwp), INTENT(IN) ::  je      !:
-    INTEGER(iwp), INTENT(IN) ::  js      !:
-    INTEGER(iwp), INTENT(IN) ::  nzc     !:  Note that nzc is cg%nz
+    CHARACTER(LEN=*), INTENT(IN) ::  name    !<
+
+    INTEGER(iwp), INTENT(IN) ::  ie      !<
+    INTEGER(iwp), INTENT(IN) ::  is      !<
+    INTEGER(iwp), INTENT(IN) ::  je      !<
+    INTEGER(iwp), INTENT(IN) ::  js      !<
+    INTEGER(iwp), INTENT(IN) ::  nzc     !<  Note that nzc is cg%nz
 
     INTEGER(iwp), INTENT(IN), OPTIONAL ::  n  !< number of chemical species
 
 #if defined( __parallel )
-    INTEGER(iwp) ::  ierr    !:
-    INTEGER(iwp) ::  istat   !:
-
-    REAL(wp), POINTER,DIMENSION(:,:)   ::  p_2d    !:
-    REAL(wp), POINTER,DIMENSION(:,:,:) ::  p_3d    !:
+    INTEGER(iwp) ::  ierr    !<
+    INTEGER(iwp) ::  istat   !<
+
+    REAL(wp), POINTER,DIMENSION(:,:)       ::  p_2d    !<
+    REAL(wp), POINTER,DIMENSION(:,:,:)     ::  p_3d    !<
+    INTEGER(idp), POINTER,DIMENSION(:,:)   ::  i_2d    !<
 
 
     NULLIFY( p_3d )
     NULLIFY( p_2d )
+    NULLIFY( i_2d )
+
 !
 !-- List of array names, which can be coupled
@@ -2996,4 +3179,10 @@
        IF ( .NOT. ALLOCATED( sc ) )  ALLOCATE( sc(0:nzc+1,js:je,is:ie) )
        p_3d => sc
+    ELSEIF (trim(name) == "nr_part") then
+       IF (.not.allocated(nr_partc))  allocate(nr_partc(js:je, is:ie))
+       i_2d => nr_partc
+    ELSEIF (trim(name) == "part_adr") then
+       IF (.not.allocated(part_adrc))  allocate(part_adrc(js:je, is:ie))
+       i_2d => part_adrc
     ELSEIF ( TRIM( name(1:5) ) == "chem_" )  THEN
        IF ( .NOT. ALLOCATED( chem_spec_c ) )                                   &
@@ -3009,4 +3198,6 @@
     ELSEIF ( ASSOCIATED( p_2d ) )  THEN
        CALL pmc_c_set_dataarray( p_2d )
+    ELSEIF ( ASSOCIATED( i_2d ) )  THEN
+       CALL pmc_c_set_dataarray( i_2d )
     ELSE
 !
@@ -3014,5 +3205,5 @@
        IF ( myid == 0  .AND.  cpl_id == 2 )  THEN
 
-          message_string = 'pointer for array "' // TRIM( name ) //             &
+          message_string = 'pointer for array "' // TRIM( name ) //            &
                            '" can''t be associated'
           CALL message( 'pmci_create_child_arrays', 'PA0170', 3, 2, 0, 6, 0 )
@@ -3037,8 +3228,8 @@
     IMPLICIT NONE
 
-    INTEGER(iwp) ::  child_id    !:
-    INTEGER(iwp) ::  m           !:
-
-    REAL(wp) ::  waittime        !:
+    INTEGER(iwp) ::  child_id    !<
+    INTEGER(iwp) ::  m           !<
+
+    REAL(wp) ::  waittime        !<
 
 
@@ -3086,15 +3277,15 @@
 !
 !--    The interpolation.
-       CALL pmci_interp_tril_all ( u,  uc,  icu, jco, kco, r1xu, r2xu, r1yo,    &
+       CALL pmci_interp_tril_all ( u,  uc,  icu, jco, kco, r1xu, r2xu, r1yo,   &
                                    r2yo, r1zo, r2zo, 'u' )
-       CALL pmci_interp_tril_all ( v,  vc,  ico, jcv, kco, r1xo, r2xo, r1yv,    &
+       CALL pmci_interp_tril_all ( v,  vc,  ico, jcv, kco, r1xo, r2xo, r1yv,   &
                                    r2yv, r1zo, r2zo, 'v' )
-       CALL pmci_interp_tril_all ( w,  wc,  ico, jco, kcw, r1xo, r2xo, r1yo,    &
+       CALL pmci_interp_tril_all ( w,  wc,  ico, jco, kcw, r1xo, r2xo, r1yo,   &
                                    r2yo, r1zw, r2zw, 'w' )
-       CALL pmci_interp_tril_all ( e,  ec,  ico, jco, kco, r1xo, r2xo, r1yo,    &
+       CALL pmci_interp_tril_all ( e,  ec,  ico, jco, kco, r1xo, r2xo, r1yo,   &
                                    r2yo, r1zo, r2zo, 'e' )
 
        IF ( .NOT. neutral )  THEN
-          CALL pmci_interp_tril_all ( pt, ptc, ico, jco, kco, r1xo, r2xo,       &
+          CALL pmci_interp_tril_all ( pt, ptc, ico, jco, kco, r1xo, r2xo,      &
                                       r1yo, r2yo, r1zo, r2zo, 's' )
        ENDIF
@@ -3102,18 +3293,18 @@
        IF ( humidity )  THEN
 
-          CALL pmci_interp_tril_all ( q, q_c, ico, jco, kco, r1xo, r2xo, r1yo,   &
+          CALL pmci_interp_tril_all ( q, q_c, ico, jco, kco, r1xo, r2xo, r1yo, &
                                       r2yo, r1zo, r2zo, 's' )
 
           IF ( cloud_physics  .AND.  microphysics_morrison )  THEN
-             CALL pmci_interp_tril_all ( qc, qcc, ico, jco, kco, r1xo, r2xo,    &
+             CALL pmci_interp_tril_all ( qc, qcc, ico, jco, kco, r1xo, r2xo,   &
                                           r1yo, r2yo, r1zo, r2zo, 's' ) 
-             CALL pmci_interp_tril_all ( nc, ncc, ico, jco, kco, r1xo, r2xo,    &
+             CALL pmci_interp_tril_all ( nc, ncc, ico, jco, kco, r1xo, r2xo,   &
                                          r1yo, r2yo, r1zo, r2zo, 's' )   
           ENDIF
 
           IF ( cloud_physics  .AND.  microphysics_seifert )  THEN
-             CALL pmci_interp_tril_all ( qr, qrc, ico, jco, kco, r1xo, r2xo,    &
+             CALL pmci_interp_tril_all ( qr, qrc, ico, jco, kco, r1xo, r2xo,   &
                                          r1yo, r2yo, r1zo, r2zo, 's' )
-             CALL pmci_interp_tril_all ( nr, nrc, ico, jco, kco, r1xo, r2xo,    &
+             CALL pmci_interp_tril_all ( nr, nrc, ico, jco, kco, r1xo, r2xo,   &
                                          r1yo, r2yo, r1zo, r2zo, 's' )
           ENDIF
@@ -3122,5 +3313,5 @@
 
        IF ( passive_scalar )  THEN
-          CALL pmci_interp_tril_all ( s, sc, ico, jco, kco, r1xo, r2xo, r1yo,   &
+          CALL pmci_interp_tril_all ( s, sc, ico, jco, kco, r1xo, r2xo, r1yo,  &
                                       r2yo, r1zo, r2zo, 's' )
        ENDIF
@@ -3169,5 +3360,5 @@
 
 
-    SUBROUTINE pmci_interp_tril_all( f, fc, ic, jc, kc, r1x, r2x, r1y, r2y,     &
+    SUBROUTINE pmci_interp_tril_all( f, fc, ic, jc, kc, r1x, r2x, r1y, r2y,    &
                                      r1z, r2z, var )
 !
@@ -3177,43 +3368,43 @@
        IMPLICIT NONE
 
-       CHARACTER(LEN=1), INTENT(IN) :: var  !:
-
-       INTEGER(iwp), DIMENSION(nxlg:nxrg), INTENT(IN)           ::  ic    !:
-       INTEGER(iwp), DIMENSION(nysg:nyng), INTENT(IN)           ::  jc    !:
-       INTEGER(iwp), DIMENSION(nzb:nzt+1), INTENT(IN)           ::  kc    !:
-
-       INTEGER(iwp) ::  i        !:
-       INTEGER(iwp) ::  ib       !:
-       INTEGER(iwp) ::  ie       !:
-       INTEGER(iwp) ::  j        !:
-       INTEGER(iwp) ::  jb       !:
-       INTEGER(iwp) ::  je       !:
-       INTEGER(iwp) ::  k        !:
-       INTEGER(iwp) ::  k_wall   !:
-       INTEGER(iwp) ::  k1       !:
-       INTEGER(iwp) ::  kbc      !:
-       INTEGER(iwp) ::  l        !:
-       INTEGER(iwp) ::  m        !:
-       INTEGER(iwp) ::  n        !:
-
-       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(INOUT) :: f !:
-       REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr), INTENT(IN) :: fc       !:
-       REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN) :: r1x   !:
-       REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN) :: r2x   !:
-       REAL(wp), DIMENSION(nysg:nyng), INTENT(IN) :: r1y   !:
-       REAL(wp), DIMENSION(nysg:nyng), INTENT(IN) :: r2y   !:
-       REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN) :: r1z   !:
-       REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN) :: r2z   !:
-
-       REAL(wp) ::  fk         !:
-       REAL(wp) ::  fkj        !:
-       REAL(wp) ::  fkjp       !:
-       REAL(wp) ::  fkp        !:
-       REAL(wp) ::  fkpj       !:
-       REAL(wp) ::  fkpjp      !:
-       REAL(wp) ::  logratio   !:
-       REAL(wp) ::  logzuc1    !:
-       REAL(wp) ::  zuc1       !:
-       REAL(wp) ::  z0_topo    !:  roughness at vertical walls
+       CHARACTER(LEN=1), INTENT(IN) :: var  !<
+
+       INTEGER(iwp), DIMENSION(nxlg:nxrg), INTENT(IN)           ::  ic    !<
+       INTEGER(iwp), DIMENSION(nysg:nyng), INTENT(IN)           ::  jc    !<
+       INTEGER(iwp), DIMENSION(nzb:nzt+1), INTENT(IN)           ::  kc    !<
+
+       INTEGER(iwp) ::  i        !<
+       INTEGER(iwp) ::  ib       !<
+       INTEGER(iwp) ::  ie       !<
+       INTEGER(iwp) ::  j        !<
+       INTEGER(iwp) ::  jb       !<
+       INTEGER(iwp) ::  je       !<
+       INTEGER(iwp) ::  k        !<
+       INTEGER(iwp) ::  k_wall   !<
+       INTEGER(iwp) ::  k1       !<
+       INTEGER(iwp) ::  kbc      !<
+       INTEGER(iwp) ::  l        !<
+       INTEGER(iwp) ::  m        !<
+       INTEGER(iwp) ::  n        !<
+
+       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(INOUT) :: f !<
+       REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr), INTENT(IN) :: fc       !<
+       REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN) :: r1x   !<
+       REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN) :: r2x   !<
+       REAL(wp), DIMENSION(nysg:nyng), INTENT(IN) :: r1y   !<
+       REAL(wp), DIMENSION(nysg:nyng), INTENT(IN) :: r2y   !<
+       REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN) :: r1z   !<
+       REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN) :: r2z   !<
+
+       REAL(wp) ::  fk         !<
+       REAL(wp) ::  fkj        !<
+       REAL(wp) ::  fkjp       !<
+       REAL(wp) ::  fkp        !<
+       REAL(wp) ::  fkpj       !<
+       REAL(wp) ::  fkpjp      !<
+       REAL(wp) ::  logratio   !<
+       REAL(wp) ::  logzuc1    !<
+       REAL(wp) ::  zuc1       !<
+       REAL(wp) ::  z0_topo    !<  roughness at vertical walls
 
 
@@ -3292,5 +3483,5 @@
                 k = k_wall + 1
                 DO  WHILE ( zu(k) < zuc1 )
-                   logratio = ( LOG( ( zu(k) - zu(k_wall) ) / z0_topo ) ) /     &
+                   logratio = ( LOG( ( zu(k) - zu(k_wall) ) / z0_topo ) ) /    &
                                 logzuc1
                    f(k,j,i) = logratio * f(k1,j,i)
@@ -3331,5 +3522,5 @@
 #if defined( __parallel )
 
-    USE control_parameters,                                                     &
+    USE control_parameters,                                                    &
         ONLY:  dt_restart, end_time, message_string, restart_time, time_restart
 
@@ -3353,9 +3544,9 @@
     IF ( .NOT. pmc_is_rootmodel() )  THEN
        IF ( end_time /= end_time_root )  THEN
-          WRITE( message_string, * )  'mismatch between root model and ',       &
-               'child settings &   end_time(root) = ', end_time_root,           &
-               ' &   end_time(child) = ', end_time, ' & child value is set',    &
+          WRITE( message_string, * )  'mismatch between root model and ',      &
+               'child settings &   end_time(root) = ', end_time_root,          &
+               ' &   end_time(child) = ', end_time, ' & child value is set',   &
                ' to root value'
-          CALL message( 'pmci_check_setting_mismatches', 'PA0419', 0, 1, 0, 6,  &
+          CALL message( 'pmci_check_setting_mismatches', 'PA0419', 0, 1, 0, 6, &
                         0 )
           end_time = end_time_root
@@ -3369,9 +3560,9 @@
     IF ( .NOT. pmc_is_rootmodel() )  THEN
        IF ( restart_time /= restart_time_root )  THEN
-          WRITE( message_string, * )  'mismatch between root model and ',       &
-               'child settings &   restart_time(root) = ', restart_time_root,   &
-               ' &   restart_time(child) = ', restart_time, ' & child ',        &
+          WRITE( message_string, * )  'mismatch between root model and ',      &
+               'child settings &   restart_time(root) = ', restart_time_root,  &
+               ' &   restart_time(child) = ', restart_time, ' & child ',       &
                'value is set to root value'
-          CALL message( 'pmci_check_setting_mismatches', 'PA0419', 0, 1, 0, 6,  &
+          CALL message( 'pmci_check_setting_mismatches', 'PA0419', 0, 1, 0, 6, &
                         0 )
           restart_time = restart_time_root
@@ -3385,9 +3576,9 @@
     IF ( .NOT. pmc_is_rootmodel() )  THEN
        IF ( dt_restart /= dt_restart_root )  THEN
-          WRITE( message_string, * )  'mismatch between root model and ',       &
-               'child settings &   dt_restart(root) = ', dt_restart_root,       &
-               ' &   dt_restart(child) = ', dt_restart, ' & child ',            &
+          WRITE( message_string, * )  'mismatch between root model and ',      &
+               'child settings &   dt_restart(root) = ', dt_restart_root,      &
+               ' &   dt_restart(child) = ', dt_restart, ' & child ',           &
                'value is set to root value'
-          CALL message( 'pmci_check_setting_mismatches', 'PA0419', 0, 1, 0, 6,  &
+          CALL message( 'pmci_check_setting_mismatches', 'PA0419', 0, 1, 0, 6, &
                         0 )
           dt_restart = dt_restart_root
@@ -3401,9 +3592,9 @@
     IF ( .NOT. pmc_is_rootmodel() )  THEN
        IF ( time_restart /= time_restart_root )  THEN
-          WRITE( message_string, * )  'mismatch between root model and ',       &
-               'child settings &   time_restart(root) = ', time_restart_root,   &
-               ' &   time_restart(child) = ', time_restart, ' & child ',        &
+          WRITE( message_string, * )  'mismatch between root model and ',      &
+               'child settings &   time_restart(root) = ', time_restart_root,  &
+               ' &   time_restart(child) = ', time_restart, ' & child ',       &
                'value is set to root value'
-          CALL message( 'pmci_check_setting_mismatches', 'PA0419', 0, 1, 0, 6,  &
+          CALL message( 'pmci_check_setting_mismatches', 'PA0419', 0, 1, 0, 6, &
                         0 )
           time_restart = time_restart_root
@@ -3424,13 +3615,13 @@
     IMPLICIT NONE
 
-    INTEGER(iwp) ::  i                           !:
-    INTEGER(iwp) ::  ierr                        !:
-    INTEGER(iwp) ::  j                           !:
-    INTEGER(iwp) ::  k                           !:
-
-    REAL(wp) ::  dxdy                            !:
-    REAL(wp) ::  innor                           !:
-    REAL(wp) ::  w_lt                            !:
-    REAL(wp), DIMENSION(1:3) ::  volume_flow_l   !:
+    INTEGER(iwp) ::  i                           !<
+    INTEGER(iwp) ::  ierr                        !<
+    INTEGER(iwp) ::  j                           !<
+    INTEGER(iwp) ::  k                           !<
+
+    REAL(wp) ::  dxdy                            !<
+    REAL(wp) ::  innor                           !<
+    REAL(wp) ::  w_lt                            !<
+    REAL(wp), DIMENSION(1:3) ::  volume_flow_l   !<
 
 !
@@ -3465,5 +3656,5 @@
 #if defined( __parallel )
     IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-    CALL MPI_ALLREDUCE( volume_flow_l(1), volume_flow(1), 1, MPI_REAL,          &
+    CALL MPI_ALLREDUCE( volume_flow_l(1), volume_flow(1), 1, MPI_REAL,         &
                         MPI_SUM, comm2d, ierr )
 #else
@@ -3502,5 +3693,5 @@
 #if defined( __parallel )
     IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-    CALL MPI_ALLREDUCE( volume_flow_l(2), volume_flow(2), 1, MPI_REAL,          &
+    CALL MPI_ALLREDUCE( volume_flow_l(2), volume_flow(2), 1, MPI_REAL,         &
                         MPI_SUM, comm2d, ierr )
 #else
@@ -3522,5 +3713,5 @@
 #if defined( __parallel )
     IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
-    CALL MPI_ALLREDUCE( volume_flow_l(3), volume_flow(3), 1, MPI_REAL,          &
+    CALL MPI_ALLREDUCE( volume_flow_l(3), volume_flow(3), 1, MPI_REAL,         &
                         MPI_SUM, comm2d, ierr )
 #else
@@ -3553,7 +3744,7 @@
    IMPLICIT NONE
 
-   INTEGER(iwp)           :: ierr  !:
-   REAL(wp), DIMENSION(1) :: dtl   !:
-   REAL(wp), DIMENSION(1) :: dtg   !:
+   INTEGER(iwp)           :: ierr  !<
+   REAL(wp), DIMENSION(1) :: dtl   !<
+   REAL(wp), DIMENSION(1) :: dtg   !<
 
    
@@ -3575,9 +3766,9 @@
     IMPLICIT NONE
 
-    INTEGER(iwp), INTENT(IN) ::  swaplevel  !: swaplevel (1 or 2) of PALM's
-                                            !: timestep
-
-    INTEGER(iwp)            ::  child_id    !:
-    INTEGER(iwp)            ::  m           !:
+    INTEGER(iwp), INTENT(IN) ::  swaplevel  !< swaplevel (1 or 2) of PALM's
+                                            !< timestep
+
+    INTEGER(iwp)            ::  child_id    !<
+    INTEGER(iwp)            ::  m           !<
 
 #if defined( __parallel )
@@ -3603,6 +3794,6 @@
     IMPLICIT NONE
 
-    INTEGER(iwp)           ::  ierr   !:
-    INTEGER(iwp)           ::  istat  !:
+    INTEGER(iwp)           ::  ierr   !<
+    INTEGER(iwp)           ::  istat  !<
 
     CHARACTER(LEN=*), INTENT(IN) ::  local_nesting_mode
@@ -3651,17 +3842,17 @@
     IMPLICIT NONE
 
-    INTEGER(iwp), INTENT(IN) ::  direction   !:
+    INTEGER(iwp), INTENT(IN) ::  direction   !<
 
 #if defined( __parallel )
-    INTEGER(iwp) ::  child_id    !:
-    INTEGER(iwp) ::  i           !:
-    INTEGER(iwp) ::  ierr        !:
-    INTEGER(iwp) ::  j           !:
-    INTEGER(iwp) ::  k           !:
-    INTEGER(iwp) ::  m           !:
-
-    REAL(wp)               ::  waittime    !:
-    REAL(wp), DIMENSION(1) ::  dtc         !:
-    REAL(wp), DIMENSION(1) ::  dtl         !:
+    INTEGER(iwp) ::  child_id    !<
+    INTEGER(iwp) ::  i           !<
+    INTEGER(iwp) ::  ierr        !<
+    INTEGER(iwp) ::  j           !<
+    INTEGER(iwp) ::  k           !<
+    INTEGER(iwp) ::  m           !<
+
+    REAL(wp)               ::  waittime    !<
+    REAL(wp), DIMENSION(1) ::  dtc         !<
+    REAL(wp), DIMENSION(1) ::  dtl         !<
 
 
@@ -3722,15 +3913,15 @@
     IMPLICIT NONE
 
-    INTEGER(iwp), INTENT(IN) ::  direction   !:
+    INTEGER(iwp), INTENT(IN) ::  direction   !<
 
 #if defined( __parallel )
-    INTEGER(iwp) ::  ierr        !:
-    INTEGER(iwp) ::  icl         !:
-    INTEGER(iwp) ::  icr         !:
-    INTEGER(iwp) ::  jcs         !:
-    INTEGER(iwp) ::  jcn         !:
+    INTEGER(iwp) ::  ierr        !<
+    INTEGER(iwp) ::  icl         !<
+    INTEGER(iwp) ::  icr         !<
+    INTEGER(iwp) ::  jcs         !<
+    INTEGER(iwp) ::  jcn         !<
     
-    REAL(wp), DIMENSION(1) ::  dtl         !:
-    REAL(wp), DIMENSION(1) ::  dts         !:
+    REAL(wp), DIMENSION(1) ::  dtl         !<
+    REAL(wp), DIMENSION(1) ::  dts         !<
 
 
@@ -3788,28 +3979,28 @@
 !--       Left border pe:
           IF ( nest_bound_l )  THEN
-             CALL pmci_interp_tril_lr( u,  uc,  icu, jco, kco, r1xu, r2xu,      &
-                                       r1yo, r2yo, r1zo, r2zo,                  &
-                                       logc_u_l, logc_ratio_u_l,                &
+             CALL pmci_interp_tril_lr( u,  uc,  icu, jco, kco, r1xu, r2xu,     &
+                                       r1yo, r2yo, r1zo, r2zo,                 &
+                                       logc_u_l, logc_ratio_u_l,               &
                                        nzt_topo_nestbc_l, 'l', 'u' )
 
-             CALL pmci_interp_tril_lr( v,  vc,  ico, jcv, kco, r1xo, r2xo,      &
-                                       r1yv, r2yv, r1zo, r2zo,                  &
-                                       logc_v_l, logc_ratio_v_l,                &
+             CALL pmci_interp_tril_lr( v,  vc,  ico, jcv, kco, r1xo, r2xo,     &
+                                       r1yv, r2yv, r1zo, r2zo,                 &
+                                       logc_v_l, logc_ratio_v_l,               &
                                        nzt_topo_nestbc_l, 'l', 'v' )
 
-             CALL pmci_interp_tril_lr( w,  wc,  ico, jco, kcw, r1xo, r2xo,      &
-                                       r1yo, r2yo, r1zw, r2zw,                  &
-                                       logc_w_l, logc_ratio_w_l,                &
+             CALL pmci_interp_tril_lr( w,  wc,  ico, jco, kcw, r1xo, r2xo,     &
+                                       r1yo, r2yo, r1zw, r2zw,                 &
+                                       logc_w_l, logc_ratio_w_l,               &
                                        nzt_topo_nestbc_l, 'l', 'w' )
 
-             CALL pmci_interp_tril_lr( e,  ec,  ico, jco, kco, r1xo, r2xo,      &
-                                       r1yo, r2yo, r1zo, r2zo,                  &
-                                       logc_u_l, logc_ratio_u_l,                &
+             CALL pmci_interp_tril_lr( e,  ec,  ico, jco, kco, r1xo, r2xo,     &
+                                       r1yo, r2yo, r1zo, r2zo,                 &
+                                       logc_u_l, logc_ratio_u_l,               &
                                        nzt_topo_nestbc_l, 'l', 'e' )
 
              IF ( .NOT. neutral )  THEN
-                CALL pmci_interp_tril_lr( pt, ptc, ico, jco, kco, r1xo, r2xo,   &
-                                          r1yo, r2yo, r1zo, r2zo,               &
-                                          logc_u_l, logc_ratio_u_l,             &
+                CALL pmci_interp_tril_lr( pt, ptc, ico, jco, kco, r1xo, r2xo,  &
+                                          r1yo, r2yo, r1zo, r2zo,              &
+                                          logc_u_l, logc_ratio_u_l,            &
                                           nzt_topo_nestbc_l, 'l', 's' )
              ENDIF
@@ -3817,7 +4008,7 @@
              IF ( humidity )  THEN
 
-                CALL pmci_interp_tril_lr( q, q_c, ico, jco, kco, r1xo, r2xo,    &
-                                          r1yo, r2yo, r1zo, r2zo,               &
-                                          logc_u_l, logc_ratio_u_l,             &
+                CALL pmci_interp_tril_lr( q, q_c, ico, jco, kco, r1xo, r2xo,   &
+                                          r1yo, r2yo, r1zo, r2zo,              &
+                                          logc_u_l, logc_ratio_u_l,            &
                                           nzt_topo_nestbc_l, 'l', 's' )
 
@@ -3853,7 +4044,7 @@
 
              IF ( passive_scalar )  THEN
-                CALL pmci_interp_tril_lr( s, sc, ico, jco, kco, r1xo, r2xo,     &
-                                          r1yo, r2yo, r1zo, r2zo,               &
-                                          logc_u_l, logc_ratio_u_l,             &
+                CALL pmci_interp_tril_lr( s, sc, ico, jco, kco, r1xo, r2xo,    &
+                                          r1yo, r2yo, r1zo, r2zo,              &
+                                          logc_u_l, logc_ratio_u_l,            &
                                           nzt_topo_nestbc_l, 'l', 's' )
              ENDIF
@@ -3916,29 +4107,29 @@
 !--       Right border pe
           IF ( nest_bound_r )  THEN
-             CALL pmci_interp_tril_lr( u,  uc,  icu, jco, kco, r1xu, r2xu,      &
-                                       r1yo, r2yo, r1zo, r2zo,                  &
-                                       logc_u_r, logc_ratio_u_r,                &
+             CALL pmci_interp_tril_lr( u,  uc,  icu, jco, kco, r1xu, r2xu,     &
+                                       r1yo, r2yo, r1zo, r2zo,                 &
+                                       logc_u_r, logc_ratio_u_r,               &
                                        nzt_topo_nestbc_r, 'r', 'u' )
 
-             CALL pmci_interp_tril_lr( v,  vc,  ico, jcv, kco, r1xo, r2xo,      &
-                                       r1yv, r2yv, r1zo, r2zo,                  &
-                                       logc_v_r, logc_ratio_v_r,                &
+             CALL pmci_interp_tril_lr( v,  vc,  ico, jcv, kco, r1xo, r2xo,     &
+                                       r1yv, r2yv, r1zo, r2zo,                 &
+                                       logc_v_r, logc_ratio_v_r,               &
                                        nzt_topo_nestbc_r, 'r', 'v' )
 
-             CALL pmci_interp_tril_lr( w,  wc,  ico, jco, kcw, r1xo, r2xo,      &
-                                       r1yo, r2yo, r1zw, r2zw,                  &
-                                       logc_w_r, logc_ratio_w_r,                &
+             CALL pmci_interp_tril_lr( w,  wc,  ico, jco, kcw, r1xo, r2xo,     &
+                                       r1yo, r2yo, r1zw, r2zw,                 &
+                                       logc_w_r, logc_ratio_w_r,               &
                                        nzt_topo_nestbc_r, 'r', 'w' )
 
-             CALL pmci_interp_tril_lr( e,  ec,  ico, jco, kco, r1xo, r2xo,      &
-                                       r1yo,r2yo, r1zo, r2zo,                   &
-                                       logc_u_r, logc_ratio_u_r,                &
+             CALL pmci_interp_tril_lr( e,  ec,  ico, jco, kco, r1xo, r2xo,     &
+                                       r1yo,r2yo, r1zo, r2zo,                  &
+                                       logc_u_r, logc_ratio_u_r,               &
                                        nzt_topo_nestbc_r, 'r', 'e' )
 
 
              IF ( .NOT. neutral )  THEN
-                CALL pmci_interp_tril_lr( pt, ptc, ico, jco, kco, r1xo, r2xo,   &
-                                          r1yo, r2yo, r1zo, r2zo,               &
-                                          logc_u_r, logc_ratio_u_r,             &
+                CALL pmci_interp_tril_lr( pt, ptc, ico, jco, kco, r1xo, r2xo,  &
+                                          r1yo, r2yo, r1zo, r2zo,              &
+                                          logc_u_r, logc_ratio_u_r,            &
                                           nzt_topo_nestbc_r, 'r', 's' )
 
@@ -3946,7 +4137,7 @@
 
              IF ( humidity )  THEN
-                CALL pmci_interp_tril_lr( q, q_c, ico, jco, kco, r1xo, r2xo,    &
-                                          r1yo, r2yo, r1zo, r2zo,               &
-                                          logc_u_r, logc_ratio_u_r,             &
+                CALL pmci_interp_tril_lr( q, q_c, ico, jco, kco, r1xo, r2xo,   &
+                                          r1yo, r2yo, r1zo, r2zo,              &
+                                          logc_u_r, logc_ratio_u_r,            &
                                           nzt_topo_nestbc_r, 'r', 's' )
 
@@ -4047,32 +4238,32 @@
 !--       South border pe
           IF ( nest_bound_s )  THEN
-             CALL pmci_interp_tril_sn( u,  uc,  icu, jco, kco, r1xu, r2xu,      &
-                                       r1yo, r2yo, r1zo, r2zo,                  &
-                                       logc_u_s, logc_ratio_u_s,                &
+             CALL pmci_interp_tril_sn( u,  uc,  icu, jco, kco, r1xu, r2xu,     &
+                                       r1yo, r2yo, r1zo, r2zo,                 &
+                                       logc_u_s, logc_ratio_u_s,               &
                                        nzt_topo_nestbc_s, 's', 'u' )
-             CALL pmci_interp_tril_sn( v,  vc,  ico, jcv, kco, r1xo, r2xo,      &
-                                       r1yv, r2yv, r1zo, r2zo,                  &
-                                       logc_v_s, logc_ratio_v_s,                &
+             CALL pmci_interp_tril_sn( v,  vc,  ico, jcv, kco, r1xo, r2xo,     &
+                                       r1yv, r2yv, r1zo, r2zo,                 &
+                                       logc_v_s, logc_ratio_v_s,               &
                                        nzt_topo_nestbc_s, 's', 'v' )
-             CALL pmci_interp_tril_sn( w,  wc,  ico, jco, kcw, r1xo, r2xo,      &
-                                       r1yo, r2yo, r1zw, r2zw,                  &
-                                       logc_w_s, logc_ratio_w_s,                &
+             CALL pmci_interp_tril_sn( w,  wc,  ico, jco, kcw, r1xo, r2xo,     &
+                                       r1yo, r2yo, r1zw, r2zw,                 &
+                                       logc_w_s, logc_ratio_w_s,               &
                                        nzt_topo_nestbc_s, 's','w' )
-             CALL pmci_interp_tril_sn( e,  ec,  ico, jco, kco, r1xo, r2xo,      &
-                                       r1yo, r2yo, r1zo, r2zo,                  &
-                                       logc_u_s, logc_ratio_u_s,                &
+             CALL pmci_interp_tril_sn( e,  ec,  ico, jco, kco, r1xo, r2xo,     &
+                                       r1yo, r2yo, r1zo, r2zo,                 &
+                                       logc_u_s, logc_ratio_u_s,               &
                                        nzt_topo_nestbc_s, 's', 'e' )
 
              IF ( .NOT. neutral )  THEN
-                CALL pmci_interp_tril_sn( pt, ptc, ico, jco, kco, r1xo, r2xo,   &
-                                          r1yo, r2yo, r1zo, r2zo,               &
-                                          logc_u_s, logc_ratio_u_s,             &
+                CALL pmci_interp_tril_sn( pt, ptc, ico, jco, kco, r1xo, r2xo,  &
+                                          r1yo, r2yo, r1zo, r2zo,              &
+                                          logc_u_s, logc_ratio_u_s,            &
                                           nzt_topo_nestbc_s, 's', 's' )
              ENDIF
 
              IF ( humidity )  THEN
-                CALL pmci_interp_tril_sn( q, q_c, ico, jco, kco, r1xo, r2xo,    &
-                                          r1yo,r2yo, r1zo, r2zo,                &
-                                          logc_u_s, logc_ratio_u_s,             &
+                CALL pmci_interp_tril_sn( q, q_c, ico, jco, kco, r1xo, r2xo,   &
+                                          r1yo,r2yo, r1zo, r2zo,               &
+                                          logc_u_s, logc_ratio_u_s,            &
                                           nzt_topo_nestbc_s, 's', 's' )
 
@@ -4112,7 +4303,7 @@
 
              IF ( passive_scalar )  THEN
-                CALL pmci_interp_tril_sn( s, sc, ico, jco, kco, r1xo, r2xo,     &
-                                          r1yo,r2yo, r1zo, r2zo,                &
-                                          logc_u_s, logc_ratio_u_s,             &
+                CALL pmci_interp_tril_sn( s, sc, ico, jco, kco, r1xo, r2xo,    &
+                                          r1yo,r2yo, r1zo, r2zo,               &
+                                          logc_u_s, logc_ratio_u_s,            &
                                           nzt_topo_nestbc_s, 's', 's' )
              ENDIF
@@ -4120,9 +4311,9 @@
              IF ( air_chemistry )  THEN
                 DO  n = 1, nspec
-                   CALL pmci_interp_tril_sn( chem_species(n)%conc,              &
-                                             chem_spec_c(:,:,:,n),              &
-                                             ico, jco, kco, r1xo, r2xo,         &
-                                             r1yo, r2yo, r1zo, r2zo,            &
-                                             logc_u_s, logc_ratio_u_s,          &
+                   CALL pmci_interp_tril_sn( chem_species(n)%conc,             &
+                                             chem_spec_c(:,:,:,n),             &
+                                             ico, jco, kco, r1xo, r2xo,        &
+                                             r1yo, r2yo, r1zo, r2zo,           &
+                                             logc_u_s, logc_ratio_u_s,         &
                                              nzt_topo_nestbc_s, 's', 's' )
                 ENDDO
@@ -4172,35 +4363,35 @@
 !--       North border pe
           IF ( nest_bound_n )  THEN
-             CALL pmci_interp_tril_sn( u,  uc,  icu, jco, kco, r1xu, r2xu,      &
-                                       r1yo, r2yo, r1zo, r2zo,                  &
-                                       logc_u_n, logc_ratio_u_n,                &
+             CALL pmci_interp_tril_sn( u,  uc,  icu, jco, kco, r1xu, r2xu,     &
+                                       r1yo, r2yo, r1zo, r2zo,                 &
+                                       logc_u_n, logc_ratio_u_n,               &
                                        nzt_topo_nestbc_n, 'n', 'u' )
 
-             CALL pmci_interp_tril_sn( v,  vc,  ico, jcv, kco, r1xo, r2xo,      &
-                                       r1yv, r2yv, r1zo, r2zo,                  &
-                                       logc_v_n, logc_ratio_v_n,                & 
+             CALL pmci_interp_tril_sn( v,  vc,  ico, jcv, kco, r1xo, r2xo,     &
+                                       r1yv, r2yv, r1zo, r2zo,                 &
+                                       logc_v_n, logc_ratio_v_n,               & 
                                        nzt_topo_nestbc_n, 'n', 'v' )
 
-             CALL pmci_interp_tril_sn( w,  wc,  ico, jco, kcw, r1xo, r2xo,      &
-                                       r1yo, r2yo, r1zw, r2zw,                  &
-                                       logc_w_n, logc_ratio_w_n,                &
+             CALL pmci_interp_tril_sn( w,  wc,  ico, jco, kcw, r1xo, r2xo,     &
+                                       r1yo, r2yo, r1zw, r2zw,                 &
+                                       logc_w_n, logc_ratio_w_n,               &
                                        nzt_topo_nestbc_n, 'n', 'w' )
 
-             CALL pmci_interp_tril_sn( e,  ec,  ico, jco, kco, r1xo, r2xo,      &
-                                       r1yo, r2yo, r1zo, r2zo,                  &
-                                       logc_u_n, logc_ratio_u_n,                &
+             CALL pmci_interp_tril_sn( e,  ec,  ico, jco, kco, r1xo, r2xo,     &
+                                       r1yo, r2yo, r1zo, r2zo,                 &
+                                       logc_u_n, logc_ratio_u_n,               &
                                        nzt_topo_nestbc_n, 'n', 'e' )
 
              IF ( .NOT. neutral )  THEN
-                CALL pmci_interp_tril_sn( pt, ptc, ico, jco, kco, r1xo, r2xo,   &
-                                          r1yo, r2yo, r1zo, r2zo,               &
-                                          logc_u_n, logc_ratio_u_n,             &
+                CALL pmci_interp_tril_sn( pt, ptc, ico, jco, kco, r1xo, r2xo,  &
+                                          r1yo, r2yo, r1zo, r2zo,              &
+                                          logc_u_n, logc_ratio_u_n,            &
                                           nzt_topo_nestbc_n, 'n', 's' )
              ENDIF
 
              IF ( humidity )  THEN
-                CALL pmci_interp_tril_sn( q, q_c, ico, jco, kco, r1xo, r2xo,    &
-                                          r1yo, r2yo, r1zo, r2zo,               &
-                                          logc_u_n, logc_ratio_u_n,             &
+                CALL pmci_interp_tril_sn( q, q_c, ico, jco, kco, r1xo, r2xo,   &
+                                          r1yo, r2yo, r1zo, r2zo,              &
+                                          logc_u_n, logc_ratio_u_n,            &
                                           nzt_topo_nestbc_n, 'n', 's' )
 
@@ -4240,7 +4431,7 @@
 
              IF ( passive_scalar )  THEN
-                CALL pmci_interp_tril_sn( s, sc, ico, jco, kco, r1xo, r2xo,     &
-                                          r1yo, r2yo, r1zo, r2zo,               &
-                                          logc_u_n, logc_ratio_u_n,             &
+                CALL pmci_interp_tril_sn( s, sc, ico, jco, kco, r1xo, r2xo,    &
+                                          r1yo, r2yo, r1zo, r2zo,              &
+                                          logc_u_n, logc_ratio_u_n,            &
                                           nzt_topo_nestbc_n, 'n', 's' )
              ENDIF
@@ -4479,56 +4670,56 @@
       IMPLICIT NONE
 
-      REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                       &
-                                      INTENT(INOUT) ::  f       !:
-      REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr),                           &
-                                      INTENT(IN)    ::  fc      !:
-      REAL(wp), DIMENSION(1:2,0:ncorr-1,nzb:nzt_topo_nestbc,nys:nyn),           &
-                                      INTENT(IN)    ::  logc_ratio   !:
-      REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN)    ::  r1x     !:
-      REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN)    ::  r2x     !:
-      REAL(wp), DIMENSION(nysg:nyng), INTENT(IN)    ::  r1y     !:
-      REAL(wp), DIMENSION(nysg:nyng), INTENT(IN)    ::  r2y     !:
-      REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN)    ::  r1z     !:
-      REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN)    ::  r2z     !:
+      REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                      &
+                                      INTENT(INOUT) ::  f       !<
+      REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr),                          &
+                                      INTENT(IN)    ::  fc      !<
+      REAL(wp), DIMENSION(1:2,0:ncorr-1,nzb:nzt_topo_nestbc,nys:nyn),          &
+                                      INTENT(IN)    ::  logc_ratio   !<
+      REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN)    ::  r1x     !<
+      REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN)    ::  r2x     !<
+      REAL(wp), DIMENSION(nysg:nyng), INTENT(IN)    ::  r1y     !<
+      REAL(wp), DIMENSION(nysg:nyng), INTENT(IN)    ::  r2y     !<
+      REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN)    ::  r1z     !<
+      REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN)    ::  r2z     !<
       
-      INTEGER(iwp), DIMENSION(nxlg:nxrg), INTENT(IN)           ::  ic     !:
-      INTEGER(iwp), DIMENSION(nysg:nyng), INTENT(IN)           ::  jc     !:
-      INTEGER(iwp), DIMENSION(nzb:nzt+1), INTENT(IN)           ::  kc     !:
-      INTEGER(iwp), DIMENSION(1:2,nzb:nzt_topo_nestbc,nys:nyn),                 &
-                                          INTENT(IN)           ::  logc   !:
-      INTEGER(iwp) ::  nzt_topo_nestbc   !:
-
-      CHARACTER(LEN=1), INTENT(IN) ::  edge   !:
-      CHARACTER(LEN=1), INTENT(IN) ::  var    !:
-
-      INTEGER(iwp) ::  i        !:
-      INTEGER(iwp) ::  ib       !:
-      INTEGER(iwp) ::  ibgp     !:
-      INTEGER(iwp) ::  iw       !:
-      INTEGER(iwp) ::  j        !:
-      INTEGER(iwp) ::  jco      !:
-      INTEGER(iwp) ::  jcorr    !:
-      INTEGER(iwp) ::  jinc     !:
-      INTEGER(iwp) ::  jw       !:
-      INTEGER(iwp) ::  j1       !:
-      INTEGER(iwp) ::  k        !:
-      INTEGER(iwp) ::  k_wall   !: vertical index of topography top
-      INTEGER(iwp) ::  kco      !:
-      INTEGER(iwp) ::  kcorr    !:
-      INTEGER(iwp) ::  k1       !:
-      INTEGER(iwp) ::  l        !:
-      INTEGER(iwp) ::  m        !:
-      INTEGER(iwp) ::  n        !:
-      INTEGER(iwp) ::  kbc      !:
+      INTEGER(iwp), DIMENSION(nxlg:nxrg), INTENT(IN)           ::  ic     !<
+      INTEGER(iwp), DIMENSION(nysg:nyng), INTENT(IN)           ::  jc     !<
+      INTEGER(iwp), DIMENSION(nzb:nzt+1), INTENT(IN)           ::  kc     !<
+      INTEGER(iwp), DIMENSION(1:2,nzb:nzt_topo_nestbc,nys:nyn),                &
+                                          INTENT(IN)           ::  logc   !<
+      INTEGER(iwp) ::  nzt_topo_nestbc   !<
+
+      CHARACTER(LEN=1), INTENT(IN) ::  edge   !<
+      CHARACTER(LEN=1), INTENT(IN) ::  var    !<
+
+      INTEGER(iwp) ::  i        !<
+      INTEGER(iwp) ::  ib       !<
+      INTEGER(iwp) ::  ibgp     !<
+      INTEGER(iwp) ::  iw       !<
+      INTEGER(iwp) ::  j        !<
+      INTEGER(iwp) ::  jco      !<
+      INTEGER(iwp) ::  jcorr    !<
+      INTEGER(iwp) ::  jinc     !<
+      INTEGER(iwp) ::  jw       !<
+      INTEGER(iwp) ::  j1       !<
+      INTEGER(iwp) ::  k        !<
+      INTEGER(iwp) ::  k_wall   !< vertical index of topography top
+      INTEGER(iwp) ::  kco      !<
+      INTEGER(iwp) ::  kcorr    !<
+      INTEGER(iwp) ::  k1       !<
+      INTEGER(iwp) ::  l        !<
+      INTEGER(iwp) ::  m        !<
+      INTEGER(iwp) ::  n        !<
+      INTEGER(iwp) ::  kbc      !<
       
-      REAL(wp) ::  coarse_dx   !:
-      REAL(wp) ::  coarse_dy   !:
-      REAL(wp) ::  coarse_dz   !:
-      REAL(wp) ::  fkj         !:
-      REAL(wp) ::  fkjp        !:
-      REAL(wp) ::  fkpj        !:
-      REAL(wp) ::  fkpjp       !:
-      REAL(wp) ::  fk          !:
-      REAL(wp) ::  fkp         !:
+      REAL(wp) ::  coarse_dx   !<
+      REAL(wp) ::  coarse_dy   !<
+      REAL(wp) ::  coarse_dz   !<
+      REAL(wp) ::  fkj         !<
+      REAL(wp) ::  fkjp        !<
+      REAL(wp) ::  fkpj        !<
+      REAL(wp) ::  fkpjp       !<
+      REAL(wp) ::  fk          !<
+      REAL(wp) ::  fkp         !<
       
 ! 
@@ -4640,7 +4831,7 @@
                         DO  kcorr = 0, ncorr-1
                            kco = k + kcorr
-                           f(kco,jco,i) = 0.5_wp * ( logc_ratio(1,kcorr,k,j) *  &
-                                                     f(k1,j,i)                  &
-                                                   + logc_ratio(2,jcorr,k,j) *  &
+                           f(kco,jco,i) = 0.5_wp * ( logc_ratio(1,kcorr,k,j) * &
+                                                     f(k1,j,i)                 &
+                                                   + logc_ratio(2,jcorr,k,j) * &
                                                      f(k,j1,i) )
                         ENDDO
@@ -4695,5 +4886,5 @@
 
 
-   SUBROUTINE pmci_interp_tril_sn( f, fc, ic, jc, kc, r1x, r2x, r1y, r2y, r1z,  &
+   SUBROUTINE pmci_interp_tril_sn( f, fc, ic, jc, kc, r1x, r2x, r1y, r2y, r1z, &
                                    r2z, logc, logc_ratio,                   &
                                    nzt_topo_nestbc, edge, var )
@@ -4706,53 +4897,53 @@
       IMPLICIT NONE
 
-      REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                       &
-                                      INTENT(INOUT) ::  f             !:
-      REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr),                           &
-                                      INTENT(IN)    ::  fc            !:
-      REAL(wp), DIMENSION(1:2,0:ncorr-1,nzb:nzt_topo_nestbc,nxl:nxr),           &
-                                      INTENT(IN)    ::  logc_ratio    !:
-      REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN)    ::  r1x           !:
-      REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN)    ::  r2x           !:
-      REAL(wp), DIMENSION(nysg:nyng), INTENT(IN)    ::  r1y           !:
-      REAL(wp), DIMENSION(nysg:nyng), INTENT(IN)    ::  r2y           !:
-      REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN)    ::  r1z           !:
-      REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN)    ::  r2z           !:
+      REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                      &
+                                      INTENT(INOUT) ::  f             !<
+      REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr),                          &
+                                      INTENT(IN)    ::  fc            !<
+      REAL(wp), DIMENSION(1:2,0:ncorr-1,nzb:nzt_topo_nestbc,nxl:nxr),          &
+                                      INTENT(IN)    ::  logc_ratio    !<
+      REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN)    ::  r1x           !<
+      REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN)    ::  r2x           !<
+      REAL(wp), DIMENSION(nysg:nyng), INTENT(IN)    ::  r1y           !<
+      REAL(wp), DIMENSION(nysg:nyng), INTENT(IN)    ::  r2y           !<
+      REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN)    ::  r1z           !<
+      REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN)    ::  r2z           !<
       
-      INTEGER(iwp), DIMENSION(nxlg:nxrg), INTENT(IN)           ::  ic    !:
-      INTEGER(iwp), DIMENSION(nysg:nyng), INTENT(IN)           ::  jc    !:
-      INTEGER(iwp), DIMENSION(nzb:nzt+1), INTENT(IN)           ::  kc    !:
-      INTEGER(iwp), DIMENSION(1:2,nzb:nzt_topo_nestbc,nxl:nxr),                 &
-                                          INTENT(IN)           ::  logc  !:
-      INTEGER(iwp) ::  nzt_topo_nestbc   !:
-
-      CHARACTER(LEN=1), INTENT(IN) ::  edge   !:
-      CHARACTER(LEN=1), INTENT(IN) ::  var    !:
+      INTEGER(iwp), DIMENSION(nxlg:nxrg), INTENT(IN)           ::  ic    !<
+      INTEGER(iwp), DIMENSION(nysg:nyng), INTENT(IN)           ::  jc    !<
+      INTEGER(iwp), DIMENSION(nzb:nzt+1), INTENT(IN)           ::  kc    !<
+      INTEGER(iwp), DIMENSION(1:2,nzb:nzt_topo_nestbc,nxl:nxr),                &
+                                          INTENT(IN)           ::  logc  !<
+      INTEGER(iwp) ::  nzt_topo_nestbc   !<
+
+      CHARACTER(LEN=1), INTENT(IN) ::  edge   !<
+      CHARACTER(LEN=1), INTENT(IN) ::  var    !<
       
-      INTEGER(iwp) ::  i       !:
-      INTEGER(iwp) ::  iinc    !:
-      INTEGER(iwp) ::  icorr   !:
-      INTEGER(iwp) ::  ico     !:
-      INTEGER(iwp) ::  i1      !:
-      INTEGER(iwp) ::  j       !:
-      INTEGER(iwp) ::  jb      !:
-      INTEGER(iwp) ::  jbgp    !:
-      INTEGER(iwp) ::  k       !:
-      INTEGER(iwp) ::  k_wall   !: vertical index of topography top
-      INTEGER(iwp) ::  kcorr   !:
-      INTEGER(iwp) ::  kco     !:
-      INTEGER(iwp) ::  k1      !:
-      INTEGER(iwp) ::  l       !:
-      INTEGER(iwp) ::  m       !:
-      INTEGER(iwp) ::  n       !:
+      INTEGER(iwp) ::  i       !<
+      INTEGER(iwp) ::  iinc    !<
+      INTEGER(iwp) ::  icorr   !<
+      INTEGER(iwp) ::  ico     !<
+      INTEGER(iwp) ::  i1      !<
+      INTEGER(iwp) ::  j       !<
+      INTEGER(iwp) ::  jb      !<
+      INTEGER(iwp) ::  jbgp    !<
+      INTEGER(iwp) ::  k       !<
+      INTEGER(iwp) ::  k_wall   !< vertical index of topography top
+      INTEGER(iwp) ::  kcorr   !<
+      INTEGER(iwp) ::  kco     !<
+      INTEGER(iwp) ::  k1      !<
+      INTEGER(iwp) ::  l       !<
+      INTEGER(iwp) ::  m       !<
+      INTEGER(iwp) ::  n       !<
                             
-      REAL(wp) ::  coarse_dx   !:
-      REAL(wp) ::  coarse_dy   !:
-      REAL(wp) ::  coarse_dz   !:
-      REAL(wp) ::  fk          !:
-      REAL(wp) ::  fkj         !:
-      REAL(wp) ::  fkjp        !:
-      REAL(wp) ::  fkpj        !:
-      REAL(wp) ::  fkpjp       !:
-      REAL(wp) ::  fkp         !:
+      REAL(wp) ::  coarse_dx   !<
+      REAL(wp) ::  coarse_dy   !<
+      REAL(wp) ::  coarse_dz   !<
+      REAL(wp) ::  fk          !<
+      REAL(wp) ::  fkj         !<
+      REAL(wp) ::  fkjp        !<
+      REAL(wp) ::  fkpj        !<
+      REAL(wp) ::  fkpjp       !<
+      REAL(wp) ::  fkp         !<
       
 !
@@ -4865,7 +5056,7 @@
                         DO  kcorr = 0, ncorr-1
                            kco = k + kcorr
-                           f(kco,j,ico) = 0.5_wp * ( logc_ratio(1,kcorr,k,i) *  &
-                                                     f(k1,j,i)                  &
-                                                   + logc_ratio(2,icorr,k,i) *  &
+                           f(kco,j,ico) = 0.5_wp * ( logc_ratio(1,kcorr,k,i) * &
+                                                     f(k1,j,i)                 &
+                                                   + logc_ratio(2,icorr,k,i) * &
                                                      f(k,j,i1) )
                         ENDDO
@@ -4918,5 +5109,5 @@
  
 
-   SUBROUTINE pmci_interp_tril_t( f, fc, ic, jc, kc, r1x, r2x, r1y, r2y, r1z,   &
+   SUBROUTINE pmci_interp_tril_t( f, fc, ic, jc, kc, r1x, r2x, r1y, r2y, r1z,  &
                                   r2z, var )
 
@@ -4928,41 +5119,41 @@
       IMPLICIT NONE
 
-      REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                       &
-                                      INTENT(INOUT) ::  f     !:
-      REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr),                           &
-                                      INTENT(IN)    ::  fc    !:
-      REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN)    ::  r1x   !:
-      REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN)    ::  r2x   !:
-      REAL(wp), DIMENSION(nysg:nyng), INTENT(IN)    ::  r1y   !:
-      REAL(wp), DIMENSION(nysg:nyng), INTENT(IN)    ::  r2y   !:
-      REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN)    ::  r1z   !:
-      REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN)    ::  r2z   !:
+      REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                      &
+                                      INTENT(INOUT) ::  f     !<
+      REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr),                          &
+                                      INTENT(IN)    ::  fc    !<
+      REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN)    ::  r1x   !<
+      REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN)    ::  r2x   !<
+      REAL(wp), DIMENSION(nysg:nyng), INTENT(IN)    ::  r1y   !<
+      REAL(wp), DIMENSION(nysg:nyng), INTENT(IN)    ::  r2y   !<
+      REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN)    ::  r1z   !<
+      REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN)    ::  r2z   !<
       
-      INTEGER(iwp), DIMENSION(nxlg:nxrg), INTENT(IN) ::  ic    !:
-      INTEGER(iwp), DIMENSION(nysg:nyng), INTENT(IN) ::  jc    !:
-      INTEGER(iwp), DIMENSION(nzb:nzt+1), INTENT(IN) ::  kc    !:
+      INTEGER(iwp), DIMENSION(nxlg:nxrg), INTENT(IN) ::  ic    !<
+      INTEGER(iwp), DIMENSION(nysg:nyng), INTENT(IN) ::  jc    !<
+      INTEGER(iwp), DIMENSION(nzb:nzt+1), INTENT(IN) ::  kc    !<
       
-      CHARACTER(LEN=1), INTENT(IN) :: var   !:
-
-      INTEGER(iwp) ::  i   !:
-      INTEGER(iwp) ::  ib  !:
-      INTEGER(iwp) ::  ie  !:
-      INTEGER(iwp) ::  j   !:
-      INTEGER(iwp) ::  jb   !:
-      INTEGER(iwp) ::  je   !:      
-      INTEGER(iwp) ::  k   !:
-      INTEGER(iwp) ::  l   !:
-      INTEGER(iwp) ::  m   !:
-      INTEGER(iwp) ::  n   !:
+      CHARACTER(LEN=1), INTENT(IN) :: var   !<
+
+      INTEGER(iwp) ::  i   !<
+      INTEGER(iwp) ::  ib  !<
+      INTEGER(iwp) ::  ie  !<
+      INTEGER(iwp) ::  j   !<
+      INTEGER(iwp) ::  jb   !<
+      INTEGER(iwp) ::  je   !<      
+      INTEGER(iwp) ::  k   !<
+      INTEGER(iwp) ::  l   !<
+      INTEGER(iwp) ::  m   !<
+      INTEGER(iwp) ::  n   !<
       
-      REAL(wp) ::  coarse_dx   !:
-      REAL(wp) ::  coarse_dy   !:
-      REAL(wp) ::  coarse_dz   !:
-      REAL(wp) ::  fk          !:
-      REAL(wp) ::  fkj         !:
-      REAL(wp) ::  fkjp        !:
-      REAL(wp) ::  fkpj        !:
-      REAL(wp) ::  fkpjp       !:
-      REAL(wp) ::  fkp         !:
+      REAL(wp) ::  coarse_dx   !<
+      REAL(wp) ::  coarse_dy   !<
+      REAL(wp) ::  coarse_dz   !<
+      REAL(wp) ::  fk          !<
+      REAL(wp) ::  fkj         !<
+      REAL(wp) ::  fkjp        !<
+      REAL(wp) ::  fkpj        !<
+      REAL(wp) ::  fkpjp       !<
+      REAL(wp) ::  fkp         !<
 
       
@@ -5036,19 +5227,19 @@
        IMPLICIT NONE
 
-       CHARACTER(LEN=1), INTENT(IN) ::  edge   !:
-       CHARACTER(LEN=1), INTENT(IN) ::  var    !:
-
-       INTEGER(iwp) ::  i       !:
-       INTEGER(iwp) ::  ib      !:
-       INTEGER(iwp) ::  ibgp    !:
-       INTEGER(iwp) ::  ied     !:
-       INTEGER(iwp) ::  j       !:
-       INTEGER(iwp) ::  k       !:
-       INTEGER(iwp) ::  k_wall  !:
-
-       REAL(wp) ::  outnor    !:
-       REAL(wp) ::  vdotnor   !:
-
-       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(INOUT) :: f !:
+       CHARACTER(LEN=1), INTENT(IN) ::  edge   !<
+       CHARACTER(LEN=1), INTENT(IN) ::  var    !<
+
+       INTEGER(iwp) ::  i       !<
+       INTEGER(iwp) ::  ib      !<
+       INTEGER(iwp) ::  ibgp    !<
+       INTEGER(iwp) ::  ied     !<
+       INTEGER(iwp) ::  j       !<
+       INTEGER(iwp) ::  k       !<
+       INTEGER(iwp) ::  k_wall  !<
+
+       REAL(wp) ::  outnor    !<
+       REAL(wp) ::  vdotnor   !<
+
+       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(INOUT) :: f !<
 !
 !--    Check which edge is to be handled: left or right
@@ -5114,19 +5305,19 @@
        IMPLICIT NONE
 
-       CHARACTER(LEN=1), INTENT(IN) ::  edge   !:
-       CHARACTER(LEN=1), INTENT(IN) ::  var    !:
+       CHARACTER(LEN=1), INTENT(IN) ::  edge   !<
+       CHARACTER(LEN=1), INTENT(IN) ::  var    !<
       
-       INTEGER(iwp) ::  i         !:
-       INTEGER(iwp) ::  j         !:
-       INTEGER(iwp) ::  jb        !:
-       INTEGER(iwp) ::  jbgp      !:
-       INTEGER(iwp) ::  jed       !:
-       INTEGER(iwp) ::  k         !:
-       INTEGER(iwp) ::  k_wall    !:
-
-       REAL(wp)     ::  outnor    !:
-       REAL(wp)     ::  vdotnor   !:
-
-       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(INOUT) :: f !:
+       INTEGER(iwp) ::  i         !<
+       INTEGER(iwp) ::  j         !<
+       INTEGER(iwp) ::  jb        !<
+       INTEGER(iwp) ::  jbgp      !<
+       INTEGER(iwp) ::  jed       !<
+       INTEGER(iwp) ::  k         !<
+       INTEGER(iwp) ::  k_wall    !<
+
+       REAL(wp)     ::  outnor    !<
+       REAL(wp)     ::  vdotnor   !<
+
+       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(INOUT) :: f !<
 
 !
@@ -5191,15 +5382,15 @@
        IMPLICIT NONE
 
-       CHARACTER(LEN=1), INTENT(IN) ::  var   !:
+       CHARACTER(LEN=1), INTENT(IN) ::  var   !<
       
-       INTEGER(iwp) ::  i     !:
-       INTEGER(iwp) ::  j     !:
-       INTEGER(iwp) ::  k     !:
-       INTEGER(iwp) ::  ked   !:
-
-       REAL(wp) ::  vdotnor   !:
-
-       REAL(wp), DIMENSION(nzb:nzt+1,nys-nbgp:nyn+nbgp,nxl-nbgp:nxr+nbgp),      &
-                 INTENT(INOUT) ::  f   !:
+       INTEGER(iwp) ::  i     !<
+       INTEGER(iwp) ::  j     !<
+       INTEGER(iwp) ::  k     !<
+       INTEGER(iwp) ::  ked   !<
+
+       REAL(wp) ::  vdotnor   !<
+
+       REAL(wp), DIMENSION(nzb:nzt+1,nys-nbgp:nyn+nbgp,nxl-nbgp:nxr+nbgp),     &
+                 INTENT(INOUT) ::  f   !<
      
 
@@ -5232,5 +5423,5 @@
 
 
-    SUBROUTINE pmci_anterp_tophat( f, fc, kct, ifl, ifu, jfl, jfu, kfl, kfu,    &
+    SUBROUTINE pmci_anterp_tophat( f, fc, kct, ifl, ifu, jfl, jfu, kfl, kfu,   &
                                    ijfc, kfc, var )
 !
@@ -5351,5 +5542,5 @@
 !--             Spatial under-relaxation.
                 fra  = frax(ii) * fray(jj) * fraz(kk)
-                fc(kk,jj,ii) = ( 1.0_wp - fra ) * fc(kk,jj,ii) +                &
+                fc(kk,jj,ii) = ( 1.0_wp - fra ) * fc(kk,jj,ii) +               &
                                fra * cellsum / REAL( nfc, KIND = wp )
 
Index: palm/trunk/SOURCE/pmc_parent_mod.f90
===================================================================
--- palm/trunk/SOURCE/pmc_parent_mod.f90	(revision 2798)
+++ palm/trunk/SOURCE/pmc_parent_mod.f90	(revision 2801)
@@ -26,4 +26,7 @@
 ! -----------------
 ! $Id$
+! Introduce particle transfer in nested models.
+! 
+! 2718 2018-01-02 08:49:38Z maronga
 ! Corrected "Former revisions" section
 ! 
@@ -88,5 +91,5 @@
 !
 ! Parent part of Palm Model Coupler
-!-------------------------------------------------------------------------------!
+!------------------------------------------------------------------------------!
 
 #if defined( __parallel )
@@ -99,13 +102,13 @@
 #endif
     USE kinds
-    USE pmc_general,                                                            &
-        ONLY: arraydef, childdef, da_namedef, da_namelen, pedef,                &
+    USE pmc_general,                                                           &
+        ONLY: arraydef, childdef, da_namedef, da_namelen, pedef,               &
               pmc_g_setname, pmc_max_array, pmc_max_models, pmc_sort
 
-    USE pmc_handle_communicator,                                                &
-        ONLY: m_model_comm,m_model_rank,m_model_npes, m_to_child_comm,          &
+    USE pmc_handle_communicator,                                               &
+        ONLY: m_model_comm,m_model_rank,m_model_npes, m_to_child_comm,         &
               m_world_rank, pmc_parent_for_child
 
-    USE pmc_mpi_wrapper,                                                        &
+    USE pmc_mpi_wrapper,                                                       &
         ONLY: pmc_alloc_mem, pmc_bcast, pmc_time
 
@@ -120,6 +123,6 @@
    END TYPE childindexdef
 
-   TYPE(childdef), DIMENSION(pmc_max_models)       ::  children     !<
-   TYPE(childindexdef), DIMENSION(pmc_max_models)  ::  indchildren  !<
+   TYPE(childdef), DIMENSION(pmc_max_models),PUBLIC   ::  children     !<
+   TYPE(childindexdef), DIMENSION(pmc_max_models)     ::  indchildren  !<
 
    INTEGER ::  next_array_in_list = 0  !<
@@ -148,4 +151,5 @@
         MODULE PROCEDURE pmc_s_set_dataarray_2d
         MODULE PROCEDURE pmc_s_set_dataarray_3d
+        MODULE PROCEDURE pmc_s_set_dataarray_ip2d
     END INTERFACE pmc_s_set_dataarray
 
@@ -166,8 +170,13 @@
     END INTERFACE pmc_s_set_active_data_array
 
-    PUBLIC pmc_parentinit, pmc_s_clear_next_array_list, pmc_s_fillbuffer,       &
-           pmc_s_getdata_from_buffer, pmc_s_getnextarray,                       &
-           pmc_s_setind_and_allocmem, pmc_s_set_active_data_array,              &
-           pmc_s_set_dataarray, pmc_s_set_2d_index_list
+    INTERFACE pmc_s_get_child_npes
+        MODULE PROCEDURE pmc_s_get_child_npes
+    END INTERFACE pmc_s_get_child_npes
+
+    PUBLIC pmc_parentinit, pmc_s_clear_next_array_list, pmc_s_fillbuffer,      &
+           pmc_s_getdata_from_buffer, pmc_s_getnextarray,                      &
+           pmc_s_setind_and_allocmem, pmc_s_set_active_data_array,             &
+           pmc_s_set_dataarray, pmc_s_set_2d_index_list,                       &
+           pmc_s_get_child_npes
 
  CONTAINS
@@ -178,8 +187,8 @@
     IMPLICIT NONE
 
-    INTEGER ::  childid   !<
-    INTEGER ::  i         !<
-    INTEGER ::  j         !<
-    INTEGER ::  istat     !<
+    INTEGER(iwp) ::  childid   !<
+    INTEGER(iwp) ::  i         !<
+    INTEGER(iwp) ::  j         !<
+    INTEGER(iwp) ::  istat     !<
 
 
@@ -193,16 +202,16 @@
 !
 !--    Get rank and size
-       CALL MPI_COMM_RANK( children(childid)%model_comm,                        &
+       CALL MPI_COMM_RANK( children(childid)%model_comm,                       &
                            children(childid)%model_rank, istat )
-       CALL MPI_COMM_SIZE( children(childid)%model_comm,                        &
+       CALL MPI_COMM_SIZE( children(childid)%model_comm,                       &
                            children(childid)%model_npes, istat )
-       CALL MPI_COMM_REMOTE_SIZE( children(childid)%inter_comm,                 &
+       CALL MPI_COMM_REMOTE_SIZE( children(childid)%inter_comm,                &
                                   children(childid)%inter_npes, istat )
 
 !
 !--    Intra communicator is used for MPI_GET
-       CALL MPI_INTERCOMM_MERGE( children(childid)%inter_comm, .FALSE.,         &
+       CALL MPI_INTERCOMM_MERGE( children(childid)%inter_comm, .FALSE.,        &
                                  children(childid)%intra_comm, istat )
-       CALL MPI_COMM_RANK( children(childid)%intra_comm,                        &
+       CALL MPI_COMM_RANK( children(childid)%intra_comm,                       &
                            children(childid)%intra_rank, istat )
 
@@ -228,14 +237,14 @@
      IMPLICIT NONE
 
-     INTEGER, INTENT(IN)                    :: childid     !<
-     INTEGER, DIMENSION(:,:), INTENT(INOUT) :: index_list  !<
-
-     INTEGER ::  ian    !<
-     INTEGER ::  ic     !<
-     INTEGER ::  ie     !<
-     INTEGER ::  ip     !<
-     INTEGER ::  is     !<
-     INTEGER ::  istat  !<
-     INTEGER ::  n      !<
+     INTEGER(iwp), INTENT(IN)                    :: childid     !<
+     INTEGER(iwp), DIMENSION(:,:), INTENT(INOUT) :: index_list  !<
+
+     INTEGER(iwp) ::  ian    !<
+     INTEGER(iwp) ::  ic     !<
+     INTEGER(iwp) ::  ie     !<
+     INTEGER(iwp) ::  ip     !<
+     INTEGER(iwp) ::  is     !<
+     INTEGER(iwp) ::  istat  !<
+     INTEGER(iwp) ::  n,i    !<
 
 
@@ -268,12 +277,12 @@
               IF ( ian > 0)  THEN
                   ALLOCATE( indchildren(childid)%index_list_2d(6,ian) )
-                  indchildren(childid)%index_list_2d(:,1:ian) =                 &
+                  indchildren(childid)%index_list_2d(:,1:ian) =                &
                                                              index_list(:,is:ie)
               ENDIF
            ELSE
-              CALL MPI_SEND( ian, 1, MPI_INTEGER, ip, 1000, m_model_comm,       &
+              CALL MPI_SEND( ian, 1, MPI_INTEGER, ip, 1000, m_model_comm,      &
                              istat )
               IF ( ian > 0)  THEN
-                  CALL MPI_SEND( index_list(1,is), 6*ian, MPI_INTEGER, ip,      &
+                  CALL MPI_SEND( index_list(1,is), 6*ian, MPI_INTEGER, ip,     &
                                  1001, m_model_comm, istat )
               ENDIF
@@ -282,16 +291,16 @@
         ENDDO
      ELSE
-        CALL MPI_RECV( indchildren(childid)%nrpoints, 1, MPI_INTEGER, 0, 1000,  &
+        CALL MPI_RECV( indchildren(childid)%nrpoints, 1, MPI_INTEGER, 0, 1000, &
                        m_model_comm, MPI_STATUS_IGNORE, istat )
         ian = indchildren(childid)%nrpoints
         IF ( ian > 0 )  THEN
            ALLOCATE( indchildren(childid)%index_list_2d(6,ian) )
-           CALL MPI_RECV( indchildren(childid)%index_list_2d, 6*ian,            &
-                          MPI_INTEGER, 0, 1001, m_model_comm,                   &
+           CALL MPI_RECV( indchildren(childid)%index_list_2d, 6*ian,           &
+                          MPI_INTEGER, 0, 1001, m_model_comm,                  &
                           MPI_STATUS_IGNORE, istat)
         ENDIF
      ENDIF
-     CALL set_pe_index_list( childid, children(childid),                        &
-                             indchildren(childid)%index_list_2d,                &
+     CALL set_pe_index_list( childid, children(childid),                       &
+                             indchildren(childid)%index_list_2d,               &
                              indchildren(childid)%nrpoints )
 
@@ -313,7 +322,6 @@
 
 !
-!-- List handling is still required to get minimal interaction with
-!-- pmc_interface
-!-- TODO: what does "still" mean? Is there a chance to change this!
+!-- Althoug there are no linked lists any more in PMC, this call still looks like working with a list
+
     CHARACTER(LEN=*), INTENT(OUT) ::  myname    !<
     INTEGER(iwp), INTENT(IN)      ::  childid   !<
@@ -338,6 +346,6 @@
     myname = ar%name
 !
-!-- Return true if legal array
-!-- TODO: what does this comment mean? Can there be non-legal arrays??
+!-- Return true if there is still an array in the list
+
     pmc_s_getnextarray = .TRUE.
 
@@ -350,11 +358,11 @@
     IMPLICIT NONE
 
-    INTEGER,INTENT(IN) ::  childid   !<
+    INTEGER(iwp), INTENT(IN) ::  childid   !<
 
     REAL(wp), INTENT(IN), DIMENSION(:,:), POINTER           ::  array    !<
     REAL(wp), INTENT(IN), DIMENSION(:,:), POINTER, OPTIONAL ::  array_2  !<
 
-    INTEGER               ::  nrdims      !<
-    INTEGER, DIMENSION(4) ::  dims        !<
+    INTEGER(iwp)               ::  nrdims      !<
+    INTEGER(iwp), DIMENSION(4) ::  dims        !<
     TYPE(C_PTR)           ::  array_adr   !<
     TYPE(C_PTR)           ::  second_adr  !<
@@ -369,5 +377,5 @@
     IF ( PRESENT( array_2 ) )  THEN
        second_adr = C_LOC(array_2)
-       CALL pmc_s_setarray( childid, nrdims, dims, array_adr,                   &
+       CALL pmc_s_setarray( childid, nrdims, dims, array_adr,                  &
                             second_adr = second_adr)
     ELSE
@@ -377,4 +385,26 @@
  END SUBROUTINE pmc_s_set_dataarray_2d
 
+ SUBROUTINE pmc_s_set_dataarray_ip2d( childid, array )
+
+    IMPLICIT NONE
+
+    INTEGER(iwp),INTENT(IN) ::  childid   !<
+
+    INTEGER(idp), INTENT(IN), DIMENSION(:,:), POINTER           ::  array    !<
+
+    INTEGER(iwp)               ::  nrdims      !<
+    INTEGER(iwp), DIMENSION(4) ::  dims        !<
+    TYPE(C_PTR)           ::  array_adr   !<
+
+
+    dims      = 1
+    nrdims    = 2
+    dims(1)   = SIZE( array,1 )
+    dims(2)   = SIZE( array,2 )
+    array_adr = C_LOC( array )
+
+    CALL pmc_s_setarray( childid, nrdims, dims, array_adr , dimkey=22)
+
+ END SUBROUTINE pmc_s_set_dataarray_ip2d
 
 
@@ -383,20 +413,16 @@
     IMPLICIT NONE
 
-    INTEGER, INTENT(IN) ::  childid   !<
-    INTEGER, INTENT(IN) ::  nz        !<
-    INTEGER, INTENT(IN) ::  nz_cl     !<
+    INTEGER(iwp), INTENT(IN) ::  childid   !<
+    INTEGER(iwp), INTENT(IN) ::  nz        !<
+    INTEGER(iwp), INTENT(IN) ::  nz_cl     !<
 
     REAL(wp), INTENT(IN), DIMENSION(:,:,:), POINTER           ::  array    !<
     REAL(wp), INTENT(IN), DIMENSION(:,:,:), POINTER, OPTIONAL ::  array_2  !<
 
-    INTEGER               ::  nrdims      !<
-    INTEGER, DIMENSION(4) ::  dims        !<
+    INTEGER(iwp)               ::  nrdims      !<
+    INTEGER(iwp), DIMENSION(4) ::  dims        !<
     TYPE(C_PTR)           ::  array_adr   !<
     TYPE(C_PTR)           ::  second_adr  !<
 
-!
-!-- TODO: the next assignment seems to be obsolete. Please check!
-    dims      = 1
-    dims      = 0
     nrdims    = 3
     dims(1)   = SIZE( array,1 )
@@ -411,5 +437,5 @@
     IF ( PRESENT( array_2 ) )  THEN
       second_adr = C_LOC( array_2 )
-      CALL pmc_s_setarray( childid, nrdims, dims, array_adr,                    &
+      CALL pmc_s_setarray( childid, nrdims, dims, array_adr,                   &
                            second_adr = second_adr)
     ELSE
@@ -423,5 +449,5 @@
  SUBROUTINE pmc_s_setind_and_allocmem( childid )
 
-    USE control_parameters,                                                     &
+    USE control_parameters,                                                    &
         ONLY:  message_string
 
@@ -433,19 +459,19 @@
 !--                                     send -> parent to child transfer
 !--                                     recv -> child to parent transfer
-    INTEGER, INTENT(IN) ::  childid   !<
-
-    INTEGER                        ::  arlen    !<
-    INTEGER                        ::  i        !<
-    INTEGER                        ::  ierr     !<
-    INTEGER                        ::  istat    !<
-    INTEGER                        ::  j        !<
-    INTEGER                        ::  myindex  !<
-    INTEGER                        ::  rcount   !< count MPI requests
-    INTEGER                        ::  tag      !<
+    INTEGER(iwp), INTENT(IN) ::  childid   !<
+
+    INTEGER(iwp)                   ::  arlen    !<
+    INTEGER(iwp)                   ::  i        !<
+    INTEGER(iwp)                   ::  ierr     !<
+    INTEGER(iwp)                   ::  istat    !<
+    INTEGER(iwp)                   ::  j        !<
+    INTEGER(iwp)                   ::  myindex  !<
+    INTEGER(iwp)                   ::  rcount   !< count MPI requests
+    INTEGER(iwp)                   ::  tag      !<
 
     INTEGER(idp)                   ::  bufsize  !< size of MPI data window
     INTEGER(KIND=MPI_ADDRESS_KIND) ::  winsize  !<
 
-    INTEGER, DIMENSION(1024)       ::  req      !<
+    INTEGER(iwp), DIMENSION(1024)       ::  req      !<
 
     TYPE(C_PTR)             ::  base_ptr  !<
@@ -482,9 +508,9 @@
           tag    = tag + 1
           rcount = rcount + 1
-          CALL MPI_ISEND( myindex, 1, MPI_INTEGER, i-1, tag,                    &
+          CALL MPI_ISEND( myindex, 1, MPI_INTEGER, i-1, tag,                   &
                           children(childid)%inter_comm, req(rcount), ierr )
 !
-!--       Maximum of 1024 outstanding requests
-!--       TODO: what does this limit mean? Does outstanding mean pending?
+!--       Maximum of 1024 pending requests
+
           IF ( rcount == 1024 )  THEN
              CALL MPI_WAITALL( rcount, req, MPI_STATUSES_IGNORE, ierr )
@@ -515,6 +541,6 @@
 
     winsize = bufsize * wp
-    CALL MPI_WIN_CREATE( base_array_pc, winsize, wp, MPI_INFO_NULL,             &
-                         children(childid)%intra_comm,                          &
+    CALL MPI_WIN_CREATE( base_array_pc, winsize, wp, MPI_INFO_NULL,            &
+                         children(childid)%intra_comm,                         &
                          children(childid)%win_parent_child, ierr )
 !
@@ -533,7 +559,7 @@
 
           IF ( ar%sendindex + ar%sendsize > bufsize )  THEN             
-             WRITE( message_string, '(a,i4,4i7,1x,a)' )                         &
-                    'parent buffer too small ',i,                               &
-                    ar%sendindex,ar%sendsize,ar%sendindex+ar%sendsize,          &
+             WRITE( message_string, '(a,i4,4i7,1x,a)' )                        &
+                    'parent buffer too small ',i,                              &
+                    ar%sendindex,ar%sendsize,ar%sendindex+ar%sendsize,         &
                     bufsize,trim(ar%name)
              CALL message( 'pmc_s_setind_and_allocmem', 'PA0429', 3, 2, 0, 6, 0 )
@@ -554,5 +580,5 @@
 !--       Receive index from child
           tag = tag + 1
-          CALL MPI_RECV( myindex, 1, MPI_INTEGER, i-1, tag,                     &
+          CALL MPI_RECV( myindex, 1, MPI_INTEGER, i-1, tag,                    &
                          children(childid)%inter_comm, MPI_STATUS_IGNORE, ierr )
           IF ( ar%nrdims == 3 )  THEN
@@ -586,20 +612,24 @@
 
 
- SUBROUTINE pmc_s_fillbuffer( childid, waittime )
-
-    IMPLICIT NONE
-
-    INTEGER, INTENT(IN)             ::  childid   !<
+ SUBROUTINE pmc_s_fillbuffer( childid, waittime, particle_transfer )
+
+    IMPLICIT NONE
+
+    INTEGER(iwp), INTENT(IN)             ::  childid   !<
 
     REAL(wp), INTENT(OUT), OPTIONAL ::  waittime  !<
-
-    INTEGER               ::  ierr     !<
-    INTEGER               ::  ij       !<
-    INTEGER               ::  ip       !<
-    INTEGER               ::  istat    !<
-    INTEGER               ::  j        !<
-    INTEGER               ::  myindex  !<
-
-    INTEGER, DIMENSION(1) ::  buf_shape
+    LOGICAL, INTENT(IN), OPTIONAL   ::  particle_transfer  !<
+
+
+    INTEGER(iwp)               ::  ierr     !<
+    INTEGER(iwp)               ::  ij       !<
+    INTEGER(iwp)               ::  ip       !<
+    INTEGER(iwp)               ::  istat    !<
+    INTEGER(iwp)               ::  j        !<
+    INTEGER(iwp)               ::  myindex  !<
+    
+    LOGICAL                    ::  lo_ptrans
+
+    INTEGER(iwp), DIMENSION(1) ::  buf_shape
 
     REAL(wp)                            ::  t1       !<
@@ -608,4 +638,6 @@
     REAL(wp), POINTER, DIMENSION(:,:)   ::  data_2d  !<
     REAL(wp), POINTER, DIMENSION(:,:,:) ::  data_3d  !<
+    INTEGER(idp), POINTER, DIMENSION(:)     ::  ibuf      !<
+    INTEGER(idp), POINTER, DIMENSION(:,:)   ::  idata_2d  !<
 
     TYPE(pedef), POINTER    ::  ape  !<
@@ -625,4 +657,7 @@
     ENDIF
 
+    lo_ptrans = .FALSE.
+    IF ( PRESENT( particle_transfer))    lo_ptrans = particle_transfer
+
     DO  ip = 1, children(childid)%inter_npes
        ape => children(childid)%pes(ip)
@@ -630,5 +665,7 @@
           ar => ape%array_list(j)
           myindex = 1
-          IF ( ar%nrdims == 2 )  THEN
+
+          IF ( ar%dimkey == 2 .AND. .NOT.lo_ptrans  )  THEN                            ! PALM 2D REAL*8 Array
+
              buf_shape(1) = ape%nrele
              CALL C_F_POINTER( ar%sendbuf, buf, buf_shape )
@@ -638,5 +675,7 @@
                 myindex = myindex + 1
              ENDDO
-          ELSEIF ( ar%nrdims == 3 )  THEN
+
+          ELSEIF ( ar%dimkey == 3  .AND. .NOT.lo_ptrans  )  THEN                       ! PALM 3D REAL*8 Array
+
              buf_shape(1) = ape%nrele*ar%a_dim(4)
              CALL C_F_POINTER( ar%sendbuf, buf, buf_shape )
@@ -647,4 +686,13 @@
                 myindex = myindex + ar%a_dim(4)
              ENDDO
+          ELSEIF ( ar%dimkey == 22 .AND. lo_ptrans  )  THEN                           ! 2D INTEGER*8 Array for particle Transfer
+
+             buf_shape(1) = ape%nrele
+             CALL C_F_POINTER( ar%sendbuf, ibuf, buf_shape )
+             CALL C_F_POINTER( ar%data, idata_2d, ar%a_dim(1:2) )
+             DO  ij = 1, ape%nrele
+                ibuf(myindex) = idata_2d(ape%locind(ij)%j,ape%locind(ij)%i)
+                myindex = myindex + 1
+             ENDDO
           ENDIF
         ENDDO
@@ -658,46 +706,65 @@
 
 
- SUBROUTINE pmc_s_getdata_from_buffer( childid, waittime )
-
-    IMPLICIT NONE
-
-    INTEGER, INTENT(IN)             ::  childid      !<
+ SUBROUTINE pmc_s_getdata_from_buffer( childid, waittime , particle_transfer, child_process_nr )
+
+    IMPLICIT NONE
+
+    INTEGER(iwp), INTENT(IN)             ::  childid      !<
     REAL(wp), INTENT(OUT), OPTIONAL ::  waittime     !<
-
-    INTEGER                        ::  ierr          !<
-    INTEGER                        ::  ij            !<
-    INTEGER                        ::  ip            !<
-    INTEGER                        ::  istat         !<
-    INTEGER                        ::  j             !<
-    INTEGER                        ::  myindex       !<
-    INTEGER                        ::  nr            !<
-    INTEGER                        ::  target_pe     !<
+    LOGICAL, INTENT(IN), OPTIONAL   ::  particle_transfer     !<
+    INTEGER(iwp), INTENT(IN), OPTIONAL   ::  child_process_nr      !<
+
+    INTEGER(iwp)                        ::  ierr          !<
+    INTEGER(iwp)                   ::  ij            !<
+    INTEGER(iwp)                   ::  ip            !<
+    INTEGER(iwp)                   ::  ip_start      !<
+    INTEGER(iwp)                   ::  ip_end        !<
+    INTEGER(iwp)                   ::  istat         !<
+    INTEGER(iwp)                   ::  j             !<
+    INTEGER(iwp)                   ::  myindex       !<
+    INTEGER(iwp)                   ::  nr            !<
+    INTEGER(iwp)                   ::  target_pe     !<
     INTEGER(kind=MPI_ADDRESS_KIND) ::  target_disp   !<
-
-    INTEGER, DIMENSION(1)          ::  buf_shape     !<
-
-    REAL(wp)                            ::  t1       !<
-    REAL(wp)                            ::  t2       !<
-    REAL(wp), POINTER, DIMENSION(:)     ::  buf      !<
-    REAL(wp), POINTER, DIMENSION(:,:)   ::  data_2d  !<
-    REAL(wp), POINTER, DIMENSION(:,:,:) ::  data_3d  !<
-
-    TYPE(pedef), POINTER    ::  ape  !<
-    TYPE(arraydef), POINTER ::  ar   !<
+    
+    LOGICAL                        ::  lo_ptrans
+
+    INTEGER(iwp), DIMENSION(1)          ::  buf_shape     !<
+
+    REAL(wp)                                ::  t1       !<
+    REAL(wp)                                ::  t2       !<
+    REAL(wp), POINTER, DIMENSION(:)         ::  buf      !<
+    REAL(wp), POINTER, DIMENSION(:,:)       ::  data_2d  !<
+    REAL(wp), POINTER, DIMENSION(:,:,:)     ::  data_3d  !<
+    INTEGER(idp), POINTER, DIMENSION(:)     ::  ibuf      !<
+    INTEGER(idp), POINTER, DIMENSION(:,:)   ::  idata_2d  !<
+
+    TYPE(pedef), POINTER                    ::  ape  !<
+    TYPE(arraydef), POINTER                 ::  ar   !<
 
 
     t1 = pmc_time()
-!
-!-- Wait for child to fill buffer
-    CALL MPI_BARRIER( children(childid)%intra_comm, ierr )
-    t2 = pmc_time() - t1
-    IF ( PRESENT( waittime ) )  waittime = t2
-!
-!-- TODO: check next statement
-!-- Fence might do it, test later
-!-- CALL MPI_WIN_FENCE( 0, children(childid)%win_parent_child, ierr)
-    CALL MPI_BARRIER( children(childid)%intra_comm, ierr )
-
-    DO  ip = 1, children(childid)%inter_npes
+
+    IF(PRESENT(child_process_nr)) then
+       ip_start = child_process_nr
+       ip_end   = child_process_nr
+    ELSE
+       ip_start = 1
+       ip_end   = children(childid)%inter_npes
+    END IF
+
+    lo_ptrans = .FALSE.
+    IF ( PRESENT( particle_transfer))    lo_ptrans = particle_transfer
+
+    IF(ip_start == 1)   THEN
+!
+!--    Wait for child to fill buffer
+       CALL MPI_BARRIER( children(childid)%intra_comm, ierr )
+       t2 = pmc_time() - t1
+       IF ( PRESENT( waittime ) )  waittime = t2
+
+       CALL MPI_BARRIER( children(childid)%intra_comm, ierr )
+    ENDIF
+
+    DO  ip = ip_start,ip_end
        ape => children(childid)%pes(ip)
        DO  j = 1, ape%nr_arrays
@@ -706,11 +773,20 @@
           IF ( ar%recvindex < 0 )  CYCLE
 
-          IF ( ar%nrdims == 2 )  THEN
+          IF ( ar%dimkey == 2  .AND. .NOT.lo_ptrans  )  THEN
              nr = ape%nrele
-          ELSEIF ( ar%nrdims == 3 )  THEN
+          ELSEIF ( ar%dimkey == 3  .AND. .NOT.lo_ptrans  )  THEN
              nr = ape%nrele * ar%a_dim(4)
+          ELSE IF ( ar%dimkey == 22 .AND. lo_ptrans)  THEN
+             nr = ape%nrele
+          ELSE
+             CYCLE                                        !particle array are not transfered here
           ENDIF
           buf_shape(1) = nr
-          CALL C_F_POINTER( ar%recvbuf, buf, buf_shape )
+          IF(lo_ptrans)   THEN
+             CALL C_F_POINTER( ar%recvbuf, ibuf, buf_shape )
+          ELSE
+             CALL C_F_POINTER( ar%recvbuf, buf, buf_shape )
+          ENDIF
+
 !
 !--       MPI passive target RMA
@@ -720,13 +796,19 @@
 !--          Child processes are located behind parent process
              target_pe = ip - 1 + m_model_npes
-             CALL MPI_WIN_LOCK( MPI_LOCK_SHARED, target_pe, 0,                  &
+             CALL MPI_WIN_LOCK( MPI_LOCK_SHARED, target_pe, 0,                      &
                                 children(childid)%win_parent_child, ierr )
-             CALL MPI_GET( buf, nr, MPI_REAL, target_pe, target_disp, nr,       &
-                           MPI_REAL, children(childid)%win_parent_child, ierr )
-             CALL MPI_WIN_UNLOCK( target_pe,                                    &
+             IF(lo_ptrans)   THEN
+                CALL MPI_GET( ibuf, nr*8, MPI_BYTE, target_pe, target_disp, nr*8,    &              !There is no MPI_INTEGER8 datatype
+                              MPI_BYTE, children(childid)%win_parent_child, ierr )
+             ELSE
+                CALL MPI_GET( buf, nr, MPI_REAL, target_pe, target_disp, nr,        &
+                              MPI_REAL, children(childid)%win_parent_child, ierr )
+             ENDIF
+             CALL MPI_WIN_UNLOCK( target_pe,                                        &
                                   children(childid)%win_parent_child, ierr )
           ENDIF
           myindex = 1
-          IF ( ar%nrdims == 2 )  THEN
+          IF ( ar%dimkey == 2  .AND. .NOT.lo_ptrans  )  THEN
+
              CALL C_F_POINTER( ar%data, data_2d, ar%a_dim(1:2) )
              DO  ij = 1, ape%nrele
@@ -734,11 +816,22 @@
                 myindex = myindex + 1
              ENDDO
-          ELSEIF ( ar%nrdims == 3 )  THEN
+
+          ELSEIF ( ar%dimkey == 3  .AND. .NOT.lo_ptrans  )  THEN
+
              CALL C_F_POINTER( ar%data, data_3d, ar%a_dim(1:3))
              DO  ij = 1, ape%nrele
-                data_3d(1:ar%a_dim(4),ape%locind(ij)%j,ape%locind(ij)%i) =      &
+                data_3d(1:ar%a_dim(4),ape%locind(ij)%j,ape%locind(ij)%i) =     &
                                               buf(myindex:myindex+ar%a_dim(4)-1)
                 myindex = myindex + ar%a_dim(4)
              ENDDO
+
+          ELSE IF ( ar%dimkey == 22 .AND. lo_ptrans)  THEN
+
+             CALL C_F_POINTER( ar%data, idata_2d, ar%a_dim(1:2) )
+             DO  ij = 1, ape%nrele
+                idata_2d(ape%locind(ij)%j,ape%locind(ij)%i) = ibuf(myindex)
+                myindex = myindex + 1
+             ENDDO
+
           ENDIF
        ENDDO
@@ -755,5 +848,5 @@
     IMPLICIT NONE
 
-    INTEGER, INTENT(IN) ::  childid  !<
+    INTEGER(iwp), INTENT(IN) ::  childid  !<
 
     TYPE(da_namedef) ::  myname  !<
@@ -767,5 +860,5 @@
        CALL pmc_bcast( myname%nameonchild,  0, comm=m_to_child_comm(childid) )
 
-       CALL pmc_g_setname( children(childid), myname%couple_index,              &
+       CALL pmc_g_setname( children(childid), myname%couple_index,             &
                            myname%nameonparent )
    ENDDO
@@ -775,5 +868,5 @@
 
 
- SUBROUTINE pmc_s_setarray(childid, nrdims, dims, array_adr, second_adr )
+ SUBROUTINE pmc_s_setarray(childid, nrdims, dims, array_adr, second_adr, dimkey )
 
 !
@@ -781,12 +874,13 @@
     IMPLICIT NONE
 
-    INTEGER, INTENT(IN)               ::  childid    !<
-    INTEGER, INTENT(IN)               ::  nrdims     !<
-    INTEGER, INTENT(IN), DIMENSION(:) ::  dims       !<
-
-    TYPE(C_PTR), INTENT(IN)           :: array_adr   !<
-    TYPE(C_PTR), INTENT(IN), OPTIONAL :: second_adr  !<
-
-    INTEGER ::  i  !< local counter
+    INTEGER(iwp), INTENT(IN)               :: childid    !<
+    INTEGER(iwp), INTENT(IN)               :: nrdims     !<
+    INTEGER(iwp), INTENT(IN), DIMENSION(:) :: dims       !<
+
+    TYPE(C_PTR), INTENT(IN)           :: array_adr  !<
+    TYPE(C_PTR), INTENT(IN), OPTIONAL :: second_adr !<
+    INTEGER(iwp), INTENT(IN), OPTIONAL     :: dimkey     !<
+
+    INTEGER(iwp) ::  i  !< local counter
 
     TYPE(pedef), POINTER    ::  ape  !<
@@ -798,4 +892,6 @@
        ar  => ape%array_list(next_array_in_list)
        ar%nrdims = nrdims
+       ar%dimkey = nrdims
+       IF(PRESENT(dimkey)) ar%dimkey = dimkey
        ar%a_dim  = dims
        ar%data   = array_adr
@@ -817,10 +913,10 @@
     IMPLICIT NONE
 
-    INTEGER, INTENT(IN) ::  childid   !<
-    INTEGER, INTENT(IN) ::  iactive   !<
-
-    INTEGER :: i   !<
-    INTEGER :: ip  !<
-    INTEGER :: j   !<
+    INTEGER(iwp), INTENT(IN) ::  childid   !<
+    INTEGER(iwp), INTENT(IN) ::  iactive   !<
+
+    INTEGER(iwp) :: i   !<
+    INTEGER(iwp) :: ip  !<
+    INTEGER(iwp) :: j   !<
 
     TYPE(pedef), POINTER    ::  ape  !<
@@ -831,4 +927,5 @@
        DO  j = 1, ape%nr_arrays
           ar => ape%array_list(j)
+          if(mod(ar%dimkey,10) == 2) CYCLE           !Not for 2D array
           IF ( iactive == 1  .OR.  iactive == 2 )  THEN
              ar%data = ar%po_data(iactive)
@@ -839,4 +936,13 @@
  END SUBROUTINE pmc_s_set_active_data_array
 
+ INTEGER FUNCTION pmc_s_get_child_npes (child_id)
+   IMPLICIT NONE
+
+   INTEGER(iwp),INTENT(IN)                 :: child_id
+
+   pmc_s_get_child_npes = children(child_id)%inter_npes
+
+   RETURN
+ END FUNCTION pmc_s_get_child_npes
 
 
@@ -845,24 +951,24 @@
     IMPLICIT NONE
 
-    INTEGER, INTENT(IN)                 ::  childid     !<
-    INTEGER, INTENT(IN), DIMENSION(:,:) ::  index_list  !<
-    INTEGER, INTENT(IN)                 ::  nrp         !<
+    INTEGER(iwp), INTENT(IN)                 ::  childid     !<
+    INTEGER(iwp), INTENT(IN), DIMENSION(:,:) ::  index_list  !<
+    INTEGER(iwp), INTENT(IN)                 ::  nrp         !<
 
     TYPE(childdef), INTENT(INOUT)       ::  mychild     !<
 
-    INTEGER                                 :: i        !<
-    INTEGER                                 :: ierr     !<
-    INTEGER                                 :: ind      !<
-    INTEGER                                 :: indwin   !<
-    INTEGER                                 :: indwin2  !<
-    INTEGER                                 :: i2       !<
-    INTEGER                                 :: j        !<
-    INTEGER                                 :: rempe    !<
+    INTEGER(iwp)                            :: i        !<
+    INTEGER(iwp)                            :: ierr     !<
+    INTEGER(iwp)                            :: ind      !<
+    INTEGER(iwp)                            :: indwin   !<
+    INTEGER(iwp)                            :: indwin2  !<
+    INTEGER(iwp)                            :: i2       !<
+    INTEGER(iwp)                            :: j        !<
+    INTEGER(iwp)                            :: rempe    !<
     INTEGER(KIND=MPI_ADDRESS_KIND)          :: winsize  !<
 
-    INTEGER, DIMENSION(mychild%inter_npes)  :: remind   !<
-
-    INTEGER, DIMENSION(:), POINTER          :: remindw  !<
-    INTEGER, DIMENSION(:), POINTER          :: rldef    !<
+    INTEGER(iwp), DIMENSION(mychild%inter_npes)  :: remind   !<
+
+    INTEGER(iwp), DIMENSION(:), POINTER          :: remindw  !<
+    INTEGER(iwp), DIMENSION(:), POINTER          :: rldef    !<
 
     TYPE(pedef), POINTER                    :: ape      !<
@@ -906,5 +1012,5 @@
     winsize = mychild%inter_npes*c_sizeof(i)*2
 
-    CALL MPI_WIN_CREATE( rldef, winsize, iwp, MPI_INFO_NULL,                    &
+    CALL MPI_WIN_CREATE( rldef, winsize, iwp, MPI_INFO_NULL,                   &
                          mychild%intra_comm, indwin, ierr )
 !
@@ -937,5 +1043,5 @@
 
     CALL MPI_BARRIER( m_model_comm, ierr )
-    CALL MPI_WIN_CREATE( remindw, winsize*c_sizeof(i), iwp, MPI_INFO_NULL,      &
+    CALL MPI_WIN_CREATE( remindw, winsize*c_sizeof(i), iwp, MPI_INFO_NULL,     &
                          mychild%intra_comm, indwin2, ierr )
 !
Index: palm/trunk/SOURCE/pmc_particle_interface.f90
===================================================================
--- palm/trunk/SOURCE/pmc_particle_interface.f90	(revision 2801)
+++ palm/trunk/SOURCE/pmc_particle_interface.f90	(revision 2801)
@@ -0,0 +1,1069 @@
+MODULE pmc_particle_interface
+
+!------------------------------------------------------------------------------!
+! This file is part of PALM.
+!
+! PALM is free software: you can redistribute it and/or modify it under the
+! terms of the GNU General Public License as published by the Free Software
+! Foundation, either version 3 of the License, or (at your option) any later
+! version.
+!
+! PALM is distributed in the hope that it will be useful, but WITHOUT ANY
+! WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS FOR
+! A PARTICULAR PURPOSE.  See the GNU General Public License for more details.
+!
+! You should have received a copy of the GNU General Public License along with
+! PALM. If not, see <http://www.gnu.org/licenses/>.
+!
+! Copyright 1997-2018 Leibniz Universitaet Hannover
+!------------------------------------------------------------------------------!
+!
+! Current revisions:
+! ------------------
+! 
+! 
+! Former revisions:
+! -----------------
+!
+! Initial Version (by Klaus Ketelsen)
+!
+! 
+! Description:
+! ------------
+! Introduce particle transfer in nested models. 
+! Interface to palm lpm model to handel particle transfer between parent and
+! child model.
+!------------------------------------------------------------------------------!
+
+   USE, INTRINSIC ::  ISO_C_BINDING
+   USE MPI
+
+   USE kinds
+
+   USE pegrid,                                                                 &
+       ONLY: myidx,myidy
+
+   USE indices,                                                                &
+       ONLY: nx, ny, nxl, nxr, nys, nyn, nzb, nzt, nxlg, nxrg, nysg, nyng, nbgp
+
+   USE grid_variables,                                                         &
+       ONLY:  dx, dy
+
+   USE arrays_3d,                                                              &
+        ONLY: zw
+
+   USE control_parameters,                                                     &
+       ONLY:  message_string
+
+   USE particle_attributes,                                                    &
+       ONLY:  prt_count, particles, grid_particles,                            &
+              particle_type, number_of_particles, zero_particle,               &
+              ibc_par_t, ibc_par_lr, ibc_par_ns, alloc_factor
+
+   USE lpm_pack_and_sort_mod
+
+   USE pmc_general,                                                            &
+       ONLY: pedef
+
+   USE pmc_parent,                                                             &
+       ONLY: children, pmc_s_fillbuffer, pmc_s_getdata_from_buffer,            &
+             pmc_s_get_child_npes
+
+   USE pmc_child,                                                              &
+       ONLY:  me, pmc_c_getbuffer, pmc_c_putbuffer
+
+   USE pmc_interface,                                                          &
+       ONLY: cpl_id, get_number_of_childs, nr_part,  part_adr, nested_run,     &
+             get_childid, get_child_edges, nr_partc,  part_adrc,               &
+             coarse_bound, coord_x, coord_y, cg,   get_child_gridspacing,      &
+             lower_left_coord_x, lower_left_coord_y
+
+    USE pmc_handle_communicator,                                               &
+        ONLY:  pmc_parent_for_child
+
+   USE pmc_mpi_wrapper,                                                        &
+       ONLY: pmc_send_to_parent, pmc_recv_from_child
+
+   USE lpm_exchange_horiz_mod,                                                 &
+       ONLY: realloc_particles_array
+
+   IMPLICIT NONE
+   PRIVATE
+   SAVE
+
+   TYPE  coarse_particle_def
+      INTEGER(iwp) ::  nr_particle
+      
+      TYPE(particle_type),ALLOCATABLE,DIMENSION(:) ::  parent_particles
+   END TYPE  coarse_particle_def
+
+   INTEGER(iwp),PARAMETER ::  Min_particles_per_column = 100      !<
+   INTEGER(iwp),PARAMETER ::  max_nr_particle_in_rma_win = 100000 !<
+
+   INTEGER(iwp) ::  nr_fine_in_coarse  !< Number of fine grid cells in coarse grid (one direction)
+   INTEGER(iwp) ::  particle_win_child !< 
+
+   INTEGER(iwp),ALLOCATABLE,DIMENSION(:) ::  particle_win_parent !<
+   
+   TYPE(C_PTR), ALLOCATABLE,DIMENSION(:) ::  buf_ptr !<
+   
+   TYPE(particle_type), DIMENSION(:),POINTER ::  particle_in_win !<
+
+   TYPE(coarse_particle_def),ALLOCATABLE,DIMENSION(:,:) ::  coarse_particles !<
+
+   
+
+   INTERFACE pmcp_g_init
+      MODULE PROCEDURE pmcp_g_init
+   END  INTERFACE pmcp_g_init
+
+   INTERFACE pmcp_g_alloc_win
+      MODULE PROCEDURE pmcp_g_alloc_win
+   END  INTERFACE pmcp_g_alloc_win
+
+   INTERFACE pmcp_c_get_particle_from_parent
+      MODULE PROCEDURE pmcp_c_get_particle_from_parent
+   END  INTERFACE pmcp_c_get_particle_from_parent
+
+   INTERFACE pmcp_c_send_particle_to_parent
+      MODULE PROCEDURE pmcp_c_send_particle_to_parent
+   END  INTERFACE pmcp_c_send_particle_to_parent
+
+   INTERFACE pmcp_p_fill_particle_win
+      MODULE PROCEDURE pmcp_p_fill_particle_win
+   END  INTERFACE pmcp_p_fill_particle_win
+
+   INTERFACE pmcp_p_empty_particle_win
+      MODULE PROCEDURE pmcp_p_empty_particle_win
+   END  INTERFACE pmcp_p_empty_particle_win
+
+   INTERFACE pmcp_g_print_number_of_particles
+      MODULE PROCEDURE pmcp_g_print_number_of_particles
+   END  INTERFACE pmcp_g_print_number_of_particles
+
+   INTERFACE pmcp_p_delete_particles_in_fine_grid_area
+      MODULE PROCEDURE pmcp_p_delete_particles_in_fine_grid_area
+   END  INTERFACE pmcp_p_delete_particles_in_fine_grid_area
+
+   PUBLIC pmcp_g_init, pmcp_g_alloc_win, pmcp_c_get_particle_from_parent
+   PUBLIC pmcp_c_send_particle_to_parent, pmcp_p_fill_particle_win, pmcp_g_print_number_of_particles
+   PUBLIC pmcp_p_empty_particle_win, pmcp_p_delete_particles_in_fine_grid_area
+
+ CONTAINS
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> general routine:
+!> Initializing actions of the particle interface
+!> check particle boundary conditions for the child models
+!------------------------------------------------------------------------------!
+ SUBROUTINE pmcp_g_init
+ 
+    IMPLICIT NONE
+ 
+    INTEGER(iwp) ::  nr_childs !< Number of child models of the current model
+
+    nr_childs = get_number_of_childs()
+!
+!-- Check if the current model has child models
+    IF ( nr_childs > 0 )   THEN
+       ALLOCATE( nr_part(nysg:nyng, nxlg:nxrg) )
+       ALLOCATE( part_adr(nysg:nyng, nxlg:nxrg) )
+       nr_part = 0
+       part_adr   = 0
+    ENDIF
+
+!
+!-- Set the boundary conditions to nested for all non root (i.e child) models
+    IF ( cpl_id > 1 )  THEN 
+    
+       IF ( ibc_par_t /= 3 )   THEN
+          ibc_par_t  = 3
+          message_string = 'In Child model:  bc_par_t is automatically set to nested '
+          CALL message( 'pmcp_g_init ', 'PA0477', 0, 1, 0, 6, 0 )   ! PA number has to be adjusted
+       ENDIF
+    
+       IF ( ibc_par_lr /= 3 )   THEN
+          ibc_par_lr = 3
+          message_string = 'In Child model:  bc_par_lr is automatically set to nested '
+          CALL message( 'pmcp_g_init ', 'PA0478', 0, 1, 0, 6, 0 )   ! PA number has to be adjusted
+       ENDIF
+        
+       IF ( ibc_par_ns /= 3 )   THEN
+          ibc_par_ns = 3
+          message_string = 'In Child model:  bc_par_ns is automatically set to nested '
+          CALL message( 'pmcp_g_init ', 'PA0479', 0, 1, 0, 6, 0 )   ! PA number has to be adjusted
+       ENDIF
+       
+    ENDIF
+
+ END SUBROUTINE pmcp_g_init
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> general routine:
+!> allocate the MPI windows
+!------------------------------------------------------------------------------!
+ SUBROUTINE pmcp_g_alloc_win
+ 
+    IMPLICIT NONE
+    
+    INTEGER(iwp) ::  m         !< loop index
+    INTEGER(iwp) ::  ierr      !< error code 
+    INTEGER(iwp) ::  icl       !< left boundary in coarse(parent) index space
+    INTEGER(iwp) ::  icr       !< right boundary in coarse(parent) index space
+    INTEGER(iwp) ::  jcs       !< south boundary in coarse(parent) index space
+    INTEGER(iwp) ::  jcn       !< north boundary in coarse(parent) index space
+    INTEGER(iwp) ::  child_id  !< Id of a child model
+    INTEGER(iwp) ::  nr_childs !< Number of child models of the current model
+    
+    INTEGER(KIND=MPI_ADDRESS_KIND) ::  winsize !<
+    
+    TYPE(C_PTR), SAVE ::  ptr !<
+    
+    TYPE(particle_type),DIMENSION(:),POINTER ::  win_buffer !<
+    
+    INTEGER(iwp),DIMENSION(1) ::  buf_shape !<
+
+!
+!-- If the model has a parent model prepare the structures for transfer
+    IF ( cpl_id > 1 )  THEN 
+       winsize = C_SIZEOF (zero_particle)
+       CALL MPI_ALLOC_MEM( winsize , MPI_INFO_NULL, ptr, ierr )
+       buf_shape(1) = 1
+       CALL C_F_POINTER( ptr, win_buffer, buf_shape )
+       CALL MPI_WIN_CREATE( win_buffer, winsize, C_SIZEOF (zero_particle),     &
+                            MPI_INFO_NULL, me%intra_comm, particle_win_child,  &
+                            ierr )
+
+!
+!--    Child domain boundaries in the parent index space
+       icl = coarse_bound(1)
+       icr = coarse_bound(2)
+       jcs = coarse_bound(3)
+       jcn = coarse_bound(4)
+
+!        ALLOCATE( coarse_particles(jcs:jcn, icl:icr) )
+
+       coarse_particles(:,:)%nr_particle = 0
+    ENDIF
+
+!
+!-- If the model has child models prepare the structures for transfer
+    nr_childs = get_number_of_childs()
+    IF ( nr_childs > 0 )   THEN
+       ALLOCATE( particle_win_parent(nr_childs) )
+       ALLOCATE( buf_ptr(nr_childs) )
+       DO  m = 1, nr_childs
+          child_id = get_childid(m)
+
+          winsize = max_nr_particle_in_rma_win * C_SIZEOF( zero_particle )
+          CALL MPI_ALLOC_MEM( winsize , MPI_INFO_NULL, buf_ptr(m), ierr )
+          buf_shape(1) = max_nr_particle_in_rma_win
+          CALL C_F_POINTER( buf_ptr(m), win_buffer, buf_shape )
+          CALL MPI_WIN_CREATE( win_buffer, winsize, C_SIZEOF( zero_particle ), &
+                               MPI_INFO_NULL, children(child_id)%intra_comm,   &
+                               particle_win_parent(m), ierr )
+          ENDDO
+    ENDIF
+
+ END SUBROUTINE pmcp_g_alloc_win
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> child routine:
+!> Read/get particles out of the parent MPI window 
+!------------------------------------------------------------------------------!
+ SUBROUTINE pmcp_c_get_particle_from_parent
+ 
+    IMPLICIT NONE
+
+    INTEGER(iwp) ::  i    !< x grid index
+    INTEGER(iwp) ::  icl  !< left boundary in coarse(parent) index space
+    INTEGER(iwp) ::  ierr !< error code
+    INTEGER(iwp) ::  ij   !< combined xy index for the buffer array
+    INTEGER(iwp) ::  ip   !< loop index (child PEs)
+    INTEGER(iwp) ::  j    !< y grid index
+    INTEGER(iwp) ::  jcs  !< south boundary in coarse(parent) index space
+    INTEGER(iwp) ::  nr   !< number of particles to receive from a parent box 
+    
+    INTEGER(KIND=MPI_ADDRESS_KIND) ::  target_disp !<
+    
+    TYPE(pedef), POINTER ::  ape !< TO_DO Klaus: give a description and better name of the variable
+    
+    TYPE(particle_type) ::  dummy_part !<
+
+    IF ( cpl_id > 1 )  THEN
+    
+       CALL pmc_c_getbuffer( particle_transfer = .TRUE. ) !Get number of particle/column and offset in RMA window xx
+
+!
+!--    Wait for buffer to fill.
+!
+!--    The parent side (in pmc_s_fillbuffer) is filling the buffer in the MPI RMA window
+!--    When the filling is complete, a MPI_BARRIER is called.
+!--    The child is not allowd to access the parent-buffer before it is completely filled
+!--    Synchronization is done implicitely in pmc_c_getbuffer and pmc_s_fillbuffer on the parent side
+
+       icl = coarse_bound(1)
+       jcs = coarse_bound(3)
+
+       DO  ip = 1, me%inter_npes
+
+          ape => me%pes(ip)
+
+          DO  ij = 1, ape%nrele
+              j = ape%locind(ij)%j + jcs - 1
+              i = ape%locind(ij)%i + icl - 1
+              nr = nr_partc(j,i)
+              IF ( nr > 0 )  THEN
+
+                 CALL check_and_alloc_coarse_particle (i, j, nr)
+
+                 target_disp = part_adrc(j,i) - 1
+                 CALL MPI_WIN_LOCK( MPI_LOCK_SHARED , ip - 1, 0, particle_win_child, ierr )
+                 CALL MPI_GET( coarse_particles(j,i)%parent_particles,         &
+                               nr * C_SIZEOF(dummy_part), MPI_BYTE, ip - 1,    &
+                               target_disp, nr * C_SIZEOF(dummy_part),         &
+                               MPI_BYTE, particle_win_child, ierr )
+                 CALL MPI_WIN_UNLOCK( ip - 1, particle_win_child, ierr )
+             ENDIF
+             coarse_particles(j,i)%nr_particle = nr
+          ENDDO
+       ENDDO
+
+       CALL c_copy_particle_to_child_grid
+    ENDIF
+
+ END SUBROUTINE pmcp_c_get_particle_from_parent
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> child routine:
+!> Write/put particles into the parent MPI window
+!------------------------------------------------------------------------------!
+  SUBROUTINE pmcp_c_send_particle_to_parent
+  
+    IMPLICIT NONE
+    
+    INTEGER(iwp) ::  disp_offset            !<
+    INTEGER(iwp) ::  i                      !< x loop index
+    INTEGER(iwp) ::  icl                    !< left boundary in coarse(parent) index space
+    INTEGER(iwp) ::  icr                    !< right boundary in coarse(parent) index space
+    INTEGER(iwp) ::  ierr                   !< error code
+    INTEGER(iwp) ::  ij                     !< combined xy index for the buffer array
+    INTEGER(iwp) ::  ip                     !< loop index (child PEs)
+    INTEGER(iwp) ::  j                      !< y loop index
+    INTEGER(iwp) ::  jcs                    !< south boundary in coarse(parent) index space
+    INTEGER(iwp) ::  jcn                    !< north boundary in coarse(parent) index space
+    INTEGER(iwp) ::  max_nr_particle_per_pe !< maximum number of particles per PE (depending on grid apect ratio)
+    INTEGER(iwp) ::  n                      !< shorter variable name for nr_fine_in_coarse
+    INTEGER(iwp) ::  nr                     !< shorter variabel name for nr_partc
+    INTEGER(iwp) ::  pe_offset              !< offset index of the current PE
+    
+    INTEGER(KIND=MPI_ADDRESS_KIND) ::  target_disp !<
+    
+    REAL(wp) ::  eps=0.00001 !< used in calculations to avoid rounding errors
+    REAL(wp) ::  xx          !< number of fine grid cells inside a coarse grid cell in x-direction
+    REAL(wp) ::  yy          !< number of fine grid cells inside a coarse grid cell in y-direction
+
+    TYPE(pedef), POINTER ::  ape !< TO_DO Klaus: give a description and better name of the variable
+    
+ !   TYPE(particle_type) ::  dummy_part !< dummy particle (needed for size calculations)
+    
+    
+    IF ( cpl_id > 1 )  THEN
+       CALL c_copy_particle_to_coarse_grid
+
+!
+!--    Child domain boundaries in the parent index space
+
+       icl = coarse_bound(1)
+       icr = coarse_bound(2)
+       jcs = coarse_bound(3)
+       jcn = coarse_bound(4)
+
+       nr_partc = 0
+       
+       DO i = icl, icr
+          DO j = jcs, jcn
+             nr_partc(j,i) = coarse_particles(j,i)%nr_particle
+          ENDDO
+       ENDDO
+       part_adrc = 0
+
+!
+!--    compute number of fine grid cells in coarse grid (one direction)
+       xx = (cg%dx + eps) / dx ! +eps to avoid rounding error
+       yy = (cg%dy + eps) / dy
+       nr_fine_in_coarse = MAX( INT(xx), INT(yy) )
+
+       IF ( MOD( coord_x(0), cg%dx ) /= 0.0 .OR. MOD( coord_y(0), cg%dy ) /= 0.0 ) THEN
+          nr_fine_in_coarse = nr_fine_in_coarse + 1
+       ENDIF
+
+!
+!--    Assign a number to my child PE to select different areas in the RMA window on server side
+!--    With this number a square of child PEs is defined which share the same coarse grid cells
+
+       n           = nr_fine_in_coarse ! local variable n to make folloing statements shorter
+       pe_offset   = MOD( myidx, n ) * n + MOD( myidy, n)
+       max_nr_particle_per_pe = max_nr_particle_in_rma_win / ( n * n )
+       disp_offset            = pe_offset * max_nr_particle_per_pe
+
+       DO  ip = 1, me%inter_npes
+
+          ape => me%pes(ip)
+
+          target_disp = disp_offset
+          DO ij = 1, ape%nrele
+             j  = ape%locind(ij)%j + jcs - 1
+             i  = ape%locind(ij)%i + icl - 1
+             nr = nr_partc(j,i)
+             IF( nr > 0 ) THEN
+                IF ( target_disp + nr - disp_offset >= max_nr_particle_per_pe ) THEN
+                   WRITE(9,*) 'RMA window too small on child ',                &
+                              target_disp + nr - disp_offset,                  &
+                              max_nr_particle_per_pe, max_nr_particle_in_rma_win
+                   message_string = 'RMA window too small on child'
+                   CALL message( 'pmci_create_child_arrays', 'PA0480', 3, 2, 0, 6, 0 )   ! PA number has to be adjusted
+                ENDIF
+                CALL MPI_WIN_LOCK( MPI_LOCK_SHARED , ip - 1, 0, particle_win_child, ierr )
+                CALL MPI_PUT( coarse_particles(j,i)%parent_particles,          &
+                              nr * C_SIZEOF(zero_particle), MPI_BYTE, ip - 1,     &
+                              target_disp, nr * C_SIZEOF(zero_particle) ,         &
+                              MPI_BYTE, particle_win_child, ierr )
+                CALL MPI_WIN_UNLOCK( ip - 1, particle_win_child, ierr )
+                part_adrc(j,i) = target_disp + 1
+                target_disp    = target_disp + nr
+             ENDIF
+          ENDDO
+       ENDDO
+
+       CALL pmc_c_putbuffer ( particle_transfer = .TRUE. )   !Send new number of particle/column and offset to parent
+
+    ENDIF
+
+ END SUBROUTINE pmcp_c_send_particle_to_parent
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> parent routine:
+!> write particles into the MPI window
+!------------------------------------------------------------------------------!
+ SUBROUTINE pmcp_p_fill_particle_win
+ 
+    IMPLICIT NONE
+
+    LOGICAL      ::  active_particle !< Particles located in the fine/child grid area are marked as active (to be transferred)
+    LOGICAL,SAVE ::  lfirst = .TRUE. !< 
+    
+    INTEGER(iwp) ::  child_id            !< id of the child model
+    INTEGER(iwp) ::  i                   !< x grid box index
+    INTEGER(iwp) ::  ierr                !< error code
+    INTEGER(iwp) ::  ij                  !< combined xy index for the buffer array
+    INTEGER(iwp) ::  ip                  !< loop index (child PEs)
+    INTEGER(iwp) ::  j                   !< y grid box index
+    INTEGER(iwp) ::  k                   !< z grid box index
+    INTEGER(iwp) ::  m                   !< loop index (number of childs)
+    INTEGER(iwp) ::  n                   !< loop index (number of particles)
+    INTEGER(iwp) ::  nr_part_col         !< Number of particles to transfer per column
+    INTEGER(iwp) ::  number_of_particles !<
+    INTEGER(iwp) ::  pindex              !<
+    INTEGER(iwp) ::  tot_particle_count  !< Total number of particles per child
+    
+    REAL(wp) ::  dx_child   !< child grid spacing
+    REAL(wp) ::  dy_child   !< child grid spacing
+    REAL(wp) ::  dz_child   !< child grid spacing
+    REAL(wp) ::  ny_coord   !< north coordinate of child grid
+    REAL(wp) ::  ny_coord_b !< north coordinate of child grid boundary
+    REAL(wp) ::  lx_coord   !< left coordinate of child grid
+    REAL(wp) ::  lx_coord_b !< left coordinate of child grid boundary
+    REAL(wp) ::  rx_coord   !< right coordinate of child grid
+    REAL(wp) ::  rx_coord_b !< right coordinate of child grid boundary
+    REAL(wp) ::  sy_coord   !< south coordinate of child grid
+    REAL(wp) ::  sy_coord_b !< south coordinate of child grid boundary
+    REAL(wp) ::  uz_coord   !< upper coordinate of child grid
+    REAL(wp) ::  uz_coord_b !< upper coordinate of child grid boundary
+    REAL(wp) ::  x          !< particle position
+    REAL(wp) ::  xo         !< origin of particle
+    REAL(wp) ::  y          !< particle position
+    REAL(wp) ::  yo         !< origin of particle
+    REAL(wp) ::  z          !< particle position
+   
+    INTEGER(iwp),DIMENSION(1) ::  buf_shape !<
+    
+    TYPE(pedef), POINTER ::  ape !< TO_DO Klaus: give a description and better name of the variable
+
+    DO  m = 1, get_number_of_childs()
+
+       child_id = get_childid(m)
+
+       CALL get_child_edges( m, lx_coord, lx_coord_b, rx_coord, rx_coord_b,    &
+                                sy_coord, sy_coord_b, ny_coord, ny_coord_b,    &
+                                uz_coord, uz_coord_b) 
+
+       CALL get_child_gridspacing( m, dx_child, dy_child, dz_child )
+
+       IF ( lfirst )   THEN
+          WRITE(9,'(a,5f10.2)') 'edges          ',lx_coord,rx_coord,sy_coord,ny_coord,uz_coord
+          WRITE(9,'(a,5f10.2)') 'edges boundary ',lx_coord_b,rx_coord_b,sy_coord_b,ny_coord_b,uz_coord_b
+          WRITE(9,'(a,5f10.2)') 'child spacing  ',dx_child, dy_child, dz_child,lower_left_coord_x,lower_left_coord_y
+       ENDIF
+!
+!--    reset values for every child
+       tot_particle_count = 0 
+       nr_part  = 0           
+       part_adr = 0
+       pindex   = 1
+
+       buf_shape(1) = max_nr_particle_in_rma_win
+       CALL C_F_POINTER( buf_ptr(m), particle_in_win , buf_shape )
+
+       DO  ip = 1, children(child_id)%inter_npes
+
+          ape => children(child_id)%pes(ip)
+
+          nr_part_col   = 0 
+	  
+          DO  ij = 1, ape%nrele
+             
+!
+!--          Inside the PMC adressing of 3d arrays starts with 1
+             i = ape%locind(ij)%i + nxl - nbgp - 1
+             j = ape%locind(ij)%j + nys - nbgp - 1
+	     nr_part_col = 0 ! Number of particles to transfer per column
+             part_adr(j,i) = pindex
+             
+             DO  k = nzb + 1, nzt
+                number_of_particles = prt_count(k,j,i)
+                
+                IF ( number_of_particles <= 0 )  CYCLE
+                
+                particles => grid_particles(k,j,i)%particles(1:number_of_particles)
+
+                ! Select particles within boundary area
+
+                DO n = 1, number_of_particles
+                   x = particles(n)%x
+                   y = particles(n)%y
+                   z = particles(n)%z
+!
+!--                check if the particle is located in the fine grid area
+                   active_particle = ((x > lx_coord .AND. x < rx_coord) .AND.  &  
+                                      (y > sy_coord .AND. y < ny_coord) .AND.  &
+                                      (z > 0.000000001 .AND. z < uz_coord))
+                   IF ( active_particle .AND. particles(n)%particle_mask )  THEN
+                      
+                      particle_in_win(pindex) = particles(n)
+!
+!--                   Change particle positions and origin relative to global origin
+                      particle_in_win(pindex)%x = particle_in_win(pindex)%x + lower_left_coord_x
+                      particle_in_win(pindex)%y = particle_in_win(pindex)%y + lower_left_coord_y
+                      particle_in_win(pindex)%origin_x = particle_in_win(pindex)%origin_x + lower_left_coord_x
+                      particle_in_win(pindex)%origin_y = particle_in_win(pindex)%origin_y + lower_left_coord_y
+
+                      tot_particle_count = tot_particle_count + 1
+                      nr_part_col        = nr_part_col + 1
+                      pindex             = pindex + 1
+                      IF ( pindex > max_nr_particle_in_rma_win ) THEN
+                         WRITE(9,*) 'RMA window too small on parent ',pindex, max_nr_particle_in_rma_win
+                         message_string = 'RMA window too small on parent'
+                         CALL message( 'pmci_create_child_arrays', 'PA0481', 3, 2, 0, 6, 0 )   ! PA number has to be adjusted
+                     ENDIF
+                   END IF
+                ENDDO
+             ENDDO
+             nr_part(j,i) = nr_part_col
+          ENDDO
+       ENDDO
+
+       CALL pmc_s_fillbuffer( child_id, particle_transfer = .TRUE. )
+    ENDDO
+
+    lfirst = .FALSE.
+
+ END SUBROUTINE pmcp_p_fill_particle_win
+ 
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> parent routine:
+!> delete particles from the MPI window
+!------------------------------------------------------------------------------!
+ SUBROUTINE pmcp_p_empty_particle_win
+    IMPLICIT NONE
+
+    INTEGER(iwp) ::  child_id           !< model id of the child
+    INTEGER(iwp) ::  ip                 !< loop index (child PEs)
+    INTEGER(iwp) ::  m                  !< loop index (number of childs)
+
+    INTEGER(iwp),DIMENSION(1) ::  buf_shape !<
+
+    DO  m = 1, get_number_of_childs()
+
+       child_id = get_childid(m)
+
+       buf_shape(1) = max_nr_particle_in_rma_win
+       CALL C_F_POINTER( buf_ptr(m), particle_in_win , buf_shape )
+
+!
+!--    In some cells of the coarse grid, there are contributions from more than one child process
+!--    Therfore p_copy_particle_to_org_grid is done for one child process per call
+
+       DO ip = 1, pmc_s_get_child_npes( child_id )
+          nr_part  = 0
+          part_adr = 0
+
+          CALL pmc_s_getdata_from_buffer( child_id, particle_transfer = .TRUE., child_process_nr = ip )
+
+          CALL p_copy_particle_to_org_grid( m, child_id )
+       ENDDO
+
+    ENDDO
+
+ END SUBROUTINE pmcp_p_empty_particle_win
+ 
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> parent routine:
+!> After the transfer mark all parent particles that are still inside on of the 
+!> child areas for deletion. 
+!------------------------------------------------------------------------------!
+ SUBROUTINE pmcp_p_delete_particles_in_fine_grid_area
+
+    IMPLICIT NONE
+
+    LOGICAL ::  to_delete !< particles outside of model domain are marked as to_delete
+    
+    INTEGER(iwp) ::  i !< loop index (x grid)
+    INTEGER(iwp) ::  j !< loop index (y grid)
+    INTEGER(iwp) ::  k !< loop index (z grid)
+    INTEGER(iwp) ::  m !< loop index (number of particles)
+    INTEGER(iwp) ::  n !< loop index (number of childs)
+    
+    REAL(wp) ::  dx_child   !< child grid spacing
+    REAL(wp) ::  dy_child   !< child grid spacing
+    REAL(wp) ::  dz_child   !< child grid spacing
+    REAL(wp) ::  ny_coord   !< north coordinate of child grid
+    REAL(wp) ::  ny_coord_b !< north coordinate of child grid boundary
+    REAL(wp) ::  lx_coord   !< left coordinate of child grid
+    REAL(wp) ::  lx_coord_b !< left coordinate of child grid boundary
+    REAL(wp) ::  rx_coord   !< right coordinate of child grid
+    REAL(wp) ::  rx_coord_b !< right coordinate of child grid boundary
+    REAL(wp) ::  sy_coord   !< south coordinate of child grid
+    REAL(wp) ::  sy_coord_b !< south coordinate of child grid boundary
+    REAL(wp) ::  uz_coord   !< upper coordinate of child grid
+    REAL(wp) ::  uz_coord_b !< upper coordinate of child grid boundary
+    REAL(wp) ::  x          !< particle position
+    REAL(wp) ::  y          !< particle position
+    REAL(wp) ::  z          !< particle position
+    
+    DO  m = 1, get_number_of_childs()
+       CALL get_child_edges( m, lx_coord, lx_coord_b, rx_coord, rx_coord_b,    &
+                                sy_coord, sy_coord_b, ny_coord, ny_coord_b,    &
+                                uz_coord, uz_coord_b )
+
+
+       CALL get_child_gridspacing( m, dx_child, dy_child, dz_child ) 
+
+       DO i = nxl, nxr
+          DO j = nys, nyn
+             DO k = nzb, nzt
+                number_of_particles = prt_count(k,j,i)
+
+                IF ( number_of_particles == 0 ) CYCLE
+
+                particles => grid_particles(k,j,i)%particles(1:number_of_particles)
+
+                DO n = 1, number_of_particles
+                   x = particles(n)%x
+                   y = particles(n)%y
+                   z = particles(n)%z
+
+                   to_delete = ((x > lx_coord .AND. x < rx_coord) .AND.        &
+                                (y > sy_coord .AND. y < ny_coord) .AND.        &
+                                (z > 0.000000001 .AND. z < uz_coord))
+
+                   IF ( to_delete ) THEN
+                      particles(n)%particle_mask = .FALSE.
+                   ENDIF
+                ENDDO
+             ENDDO
+          ENDDO
+       ENDDO
+
+    ENDDO
+
+ END SUBROUTINE pmcp_p_delete_particles_in_fine_grid_area
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> general routine:
+!> print the total number of of the current model and its child models into a file 
+!------------------------------------------------------------------------------!
+ SUBROUTINE pmcp_g_print_number_of_particles (my_time,local_nr_particles)
+ 
+    USE pegrid,                                                                &
+        ONLY: myid
+ 
+    IMPLICIT NONE
+
+    INTEGER(iwp),INTENT(IN) ::  local_nr_particles !<
+    
+    REAL(wp),INTENT(IN) ::  my_time !<
+     
+    LOGICAL, SAVE ::  is_file_open=.FALSE. !< 
+    
+    INTEGER(iwp) ::  child_id           !<
+    INTEGER(iwp) ::  child_nr_particles !< total number of particles in all child models 
+    INTEGER(iwp) ::  ierr               !< error code 
+    INTEGER(iwp) ::  m                  !< loop index (number of childs)
+    
+    CHARACTER(LEN=16) ::  fname !< filename 
+    
+    INTEGER(iwp),DIMENSION(2) ::  ivalr !< integer value to be received
+    INTEGER(iwp),DIMENSION(2) ::  ivals !< integer value to be send
+    
+
+    child_nr_particles = 0
+    IF ( myid == 0 )  THEN
+       IF ( cpl_id > 1 )  THEN 
+          ivals(1) = local_nr_particles
+          CALL pmc_send_to_parent( ivals, 1, 0, 400, ierr )
+       ENDIF
+       DO  m = 1, SIZE( pmc_parent_for_child ) - 1
+
+          child_id = pmc_parent_for_child(m)
+          CALL pmc_recv_from_child( child_id, ivalr, 1, 0, 400, ierr )
+          child_nr_particles = child_nr_particles + ivalr(1)
+       ENDDO
+
+       IF ( SIZE( pmc_parent_for_child ) > 1 ) THEN
+          IF ( .NOT. is_file_open )  THEN !kk muss noch auf file_open umgestellt werden
+             WRITE(fname,'(a,i2.2)') 'nr_particles_',cpl_id
+             OPEN (333,file = fname)
+             is_file_open = .true.
+          ENDIF
+          WRITE(333,'(f12.2,3i10)') my_time,local_nr_particles + child_nr_particles,local_nr_particles,child_nr_particles
+       ENDIF
+    ENDIF
+
+ END SUBROUTINE pmcp_g_print_number_of_particles
+
+!------------------------------------------------------------------------------!
+!------------------------------------------------------------------------------!
+! Private subroutines
+!------------------------------------------------------------------------------!
+!------------------------------------------------------------------------------!
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> child routine
+!> update the size of the local buffer (coarse_particles)
+!------------------------------------------------------------------------------!
+ SUBROUTINE check_and_alloc_coarse_particle (ic,jc,nr,with_copy)
+    
+    IMPLICIT NONE
+    
+    INTEGER(iwp),INTENT(IN) ::  ic !< coarse x grid index
+    INTEGER(iwp),INTENT(IN) ::  jc !< coarse y grid index
+    INTEGER(iwp),INTENT(IN) ::  nr !< number of particles to be transferred/stored in local buffer
+    
+    LOGICAL,INTENT(IN),OPTIONAL ::  with_copy !< copy particles in buffer? or reallocate empty buffer
+
+    LOGICAL :: with_copy_lo !< local variable of with copy
+    
+    INTEGER(iwp) ::  new_size !< new size of the local buffer
+    INTEGER(iwp) ::  old_size !< old size of the local buffer
+    
+    TYPE(particle_type), DIMENSION(:), ALLOCATABLE ::  tmp_particles_d !<
+
+    with_copy_lo = .FALSE.
+    IF ( PRESENT( with_copy ) ) with_copy_lo = with_copy
+
+    IF ( .NOT. ALLOCATED( coarse_particles(jc,ic)%parent_particles ) ) THEN
+       new_size = MAX( nr, Min_particles_per_column )
+       ALLOCATE( coarse_particles(jc,ic)%parent_particles(new_size) )
+    ELSEIF ( nr > SIZE( coarse_particles(jc,ic)%parent_particles ) ) THEN
+
+       old_size = SIZE( coarse_particles(jc,ic)%parent_particles )
+       new_size = old_size * ( 1.0_wp + alloc_factor / 100.0_wp )
+       new_size = MAX( nr, new_size, old_size + Min_particles_per_column )
+
+!
+!--    Copy existing particles to new particle buffer
+       IF ( with_copy_lo ) THEN 
+          ALLOCATE( tmp_particles_d(old_size) )
+          tmp_particles_d(1:old_size) = coarse_particles(jc,ic)%parent_particles
+
+          DEALLOCATE( coarse_particles(jc,ic)%parent_particles )
+          ALLOCATE( coarse_particles(jc,ic)%parent_particles(new_size) )
+
+          coarse_particles(jc,ic)%parent_particles(1:old_size)          = tmp_particles_d(1:old_size)
+          coarse_particles(jc,ic)%parent_particles(old_size+1:new_size) = zero_particle
+
+          DEALLOCATE( tmp_particles_d )
+!
+!--    allocate or reallocate an empty buffer
+       ELSE 
+          DEALLOCATE( coarse_particles(jc,ic)%parent_particles )
+          ALLOCATE( coarse_particles(jc,ic)%parent_particles(new_size) )
+       ENDIF
+    ENDIF
+
+ END SUBROUTINE check_and_alloc_coarse_particle
+
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> child routine: 
+!> copy/sort particles out of the local buffer into the respective grid boxes
+!------------------------------------------------------------------------------!
+ SUBROUTINE c_copy_particle_to_child_grid
+ 
+    IMPLICIT NONE
+ 
+    INTEGER(iwp) ::  ic  !< coarse x grid index 
+    INTEGER(iwp) ::  icl !< left boundary in coarse(parent) index space
+    INTEGER(iwp) ::  icr !< right boundary in coarse(parent) index space
+    INTEGER(iwp) ::  ip  !< x grid index
+    INTEGER(iwp) ::  jc  !< coarse y grid index
+    INTEGER(iwp) ::  jcn !< north boundary in coarse(parent) index space
+    INTEGER(iwp) ::  jcs !< south boundary in coarse(parent) index space
+    INTEGER(iwp) ::  jp  !< y grid index
+    INTEGER(iwp) ::  kp  !< z grid index
+    INTEGER(iwp) ::  n   !< loop index (number of particles)
+    INTEGER(iwp) ::  nr  !< short variable for name number or particles
+    
+    REAL(wp) ::  xc  !< child x coordinate
+    REAL(wp) ::  xoc !< child x origin
+    REAL(wp) ::  yc  !< child y coordinate
+    REAL(wp) ::  yoc !< child y origin
+    REAL(wp) ::  zc  !< child z coordinate
+
+!
+!-- Child domain boundaries in the parent index space
+    icl = coarse_bound(1)
+    icr = coarse_bound(2)
+    jcs = coarse_bound(3)
+    jcn = coarse_bound(4)
+
+    DO ic = icl, icr
+       DO jc = jcs, jcn
+          nr = coarse_particles(jc,ic)%nr_particle
+
+          IF ( nr > 0 ) THEN
+             DO n = 1, nr
+                xc =  coarse_particles(jc,ic)%parent_particles(n)%x-lower_left_coord_x
+                yc =  coarse_particles(jc,ic)%parent_particles(n)%y-lower_left_coord_y
+                zc =  coarse_particles(jc,ic)%parent_particles(n)%z
+                xoc = coarse_particles(jc,ic)%parent_particles(n)%origin_x-lower_left_coord_x
+                yoc = coarse_particles(jc,ic)%parent_particles(n)%origin_y-lower_left_coord_y
+                ip = xc / dx
+                jp = yc / dy
+                kp = nzt
+                DO WHILE ( zw(kp-1) > zc .AND. kp > nzb + 1 )         ! kk search loop has to be optimzed !!!
+                   kp = kp - 1
+                ENDDO 
+
+                IF ( ip >= nxl .AND. ip <= nxr .AND. jp >= nys .AND. jp <= nyn ) THEN
+                   prt_count(kp,jp,ip) = prt_count(kp,jp,ip) + 1
+                   IF ( prt_count(kp,jp,ip) > SIZE( grid_particles(kp,jp,ip)%particles ) ) THEN
+                      CALL realloc_particles_array( ip, jp, kp )
+                   ENDIF
+                   coarse_particles(jc,ic)%parent_particles(n)%x = xc                   ! Adjust coordinates to child grid
+            	   coarse_particles(jc,ic)%parent_particles(n)%y = yc
+                   coarse_particles(jc,ic)%parent_particles(n)%origin_x = xoc           ! Adjust origins to child grid
+                   coarse_particles(jc,ic)%parent_particles(n)%origin_y = yoc
+                   grid_particles(kp,jp,ip)%particles(prt_count(kp,jp,ip)) = coarse_particles(jc,ic)%parent_particles(n)
+                ENDIF
+             ENDDO
+          ENDIF
+       ENDDO
+    ENDDO
+
+ END SUBROUTINE c_copy_particle_to_child_grid
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> child routine:
+!> copy particles which left the model area into the local buffer
+!------------------------------------------------------------------------------!
+ SUBROUTINE c_copy_particle_to_coarse_grid
+ 
+    IMPLICIT NONE
+    
+    LOGICAL ::  boundary_particle !<
+    
+    INTEGER(iwp) ::  i    !< loop index (x grid)
+    INTEGER(iwp) ::  ic   !< loop index (coarse x grid)
+    INTEGER(iwp) ::  icl  !< left boundary in coarse(parent) index space
+    INTEGER(iwp) ::  icr  !< left boundary in coarse(parent) index space
+    INTEGER(iwp) ::  ierr !< error code
+    INTEGER(iwp) ::  j    !< loop index (y grid)
+    INTEGER(iwp) ::  jc   !< loop index (coarse y grid)
+    INTEGER(iwp) ::  jcs  !< south boundary in coarse(parent) index space
+    INTEGER(iwp) ::  jcn  !< north boundary in coarse(parent) index space
+    INTEGER(iwp) ::  k    !< loop index (z grid)
+    INTEGER(iwp) ::  n    !< loop index (number of particles)
+    
+    REAL(iwp) ::  x       !< x coordinate
+    REAL(iwp) ::  xo      !< x origin
+    REAL(iwp) ::  x_left  !< absolute left boundary
+    REAL(iwp) ::  x_right !< absolute right boundary
+    REAL(iwp) ::  y       !< left boundary in coarse(parent) index space
+    REAL(iwp) ::  yo      !< y origin
+    REAL(iwp) ::  y_north !< absolute north boundary
+    REAL(iwp) ::  y_south !< absoulte south boundary
+    REAL(iwp) ::  z       !< z coordinate
+
+!
+!-- Child domain boundaries in the parent index space
+
+    icl = coarse_bound(1)
+    icr = coarse_bound(2)
+    jcs = coarse_bound(3)
+    jcn = coarse_bound(4)
+
+!
+!-- absolute coordinates
+    x_left  = coord_x(0)
+    x_right = coord_x(nx) + dx
+    y_south = coord_y(0)
+    y_north = coord_y(ny) + dy
+
+!   Clear Particle Buffer
+
+    DO ic = icl, icr
+       DO jc = jcs, jcn
+          coarse_particles(jc,ic)%nr_particle = 0
+       ENDDO
+    ENDDO
+
+!
+!-- Determine particles which leave the inner area in east or west dirextion
+!-- Compute only first (nxl) and last (nxr) loop iterration.
+    DO  i = nxl, nxr
+       DO  j = nys, nyn
+          DO  k = nzb + 1, nzt
+             number_of_particles = prt_count(k,j,i)
+             IF ( number_of_particles <= 0 )  CYCLE
+             particles => grid_particles(k,j,i)%particles(1:number_of_particles)
+             DO  n = 1, number_of_particles
+                IF ( particles(n)%particle_mask )  THEN
+                   x =  particles(n)%x+ lower_left_coord_x  
+                   y =  particles(n)%y+ lower_left_coord_y 
+                   xo = particles(n)%origin_x + lower_left_coord_x
+                   yo = particles(n)%origin_y + lower_left_coord_y
+                   z =  particles(n)%z
+                   
+                   boundary_particle = .FALSE.
+                   boundary_particle = boundary_particle .OR. (x < x_left  .OR. x > x_right)
+                   boundary_particle = boundary_particle .OR. (y < y_south .OR. y > y_north)
+                   boundary_particle = boundary_particle .OR. (z > zw(nzt))
+
+                   IF ( boundary_particle ) THEN                     
+                      ic = x / cg%dx                     !TODO anpassen auf Mehrfachnesting
+                      jc = y / cg%dy
+
+                      IF ( ic >= icl .AND. ic <= icr .AND. jc >= jcs .AND. jc <= jcn ) THEN
+                         coarse_particles(jc,ic)%nr_particle = coarse_particles(jc,ic)%nr_particle + 1
+                         CALL check_and_alloc_coarse_particle( ic, jc, coarse_particles(jc,ic)%nr_particle, with_copy=.TRUE. )
+
+                         coarse_particles(jc,ic)%parent_particles(coarse_particles(jc,ic)%nr_particle)   = particles(n)
+                         coarse_particles(jc,ic)%parent_particles(coarse_particles(jc,ic)%nr_particle)%x = x   !adapt to global coordinates
+                         coarse_particles(jc,ic)%parent_particles(coarse_particles(jc,ic)%nr_particle)%y = y
+                         coarse_particles(jc,ic)%parent_particles(coarse_particles(jc,ic)%nr_particle)%origin_x = xo
+                         coarse_particles(jc,ic)%parent_particles(coarse_particles(jc,ic)%nr_particle)%origin_y = yo
+!--                      Mark particle as deleted after copying it to the transfer buffer
+                         grid_particles(k,j,i)%particles(n)%particle_mask = .FALSE.
+                      ELSE
+                         WRITE(9,'(a,10i6)') 'This should not happen ',i,j,k,ic,jc,icl,icr,jcs,jcn
+                         CALL MPI_Abort( MPI_COMM_WORLD, 9999, ierr )
+                      ENDIF
+                   ENDIF
+                ENDIF
+             ENDDO
+          ENDDO
+       ENDDO
+    ENDDO
+
+!
+!- Pack particles (eliminate those marked for deletion),
+!- determine new number of particles
+   CALL lpm_sort_in_subboxes
+
+ END SUBROUTINE c_copy_particle_to_coarse_grid
+!------------------------------------------------------------------------------!
+! Description:
+! ------------
+!> parent routine:
+!> copy/sort particles from the MPI window into the respective grid boxes
+!------------------------------------------------------------------------------!
+ SUBROUTINE p_copy_particle_to_org_grid( m, child_id )
+
+    IMPLICIT NONE
+
+    INTEGER(iwp),INTENT(IN) ::  child_id !<
+    INTEGER(iwp),INTENT(IN) ::  m        !<
+
+    INTEGER(iwp) ::  i      !< loop index (x grid)
+    INTEGER(iwp) ::  j      !< loop index (y grid)
+    INTEGER(iwp) ::  k      !< loop index (z grid)
+    INTEGER(iwp) ::  n      !< loop index (nr part)
+    INTEGER(iwp) ::  nr     !< short variable name for nr_part
+    INTEGER(iwp) ::  pindex !< short variable name part_adr
+    
+    REAL(iwp) ::  x  !< x coordinate
+    REAL(iwp) ::  xo !< x origin
+    REAL(iwp) ::  y  !< y coordinate
+    REAL(iwp) ::  yo !< y origin
+    REAL(iwp) ::  z  !< z coordinate
+    
+    INTEGER(iwp),DIMENSION(1) ::  buf_shape !<
+
+    buf_shape(1) = max_nr_particle_in_rma_win
+    CALL C_F_POINTER( buf_ptr(m), particle_in_win , buf_shape )
+
+    DO i = nxl, nxr
+       DO j = nys, nyn
+          nr = nr_part(j,i)
+          IF ( nr > 0 ) THEN
+             pindex = part_adr(j,i)
+             DO n = 1, nr
+                x = particle_in_win(pindex)%x-lower_left_coord_x
+                y = particle_in_win(pindex)%y-lower_left_coord_y
+                z = particle_in_win(pindex)%z
+                xo = particle_in_win(pindex)%origin_x-lower_left_coord_x
+                yo = particle_in_win(pindex)%origin_y-lower_left_coord_y
+                k = nzt + 1
+                DO WHILE ( zw(k-1) > z .AND. k > nzb + 1 )                               ! kk search loop has to be optimzed !!!
+                   k = k - 1
+                END DO
+
+                prt_count(k,j,i) = prt_count(k,j,i) + 1
+                IF ( prt_count(k,j,i) > SIZE( grid_particles(k,j,i)%particles ) ) THEN
+                   CALL realloc_particles_array( i, j, k )
+                ENDIF
+                grid_particles(k,j,i)%particles(prt_count(k,j,i)) = particle_in_win(pindex)
+                
+!
+!--             Update particle positions and origins relative to parent domain
+                grid_particles(k,j,i)%particles(prt_count(k,j,i))%x = x
+                grid_particles(k,j,i)%particles(prt_count(k,j,i))%y = y
+                grid_particles(k,j,i)%particles(prt_count(k,j,i))%origin_x = xo
+                grid_particles(k,j,i)%particles(prt_count(k,j,i))%origin_y = yo
+                pindex = pindex + 1
+             ENDDO
+          ENDIF
+       ENDDO
+    ENDDO
+    
+ END SUBROUTINE p_copy_particle_to_org_grid
+
+
+END MODULE pmc_particle_interface
Index: palm/trunk/SOURCE/time_integration.f90
===================================================================
--- palm/trunk/SOURCE/time_integration.f90	(revision 2798)
+++ palm/trunk/SOURCE/time_integration.f90	(revision 2801)
@@ -25,4 +25,8 @@
 ! -----------------
 ! $Id$
+! Changed lpm from subroutine to module.
+! Introduce particle transfer in nested models.
+! 
+! 2776 2018-01-31 10:44:42Z Giersch
 ! Variable use_synthetic_turbulence_generator has been abbreviated
 ! 
@@ -452,4 +456,7 @@
         ONLY:  wtm_forces
 
+    USE lpm_mod,                                                               &
+        ONLY:  lpm
+
     USE vertical_nesting_mod,                                                  &
         ONLY:  vnested, vnest_anterpolate, vnest_anterpolate_e,                &
