Index: palm/trunk/SOURCE/Makefile
===================================================================
--- palm/trunk/SOURCE/Makefile	(revision 1761)
+++ palm/trunk/SOURCE/Makefile	(revision 1762)
@@ -20,5 +20,5 @@
 # Current revisions:
 # ------------------
-# 
+# +pmc_interface, +pmc routines
 # 
 # Former revisions:
@@ -245,5 +245,8 @@
 	ls_forcing.f90 message.f90 microphysics.f90 modules.f90 mod_kinds.f90 \
 	mod_particle_attributes.f90 netcdf.f90 nudging.f90 package_parin.f90 \
-	palm.f90 parin.f90 plant_canopy_model.f90 poisfft.f90 poismg.f90 \
+	palm.f90 parin.f90 plant_canopy_model.f90 pmc_interface.f90 \
+	pmc_client.f90 pmc_general.f90 pmc_handle_communicator.f90 pmc_mpi_wrapper.f90 \
+	pmc_server.f90 \
+	poisfft.f90 poismg.f90 \
 	poismg_fast.f90 pres.f90 print_1d.f90 production_e.f90 \
 	prognostic_equations.f90 progress_bar.f90 radiation_model.f90 \
@@ -371,5 +374,5 @@
 init_masks.o: modules.o mod_kinds.o
 init_ocean.o: modules.o eqn_state_seawater.o mod_kinds.o
-init_pegrid.o: modules.o mod_kinds.o
+init_pegrid.o: modules.o mod_kinds.o pmc_interface.o
 init_pt_anomaly.o: modules.o mod_kinds.o
 init_rankine.o: modules.o mod_kinds.o
@@ -423,7 +426,13 @@
                  plant_canopy_model.o radiation_model.o
 palm.o: modules.o cpulog.o ls_forcing.o mod_kinds.o nudging.o\
-	 surface_layer_fluxes.o
+	pmc_interface.o surface_layer_fluxes.o
 parin.o: modules.o cpulog.o mod_kinds.o progress_bar.o
 plant_canopy_model.o: modules.o mod_kinds.o
+pmc_interface.o: modules.o mod_kinds.o pmc_client.o pmc_general.o\
+	pmc_handle_communicator.o pmc_mpi_wrapper.o pmc_server.o
+pmc_client.o: pmc_general.o pmc_handle_communicator.o pmc_mpi_wrapper.o
+pmc_handle_communicator.o: pmc_general.o
+pmc_mpi_wrapper.o: pmc_handle_communicator.o
+pmc_server.o: pmc_general.o pmc_handle_communicator.o pmc_mpi_wrapper.o
 poisfft.o: modules.o cpulog.o fft_xy.o mod_kinds.o tridia_solver.o
 poismg.o: modules.o cpulog.o mod_kinds.o
@@ -461,5 +470,5 @@
 time_integration.o: modules.o advec_ws.o buoyancy.o calc_mean_profile.o \
 	cpulog.o interaction_droplets_ptq.o land_surface_model.o \
-	ls_forcing.o mod_kinds.o nudging.o production_e.o \
+	ls_forcing.o mod_kinds.o nudging.o pmc_interface.o production_e.o \
 	prognostic_equations.o progress_bar.o radiation_model.o \
 	 user_actions.o surface_layer_fluxes.o
Index: palm/trunk/SOURCE/boundary_conds.f90
===================================================================
--- palm/trunk/SOURCE/boundary_conds.f90	(revision 1761)
+++ palm/trunk/SOURCE/boundary_conds.f90	(revision 1762)
@@ -19,5 +19,5 @@
 ! Current revisions:
 ! -----------------
-!
+! Introduction of nested domain feature
 !
 ! Former revisions:
@@ -134,8 +134,8 @@
                ibc_pt_b, ibc_pt_t, ibc_q_b, ibc_q_t, ibc_sa_t, ibc_uv_b,       &
                ibc_uv_t, icloud_scheme, inflow_l, inflow_n, inflow_r, inflow_s,&
-               intermediate_timestep_count, large_scale_forcing, ocean,        &
+               intermediate_timestep_count, large_scale_forcing, nest_domain,  &
+               nest_bound_l, nest_bound_s, nudging, ocean,                     &
                outflow_l, outflow_n, outflow_r, outflow_s, passive_scalar,     &
-               precipitation, tsc, use_cmax, &
-               nudging
+               precipitation, tsc, use_cmax
 
     USE grid_variables,                                                        &
@@ -179,5 +179,5 @@
 
 !
-!-- Top boundary
+!-- Top boundary. A nested domain ( ibc_uv_t = 3 ) does not require settings.
     IF ( ibc_uv_t == 0 )  THEN
        !$acc kernels present( u_init, u_p, v_init, v_p )
@@ -185,5 +185,5 @@
         v_p(nzt+1,:,:) = v_init(nzt+1)
        !$acc end kernels
-    ELSE
+    ELSEIF ( ibc_uv_t == 1 )  THEN
        !$acc kernels present( u_p, v_p )
         u_p(nzt+1,:,:) = u_p(nzt,:,:)
@@ -191,7 +191,10 @@
        !$acc end kernels
     ENDIF
-    !$acc kernels present( w_p )
-    w_p(nzt:nzt+1,:,:) = 0.0_wp  ! nzt is not a prognostic level (but cf. pres)
-    !$acc end kernels
+
+    IF ( .NOT. nest_domain )  THEN
+       !$acc kernels present( w_p )
+       w_p(nzt:nzt+1,:,:) = 0.0_wp  ! nzt is not a prognostic level (but cf. pres)
+       !$acc end kernels
+    ENDIF
 
 !
@@ -255,5 +258,7 @@
           ENDDO
        ENDDO
-       e_p(nzt+1,:,:) = e_p(nzt,:,:)
+       IF ( .NOT. nest_domain )  THEN
+          e_p(nzt+1,:,:) = e_p(nzt,:,:)
+       ENDIF
        !$acc end kernels
     ENDIF
@@ -325,8 +330,9 @@
     ENDIF
 !
-!-- In case of inflow at the south boundary the boundary for v is at nys
-!-- and in case of inflow at the left boundary the boundary for u is at nxl.
-!-- Since in prognostic_equations (cache optimized version) these levels are
-!-- handled as a prognostic level, boundary values have to be restored here.
+!-- In case of inflow or nest boundary at the south boundary the boundary for v
+!-- is at nys and in case of inflow or nest boundary at the left boundary the
+!-- boundary for u is at nxl. Since in prognostic_equations (cache optimized
+!-- version) these levels are handled as a prognostic level, boundary values
+!-- have to be restored here.
 !-- For the SGS-TKE, Neumann boundary conditions are used at the inflow.
     IF ( inflow_s )  THEN
@@ -340,4 +346,16 @@
     ELSEIF ( inflow_r )  THEN
        IF ( .NOT. constant_diffusion ) e_p(:,:,nxr+1) = e_p(:,:,nxr)
+    ENDIF
+
+!
+!-- The same restoration for u at i=nxl and v at j=nys as above must be made
+!-- in case of nest boundaries. Note however, that the above ELSEIF-structure is
+!-- not appropriate here as there may be more than one nest boundary on a
+!-- PE-domain. Furthermore Neumann conditions for SGS-TKE are not required here.
+    IF ( nest_bound_s )  THEN
+       v_p(:,nys,:) = v_p(:,nys-1,:)
+    ENDIF
+    IF ( nest_bound_l )  THEN
+       u_p(:,:,nxl) = u_p(:,:,nxl-1)
     ENDIF
 
Index: palm/trunk/SOURCE/check_parameters.f90
===================================================================
--- palm/trunk/SOURCE/check_parameters.f90	(revision 1761)
+++ palm/trunk/SOURCE/check_parameters.f90	(revision 1762)
@@ -19,5 +19,5 @@
 ! Current revisions:
 ! -----------------
-! Previous version restored.
+! Introduction of nested domain feature
 ! 
 ! Former revisions:
@@ -1755,5 +1755,5 @@
 !-- Lateral boundary conditions
     IF ( bc_lr /= 'cyclic'  .AND.  bc_lr /= 'dirichlet/radiation'  .AND. &
-         bc_lr /= 'radiation/dirichlet' )  THEN
+         bc_lr /= 'radiation/dirichlet'  .AND.  bc_lr /= 'nested' )  THEN
        message_string = 'unknown boundary condition: bc_lr = "' // &
                         TRIM( bc_lr ) // '"'
@@ -1761,5 +1761,5 @@
     ENDIF
     IF ( bc_ns /= 'cyclic'  .AND.  bc_ns /= 'dirichlet/radiation'  .AND. &
-         bc_ns /= 'radiation/dirichlet' )  THEN
+         bc_ns /= 'radiation/dirichlet'  .AND.  bc_ns /= 'nested' )  THEN
        message_string = 'unknown boundary condition: bc_ns = "' // &
                         TRIM( bc_ns ) // '"'
@@ -1843,5 +1843,6 @@
     IF ( bc_p_t == 'dirichlet' )  THEN
        ibc_p_t = 0
-    ELSEIF ( bc_p_t == 'neumann' )  THEN
+!-- TO_DO: later set bc_p_t to neumann before, in case of nested domain
+    ELSEIF ( bc_p_t == 'neumann' .OR. bc_p_t == 'nested' )  THEN
        ibc_p_t = 1
     ELSE
@@ -1873,4 +1874,6 @@
     ELSEIF ( bc_pt_t == 'initial_gradient' )  THEN
        ibc_pt_t = 2
+    ELSEIF ( bc_pt_t == 'nested' )  THEN
+       ibc_pt_t = 3
     ELSE
        message_string = 'unknown boundary condition: bc_pt_t = "' // &
@@ -2015,4 +2018,6 @@
        ELSEIF ( bc_q_t == 'neumann' )  THEN
           ibc_q_t = 1
+       ELSEIF ( bc_q_t == 'nested' )  THEN
+          ibc_q_t = 3
        ELSE
           message_string = 'unknown boundary condition: bc_' // TRIM( sq ) // &
@@ -2098,4 +2103,6 @@
        ELSEIF ( bc_uv_t == 'neumann' )  THEN
           ibc_uv_t = 1
+       ELSEIF ( bc_uv_t == 'nested' )  THEN
+          ibc_uv_t = 3
        ELSE
           message_string = 'unknown boundary condition: bc_uv_t = "' // &
@@ -3861,6 +3868,5 @@
        ntdim_2d_xz(1) = ntdim_3d(1)
        ntdim_2d_yz(1) = ntdim_3d(1)
-             write(9,*) "ntdim_3d(av)=",ntdim_3d(0)
-             CALL local_flush(9)
+
     ENDIF
 
Index: palm/trunk/SOURCE/exchange_horiz_2d.f90
===================================================================
--- palm/trunk/SOURCE/exchange_horiz_2d.f90	(revision 1761)
+++ palm/trunk/SOURCE/exchange_horiz_2d.f90	(revision 1762)
@@ -19,5 +19,5 @@
 ! Current revisions:
 ! -----------------
-! 
+! Introduction of nested domain feature
 ! 
 ! Former revisions:
@@ -62,4 +62,5 @@
     USE control_parameters,                                                    &
         ONLY :  bc_lr_cyc, bc_ns_cyc, inflow_l, inflow_n, inflow_r, inflow_s,  &
+                nest_bound_l, nest_bound_n, nest_bound_r, nest_bound_s,        &
                 outflow_l, outflow_n, outflow_r, outflow_s
                 
@@ -153,26 +154,26 @@
 
 !
-!-- Neumann-conditions at inflow/outflow in case of non-cyclic boundary
-!-- conditions
-    IF ( inflow_l .OR. outflow_l )  THEN
-       DO i=nbgp, 1, -1
+!-- Neumann-conditions at inflow/outflow/nested boundaries
+    IF ( inflow_l .OR. outflow_l .OR. nest_bound_l )  THEN
+       DO  i = nbgp, 1, -1
          ar(:,nxl-i) = ar(:,nxl)
-       END DO
-    END IF
-    IF ( inflow_r .OR. outflow_r )  THEN 
-       DO i=1, nbgp
+       ENDDO
+    ENDIF
+    IF ( inflow_r .OR. outflow_r .OR. nest_bound_r )  THEN
+       DO  i = 1, nbgp
           ar(:,nxr+i) = ar(:,nxr)
-       END DO
-    END IF
-    IF ( inflow_s .OR. outflow_s )  THEN
-       DO i=nbgp, 1, -1
+       ENDDO
+    ENDIF
+    IF ( inflow_s .OR. outflow_s .OR. nest_bound_s )  THEN
+       DO  i = nbgp, 1, -1
          ar(nys-i,:) = ar(nys,:)
-       END DO
-    END IF
-    IF ( inflow_n .OR. outflow_n )  THEN
-       DO i=1, nbgp
+       ENDDO
+    ENDIF
+    IF ( inflow_n .OR. outflow_n .OR. nest_bound_n )  THEN
+       DO  i = 1, nbgp
          ar(nyn+i,:) = ar(nyn,:)
-       END DO
-    END IF
+       ENDDO
+    ENDIF
+
     CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'stop' )
 
@@ -193,5 +194,6 @@
 
     USE control_parameters,                                                    &
-        ONLY:  bc_lr_cyc, bc_ns_cyc
+        ONLY:  bc_lr_cyc, bc_ns_cyc, nest_bound_l, nest_bound_n, nest_bound_r, &
+               nest_bound_s
         
     USE cpulog,                                                                &
@@ -207,4 +209,5 @@
     IMPLICIT NONE
 
+    INTEGER(iwp) ::  i
     INTEGER(iwp) ::  ar(nysg:nyng,nxlg:nxrg)  !<
 
@@ -277,4 +280,27 @@
 
 #endif
+!
+!-- Neumann-conditions at inflow/outflow/nested boundaries
+    IF ( nest_bound_l )  THEN
+       DO  i = nbgp, 1, -1
+         ar(:,nxl-i) = ar(:,nxl)
+       ENDDO
+    ENDIF
+    IF ( nest_bound_r )  THEN
+       DO  i = 1, nbgp
+          ar(:,nxr+i) = ar(:,nxr)
+       ENDDO
+    ENDIF
+    IF ( nest_bound_s )  THEN
+       DO  i = nbgp, 1, -1
+         ar(nys-i,:) = ar(nys,:)
+       ENDDO
+    ENDIF
+    IF ( nest_bound_n )  THEN
+       DO  i = 1, nbgp
+         ar(nyn+i,:) = ar(nyn,:)
+       ENDDO
+    ENDIF
+
     CALL cpu_log( log_point_s(13), 'exchange_horiz_2d', 'stop' )
 
Index: palm/trunk/SOURCE/init_3d_model.f90
===================================================================
--- palm/trunk/SOURCE/init_3d_model.f90	(revision 1761)
+++ palm/trunk/SOURCE/init_3d_model.f90	(revision 1762)
@@ -19,5 +19,5 @@
 ! Current revisions:
 ! ------------------
-!
+! Introduction of nested domain feature
 !
 ! Former revisions:
@@ -669,6 +669,9 @@
 !-- is done). Further below the values needed within the timestep scheme
 !-- will be set.
+!-- TO_DO: zeroth element added to weight_pres because in case of nesting
+!--        pres may need to be called  outside the RK-substeps. Antti will
+!--        check if this is really required.
     ALLOCATE( weight_substep(1:intermediate_timestep_count_max), &
-              weight_pres(1:intermediate_timestep_count_max) )
+              weight_pres(0:intermediate_timestep_count_max) )
     weight_substep = 1.0_wp
     weight_pres    = 1.0_wp
@@ -774,7 +777,8 @@
 
 !
+!--       Inside buildings set velocities back to zero
           IF ( topography /= 'flat' )  THEN
-             DO  i = nxl-1, nxr+1
-                DO  j = nys-1, nyn+1
+             DO  i = nxlg, nxrg
+                DO  j = nysg, nyng
                    u(nzb:nzb_u_inner(j,i),j,i) = 0.0_wp
                    v(nzb:nzb_v_inner(j,i),j,i) = 0.0_wp
@@ -841,12 +845,13 @@
 !--       in the limiting formula!). The original values are stored to be later
 !--       used for volume flow control.
-          IF ( ibc_uv_b /= 1 )  THEN    
-             DO  i = nxlg, nxrg
-                DO  j = nysg, nyng
-                   u(nzb:nzb_u_inner(j,i)+1,j,i) = 0.0_wp
-                   v(nzb:nzb_v_inner(j,i)+1,j,i) = 0.0_wp
-                ENDDO
-             ENDDO
-          ENDIF
+          ! TO_DO:  Antti will check if this is really required
+          !AH IF ( ibc_uv_b /= 1 )  THEN
+          !AH    DO  i = nxlg, nxrg
+          !AH       DO  j = nysg, nyng
+          !AH          u(nzb:nzb_u_inner(j,i)+1,j,i) = 0.0_wp
+          !AH          v(nzb:nzb_v_inner(j,i)+1,j,i) = 0.0_wp
+          !AH       ENDDO
+          !AH    ENDDO
+          !AH ENDIF
 
           IF ( humidity  .OR.  passive_scalar )  THEN
@@ -1669,5 +1674,8 @@
 !
 !-- Setting weighting factors for calculation of perturbation pressure 
-!-- and turbulent quantities from the RK substeps                
+!-- and turbulent quantities from the RK substeps
+!-- TO_DO: zeroth element is added to weight_pres because in nesting pres
+!--        may need to be called outside the RK-substeps
+    weight_pres(0) = 1.0_wp
     IF ( TRIM(timestep_scheme) == 'runge-kutta-3' )  THEN      ! for RK3-method
 
Index: palm/trunk/SOURCE/init_grid.f90
===================================================================
--- palm/trunk/SOURCE/init_grid.f90	(revision 1761)
+++ palm/trunk/SOURCE/init_grid.f90	(revision 1762)
@@ -19,5 +19,5 @@
 ! Current revisions:
 ! -----------------
-! 
+! Introduction of nested domain feature
 !
 ! Former revisions:
@@ -156,6 +156,7 @@
                io_group, inflow_l, inflow_n, inflow_r, inflow_s,               &
                masking_method, maximum_grid_level, message_string,             &
-               momentum_advec, ocean, outflow_l, outflow_n, outflow_r,         &
-               outflow_s, psolver, scalar_advec, topography,                   &
+               momentum_advec, nest_domain, nest_bound_l, nest_bound_n,        &
+               nest_bound_r, nest_bound_s, ocean, outflow_l, outflow_n,        &
+               outflow_r, outflow_s, psolver, scalar_advec, topography,        &
                topography_grid_convention, use_surface_fluxes, use_top_fluxes, &
                wall_adjustment_factor 
@@ -734,6 +735,8 @@
     nzb_max = MAXVAL( nzb_local ) + 1
     IF ( inflow_l .OR. outflow_l .OR. inflow_r .OR. outflow_r .OR.             &
-         inflow_n .OR. outflow_n .OR. inflow_s .OR. outflow_s )  THEN
-         nzb_max = nzt
+         inflow_n .OR. outflow_n .OR. inflow_s .OR. outflow_s .OR.             &
+         nest_domain )                                                         &
+    THEN
+       nzb_max = nzt
     ENDIF
 
@@ -1221,12 +1224,18 @@
 !--             scalar - x-direction
 !--             WS1 (0), WS3 (1), WS5 (2)
-                IF ( k <= nzb_s_inner(j,i+1) .OR. ( ( inflow_l .OR. outflow_l )&
-                     .AND. i == nxl ) .OR. ( ( inflow_r .OR. outflow_r )       &
-                     .AND. i == nxr ) )  THEN
+                IF ( k <= nzb_s_inner(j,i+1) .OR.                              &
+                         ( ( inflow_l .OR. outflow_l .OR. nest_bound_l )       &
+                           .AND. i == nxl   )    .OR.                          &
+                         ( ( inflow_r .OR. outflow_r .OR. nest_bound_r )       &
+                           .AND. i == nxr   ) )                                &
+                THEN
                    wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 0 )
                 ELSEIF ( k <= nzb_s_inner(j,i+2) .OR. k <= nzb_s_inner(j,i-1)  &
-                         .OR. ( ( inflow_r .OR. outflow_r ) .AND. i == nxr-1 ) &
-                         .OR. ( ( inflow_l .OR. outflow_l ) .AND. i == nxlu  ) &
-                       )  THEN
+                                                 .OR.                          &
+                         ( ( inflow_r .OR. outflow_r .OR. nest_bound_r )       &
+                           .AND. i == nxr-1 )    .OR.                          &
+                         ( ( inflow_l .OR. outflow_l .OR. nest_bound_l )       &
+                           .AND. i == nxlu  ) )                                &
+                THEN
                    wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 1 )
                 ELSE
@@ -1236,14 +1245,22 @@
 !--             scalar - y-direction
 !--             WS1 (3), WS3 (4), WS5 (5)
-                IF ( k <= nzb_s_inner(j+1,i) .OR. ( ( inflow_s .OR. outflow_s )&
-                     .AND. j == nys ) .OR. ( ( inflow_n .OR. outflow_n )       &
-                     .AND. j == nyn ) )  THEN
+                IF ( k <= nzb_s_inner(j+1,i) .OR.                              &
+                         ( ( inflow_s .OR. outflow_s .OR. nest_bound_s )       &
+                           .AND. j == nys   )    .OR.                          &
+                         ( ( inflow_n .OR. outflow_n .OR. nest_bound_n )       &
+                           .AND. j == nyn   ) )                                &
+                THEN
                    wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 3 )
+!
 !--             WS3
                 ELSEIF ( k <= nzb_s_inner(j+2,i) .OR. k <= nzb_s_inner(j-1,i)  &
-                         .OR. ( ( inflow_s .OR. outflow_s ) .AND. j == nysv  ) &
-                         .OR. ( ( inflow_n .OR. outflow_n ) .AND. j == nyn-1 ) &
-                       )  THEN
+                                                 .OR.                          &
+                         ( ( inflow_s .OR. outflow_s .OR. nest_bound_s )       &
+                           .AND. j == nysv  )    .OR.                          &
+                         ( ( inflow_n .OR. outflow_n .OR. nest_bound_n )       &
+                           .AND. j == nyn-1 ) )                                &
+                THEN
                    wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 4 )
+!
 !--             WS5
                 ELSE
@@ -1287,13 +1304,18 @@
 !--             u component - x-direction
 !--             WS1 (9), WS3 (10), WS5 (11)
-                IF ( k <= nzb_u_inner(j,i+1)                                  &
-                     .OR. ( ( inflow_l .OR. outflow_l ) .AND. i <= nxlu )     &
-                     .OR. ( ( inflow_r .OR. outflow_r ) .AND. i == nxr  )     &
-                   )  THEN
+                IF ( k <= nzb_u_inner(j,i+1) .OR.                              &
+                         ( ( inflow_l .OR. outflow_l .OR. nest_bound_l )       &
+                           .AND. i <= nxlu  )    .OR.                          &
+                         ( ( inflow_r .OR. outflow_r .OR. nest_bound_r )       &
+                           .AND. i == nxr   ) )                                &
+                THEN
                     wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 9 )
-                ELSEIF ( k <= nzb_u_inner(j,i+2) .OR. k <= nzb_u_inner(j,i-1) &
-                         .OR. ( ( inflow_r .OR. outflow_r ) .AND. i == nxr-1 )&
-                         .OR. ( ( inflow_l .OR. outflow_l ) .AND. i == nxlu+1)&
-                       )  THEN
+                ELSEIF ( k <= nzb_u_inner(j,i+2) .OR. k <= nzb_u_inner(j,i-1)  &
+                                                 .OR.                          &
+                         ( ( inflow_r .OR. outflow_r .OR. nest_bound_r )       &
+                           .AND. i == nxr-1 )    .OR.                          &
+                         ( ( inflow_l .OR. outflow_l .OR. nest_bound_l )       &
+                           .AND. i == nxlu+1) )                                &
+                THEN
                    wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 10 )
 !
@@ -1309,12 +1331,18 @@
 !--             u component - y-direction
 !--             WS1 (12), WS3 (13), WS5 (14)
-                IF ( k <= nzb_u_inner(j+1,i) .OR. ( ( inflow_s .OR. outflow_s )&
-                     .AND. j == nys ) .OR. ( ( inflow_n .OR. outflow_n )       &
-                     .AND. j == nyn ) )  THEN
-                    wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 12 )
+                IF ( k <= nzb_u_inner(j+1,i) .OR.                              &
+                         ( ( inflow_s .OR. outflow_s .OR. nest_bound_s )       &
+                           .AND. j == nys   )    .OR.                          &
+                         ( ( inflow_n .OR. outflow_n .OR. nest_bound_n )       &
+                           .AND. j == nyn   ) )                                &
+                THEN
+                   wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 12 )
                 ELSEIF ( k <= nzb_u_inner(j+2,i) .OR. k <= nzb_u_inner(j-1,i)  &
-                         .OR. ( ( inflow_s .OR. outflow_s ) .AND. j == nysv  ) &
-                         .OR. ( ( inflow_n .OR. outflow_n ) .AND. j == nyn-1 ) &
-                       )  THEN
+                                                 .OR.                          &
+                         ( ( inflow_s .OR. outflow_s .OR. nest_bound_s )       &
+                           .AND. j == nysv  )    .OR.                          &
+                         ( ( inflow_n .OR. outflow_n .OR. nest_bound_n )       &
+                           .AND. j == nyn-1 ) )                                &
+                THEN
                    wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 13 )
 !
@@ -1357,13 +1385,20 @@
 !--             v component - x-direction
 !--             WS1 (18), WS3 (19), WS5 (20)
-                IF ( k <= nzb_v_inner(j,i+1) .OR. ( ( inflow_l .OR. outflow_l )&
-                     .AND. i == nxl ) .OR. (( inflow_r .OR. outflow_r )        &
-                     .AND. i == nxr ) )  THEN
-                     wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 18 )
+                IF ( k <= nzb_v_inner(j,i+1) .OR.                              &
+                         ( ( inflow_l .OR. outflow_l .OR. nest_bound_l )       &
+                           .AND. i == nxl   )    .OR.                          &
+                         ( ( inflow_r .OR. outflow_r .OR. nest_bound_r )       &
+                           .AND. i == nxr   ) )                                &
+                THEN
+                   wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 18 )
+!
 !--             WS3
                 ELSEIF ( k <= nzb_v_inner(j,i+2) .OR. k <= nzb_v_inner(j,i-1)  &
-                         .OR. ( ( inflow_r .OR. outflow_r ) .AND. i == nxr-1 ) &
-                         .OR. ( ( inflow_l .OR. outflow_l ) .AND. i == nxlu  ) &
-                       )  THEN
+                                                 .OR.                          &
+                         ( ( inflow_r .OR. outflow_r .OR. nest_bound_r )       &
+                           .AND. i == nxr-1 )    .OR.                          &
+                         ( ( inflow_l .OR. outflow_l .OR. nest_bound_l )       &
+                           .AND. i == nxlu  ) )                                &
+                THEN
                    wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 19 )
 !
@@ -1379,13 +1414,18 @@
 !--             v component - y-direction
 !--             WS1 (21), WS3 (22), WS5 (23)
-                IF ( k <= nzb_v_inner(j+1,i)                                   &
-                     .OR. ( ( inflow_s .OR. outflow_s ) .AND. j <= nysv )      &
-                     .OR. ( ( inflow_n .OR. outflow_n ) .AND. j == nyn  )      &
-                   )  THEN
-                    wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 21 )
+                IF ( k <= nzb_v_inner(j+1,i) .OR.                              &
+                         ( ( inflow_s .OR. outflow_s .OR. nest_bound_s )       &
+                           .AND. j <= nysv  )    .OR.                          &
+                         ( ( inflow_n .OR. outflow_n .OR. nest_bound_n )       &
+                           .AND. j == nyn   ) )                                &
+                THEN
+                   wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 21 )
                 ELSEIF ( k <= nzb_v_inner(j+2,i) .OR. k <= nzb_v_inner(j-1,i)  &
-                         .OR. ( ( inflow_s .OR. outflow_s ) .AND. j == nysv+1 )&
-                         .OR. ( ( inflow_n .OR. outflow_n ) .AND. j == nyn-1  )&
-                       )  THEN
+                                                 .OR.                          &
+                         ( ( inflow_s .OR. outflow_s .OR. nest_bound_s )       &
+                           .AND. j == nysv+1)    .OR.                          &
+                         ( ( inflow_n .OR. outflow_n .OR. nest_bound_n )       &
+                           .AND. j == nyn-1 ) )                                &
+                THEN
                    wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 22 )
 !
@@ -1427,12 +1467,18 @@
 !--             w component - x-direction
 !--             WS1 (27), WS3 (28), WS5 (29)
-                IF ( k <= nzb_w_inner(j,i+1) .OR. ( ( inflow_l .OR. outflow_l )&
-                     .AND. i == nxl ) .OR. ( ( inflow_r .OR. outflow_r )       &
-                     .AND. i == nxr ) )  THEN
-                    wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 27 )
+                IF ( k <= nzb_w_inner(j,i+1) .OR.                              &
+                         ( ( inflow_l .OR. outflow_l .OR. nest_bound_l )       &
+                           .AND. i == nxl   )    .OR.                          &
+                         ( ( inflow_r .OR. outflow_r .OR. nest_bound_r )       &
+                           .AND. i == nxr   ) )                                &
+                THEN
+                   wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 27 )
                 ELSEIF ( k <= nzb_w_inner(j,i+2) .OR. k <= nzb_w_inner(j,i-1)  &
-                         .OR. ( ( inflow_r .OR. outflow_r ) .AND. i == nxr-1 ) &
-                         .OR. ( ( inflow_l .OR. outflow_l ) .AND. i == nxlu  ) &
-                       )  THEN
+                                                 .OR.                          &
+                         ( ( inflow_r .OR. outflow_r .OR. nest_bound_r )       &
+                           .AND. i == nxr-1 )    .OR.                          &
+                         ( ( inflow_l .OR. outflow_l .OR. nest_bound_l )       &
+                           .AND. i == nxlu  ) )                                &
+                THEN
                    wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 28 )
 !
@@ -1448,12 +1494,18 @@
 !--             w component - y-direction
 !--             WS1 (30), WS3 (31), WS5 (32)
-                IF ( k <= nzb_w_inner(j+1,i) .OR. ( ( inflow_s .OR. outflow_s )&
-                     .AND. j == nys ) .OR. ( ( inflow_n .OR. outflow_n )       &
-                     .AND. j == nyn ) )  THEN
-                    wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 30 )
+                IF ( k <= nzb_w_inner(j+1,i) .OR.                              &
+                         ( ( inflow_s .OR. outflow_s .OR. nest_bound_s )       &
+                           .AND. j == nys   )    .OR.                          &
+                         ( ( inflow_n .OR. outflow_n .OR. nest_bound_n )       &
+                           .AND. j == nyn   ) )                                &
+                THEN
+                   wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 30 )
                 ELSEIF ( k <= nzb_w_inner(j+2,i) .OR. k <= nzb_w_inner(j-1,i)  &
-                         .OR. ( ( inflow_s .OR. outflow_s ) .AND. j == nysv  ) &
-                         .OR. ( ( inflow_n .OR. outflow_n ) .AND. j == nyn-1 ) &
-                       )  THEN
+                                                 .OR.                          &
+                         ( ( inflow_s .OR. outflow_s .OR. nest_bound_s )       &
+                           .AND. j == nysv  )    .OR.                          &
+                         ( ( inflow_n .OR. outflow_n .OR. nest_bound_n )       &
+                           .AND. j == nyn-1 ) )                                &
+                THEN
                    wall_flags_0(k,j,i) = IBSET( wall_flags_0(k,j,i), 31 )
 !
@@ -1504,20 +1556,20 @@
 !--    Set boundary flags at inflow and outflow boundary in case of 
 !--    non-cyclic boundary conditions.
-       IF ( inflow_l .OR. outflow_l )  THEN
+       IF ( inflow_l .OR. outflow_l .OR. nest_bound_l )  THEN
           wall_flags_0(:,:,nxl-1)  = wall_flags_0(:,:,nxl)
           wall_flags_00(:,:,nxl-1) = wall_flags_00(:,:,nxl)
        ENDIF
 
-       IF ( inflow_r .OR. outflow_r )  THEN
+       IF ( inflow_r .OR. outflow_r .OR. nest_bound_r )  THEN
           wall_flags_0(:,:,nxr+1)  = wall_flags_0(:,:,nxr)
           wall_flags_00(:,:,nxr+1) = wall_flags_00(:,:,nxr)
        ENDIF
 
-       IF ( inflow_n .OR. outflow_n )  THEN
+       IF ( inflow_n .OR. outflow_n .OR. nest_bound_n )  THEN
           wall_flags_0(:,nyn+1,:)  = wall_flags_0(:,nyn,:)
           wall_flags_00(:,nyn+1,:) = wall_flags_00(:,nyn,:)
        ENDIF
 
-       IF ( inflow_s .OR. outflow_s )  THEN
+       IF ( inflow_s .OR. outflow_s  .OR. nest_bound_s )  THEN
           wall_flags_0(:,nys-1,:)  = wall_flags_0(:,nys,:)
           wall_flags_00(:,nys-1,:) = wall_flags_00(:,nys,:)
Index: palm/trunk/SOURCE/init_pegrid.f90
===================================================================
--- palm/trunk/SOURCE/init_pegrid.f90	(revision 1761)
+++ palm/trunk/SOURCE/init_pegrid.f90	(revision 1762)
@@ -19,5 +19,5 @@
 ! Current revisions:
 ! ------------------
-! 
+! Introduction of nested domain feature
 ! 
 ! Former revisions:
@@ -129,5 +129,6 @@
                io_blocks, io_group, maximum_grid_level,                        &
                maximum_parallel_io_streams, message_string,                    &
-               mg_switch_to_pe0_level, momentum_advec, neutral, psolver,       &
+               mg_switch_to_pe0_level, momentum_advec, nest_bound_l,           &
+               nest_bound_n, nest_bound_r, nest_bound_s, neutral, psolver,     &
                outflow_l, outflow_n, outflow_r, outflow_s, recycling_width,    &
                scalar_advec, subdomain_size 
@@ -147,4 +148,9 @@
     USE pegrid
  
+#if defined( PMC_ACTIVE )
+    USE pmc_interface,                                                         &
+        ONLY:  cpl_npex,cpl_npey
+#endif
+
     USE transpose_indices,                                                     &
         ONLY:  nxl_y, nxl_yd, nxl_z, nxr_y, nxr_yd, nxr_z, nyn_x, nyn_z, nys_x,&
@@ -206,4 +212,11 @@
     CALL location_message( 'creating virtual PE grids + MPI derived data types', &
                            .FALSE. )
+#if defined( PMC_ACTIVE )
+!
+!-- In case of nested-domain runs, the processor grid is explicitly given
+!-- by the user in the nestpar-NAMELIST
+    pdims(1) = cpl_npex
+    pdims(2) = cpl_npey
+#else
 !
 !-- Determine the processor topology or check it, if prescribed by the user
@@ -243,4 +256,5 @@
 
     ENDIF
+#endif
 
 !
@@ -1058,5 +1072,5 @@
 #if defined( __parallel ) && ! defined ( __check )
 !
-!-- Setting of flags for inflow/outflow conditions in case of non-cyclic
+!-- Setting of flags for inflow/outflow/nesting conditions in case of non-cyclic
 !-- horizontal boundary conditions.
     IF ( pleft == MPI_PROC_NULL )  THEN
@@ -1065,4 +1079,8 @@
        ELSEIF ( bc_lr == 'radiation/dirichlet' )  THEN
           outflow_l = .TRUE.
+#if defined( PMC_ACTIVE )
+       ELSEIF ( bc_lr == 'nested' )  THEN
+          nest_bound_l = .TRUE.
+#endif
        ENDIF
     ENDIF
@@ -1073,4 +1091,8 @@
        ELSEIF ( bc_lr == 'radiation/dirichlet' )  THEN
           inflow_r  = .TRUE.
+#if defined( PMC_ACTIVE )
+       ELSEIF ( bc_lr == 'nested' )  THEN
+          nest_bound_r = .TRUE.
+#endif
        ENDIF
     ENDIF
@@ -1081,4 +1103,8 @@
        ELSEIF ( bc_ns == 'radiation/dirichlet' )  THEN
           inflow_s  = .TRUE.
+#if defined( PMC_ACTIVE )
+       ELSEIF ( bc_ns == 'nested' )  THEN
+          nest_bound_s = .TRUE.
+#endif
        ENDIF
     ENDIF
@@ -1089,4 +1115,8 @@
        ELSEIF ( bc_ns == 'radiation/dirichlet' )  THEN
           outflow_n = .TRUE.
+#if defined( PMC_ACTIVE )
+       ELSEIF ( bc_ns == 'nested' )  THEN
+          nest_bound_n = .TRUE.
+#endif
        ENDIF
     ENDIF
@@ -1139,10 +1169,10 @@
 !-- At the inflow or outflow, u or v, respectively, have to be calculated for
 !-- one more grid point.
-    IF ( inflow_l .OR. outflow_l )  THEN
+    IF ( inflow_l .OR. outflow_l .OR. nest_bound_l )  THEN
        nxlu = nxl + 1
     ELSE
        nxlu = nxl
     ENDIF
-    IF ( inflow_s .OR. outflow_s )  THEN
+    IF ( inflow_s .OR. outflow_s .OR. nest_bound_s )  THEN
        nysv = nys + 1
     ELSE
Index: palm/trunk/SOURCE/modules.f90
===================================================================
--- palm/trunk/SOURCE/modules.f90	(revision 1761)
+++ palm/trunk/SOURCE/modules.f90	(revision 1762)
@@ -19,5 +19,5 @@
 ! Current revisions:
 ! ------------------
-! 
+! +nest_* variables, size of volume_flow arrays increased by one element
 !
 ! Former revisions:
@@ -711,4 +711,7 @@
                 masking_method = .FALSE., mg_switch_to_pe0 = .FALSE., &
                 monotonic_adjustment = .FALSE., &
+                nest_bound_l = .FALSE., nest_bound_n = .FALSE., &
+                nest_bound_r = .FALSE., nest_bound_s = .FALSE., &
+                nest_domain = .FALSE., &
                 neutral = .FALSE., nudging = .FALSE., &
                 ocean = .FALSE., on_device = .FALSE., &
@@ -828,6 +831,6 @@
                  vg_vertical_gradient(10) = 0.0_wp, &
                  vg_vertical_gradient_level(10) = -9999999.9_wp, &
-                 volume_flow(1:2) = 0.0_wp, volume_flow_area(1:2) = 0.0_wp, &
-                 volume_flow_initial(1:2) = 0.0_wp, wall_heatflux(0:4) = 0.0_wp, &
+                 volume_flow(1:3) = 0.0_wp, volume_flow_area(1:3) = 0.0_wp, &
+                 volume_flow_initial(1:3) = 0.0_wp, wall_heatflux(0:4) = 0.0_wp, &
                  wall_humidityflux(0:4) = 0.0_wp, wall_nrflux(0:4) = 0.0_wp, &
                  wall_qflux(0:4) = 0.0_wp, wall_qrflux(0:4) = 0.0_wp, &
Index: palm/trunk/SOURCE/palm.f90
===================================================================
--- palm/trunk/SOURCE/palm.f90	(revision 1761)
+++ palm/trunk/SOURCE/palm.f90	(revision 1762)
@@ -19,5 +19,5 @@
 ! Current revisions:
 ! -----------------
-! 
+! Introduction of nested domain feature
 !
 ! Former revisions:
@@ -113,5 +113,5 @@
         ONLY:  coupling_char, coupling_mode, do2d_at_begin, do3d_at_begin,     &
                io_blocks, io_group, large_scale_forcing, message_string,       &
-               nudging, simulated_time, simulated_time_chr,                    &
+               nest_domain, nudging, simulated_time, simulated_time_chr,       &
                user_interface_current_revision,                                &
                user_interface_required_revision, version, wall_heatflux,       &
@@ -144,4 +144,9 @@
 
     USE pegrid
+
+#if defined( PMC_ACTIVE )
+    USE pmc_interface,                                                         &
+        ONLY:  cpl_id, pmci_init, pmci_modelconfiguration
+#endif
 
     USE statistics,                                                            &
@@ -176,12 +181,28 @@
 !-- it will be defined in init_pegrid but is used before in cpu_log.
     CALL MPI_INIT( ierr )
+
+#if defined( PMC_ACTIVE )
+!
+!-- Initialize the coupling for nested-domain runs
+    CALL pmci_init( comm_palm )
+    comm2d = comm_palm
+
+    IF ( cpl_id >= 2 )  THEN
+       nest_domain = .TRUE.
+       WRITE( coupling_char, '(A1,I1.1)') '_', cpl_id
+    ENDIF
+
+    CALL MPI_COMM_SIZE( comm_palm, numprocs, ierr )
+    CALL MPI_COMM_RANK( comm_palm, myid, ierr )
+#else
     CALL MPI_COMM_SIZE( MPI_COMM_WORLD, numprocs, ierr )
     CALL MPI_COMM_RANK( MPI_COMM_WORLD, myid, ierr )
     comm_palm = MPI_COMM_WORLD
     comm2d    = MPI_COMM_WORLD
-
-!
-!-- Initialize PE topology in case of coupled runs
+!
+!-- Initialize PE topology in case of coupled atmosphere-ocean runs (comm_palm
+!-- will be splitted in init_coupling)
     CALL init_coupling
+#endif
 #endif
 
@@ -291,4 +312,10 @@
 !-- Initialize all necessary variables
     CALL init_3d_model
+
+#if defined( PMC_ACTIVE )
+!
+!-- Coupling protocol setup for nested-domain runs
+    CALL pmci_modelconfiguration
+#endif
 
 !
Index: palm/trunk/SOURCE/parin.f90
===================================================================
--- palm/trunk/SOURCE/parin.f90	(revision 1761)
+++ palm/trunk/SOURCE/parin.f90	(revision 1762)
@@ -19,5 +19,5 @@
 ! Current revisions:
 ! -----------------
-! 
+! Introduction of nested domain feature
 ! 
 ! Former revisions:
@@ -176,81 +176,5 @@
                limiter_sedimentation, nc_const, ventilation_effect
 
-    USE control_parameters,                                                    &
-        ONLY:  alpha_surface, averaging_interval, averaging_interval_pr,       &
-               bc_e_b, bc_lr, bc_ns, bc_p_b, bc_p_t, bc_pt_b, bc_pt_t,         &
-               bc_q_b, bc_q_t,bc_s_b, bc_s_t, bc_sa_t, bc_uv_b, bc_uv_t,       &
-               bottom_salinityflux, building_height, building_length_x,        &
-               building_length_y, building_wall_left, building_wall_south,     &
-               call_microphysics_at_all_substeps, call_psolver_at_all_substeps,&
-               canyon_height,                                                  &
-               canyon_width_x, canyon_width_y, canyon_wall_left,               &
-               canyon_wall_south, cfl_factor,                                  &
-               cloud_droplets, cloud_physics, cloud_scheme,                    &
-               cloud_top_radiation, conserve_volume_flow,                      &
-               conserve_volume_flow_mode, constant_flux_layer,                 &
-               coupling_start_time,                                            &
-               create_disturbances, cycle_mg, data_output, data_output_masks,  &
-               data_output_pr, data_output_2d_on_each_pe,                      &
-               disturbance_amplitude, disturbance_energy_limit,                &
-               disturbance_level_b, disturbance_level_t, dissipation_1d,       &
-               do2d_at_begin, do3d_at_begin,                                   &
-               dp_external, dp_level_b, dp_smooth, dpdxy,                      &
-               drizzle, dt, dt_averaging_input, dt_averaging_input_pr,         &
-               dt_coupling, dt_data_output, dt_data_output_av, dt_disturb,     &
-               dt_domask, dt_dopr, dt_dopr_listing, dt_dots, dt_do2d_xy,       &
-               dt_do2d_xz, dt_do2d_yz, dt_do3d, dt_max, dt_restart,            &
-               dt_run_control, dz, dz_max, dz_stretch_factor, dz_stretch_level,&
-               end_time, ensemble_member_nr, e_init, e_min, fft_method,        &
-               force_print_header,                                             &
-               galilei_transformation, host, humidity, inflow_damping_height,  &
-               inflow_damping_width, inflow_disturbance_begin,                 &
-               inflow_disturbance_end,  initializing_actions, io_blocks,       &
-               io_group, km_constant,                                          &
-               large_scale_forcing,                                            &
-               large_scale_subsidence,                                         &
-               loop_optimization, masking_method, mask_scale_x, mask_scale_y,  &
-               mask_scale_z, mask_x, mask_y, mask_z, mask_x_loop,              &
-               mask_y_loop, mask_z_loop, maximum_cpu_time_allowed,             &
-               maximum_parallel_io_streams, max_pr_user, message_string,       &
-               mg_cycles, mg_switch_to_pe0_level, mixing_length_1d,            &
-               momentum_advec, most_method, netcdf_data_format,                &
-               netcdf_precision, neutral, ngsrb, normalizing_region, nsor,     &
-               nsor_ini, nudging, ocean,                                       &
-               omega, omega_sor, passive_scalar, phi, nz_do3d,                 &
-               prandtl_number, precipitation,                                  &
-               precipitation_amount_interval, psolver, pt_damping_factor,      &
-               pt_damping_width, pt_reference, pt_surface,                     &
-               pt_surface_initial_change, pt_vertical_gradient,                &
-               pt_vertical_gradient_level, q_surface,                          &
-               q_surface_initial_change, q_vertical_gradient,                  &
-               q_vertical_gradient_level, random_generator,                    &
-               random_heatflux, rayleigh_damping_factor,                       &
-               rayleigh_damping_height, recycling_width, recycling_yshift,     &
-               reference_state, residual_limit,                                &
-               restart_time, return_addres, return_username,                   &
-               revision, roughness_length, runnr,                              &
-               run_identifier, sa_surface, sa_vertical_gradient,               &
-               sa_vertical_gradient_level, scalar_advec,                       &
-               scalar_rayleigh_damping,                                        &
-               section_xy, section_xz, section_yz, skip_time_data_output,      &
-               skip_time_data_output_av, skip_time_dopr, skip_time_do2d_xy,    &
-               skip_time_do2d_xz, skip_time_do2d_yz, skip_time_do3d,           &
-               skip_time_domask, subs_vertical_gradient,                       &
-               subs_vertical_gradient_level, surface_heatflux,                 &
-               surface_pressure, surface_scalarflux, surface_waterflux,        &
-               synchronous_exchange,s_surface, s_surface_initial_change,       &
-               s_vertical_gradient, s_vertical_gradient_level,                 &
-               termination_time_needed, timestep_scheme, topography,           &
-               topography_grid_convention, top_heatflux,  top_momentumflux_u,  &
-               top_momentumflux_v, top_salinityflux,                           &
-               transpose_compute_overlap, turbulence, turbulent_inflow,        &
-               ug_surface, ug_vertical_gradient, ug_vertical_gradient_level,   &
-               use_subsidence_tendencies, use_surface_fluxes, use_cmax,        &
-               use_top_fluxes, use_ug_for_galilei_tr, use_upstream_for_tke,    &
-               uv_heights, u_bulk, u_profile, vg_surface, vg_vertical_gradient,&
-               vg_vertical_gradient_level, v_bulk, v_profile,                  &
-               wall_adjustment, wall_heatflux, wall_humidityflux,              &
-               wall_scalarflux, write_binary, zeta_max, zeta_min, z0h_factor,  &
-               z_max_do2d
+    USE control_parameters
 
     USE cpulog,                                                                &
@@ -418,4 +342,26 @@
           READ ( 11, inipar, ERR=10, END=11 )
 
+#if defined ( PMC_ACTIVE )
+!
+!--       In nested domains, npex or npey must not be given in \$inipar
+!--       because here the PE-grids are always defined in the nestpar-NAMELIST
+          IF ( ( npex /= -1 ) .OR. ( npey /= -1 ) )  THEN
+             message_string = 'npex or npey must not be given in \$inipar ' // &
+                              'in nested domains'
+             CALL message( 'parin', 'PAXXXX', 1, 2, 0, 6, 0 )
+          ENDIF
+#else
+!
+!--       Make sure that no nesting boundary conditions are defined if
+!--       PMC_ACTIVE is not defined. Otherwise initiate abort.
+          IF ( ( bc_lr == 'nested' ) .OR. ( bc_ns == 'nested' ) .OR. ( bc_uv_t == 'nested' ) .OR. &
+               ( bc_pt_t ==  'nested' ) .OR. ( bc_q_t == 'nested') .OR. ( bc_sa_t == 'nested') .OR. &
+               ( bc_p_t == 'nested' ) ) THEN
+             message_string = 'Nested boundary conditions are not allowed ' // &
+                              'since the cpp flag PMC_ACTIVE is not set'
+             CALL message( 'parin', 'PAXXXX', 1, 2, 0, 6, 0 )
+          ENDIF
+#endif
+
 #if defined ( __check )
 !
Index: palm/trunk/SOURCE/pmc_client.f90
===================================================================
--- palm/trunk/SOURCE/pmc_client.f90	(revision 1762)
+++ palm/trunk/SOURCE/pmc_client.f90	(revision 1762)
@@ -0,0 +1,577 @@
+MODULE pmc_client
+
+!--------------------------------------------------------------------------------!
+! 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-2015 Leibniz Universitaet Hannover
+!--------------------------------------------------------------------------------!
+!
+! Current revisions:
+! ------------------
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! Intoduction of the pure FORTRAN Palm Model Coupler     (PMC)  12.11.2015  K. Ketelsen
+!
+! Description:
+! ------------
+!
+! Client part of Palm Model Coupler
+!------------------------------------------------------------------------------!
+
+
+    use, intrinsic :: iso_c_binding
+
+    USE  mpi
+    USE  kinds,         ONLY: wp, iwp
+    USE  PMC_general,   ONLY: ClientDef, DA_NameDef, DA_Namelen, PMC_STATUS_OK, PMC_DA_NAME_ERR, PeDef, ArrayDef, &
+                                         DA_Desclen, DA_Namelen, PMC_G_SetName, PMC_G_GetName
+    USE  PMC_handle_communicator,   ONLY: m_model_comm,m_model_rank,m_model_npes, m_to_server_comm
+    USE  PMC_MPI_wrapper,           ONLY: PMC_Send_to_Server, PMC_Recv_from_Server, PMC_Time,                     &
+                                              PMC_Bcast, PMC_Inter_Bcast, PMC_Alloc_mem
+    IMPLICIT none
+    PRIVATE
+    SAVE
+
+!   data local to this MODULE
+    Type(ClientDef)                       :: me
+    INTEGER, PARAMETER                    :: dp = wp
+
+    INTEGER, save                         :: myIndex = 0                !Counter and unique number for Data Arrays
+
+    ! INTERFACE section
+
+    INTERFACE PMC_ClientInit
+        MODULE procedure PMC_ClientInit
+    END INTERFACE PMC_ClientInit
+
+    INTERFACE PMC_Set_DataArray_Name
+        MODULE procedure PMC_Set_DataArray_Name
+        MODULE procedure PMC_Set_DataArray_Name_LastEntry
+    END INTERFACE PMC_Set_DataArray_Name
+
+    INTERFACE PMC_C_Get_2D_index_list
+        MODULE procedure PMC_C_Get_2D_index_list
+    END INTERFACE PMC_C_Get_2D_index_list
+
+    INTERFACE PMC_C_GetNextArray
+        MODULE procedure PMC_C_GetNextArray
+    END INTERFACE PMC_C_GetNextArray
+
+    INTERFACE PMC_C_Set_DataArray
+        MODULE procedure PMC_C_Set_DataArray_2d
+        MODULE procedure PMC_C_Set_DataArray_3d
+    END INTERFACE PMC_C_Set_DataArray
+
+    INTERFACE PMC_C_setInd_and_AllocMem
+        MODULE procedure PMC_C_setInd_and_AllocMem
+    END INTERFACE PMC_C_setInd_and_AllocMem
+
+    INTERFACE PMC_C_GetBuffer
+        MODULE procedure PMC_C_GetBuffer
+    END INTERFACE PMC_C_GetBuffer
+
+    INTERFACE PMC_C_PutBuffer
+        MODULE procedure PMC_C_PutBuffer
+    END INTERFACE PMC_C_PutBuffer
+
+    ! Public section
+
+    PUBLIC PMC_ClientInit , PMC_Set_DataArray_Name, PMC_C_Get_2D_index_list
+    PUBLIC PMC_C_GetNextArray, PMC_C_Set_DataArray
+    PUBLIC PMC_C_setInd_and_AllocMem , PMC_C_GetBuffer, PMC_C_PutBuffer ! ,PMC_C_GetServerType
+
+CONTAINS
+
+    SUBROUTINE PMC_ClientInit
+        IMPLICIT none
+
+        INTEGER                       :: i
+        INTEGER                       :: istat
+
+
+        ! Tailor MPI environment
+
+        me%model_comm = m_model_comm
+        me%inter_comm = m_to_server_comm
+
+        ! Get rank and size
+        CALL MPI_Comm_rank (me%model_comm, me%model_rank, istat);
+        CALL MPI_Comm_size (me%model_comm, me%model_npes, istat);
+        CALL MPI_Comm_remote_size (me%inter_comm, me%inter_npes, istat);
+
+        ! intra communicater is used for MPI_Get
+        CALL MPI_Intercomm_merge (me%inter_comm, .true., me%intra_comm, istat);
+        CALL MPI_Comm_rank (me%intra_comm, me%intra_rank, istat);
+
+        ALLOCATE (me%PEs(me%inter_npes))
+
+        do i=1,me%inter_npes
+           NULLIFY(me%PEs(i)%Arrays)
+        end do
+
+        if(me%model_rank == 0) write(0,'(a,5i6)') 'PMC_ClientInit ',me%model_rank,me%model_npes,me%inter_npes,me%intra_rank
+
+        return
+    END SUBROUTINE PMC_ClientInit
+
+    SUBROUTINE PMC_Set_DataArray_Name (ServerArrayDesc, ServerArrayName, ClientArrayDesc, ClientArrayName, istat, LastEntry)
+        IMPLICIT none
+        character(len=*),INTENT(IN)           :: ServerArrayName
+        character(len=*),INTENT(IN)           :: ServerArrayDesc
+        character(len=*),INTENT(IN)           :: ClientArrayName
+        character(len=*),INTENT(IN)           :: ClientArrayDesc
+        INTEGER,INTENT(OUT)                   :: istat
+        LOGICAL,INTENT(IN),optional           :: LastEntry
+
+        !-- local variables
+        type(DA_NameDef)                      :: myName
+        INTEGER                               :: myPe
+        INTEGER                               :: my_AddiArray=0
+
+        istat = PMC_STATUS_OK
+        if(len(trim(ServerArrayName)) > DA_Namelen .or.                                         &
+            len(trim(ClientArrayName)) > DA_Namelen)  then !Name too long
+            istat = PMC_DA_NAME_ERR
+        end if
+
+        if(m_model_rank == 0) then
+            myIndex = myIndex+1
+            myName%couple_index  = myIndex
+            myName%ServerDesc    = trim(ServerArrayDesc)
+            myName%NameOnServer  = trim(ServerArrayName)
+            myName%ClientDesc    = trim(ClientArrayDesc)
+            myName%NameOnClient  = trim(ClientArrayName)
+        end if
+
+        !   Broadcat to all Client PEs
+
+        CALL PMC_Bcast ( myName%couple_index,  0,   comm=m_model_comm)
+        CALL PMC_Bcast ( myName%ServerDesc, 0,      comm=m_model_comm)
+        CALL PMC_Bcast ( myName%NameOnServer,    0, comm=m_model_comm)
+        CALL PMC_Bcast ( myName%ClientDesc, 0,      comm=m_model_comm)
+        CALL PMC_Bcast ( myName%NameOnClient,    0, comm=m_model_comm)
+
+        !   Broadcat to all Server PEs
+
+        if(m_model_rank == 0) then
+            myPE = MPI_ROOT
+        else
+            myPE = MPI_PROC_NULL
+        endif
+        CALL PMC_Bcast ( myName%couple_index, myPE, comm=m_to_server_comm)
+        CALL PMC_Bcast ( myName%ServerDesc,   myPE, comm=m_to_server_comm)
+        CALL PMC_Bcast ( myName%NameOnServer, myPE, comm=m_to_server_comm)
+        CALL PMC_Bcast ( myName%ClientDesc,   myPE, comm=m_to_server_comm)
+        CALL PMC_Bcast ( myName%NameOnClient, myPE, comm=m_to_server_comm)
+
+        if(present (LastEntry))   then
+            CALL PMC_Set_DataArray_Name_LastEntry ( LastEntry = LastEntry)
+        end if
+
+        CALL PMC_G_SetName (me, myName%couple_index, myName%NameOnClient)
+
+        return
+    END SUBROUTINE PMC_Set_DataArray_Name
+
+    SUBROUTINE PMC_Set_DataArray_Name_LastEntry (LastEntry)
+        IMPLICIT none
+        LOGICAL,INTENT(IN),optional           :: LastEntry
+
+        !-- local variables
+        type(DA_NameDef)                      :: myName
+        INTEGER                               :: myPe
+
+        myName%couple_index  = -1
+
+        if(m_model_rank == 0) then
+            myPE = MPI_ROOT
+        else
+            myPE = MPI_PROC_NULL
+        endif
+        CALL PMC_Bcast ( myName%couple_index,  myPE, comm=m_to_server_comm)
+
+        return
+    END SUBROUTINE PMC_Set_DataArray_Name_LastEntry
+
+    SUBROUTINE PMC_C_Get_2D_index_list
+       IMPLICIT none
+
+       INTEGER                                 :: i,j,i2,nr,ierr
+       INTEGER                                 :: dummy
+       INTEGER                                 :: indWin          !: MPI window object
+       INTEGER                                 :: indWin2         !: MPI window object
+       INTEGER(KIND=MPI_ADDRESS_KIND)          :: win_size        !: Size of MPI window 1 (in bytes)
+       INTEGER(KIND=MPI_ADDRESS_KIND)          :: disp            !: Displacement Unit (Integer = 4, floating poit = 8
+       INTEGER,DIMENSION(me%inter_npes*2)      :: NrEle           !: Number of Elements of a horizontal slice
+       TYPE(PeDef),POINTER                     :: aPE             !: Pointer to PeDef strzcture
+       INTEGER(KIND=MPI_ADDRESS_KIND)          :: WinSize         !: Size of MPI window 2 (in bytes)
+       INTEGER,DIMENSION(:),POINTER            :: myInd
+
+!      CALL PMC_C_CGet_Rem_index_list
+
+       win_size = c_sizeof(dummy)
+       CALL MPI_Win_create (dummy, win_size, iwp, MPI_INFO_NULL, me%intra_comm, indWin, ierr);
+       CALL MPI_Win_fence (0, indWin, ierr)                ! Open Window on Server side
+       CALL MPI_Win_fence (0, indWin, ierr)                ! Close Window on Server Side and opem on Client side
+
+       do i=1,me%inter_npes
+          disp = me%model_rank*2
+          CALL MPI_Get (NrEle((i-1)*2+1),2,MPI_INTEGER,i-1,disp,2,MPI_INTEGER,indWin, ierr)
+       end do
+       CALL MPI_Win_fence (0, indWin, ierr)    ! MPI_get is Non-blocking -> data in NrEle is not available until MPI_fence CALL
+
+       WinSize = 0
+       do i=1,me%inter_npes                         !Allocate memory for index array
+         aPE => me%PEs(i)
+         i2 = (i-1)*2+1
+         nr = NrEle(i2+1)
+         if(nr > 0)  then
+            ALLOCATE(aPE%locInd(nr))
+         else
+            NULLIFY (aPE%locInd)
+         endif
+         WinSize = max(nr,WinSize)                  !Maximum window size
+       end do
+
+       ALLOCATE(myInd(2*WinSize))
+       WinSize = WinSize*c_sizeof(i)
+
+!      local Buffer used in MPI_Get can but must not be inside the MPI Window
+!      Here, we use a dummy for MPI Window because the server PEs do not access the RMA window via MPI_get or MPI_Put
+
+       CALL MPI_Win_create (dummy, 1, iwp, MPI_INFO_NULL, me%intra_comm, indWin2, ierr);
+
+       CALL MPI_Win_fence (0, indWin2, ierr)    ! MPI_get is Non-blocking -> data in NrEle is not available until MPI_fence CALL
+       CALL MPI_Win_fence (0, indWin2, ierr)    ! MPI_get is Non-blocking -> data in NrEle is not available until MPI_fence CALL
+
+       do i=1,me%inter_npes
+          aPE => me%PEs(i)
+          nr = NrEle(i*2)
+          if(nr > 0 )  then
+             disp = NrEle(2*(i-1)+1)
+             CALL MPI_Win_lock (MPI_LOCK_SHARED , i-1, 0, indWin2, ierr)
+             CALL MPI_Get (myInd,2*nr,MPI_INTEGER,i-1,disp,2*nr,MPI_INTEGER,indWin2, ierr)
+             CALL MPI_Win_unlock (i-1, indWin2, ierr)
+             do j=1,nr
+                aPE%locInd(j)%i = myInd(2*j-1)
+                aPE%locInd(j)%j = myInd(2*j)
+             end do
+             aPE%NrEle = nr
+          else
+             aPE%NrEle = -1
+          end if
+       end do
+
+       CALL MPI_Barrier(me%intra_comm, ierr)   ! Dont know why, but this barrier is necessary before we can free the windows
+
+       CALL MPI_Win_free(indWin, ierr);
+       CALL MPI_Win_free(indWin2, ierr);
+       DEALLOCATE (myInd)
+
+       return
+    END SUBROUTINE PMC_C_Get_2D_index_list
+
+    LOGICAL function PMC_C_GetNextArray (myName)
+        character(len=*),INTENT(OUT)               :: myName
+
+        !-- local variables
+        INTEGER                      :: MyCoupleIndex
+        LOGICAL                      :: MyLast                             !Last Array in List
+        character(len=DA_Namelen)    :: loName
+
+        loName = 'NoName '
+        MyLast = .true.
+
+        CALL PMC_G_GetName (me, MyCoupleIndex, loName, MyLast)
+
+        myName = trim(loName)
+
+        PMC_C_GetNextArray = .NOT. MyLast                        ! Return true if valid array
+
+        return
+    END function PMC_C_GetNextArray
+
+    SUBROUTINE PMC_C_Set_DataArray_2d (array)
+       IMPLICIT none
+       REAL(kind=dp),INTENT(IN),DIMENSION(:,:)    :: array
+       !-- local variables
+       INTEGER                           :: NrDims
+       INTEGER,DIMENSION (4)             :: dims
+       INTEGER                           :: dim_order
+       TYPE(c_ptr)                       :: array_adr
+       INTEGER                           :: i
+       TYPE(PeDef),POINTER               :: aPE
+       TYPE(ArrayDef),POINTER            :: ar
+
+
+       dims = 1
+
+       NrDims    = 2
+       dims(1)   = size(array,1)
+       dims(2)   = size(array,2)
+       dim_order = 2
+
+       array_adr = c_loc(array)
+
+       do i=1,me%inter_npes
+          aPE => me%PEs(i)
+          ar  => aPE%Arrays
+          ar%NrDims    = NrDims
+          ar%A_dim     = dims
+          ar%dim_order = dim_order
+          ar%data      = array_adr
+       end do
+
+       return
+    END SUBROUTINE PMC_C_Set_DataArray_2d
+
+    SUBROUTINE PMC_C_Set_DataArray_3d (array)
+       IMPLICIT none
+       REAL(kind=dp),INTENT(IN),DIMENSION(:,:,:)  :: array
+       !-- local variables
+       INTEGER                           :: NrDims
+       INTEGER,DIMENSION (4)             :: dims
+       INTEGER                           :: dim_order
+       TYPE(c_ptr)                       :: array_adr
+       INTEGER                           :: i
+       TYPE(PeDef),POINTER               :: aPE
+       TYPE(ArrayDef),POINTER            :: ar
+
+       dims = 1
+
+       NrDims    = 3
+       dims(1)   = size(array,1)
+       dims(2)   = size(array,2)
+       dims(3)   = size(array,3)
+       dim_order =33
+
+       array_adr = c_loc(array)
+
+       do i=1,me%inter_npes
+          aPE => me%PEs(i)
+          ar  => aPE%Arrays
+          ar%NrDims    = NrDims
+          ar%A_dim     = dims
+          ar%dim_order = dim_order
+          ar%data      = array_adr
+       end do
+
+       return
+    END SUBROUTINE PMC_C_Set_DataArray_3d
+
+   SUBROUTINE PMC_C_setInd_and_AllocMem
+      IMPLICIT none
+
+      INTEGER                                 :: i, ierr
+      INTEGER                                 :: arlen, myIndex, tag
+      INTEGER(kind=8)                         :: bufsize                   ! Size of MPI data Window
+      TYPE(PeDef),POINTER                     :: aPE
+      TYPE(ArrayDef),POINTER                  :: ar
+      character(len=DA_Namelen)               :: myName
+      Type(c_ptr)                             :: base_ptr
+      REAL(kind=wp),DIMENSION(:),POINTER      :: base_array
+      INTEGER(KIND=MPI_ADDRESS_KIND)          :: WinSize
+
+      myIndex = 0
+      bufsize = 8
+
+      ! First stride, Compute size and set index
+
+      do i=1,me%inter_npes
+         aPE => me%PEs(i)
+         tag = 200
+
+         do while (PMC_C_GetNextArray (myName))
+            ar  => aPE%Arrays
+
+            ! Receive Index from client
+            tag = tag+1
+            CALL MPI_Recv (myIndex, 1, MPI_INTEGER, i-1, tag, me%inter_comm, MPI_STATUS_IGNORE, ierr)
+
+            if(ar%dim_order == 33) then                    ! PALM has k in first dimension
+               bufsize = max(bufsize,ar%A_dim(1)*ar%A_dim(2)*ar%A_dim(3))    ! determine max, because client buffer is allocated only once
+            else
+               bufsize = max(bufsize,ar%A_dim(1)*ar%A_dim(2))
+            end if
+            ar%BufIndex = myIndex
+          end do
+      end do
+
+      ! Create RMA (One Sided Communication) window for data buffer
+
+      CALL PMC_Alloc_mem (base_array, bufsize, base_ptr)
+      me%TotalBufferSize = bufsize*wp                          !Total buffer size in Byte
+
+      WinSize = me%TotalBufferSize
+!      write(9,'(a,8i7)') 'PMC_S_SetInd_and_Mem ',m_model_rank,me%inter_npes,WinSize,ar%A_dim
+      CALL MPI_Win_create (base_array, WinSize, wp, MPI_INFO_NULL, me%intra_comm, me%BufWin, ierr);
+      CALL MPI_Win_fence (0, me%BufWin, ierr);                    !  Open Window to set data
+      CALL MPI_Barrier(me%intra_comm, ierr)
+
+      do i=1,me%inter_npes
+         aPE => me%PEs(i)
+
+         do while (PMC_C_GetNextArray (myName))
+            ar  => aPE%Arrays
+            ar%SendBuf = base_ptr
+         end do
+      end do
+
+      return
+   END SUBROUTINE PMC_C_setInd_and_AllocMem
+
+   SUBROUTINE PMC_C_GetBuffer (WaitTime)
+      IMPLICIT none
+      REAL(kind=dp),INTENT(OUT),optional         :: WaitTime
+
+      !-- local variables
+      INTEGER                                 :: ip, ij, ierr
+      INTEGER                                 :: nr                 ! Number of Elements to getb from server
+      INTEGER                                 :: myIndex
+      REAL(kind=dp)                           :: t1,t2
+      TYPE(PeDef),POINTER                     :: aPE
+      TYPE(ArrayDef),POINTER                  :: ar
+      INTEGER,DIMENSION(1)                    :: buf_shape
+      REAL(kind=wp),POINTER,DIMENSION(:)      :: buf
+      REAL(kind=wp),POINTER,DIMENSION(:,:)    :: data_2d
+      REAL(kind=wp),POINTER,DIMENSION(:,:,:)  :: data_3d
+      character(len=DA_Namelen)               :: myName
+      INTEGER(kind=MPI_ADDRESS_KIND)          :: target_disp
+
+      t1 = PMC_Time()
+      CALL MPI_Barrier(me%intra_comm, ierr)                         ! Wait for server to fill buffer
+      t2 = PMC_Time()
+      if(present(WaitTime)) WaitTime = t2-t1
+
+      CALL MPI_Barrier(me%intra_comm, ierr)                         ! Wait for buffer is filled
+
+      do ip=1,me%inter_npes
+         aPE => me%PEs(ip)
+
+         do while (PMC_C_GetNextArray (myName))
+            ar  => aPE%Arrays
+            if(ar%dim_order == 2) then
+               nr = aPE%NrEle
+            else if(ar%dim_order == 33) then
+               nr = aPE%NrEle*ar%A_dim(1)
+            end if
+
+            buf_shape(1) = nr
+            CALL c_f_pointer(ar%SendBuf, buf, buf_shape)
+
+            if(nr > 0)   then
+               target_disp = (ar%BufIndex-1)
+               CALL MPI_Win_lock (MPI_LOCK_SHARED , ip-1, 0, me%BufWin, ierr)
+               CALL MPI_Get (buf, nr, MPI_REAL, ip-1, target_disp, nr, MPI_REAL, me%BufWin, ierr)
+               CALL MPI_Win_unlock (ip-1, me%BufWin, ierr)
+            end if
+
+            myIndex = 1
+            if(ar%dim_order == 2) then
+
+               CALL c_f_pointer(ar%data, data_2d, ar%A_dim(1:2))
+               do ij=1,aPE%NrEle
+                  data_2d(aPE%locInd(ij)%j,aPE%locInd(ij)%i) = buf(myIndex)
+                  myIndex = myIndex+1
+               end do
+            else if(ar%dim_order == 33) then
+               CALL c_f_pointer(ar%data, data_3d, ar%A_dim(1:3))
+               do ij=1,aPE%NrEle
+                  data_3d(:,aPE%locInd(ij)%j,aPE%locInd(ij)%i) = buf(myIndex:myIndex+ar%A_dim(1)-1)
+                  myIndex = myIndex+ar%A_dim(1)
+               end do
+            end if
+
+         end do
+      end do
+      return
+   END SUBROUTINE PMC_C_GetBuffer
+
+   SUBROUTINE PMC_C_PutBuffer (WaitTime)
+      IMPLICIT none
+      REAL(kind=dp),INTENT(OUT),optional         :: WaitTime
+
+      !-- local variables
+      INTEGER                                 :: ip, ij, ierr
+      INTEGER                                 :: nr                 ! Number of Elements to getb from server
+      INTEGER                                 :: myIndex
+      REAL(kind=dp)                           :: t1,t2
+      TYPE(PeDef),POINTER                     :: aPE
+      TYPE(ArrayDef),POINTER                  :: ar
+      INTEGER,DIMENSION(1)                    :: buf_shape
+      REAL(kind=wp),POINTER,DIMENSION(:)      :: buf
+      REAL(kind=wp),POINTER,DIMENSION(:,:)    :: data_2d
+      REAL(kind=wp),POINTER,DIMENSION(:,:,:)  :: data_3d
+      character(len=DA_Namelen)               :: myName
+      INTEGER(kind=MPI_ADDRESS_KIND)          :: target_disp
+
+
+      do ip=1,me%inter_npes
+         aPE => me%PEs(ip)
+
+         do while (PMC_C_GetNextArray (myName))
+            ar  => aPE%Arrays
+            if(ar%dim_order == 2) then
+               nr = aPE%NrEle
+            else if(ar%dim_order == 33) then
+               nr = aPE%NrEle*ar%A_dim(1)
+            end if
+
+            buf_shape(1) = nr
+            CALL c_f_pointer(ar%SendBuf, buf, buf_shape)
+
+            myIndex = 1
+            if(ar%dim_order == 2) then
+               CALL c_f_pointer(ar%data, data_2d, ar%A_dim(1:2))
+               do ij=1,aPE%NrEle
+                  buf(myIndex) = data_2d(aPE%locInd(ij)%j,aPE%locInd(ij)%i)
+                  myIndex = myIndex+1
+               end do
+            else if(ar%dim_order == 33) then
+               CALL c_f_pointer(ar%data, data_3d, ar%A_dim(1:3))
+               do ij=1,aPE%NrEle
+                  buf(myIndex:myIndex+ar%A_dim(1)-1) = data_3d(:,aPE%locInd(ij)%j,aPE%locInd(ij)%i)
+                  myIndex = myIndex+ar%A_dim(1)
+               end do
+            end if
+
+            if(nr > 0)   then
+               target_disp = (ar%BufIndex-1)
+               CALL MPI_Win_lock (MPI_LOCK_SHARED , ip-1, 0, me%BufWin, ierr)
+               CALL MPI_Put (buf, nr, MPI_REAL, ip-1, target_disp, nr, MPI_REAL, me%BufWin, ierr)
+               CALL MPI_Win_unlock (ip-1, me%BufWin, ierr)
+            end if
+
+          end do
+      end do
+
+
+      t1 = PMC_Time()
+      CALL MPI_Barrier(me%intra_comm, ierr)                         ! Wait for server to fill buffer
+      t2 = PMC_Time()
+      if(present(WaitTime)) WaitTime = t2-t1
+
+      CALL MPI_Barrier(me%intra_comm, ierr)                         ! Wait for buffer is filled
+
+
+      return
+    END SUBROUTINE PMC_C_PutBuffer
+
+
+! Private SUBROUTINEs
+
+END MODULE pmc_client
Index: palm/trunk/SOURCE/pmc_general.f90
===================================================================
--- palm/trunk/SOURCE/pmc_general.f90	(revision 1762)
+++ palm/trunk/SOURCE/pmc_general.f90	(revision 1762)
@@ -0,0 +1,258 @@
+MODULE pmc_general
+
+!--------------------------------------------------------------------------------!
+! 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-2015 Leibniz Universitaet Hannover
+!--------------------------------------------------------------------------------!
+!
+! Current revisions:
+! ------------------
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! Intoduction of the pure FORTRAN Palm Model Coupler     (PMC)  12.11.2015  K. Ketelsen
+!
+! Description:
+! ------------
+!
+! Structure definition and utilities of Palm Model Coupler
+!------------------------------------------------------------------------------!
+
+
+   use, intrinsic :: iso_c_binding
+   USE            :: MPI
+
+   IMPLICIT none
+   PRIVATE
+   SAVE
+
+! return status
+   INTEGER,parameter,PUBLIC              :: PMC_STATUS_OK    = 0
+   INTEGER,parameter,PUBLIC              :: PMC_STATUS_ERROR = -1
+   INTEGER,parameter,PUBLIC              :: PMC_DA_NAME_ERR  = 10
+
+   INTEGER,parameter,PUBLIC              :: PMC_MAX_MODELL   = 64
+!  TO_DO: the next variable doesn't seem to be used.  Remove?
+   INTEGER,parameter,PUBLIC              :: PMC_MPI_REAL     = MPI_DOUBLE_PRECISION
+   INTEGER,parameter,PUBLIC              :: DA_Desclen       = 8
+   INTEGER,parameter,PUBLIC              :: DA_Namelen       = 16
+
+   TYPE, PUBLIC :: xy_ind                                          ! Pair of indices in horizontal plane
+      INTEGER                       ::  i
+      INTEGER                       ::  j
+   END TYPE
+
+   TYPE, PUBLIC :: ArrayDef
+      INTEGER                       :: coupleIndex
+      INTEGER                       :: NrDims                      ! Number of Dimensions
+      INTEGER,DIMENSION(4)          :: A_dim                       ! Size of dimensions
+      INTEGER                       :: dim_order                   ! Order of Dimensions: 2 = 2D array, 33 = 3D array
+      TYPE (c_ptr)                  :: data                        ! Pointer of data in server space
+      INTEGER(kind=8)               :: BufIndex                    ! index in Send Buffer
+      INTEGER                       :: BufSize                     ! size in Send Buffer
+      TYPE (c_ptr)                  :: SendBuf                     ! Pointer of Data in Send buffer
+      CHARACTER(len=8)              :: Name                        ! Name of Array
+
+      Type(ArrayDef),POINTER        :: next
+   END TYPE ArrayDef
+
+   TYPE (ArrayDef), PUBLIC, POINTER :: next;
+
+   TYPE, PUBLIC :: PeDef
+      INTEGER(KIND=8)                     :: NrEle                 ! Number of Elemets
+      TYPE (xy_ind), POINTER,DIMENSION(:) :: locInd                ! xy index local array for remote PE
+      TYPE( ArrayDef), POINTER            :: Arrays                ! Pointer to Data Array List (Type ArrayDef)
+      TYPE( ArrayDef), POINTER            :: ArrayStart            ! Pointer to Star of the List
+   END TYPE PeDef
+
+   TYPE, PUBLIC :: ClientDef
+      INTEGER(KIND=8)               :: TotalBufferSize
+      INTEGER                       :: model_comm                  ! Communicator of this model
+      INTEGER                       :: inter_comm                  ! Inter communicator model and client
+      INTEGER                       :: intra_comm                  ! Intra communicator model and client
+      INTEGER                       :: model_rank                  ! Rank of this model
+      INTEGER                       :: model_npes                  ! Number of PEs this model
+      INTEGER                       :: inter_npes                  ! Number of PEs client model
+      INTEGER                       :: intra_rank                  ! rank within intra_comm
+      INTEGER                       :: BufWin                      ! MPI RMA windows
+      TYPE (PeDef), DIMENSION(:), POINTER      :: PEs              ! List of all Client PEs
+   END TYPE ClientDef
+
+   TYPE, PUBLIC    :: DA_NameDef                                   ! Data Array Name Definition
+      INTEGER                       :: couple_index                ! Unique Number of Array
+      CHARACTER(len=DA_Desclen)     :: ServerDesc                  ! Server array description
+      CHARACTER(len=DA_Namelen)     :: NameOnServer                ! Name of array within Server
+      CHARACTER(len=DA_Desclen)     :: ClientDesc                  ! Client array description
+      CHARACTER(len=DA_Namelen)     :: NameOnClient                ! Name of array within Client
+    END TYPE DA_NameDef
+
+    INTERFACE PMC_G_SetName
+       MODULE procedure PMC_G_SetName
+    end INTERFACE PMC_G_SetName
+
+    INTERFACE PMC_G_GetName
+       MODULE procedure PMC_G_GetName
+    end INTERFACE PMC_G_GetName
+
+    INTERFACE PMC_sort
+       MODULE procedure sort_2d_i
+    end INTERFACE PMC_sort
+
+    PUBLIC PMC_G_SetName, PMC_G_GetName, PMC_sort
+
+
+ CONTAINS
+    SUBROUTINE PMC_G_SetName (myClient, couple_index, aName)
+       IMPLICIT none
+
+       TYPE(ClientDef),INTENT(INOUT)           :: myClient
+       INTEGER,INTENT(IN)                      :: couple_index
+       CHARACTER(LEN=*)                        :: aName
+
+       INTEGER                                 :: i
+       TYPE(ArrayDef),POINTER                  :: ar
+       TYPE(PeDef),POINTER                     :: aPE
+
+       do i=1,myClient%inter_npes
+          aPE => myClient%PEs(i)
+          ar  => aPE%Arrays
+          if(.not. associated (ar) )  then
+             ar => DA_List_append (ar, couple_index)
+             aPE%ArrayStart => ar
+         else
+             ar => DA_List_append (ar, couple_index)
+           endif
+          Ar%Name    = trim(aName) // " "
+          myClient%PEs(i)%Arrays => ar
+       end do
+
+       return
+    end SUBROUTINE PMC_G_SetName
+
+    SUBROUTINE PMC_G_GetName (myClient, couple_index, aName, aLast,Client_PeIndex)
+       IMPLICIT none
+
+       TYPE(ClientDef),INTENT(INOUT)           :: myClient
+       INTEGER,INTENT(OUT)                     :: couple_index
+       CHARACTER(LEN=*),INTENT(OUT)            :: aName
+       logical,INTENT(OUT)                     :: aLast
+       INTEGER,INTENT(IN),optional             :: Client_PeIndex
+
+       INTEGER                                 :: i,istart,istop
+       TYPE(PeDef),POINTER                     :: aPE
+       TYPE(ArrayDef),POINTER                  :: ar
+       logical,save                            :: first=.true.
+
+       aLast = .false.
+
+       if(present(Client_PeIndex))  then       !Loop over all Client PEs or just one selected via Client_PeIndex
+          istart = Client_PeIndex
+          istop  = Client_PeIndex
+       else
+          istart = 1
+          istop  = myClient%inter_npes
+       end if
+
+       do i=istart,istop
+          aPE => myClient%PEs(i)
+          ar  => aPE%Arrays
+          if(first)  then
+             ar => aPE%ArrayStart
+          else
+             ar => aPE%Arrays
+             ar => DA_List_next (ar)
+             if(.not. associated (ar) )  then
+                aLast = .true.
+                first = .true.                                  !Reset linked list to begin
+                aPE%Arrays => ar
+              end if
+          endif
+          aPE%Arrays => ar
+       end do
+       if(aLast) then
+          return
+       end if
+
+       couple_index = ar%coupleIndex
+       aName        = ar%Name
+       aLast        = .false.
+
+       first = .false.
+
+
+       return
+    END SUBROUTINE PMC_G_GetName
+
+    SUBROUTINE sort_2d_i (array,sort_ind)
+       IMPLICIT none
+       INTEGER,DIMENSION(:,:),INTENT(INOUT)         :: array
+       INTEGER,INTENT(IN)                           :: sort_ind
+
+       !-- local Variables
+       INTEGER      :: i,j,n
+       INTEGER,DIMENSION(size(array,1))             :: tmp
+
+       n = size(array,2)
+       do j=1,n-1
+          do i=j+1,n
+             if(array(sort_ind,i) < array(sort_ind,j) )  then
+                tmp = array(:,i)
+                array(:,i) = array(:,j)
+                array(:,j) = tmp
+             end if
+          end do
+       end do
+
+       return
+    END  SUBROUTINE sort_2d_i
+
+!   Private section
+!   linked List routines for Data Array handling
+
+    FUNCTION DA_List_append   (node, couple_index)
+       TYPE(ArrayDef),POINTER      :: DA_List_append
+       TYPE(ArrayDef),POINTER      :: node
+       INTEGER,INTENT(IN)          :: couple_index
+
+!--    local variables
+       TYPE(ArrayDef),POINTER      :: ar
+
+       if(.not. associated (node))   then
+          ALLOCATE(ar)
+          ar%coupleIndex = couple_index
+          NULLIFY(ar%next)
+          DA_List_append => ar
+       else
+          ALLOCATE(node%next)
+          node%next%coupleIndex = couple_index
+          NULLIFY(node%next%next)
+          DA_List_append => node%next
+       end if
+
+       return
+    END FUNCTION DA_List_append
+
+    FUNCTION DA_List_next   (node)
+       TYPE(ArrayDef),POINTER      :: DA_List_next
+       TYPE(ArrayDef),POINTER      :: node
+
+       DA_List_next => node%next
+
+       return
+    END FUNCTION DA_List_next
+
+end MODULE pmc_general
Index: palm/trunk/SOURCE/pmc_handle_communicator.f90
===================================================================
--- palm/trunk/SOURCE/pmc_handle_communicator.f90	(revision 1762)
+++ palm/trunk/SOURCE/pmc_handle_communicator.f90	(revision 1762)
@@ -0,0 +1,317 @@
+MODULE PMC_handle_communicator
+
+
+!--------------------------------------------------------------------------------!
+! 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-2015 Leibniz Universitaet Hannover
+!--------------------------------------------------------------------------------!
+!
+! Current revisions:
+! ------------------
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! Intoduction of the pure FORTRAN Palm Model Coupler     (PMC)  12.11.2015  K. Ketelsen
+!
+! Description:
+! ------------
+!
+! Handle MPI Communicator in Palm Model Coupler
+!------------------------------------------------------------------------------!
+
+   USE      mpi
+   USE      pmc_general,                        &
+      ONLY: PMC_STATUS_OK, PMC_STATUS_ERROR, PMC_MAX_MODELL
+
+   IMPLICIT none
+
+   ! Define Types
+
+   type PMC_layout
+      INTEGER                         :: comm_parent
+      INTEGER                         :: comm_cpl
+      INTEGER                         :: Id
+      INTEGER                         :: Parent_id
+
+      INTEGER                         :: npe_x
+      INTEGER                         :: npe_y
+
+      REAL(kind=8)                    :: lower_left_x
+      REAL(kind=8)                    :: lower_left_y
+
+      CHARACTER(len=32)               :: name
+   END type PMC_layout
+
+   ! return status
+   PUBLIC                               PMC_STATUS_OK, PMC_STATUS_ERROR
+   INTEGER,parameter,PUBLIC          :: PMC_ERROR_NPES = 1                       ! illegal Number of PEs
+   INTEGER,parameter,PUBLIC          :: PMC_ERROR_MPI  = 2                       ! MPI Error
+   INTEGER,parameter,PUBLIC          :: PMC_ERRO_NOF   = 3                       ! No couple layout file found
+
+   ! Coupler Setup
+
+   INTEGER                                    :: m_my_CPL_id  !Coupler id of this model
+   INTEGER                                    :: m_Parent_id  !Coupler id of parent of this model
+   INTEGER                                    :: m_NrOfCpl    !Number of Coupler in layout file
+   type(PMC_layout),DIMENSION(PMC_MAX_MODELL) :: m_couplers   !Information of all coupler
+
+   ! MPI settings
+
+   INTEGER,PUBLIC                    :: m_model_comm          !Communicator of this model
+   INTEGER,PUBLIC                    :: m_to_server_comm      !Communicator to the server
+   INTEGER,DIMENSION(PMC_MAX_MODELL) :: m_to_client_comm      !Communicator to the client(s)
+   INTEGER,PUBLIC                    :: m_world_rank
+   INTEGER                           :: m_world_npes
+   INTEGER,PUBLIC                    :: m_model_rank
+   INTEGER,PUBLIC                    :: m_model_npes
+   INTEGER                           :: m_server_remote_size  !Number of Server PE's
+
+   PUBLIC m_to_client_comm
+
+   !Indicates this PE is server for Cleint NR
+
+   INTEGER,DIMENSION(:),POINTER,PUBLIC :: PMC_Server_for_Client
+
+   !INTERFACE Section
+
+   INTERFACE PMC_is_RootModel
+      MODULE PROCEDURE PMC_is_RootModel
+   END INTERFACE PMC_is_RootModel
+
+   INTERFACE PMC_get_local_model_info
+      MODULE PROCEDURE PMC_get_local_model_info
+   END INTERFACE PMC_get_local_model_info
+
+   PUBLIC PMC_init_model,PMC_get_local_model_info, PMC_is_RootModel
+CONTAINS
+
+   SUBROUTINE PMC_init_model (comm, PMC_status)
+      IMPLICIT     none
+      INTEGER,INTENT(OUT)                 :: comm
+      INTEGER,INTENT(OUT)                 :: PMC_status
+
+      !-- local declarations
+      INTEGER                             :: i,istat, ierr
+      INTEGER,DIMENSION(PMC_MAX_MODELL+1) :: start_PE
+      INTEGER                             :: m_my_CPL_rank
+      INTEGER                             :: tag, ClientCount
+      INTEGER,DIMENSION(PMC_MAX_MODELL)   :: activeServer        !I am active server for this client ID
+
+      PMC_status   = PMC_STATUS_OK
+      comm         = -1
+      m_my_CPL_id  = -1
+      ClientCount  = 0
+      activeServer = -1
+      start_PE(:)  = 0
+
+      CALL  MPI_Comm_rank (MPI_COMM_WORLD, m_world_rank, istat)
+      CALL  MPI_Comm_size (MPI_COMM_WORLD, m_world_npes, istat)
+
+      if(m_world_rank == 0) then ! only PE 0 of root model reads
+
+         CALL read_coupling_layout (PMC_status)
+
+         IF (PMC_status /= PMC_ERRO_NOF  ) THEN
+            ! Compute Start PE of every model
+            start_PE(1) = 0
+            do i=2,m_NrOfCpl+1
+               start_pe(i) = start_PE(i-1) + m_couplers(i-1)%npe_x*m_couplers(i-1)%npe_y
+            END do
+            if(start_pe(m_NrOfCpl+1) /= m_world_npes)   then
+               if(m_world_rank == 0) then
+                  write(0,*) 'PMC ERROR: Coupler Setup Not equal Nr. MPI procs ',start_pe(m_NrOfCpl+1),m_world_npes
+               END if
+               CALL MPI_Abort (MPI_COMM_WORLD, ierr, istat)
+            END if
+         END IF
+      END if
+
+      CALL MPI_Bcast (PMC_status, 1,          MPI_INTEGER, 0, MPI_COMM_WORLD, istat)
+      IF (PMC_status == PMC_ERRO_NOF  ) THEN
+         if(m_world_rank == 0)  write(0,*) 'PMC ERROR: file PMC_couple_layout not found'
+         CALL MPI_Abort (MPI_COMM_WORLD, ierr, istat)
+      END IF
+
+      CALL MPI_Bcast (m_NrOfCpl, 1,          MPI_INTEGER, 0, MPI_COMM_WORLD, istat)
+      CALL MPI_Bcast (start_PE, m_NrOfCpl+1, MPI_INTEGER, 0, MPI_COMM_WORLD, istat)
+
+      !   Broadcast coupling layout
+
+      do i=1,m_NrOfCpl
+         CALL MPI_Bcast (m_couplers(i)%name, len(m_couplers(i)%name ), MPI_CHARACTER, 0, MPI_COMM_WORLD, istat)
+         CALL MPI_Bcast (m_couplers(i)%id,           1, MPI_INTEGER, 0, MPI_COMM_WORLD, istat)
+         CALL MPI_Bcast (m_couplers(i)%Parent_id,    1, MPI_INTEGER, 0, MPI_COMM_WORLD, istat)
+         CALL MPI_Bcast (m_couplers(i)%npe_x,        1, MPI_INTEGER, 0, MPI_COMM_WORLD, istat)
+         CALL MPI_Bcast (m_couplers(i)%npe_y,        1, MPI_INTEGER, 0, MPI_COMM_WORLD, istat)
+         CALL MPI_Bcast (m_couplers(i)%lower_left_x, 1, MPI_REAL8,   0, MPI_COMM_WORLD, istat)
+         CALL MPI_Bcast (m_couplers(i)%lower_left_y, 1, MPI_REAL8,   0, MPI_COMM_WORLD, istat)
+      END do
+
+      ! Assign global MPI processes to individual models by setting the couple id
+
+      do i=1,m_NrOfCpl
+         if(m_world_rank >= start_PE(i) .and. m_world_rank < start_PE(i+1) ) then
+            m_my_CPL_id = i
+            EXIT
+         END if
+      END do
+      m_my_CPL_rank = m_world_rank-start_PE(i)
+
+      !   MPI_COMM_WORLD is the communicator for ALL models (MPI-1 approach)
+      !   The communictors for the individual models a created by MPI_Comm_split
+      !   The color of the model is represented by the Coupler id
+
+      CALL MPI_Comm_split (MPI_COMM_WORLD, m_my_CPL_id, m_my_CPL_rank, comm, istat)
+      if(istat /= MPI_SUCCESS) then
+         if(m_world_rank == 0) write(0,*) 'PMC: Error in MPI_Comm_split '
+         CALL MPI_Abort (MPI_COMM_WORLD, ierr, istat)
+      END if
+
+      !   Get size and rank of the model running on THIS PE
+
+      CALL  MPI_Comm_rank (comm, m_model_rank, istat)
+      CALL  MPI_Comm_size (comm, m_model_npes, istat)
+
+      !   Pe 0  brodcasts the Parent ID and Id of every model
+
+      do i=1,m_NrOfCpl
+         CALL MPI_Bcast (m_couplers(i)%Parent_Id,  1, MPI_INTEGER, 0,           MPI_COMM_WORLD, istat)
+         CALL MPI_Bcast (m_couplers(i)%Id,         1, MPI_INTEGER, 0,           MPI_COMM_WORLD, istat)
+      END do
+
+      m_model_comm = comm
+
+      !   create Intercommunicator to server and clients
+      !   MPI_Intercomm_create creates an intercommunicator between 2 groups of different colors
+      !   The grouping with done prior with MPI_Comm_split
+
+      do i=2,m_NrOfCpl
+         if(m_couplers(i)%Parent_Id == m_my_CPL_id)   then                         !collect server PEs
+            tag = 500+i
+!kk            write(0,'(a,6i4)') 'server Part ',m_world_rank,m_world_npes,m_model_rank,m_model_npes,tag,start_pe(i)
+            CALL MPI_Intercomm_create (comm, 0, MPI_COMM_WORLD, start_pe(i), &
+               tag, m_to_client_comm(i), istat)
+
+            clientCount = clientCount+1
+            activeServer(i) = 1
+         else if (i == m_my_CPL_id)   then                                         !collect client PEs
+            tag = 500+i
+            CALL MPI_Intercomm_create (comm, 0, MPI_COMM_WORLD, start_pe(m_couplers(i)%Parent_Id), &
+               tag, m_to_server_comm, istat)
+!kk            write(0,'(a,7i4)') 'client Part',m_world_rank,m_world_npes,m_model_rank,m_model_npes,tag, start_pe(m_couplers(i)%Parent_Id)
+         END if
+         if(istat /= MPI_SUCCESS) then
+            if(m_world_rank == 0) write(0,*) 'PMC: Error in Coupler Setup '
+            CALL MPI_Abort (MPI_COMM_WORLD, ierr, istat)
+         END if
+      END do
+
+!     If I am server, count nr. of clients
+!     Although this loop is symetric on all processes, the active server flag is valid only on the individual PE.
+
+      ALLOCATE(PMC_Server_for_Client(ClientCount+1))
+      ClientCount = 0
+      do i=2,m_NrOfCpl
+         if(activeServer(i) == 1)  then
+            ClientCount = clientCount+1
+            PMC_Server_for_Client(ClientCount) = i
+         END if
+      END do
+      PMC_Server_for_Client(ClientCount+1) = -1
+
+      !   Get size of the server model
+
+      if(m_my_CPL_id > 1)  then
+         CALL MPI_Comm_remote_size (m_to_server_comm, m_server_remote_size, istat)
+      else
+         m_server_remote_size = -1             ! root model does not have a server
+      END if
+
+!      write(0,'(a,a,1x,9i7)') 'New Communicator ',trim(m_couplers(m_my_CPL_id)%name),m_world_npes,m_model_npes,m_world_rank, &
+!                                           m_model_rank,m_my_CPL_id,m_my_CPL_rank,m_server_remote_size,ClientCount
+
+      return
+   END SUBROUTINE PMC_init_model
+
+!  Make module private variables available to palm
+
+   SUBROUTINE PMC_get_local_model_info (my_CPL_id, CPL_name,  npe_x, npe_y, lower_left_x, lower_left_y)
+      IMPLICIT     none
+      INTEGER,INTENT(OUT),optional             :: my_CPL_id
+      CHARACTER(len=*),INTENT(OUT),optional    :: CPL_name
+      INTEGER,INTENT(OUT),optional             :: npe_x
+      INTEGER,INTENT(OUT),optional             :: npe_y
+      REAL(kind=8),INTENT(OUT),optional        :: lower_left_x
+      REAL(kind=8),INTENT(OUT),optional        :: lower_left_y
+
+      if(present(my_CPL_id))    my_CPL_id    = m_my_CPL_id
+      if(present(CPL_name))     CPL_name     = m_couplers(my_CPL_id)%name
+      if(present(npe_x))        npe_x        = m_couplers(my_CPL_id)%npe_x
+      if(present(npe_y))        npe_y        = m_couplers(my_CPL_id)%npe_y
+      if(present(lower_left_x)) lower_left_x = m_couplers(my_CPL_id)%lower_left_x
+      if(present(lower_left_y)) lower_left_y = m_couplers(my_CPL_id)%lower_left_y
+
+      return
+   END  SUBROUTINE PMC_get_local_model_info
+
+   LOGICAL function PMC_is_RootModel ()
+      IMPLICIT     none
+
+      PMC_is_RootModel = (m_my_CPL_id == 1)
+
+      return
+   END  function PMC_is_RootModel
+
+! Private SUBROUTINEs
+
+  SUBROUTINE read_coupling_layout (PMC_status)
+    IMPLICIT     none
+    INTEGER,INTENT(INOUT)           :: PMC_status
+    INTEGER                         :: i,iunit,istat
+    CHARACTER(LEN=*), PARAMETER     :: fname = 'PMC_couple_layout'
+    LOGICAL                         :: lex
+
+    m_NrOfCpl = 0
+    iunit     = 345
+
+    PMC_STATUS = PMC_STATUS_OK
+    INQUIRE(file=TRIM(fname), exist=lex)
+    IF (.NOT. lex) THEN
+       PMC_status = PMC_ERRO_NOF
+       RETURN
+    END IF
+
+    open(iunit,file=TRIM(fname),status='OLD')
+    do i=1,PMC_MAX_MODELL
+      read(iunit,*,iostat=istat) m_couplers(i)%name                     &
+           , m_couplers(i)%id,m_couplers(i)%Parent_id                   &
+           , m_couplers(i)%npe_x,m_couplers(i)%npe_y                    &
+           , m_couplers(i)%lower_left_x, m_couplers(i)%lower_left_y
+      if(istat /= 0)  EXIT
+
+      write(0,'(a,a,1x,4i7,1x,2F10.2)') 'Set up Model  ',trim(m_couplers(i)%name),m_couplers(i)%id,m_couplers(i)%Parent_id, &
+                                                     m_couplers(i)%npe_x,m_couplers(i)%npe_y,                               &
+                                                     m_couplers(i)%lower_left_x,m_couplers(i)%lower_left_y
+
+      m_NrOfCpl = i
+    END do
+    close(iunit)
+
+    return
+  END SUBROUTINE read_coupling_layout
+
+END MODULE PMC_handle_communicator
Index: palm/trunk/SOURCE/pmc_interface.f90
===================================================================
--- palm/trunk/SOURCE/pmc_interface.f90	(revision 1762)
+++ palm/trunk/SOURCE/pmc_interface.f90	(revision 1762)
@@ -0,0 +1,3640 @@
+MODULE pmc_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-2014 Leibniz Universitaet Hannover
+!--------------------------------------------------------------------------------!
+!
+! Current revisions:
+! ------------------
+! 
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! Renamed into pmc_interface                             23.02.2016  A. Hellsten & S. Raasch
+! Renamed into pmc_palm_interface                        12.11.2015  K. Ketelsen
+! Intoduction of the pure FORTRAN Palm Model Coupler     (PMC)
+!
+! Description:
+! ------------
+! Domain nesting interface routines. The low-level inter-domain communication   
+! is conducted by the PMC-library routines.
+!------------------------------------------------------------------------------!
+
+
+    USE mpi
+
+!
+!-- PALM modules
+    USE kinds
+    USE pegrid,                                                                           &
+        ONLY:  myid, numprocs, comm2d, comm1dx, comm1dy, myidx, myidy, collective_wait
+    USE arrays_3d,                                                                        &
+        ONLY:  u, v, w, e, pt, q, u_p, v_p, w_p, e_p, pt_p, q_p, z0, dzu, dzw, zu, zw,    &
+               tu_m, tv_m, tw_m, te_m
+    USE indices,                                                                          &
+        ONLY:  nx, ny, nz, nxl, nxr, nys, nyn, nzb, nzt, nxlu, nysv, nxlg, nxrg,          &
+               nysg, nyng, nbgp, nzb_u_inner, nzb_v_inner, nzb_w_inner,                   &
+               nzb_s_inner, nzb_u_outer, nzb_v_outer, nzb_w_outer
+    USE control_parameters,                                                               &
+        ONLY:  dz, dt_3d, simulated_time, message_string, volume_flow,                    &
+               nest_bound_l, nest_bound_r, nest_bound_s, nest_bound_n,                    &
+               topography, humidity, passive_scalar
+    USE grid_variables,                                                                   &
+        ONLY:  dx, dy
+    USE cpulog,                                                                           &
+        ONLY:  cpu_log, log_point_s
+
+!
+!-- PMC modules
+    USE pmc_general,                                                                      &
+        ONLY:  pmc_status_ok, pmc_max_modell, da_namelen
+    USE pmc_handle_communicator,                                                          &
+        ONLY:  pmc_init_model, pmc_is_rootmodel, pmc_get_local_model_info,                &
+               pmc_server_for_client
+    USE pmc_mpi_Wrapper,                                                                  &
+        ONLY:  pmc_recv_from_client, pmc_send_to_server, pmc_recv_from_server,            &
+               pmc_send_to_client, pmc_bcast
+    USE pmc_server,                                                                       &
+        ONLY:  pmc_serverinit, pmc_s_getnextarray,                                        &
+               pmc_s_set_dataarray, pmc_s_setind_and_allocmem,                            &
+               pmc_s_set_2d_index_list, pmc_s_fillbuffer,pmc_s_getdata_from_buffer
+    USE pmc_client,                                                                       &
+        ONLY:  pmc_clientinit, pmc_set_dataarray_name, pmc_c_get_2d_index_list,           &
+               pmc_c_getnextarray, pmc_c_set_dataarray, pmc_c_setind_and_allocmem,        &
+               pmc_c_putbuffer, pmc_c_getbuffer
+
+    IMPLICIT NONE
+
+    PRIVATE    !:  Note that the default publicity is here set to private.
+
+!
+!-- Constants
+    INTEGER(iwp), PARAMETER, PUBLIC        ::  client_to_server = 2   !:
+    INTEGER(iwp), PARAMETER, PUBLIC        ::  server_to_client = 1   !:
+
+!
+!-- Coupler setup
+    INTEGER(iwp), PUBLIC, SAVE             ::  cpl_id                 !:
+    CHARACTER(LEN=32), PUBLIC, SAVE        ::  cpl_name               !:
+    INTEGER(iwp), PUBLIC, SAVE             ::  cpl_npex               !: 
+    INTEGER(iwp), PUBLIC, SAVE             ::  cpl_npey               !:
+
+!
+!-- Control parameters, will be made input parameters later
+    CHARACTER(LEN=7), PUBLIC, SAVE         ::  nesting_mode = 'two-way'          !:
+    REAL(wp), PUBLIC, SAVE                 ::  anterp_relax_length_l = -1.0_wp   !:
+    REAL(wp), PUBLIC, SAVE                 ::  anterp_relax_length_r = -1.0_wp   !:
+    REAL(wp), PUBLIC, SAVE                 ::  anterp_relax_length_s = -1.0_wp   !:
+    REAL(wp), PUBLIC, SAVE                 ::  anterp_relax_length_n = -1.0_wp   !:
+    REAL(wp), PUBLIC, SAVE                 ::  anterp_relax_length_t = -1.0_wp   !:
+
+!
+!-- Geometry
+    REAL(wp), PUBLIC, SAVE                    ::  area_t               !:
+    REAL(wp), SAVE, DIMENSION(:), ALLOCATABLE ::  coord_x              !:
+    REAL(wp), SAVE, DIMENSION(:), ALLOCATABLE ::  coord_y              !:
+    REAL(wp), PUBLIC, SAVE                    ::  lower_left_coord_x   !:
+    REAL(wp), PUBLIC, SAVE                    ::  lower_left_coord_y   !:
+
+!
+!-- Client coarse data arrays
+    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET, PUBLIC ::  ec   !:
+    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET, PUBLIC ::  ptc  !:
+    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET, PUBLIC ::  uc   !:
+    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET, PUBLIC ::  vc   !:
+    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET, PUBLIC ::  wc   !:
+    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET, PUBLIC ::  qc   !:
+
+    INTEGER(iwp), DIMENSION(5)                          ::  coarse_bound   !: Moved here form map_fine_to_coarse.
+    REAL(wp), PUBLIC, SAVE                              ::  xexl           !:
+    REAL(wp), PUBLIC, SAVE                              ::  xexr           !:
+    REAL(wp), PUBLIC, SAVE                              ::  yexs           !:
+    REAL(wp), PUBLIC, SAVE                              ::  yexn           !:
+    REAL(wp), PUBLIC, SAVE, DIMENSION(:,:), ALLOCATABLE ::  tkefactor_l    !:
+    REAL(wp), PUBLIC, SAVE, DIMENSION(:,:), ALLOCATABLE ::  tkefactor_n    !:
+    REAL(wp), PUBLIC, SAVE, DIMENSION(:,:), ALLOCATABLE ::  tkefactor_r    !:
+    REAL(wp), PUBLIC, SAVE, DIMENSION(:,:), ALLOCATABLE ::  tkefactor_s    !:
+    REAL(wp), PUBLIC, SAVE, DIMENSION(:,:), ALLOCATABLE ::  tkefactor_t    !:
+
+!
+!-- Client interpolation coefficients and client-array indices to be precomputed and stored.
+    INTEGER(iwp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:) ::  ico    !:
+    INTEGER(iwp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:) ::  icu    !:
+    INTEGER(iwp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:) ::  jco    !:
+    INTEGER(iwp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:) ::  jcv    !:
+    INTEGER(iwp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:) ::  kco    !:
+    INTEGER(iwp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:) ::  kcw    !:
+    REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:)     ::  r1xo   !:
+    REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:)     ::  r2xo   !:
+    REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:)     ::  r1xu   !:
+    REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:)     ::  r2xu   !:
+    REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:)     ::  r1yo   !:
+    REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:)     ::  r2yo   !:
+    REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:)     ::  r1yv   !:
+    REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:)     ::  r2yv   !:
+    REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:)     ::  r1zo   !:
+    REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:)     ::  r2zo   !:
+    REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:)     ::  r1zw   !:
+    REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:)     ::  r2zw   !:
+
+!
+!-- Client index arrays and log-ratio arrays for the log-law near-wall corrections.
+!-- These are not truly 3-D arrays but multiply 2-D arrays.
+    INTEGER(iwp), PUBLIC, SAVE :: ncorr  !: ncorr is the 4th dimension of the log_ratio-arrays
+    INTEGER(iwp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_u_l   !:
+    INTEGER(iwp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_u_n   !:
+    INTEGER(iwp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_u_r   !:
+    INTEGER(iwp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_u_s   !:
+    INTEGER(iwp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_v_l   !:
+    INTEGER(iwp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_v_n   !:
+    INTEGER(iwp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_v_r   !:
+    INTEGER(iwp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_v_s   !:
+    INTEGER(iwp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_w_l   !:
+    INTEGER(iwp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_w_n   !:
+    INTEGER(iwp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_w_r   !:
+    INTEGER(iwp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_w_s   !:
+    REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_u_l   !:
+    REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_u_n   !:
+    REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_u_r   !:
+    REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_u_s   !:
+    REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_v_l   !:
+    REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_v_n   !:
+    REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_v_r   !:
+    REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_v_s   !:
+    REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_w_l   !:
+    REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_w_n   !:
+    REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_w_r   !:
+    REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_w_s   !:
+
+!
+!-- Upper bounds for k in anterpolation.
+    INTEGER(iwp), PUBLIC, SAVE ::  kceu   !:
+    INTEGER(iwp), PUBLIC, SAVE ::  kcew   !:
+
+!
+!-- Upper bound for k in log-law correction in interpolation.
+    INTEGER(iwp), PUBLIC, SAVE ::  nzt_topo_nestbc_l   !:
+    INTEGER(iwp), PUBLIC, SAVE ::  nzt_topo_nestbc_n   !:
+    INTEGER(iwp), PUBLIC, SAVE ::  nzt_topo_nestbc_r   !:
+    INTEGER(iwp), PUBLIC, SAVE ::  nzt_topo_nestbc_s   !:
+
+!
+!-- Number of ghost nodes in coarse-grid arrays for i and j in anterpolation.
+    INTEGER(iwp), PUBLIC, SAVE ::  nhll   !:
+    INTEGER(iwp), PUBLIC, SAVE ::  nhlr   !:
+    INTEGER(iwp), PUBLIC, SAVE ::  nhls   !:
+    INTEGER(iwp), PUBLIC, SAVE ::  nhln   !:
+
+!
+!-- Spatial under-relaxation coefficients for anterpolation.
+    REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:) ::  frax   !:
+    REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:) ::  fray   !:
+    REAL(wp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:) ::  fraz   !:
+
+!
+!-- Client-array indices to be precomputed and stored for anterpolation.
+    INTEGER(iwp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:) ::  iflu   !:
+    INTEGER(iwp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:) ::  ifuu   !:
+    INTEGER(iwp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:) ::  iflo   !:
+    INTEGER(iwp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:) ::  ifuo   !:
+    INTEGER(iwp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:) ::  jflv   !:
+    INTEGER(iwp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:) ::  jfuv   !:
+    INTEGER(iwp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:) ::  jflo   !:
+    INTEGER(iwp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:) ::  jfuo   !:
+    INTEGER(iwp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:) ::  kflw   !:
+    INTEGER(iwp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:) ::  kfuw   !:
+    INTEGER(iwp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:) ::  kflo   !:
+    INTEGER(iwp), PUBLIC, SAVE, ALLOCATABLE, DIMENSION(:) ::  kfuo   !:
+
+!
+!-- Module private variables.
+    INTEGER(iwp), DIMENSION(3)          ::  define_coarse_grid_int    !:
+    REAL(wp), DIMENSION(9)              ::  define_coarse_grid_real   !:
+
+    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        
+    END TYPE coarsegrid_def
+                                          
+    TYPE(coarsegrid_def), SAVE             ::  cg   !:
+
+!
+!-- Interface section.
+    INTERFACE pmci_init
+       MODULE PROCEDURE pmci_init
+    END INTERFACE
+    
+    INTERFACE pmci_modelconfiguration
+       MODULE PROCEDURE pmci_modelconfiguration
+    END INTERFACE
+    
+    INTERFACE pmci_server_synchronize
+       MODULE PROCEDURE pmci_server_synchronize
+    END INTERFACE
+    
+    INTERFACE pmci_client_synchronize
+       MODULE PROCEDURE pmci_client_synchronize
+    END INTERFACE
+    
+    INTERFACE pmci_server_datatrans
+       MODULE PROCEDURE pmci_server_datatrans
+    END INTERFACE
+    
+    INTERFACE pmci_client_datatrans
+       MODULE PROCEDURE pmci_client_datatrans
+    END INTERFACE
+    
+    INTERFACE pmci_update_new
+       MODULE PROCEDURE pmci_update_new
+    END INTERFACE
+
+    INTERFACE pmci_ensure_nest_mass_conservation
+       MODULE PROCEDURE pmci_ensure_nest_mass_conservation
+    END INTERFACE
+    
+    INTERFACE pmci_server_initialize
+       MODULE PROCEDURE pmci_server_initialize
+    END INTERFACE
+    
+    INTERFACE pmci_client_initialize
+       MODULE PROCEDURE pmci_client_initialize
+    END INTERFACE
+    
+    PUBLIC pmci_init
+    PUBLIC pmci_modelconfiguration
+    PUBLIC pmci_server_synchronize
+    PUBLIC pmci_client_synchronize
+    PUBLIC pmci_server_datatrans
+    PUBLIC pmci_client_datatrans
+    PUBLIC pmci_update_new
+    PUBLIC pmci_ensure_nest_mass_conservation
+    PUBLIC pmci_server_initialize
+    PUBLIC pmci_client_initialize
+
+
+ CONTAINS
+
+
+ SUBROUTINE pmci_init( world_comm )
+    IMPLICIT NONE
+
+    INTEGER, INTENT(OUT)  ::  world_comm   !:
+
+    INTEGER(iwp)          ::  ierr         !:
+    INTEGER(iwp)          ::  istat        !:
+    INTEGER(iwp)          ::  PMC_status   !:
+
+
+#if defined PMC_ACTIVE
+    CALL pmc_init_model( world_comm, pmc_status )
+    IF ( pmc_status /= pmc_status_ok )  THEN
+       CALL MPI_ABORT( MPI_COMM_WORLD, istat, ierr )
+    ENDIF
+    CALL pmc_get_local_model_info( my_cpl_id = cpl_id, cpl_name = cpl_name,  npe_x=cpl_npex, npe_y = cpl_npey,  &
+                                   lower_left_x = lower_left_coord_x, lower_left_y = lower_left_coord_y )
+#else
+    world_comm = MPI_COMM_WORLD
+    cpl_id     = 1
+    cpl_name   = ""
+    cpl_npex   = 2
+    cpl_npey   = 2
+    lower_left_coord_x = 0.0_wp
+    lower_left_coord_y = 0.0_wp
+#endif
+
+ END SUBROUTINE pmci_init
+
+
+
+ SUBROUTINE pmci_modelconfiguration
+    IMPLICIT NONE
+
+    CALL pmci_setup_coordinates   !:  Compute absolute coordinates valid for all models
+    CALL pmci_setup_client        !:  Initialize PMC Client (Must be called before pmc_palm_SetUp_Server)
+    CALL pmci_setup_server        !:  Initialize PMC Server
+
+ END SUBROUTINE pmci_modelconfiguration
+
+
+
+ SUBROUTINE pmci_setup_server
+    IMPLICIT NONE
+
+    INTEGER(iwp)               ::  client_id        !:
+    INTEGER(iwp)               ::  ierr             !:
+    INTEGER(iwp)               ::  i                !:
+    INTEGER(iwp)               ::  j                !:
+    INTEGER(iwp)               ::  k                !:
+    INTEGER(iwp)               ::  m                !:
+    INTEGER(iwp)               ::  nomatch          !:
+    INTEGER(iwp)               ::  nx_cl            !:
+    INTEGER(iwp)               ::  ny_cl            !:
+    INTEGER(iwp)               ::  nz_cl            !:
+    INTEGER(iwp), DIMENSION(5) ::  val              !:
+    REAL(wp), DIMENSION(1)     ::  fval             !:
+    REAL(wp)                   ::  dx_cl            !:
+    REAL(wp)                   ::  dy_cl            !:
+    REAL(wp)                   ::  xez              !:
+    REAL(wp)                   ::  yez              !:
+    CHARACTER(len=32)          ::  mychannel
+    CHARACTER(len=32)          ::  myname
+    REAL(wp), DIMENSION(:), ALLOCATABLE ::  cl_coord_x   !:
+    REAL(wp), DIMENSION(:), ALLOCATABLE ::  cl_coord_y   !:
+    
+
+#if defined PMC_ACTIVE
+    CALL pmc_serverinit                                !  Initialize PMC Server
+
+!
+!-- Get coordinates from all Clients.
+    DO  m = 1, SIZE( pmc_server_for_client ) - 1
+       client_id = pmc_server_for_client(m)
+       IF ( myid == 0 )  THEN        
+
+          CALL pmc_recv_from_client( client_id, val,  size(val),  0, 123, ierr )
+          CALL pmc_recv_from_client( client_id, fval, size(fval), 0, 124, ierr )
+         
+          nx_cl = val(1)
+          ny_cl = val(2)
+          dx_cl = val(4)
+          dy_cl = val(5)
+
+          nz_cl = nz
+
+!
+!--       Find the highest client level in the coarse grid for the reduced z transfer
+          DO  k = 1, nz                 
+             IF ( zw(k) > fval(1) )  THEN
+                nz_cl = k
+                EXIT
+             ENDIF
+          ENDDO
+
+!    
+!--       Get absolute coordinates from the client
+          ALLOCATE( cl_coord_x(-nbgp:nx_cl+nbgp) )
+          ALLOCATE( cl_coord_y(-nbgp:ny_cl+nbgp) )
+         
+          CALL pmc_recv_from_client( client_id, cl_coord_x, SIZE( cl_coord_x ), 0, 11, ierr )
+          CALL pmc_recv_from_client( client_id, cl_coord_y, SIZE( cl_coord_y ), 0, 12, ierr )
+          WRITE ( 0, * )  'receive from pmc Client ', client_id, nx_cl, ny_cl
+         
+          define_coarse_grid_real(1) = lower_left_coord_x
+          define_coarse_grid_real(2) = lower_left_coord_y
+          define_coarse_grid_real(3) = 0                                      !  KK currently not used.
+          define_coarse_grid_real(4) = 0
+          define_coarse_grid_real(5) = dx
+          define_coarse_grid_real(6) = dy
+          define_coarse_grid_real(7) = lower_left_coord_x + ( nx + 1 ) * dx   !  AH: corrected 6.2.2015
+          define_coarse_grid_real(8) = lower_left_coord_y + ( ny + 1 ) * dy   !  AH: corrected 6.2.2015
+          define_coarse_grid_real(9) = dz                                     !  AH: added 24.2.2015
+
+          define_coarse_grid_int(1)  = nx
+          define_coarse_grid_int(2)  = ny
+          define_coarse_grid_int(3)  = nz_cl
+
+!
+!--       Check that the client domain is completely inside the server domain. 
+          nomatch = 0
+          xez = ( nbgp + 1 ) * dx 
+          yez = ( nbgp + 1 ) * dy 
+          IF ( cl_coord_x(0) < define_coarse_grid_real(1) + xez )          nomatch = 1 
+          IF ( cl_coord_x(nx_cl + 1) > define_coarse_grid_real(7) - xez )  nomatch = 1 
+          IF ( cl_coord_y(0) < define_coarse_grid_real(2) + yez )          nomatch = 1 
+          IF ( cl_coord_y(ny_cl + 1) > define_coarse_grid_real(8) - yez )  nomatch = 1
+
+          DEALLOCATE( cl_coord_x )
+          DEALLOCATE( cl_coord_y )
+
+!
+!--       Send coarse grid information to client
+          CALL pmc_send_to_client( client_id, Define_coarse_grid_real, 9, 0, 21, ierr )
+          CALL pmc_send_to_client( client_id, Define_coarse_grid_int,  3, 0, 22, ierr )
+
+!
+!--       Send local grid to client.
+          CALL pmc_send_to_client( client_id, coord_x, nx+1+2*nbgp, 0, 24, ierr )
+          CALL pmc_send_to_client( client_id, coord_y, ny+1+2*nbgp, 0, 25, ierr )
+
+!
+!--       Also send the dzu-, dzw-, zu- and zw-arrays here.    
+          CALL pmc_send_to_client( client_id, dzu, nz_cl + 1, 0, 26, ierr )
+          CALL pmc_send_to_client( client_id, dzw, nz_cl + 1, 0, 27, ierr )
+          CALL pmc_send_to_client( client_id, zu,  nz_cl + 2, 0, 28, ierr )
+          CALL pmc_send_to_client( client_id, zw,  nz_cl + 2, 0, 29, ierr )
+
+       ENDIF
+
+       CALL MPI_Bcast( nomatch, 1, MPI_INTEGER, 0, comm2d, ierr )
+       IF ( nomatch /= 0 ) THEN
+          WRITE ( message_string, * )  'Error: nested client domain does not fit ',    &
+                                       'into its server domain'
+          CALL message( 'pmc_palm_setup_server', 'PA0XYZ', 1, 2, 0, 6, 0 )
+       ENDIF
+      
+       CALL MPI_Bcast( nz_cl, 1, MPI_INTEGER, 0, comm2d, ierr )
+       
+       CALL pmci_create_index_list
+
+!
+!--    Include couple arrays into server content
+       DO  WHILE ( pmc_s_getnextarray( client_id, myname ) )
+          CALL pmci_set_array_pointer( myName, client_id = client_id, nz_cl = nz_cl )
+       ENDDO
+       CALL pmc_s_setind_and_allocmem( client_id )
+    ENDDO
+
+#endif
+
+
+ CONTAINS
+
+
+   SUBROUTINE pmci_create_index_list
+       IMPLICIT NONE
+       INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE  ::  coarse_bound_all   !:
+       INTEGER(iwp)                               ::  i                  !:
+       INTEGER(iwp)                               ::  ic                 !:
+       INTEGER(iwp)                               ::  ierr               !:
+       INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE  ::  index_list         !:
+       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), DIMENSION(2)                 ::  scoord             !:
+       INTEGER(iwp)                               ::  server_pe          !:
+       INTEGER(iwp), DIMENSION(2)                 ::  size_of_array      !:
+
+
+       IF ( myid == 0 )  THEN
+          CALL pmc_recv_from_client( client_id, size_of_array, 2, 0, 40, ierr )
+          ALLOCATE( coarse_bound_all(size_of_array(1),size_of_array(2)) )
+          CALL pmc_recv_from_client( client_id, coarse_bound_all, SIZE( coarse_bound_all ), 0, 41, ierr )
+
+!
+!--       Compute size of index_list.
+          ic = 0
+          DO  k = 1, size_of_array(2)
+             DO  j = coarse_bound_all(3,k), coarse_bound_all(4,k)
+                DO  i = coarse_bound_all(1,k), coarse_bound_all(2,k)
+                   ic = ic + 1
+                ENDDO
+             ENDDO
+          ENDDO
+
+          ALLOCATE( index_list(6,ic) )
+
+          CALL MPI_Comm_size( comm1dx, npx, ierr )
+          CALL MPI_Comm_size( comm1dy, npy, ierr )
+
+          nrx = nxr - nxl + 1   !  +1 in index because FORTRAN indexing starts with 1, palm with 0
+          nry = nyn - nys + 1
+          ic  = 0
+          DO  k = 1, size_of_array(2)                                   !  loop over all client PEs
+             DO  j = coarse_bound_all(3,k), coarse_bound_all(4,k)       !  area in y required by actual client PE
+                DO  i = coarse_bound_all(1,k), coarse_bound_all(2,k)    !  area in x required by actual client PE
+                   px = i / nrx
+                   py = j / nry
+                   scoord(1) = px
+                   scoord(2) = py
+                   CALL MPI_Cart_rank( comm2d, scoord, server_pe, ierr )
+                  
+                   ic = ic + 1
+                   index_list(1,ic) = i - ( px * nrx ) + 1 + nbgp       !  First index in Server Array
+                   index_list(2,ic) = j - ( py * nry ) + 1 + nbgp       !  Second index in Server Array
+                   index_list(3,ic) = i - coarse_bound_all(1,k) + 1     !  x Index client coarse grid
+                   index_list(4,ic) = j - coarse_bound_all(3,k) + 1     !  y Index client coarse grid
+                   index_list(5,ic) = k - 1                             !  PE Number client
+                   index_list(6,ic) = server_pe                         !  PE Number server
+                ENDDO
+             ENDDO
+          ENDDO
+          CALL pmc_s_set_2d_index_list( client_id, index_list(:,1:ic) )
+       ELSE
+          ALLOCATE( index_list(6,1) )                                   !  Dummy allocate
+          CALL pmc_s_set_2d_index_list( client_id, index_list )
+       ENDIF
+
+       DEALLOCATE(index_list)
+
+     END SUBROUTINE pmci_create_index_list
+
+
+ END SUBROUTINE pmci_setup_server
+
+
+
+ SUBROUTINE pmci_setup_client
+    IMPLICIT NONE
+    INTEGER(iwp)               ::  i          !:
+    INTEGER(iwp)               ::  ierr       !:
+    INTEGER(iwp)               ::  icl        !:
+    INTEGER(iwp)               ::  icr        !:
+    INTEGER(iwp)               ::  j          !:
+    INTEGER(iwp)               ::  jcn        !:
+    INTEGER(iwp)               ::  jcs        !:
+    INTEGER(iwp), DIMENSION(5) ::  val        !:
+    
+    REAL(wp)                   ::  area_t_l   !:
+    REAL(wp), DIMENSION(1)     ::  fval       !:
+    REAL(wp)                   ::  xcs        !:
+    REAL(wp)                   ::  xce        !:
+    REAL(wp)                   ::  ycs        !:
+    REAL(wp)                   ::  yce        !:
+    REAL(wp)                   ::  zct        !:
+    REAL(wp), DIMENSION(4)     ::  ztt        !:
+                                             
+    CHARACTER(LEN=DA_Namelen)  ::  myname     !:
+
+
+#if defined PMC_ACTIVE
+    IF ( .not. pmc_is_rootmodel() )  THEN     !  Root Model does not have Server and is not a client
+       CALL pmc_clientinit
+       
+       CALL pmc_set_dataarray_name( 'coarse', 'u'  ,'fine', 'u',  ierr )
+       CALL pmc_set_dataarray_name( 'coarse', 'v'  ,'fine', 'v',  ierr )
+       CALL pmc_set_dataarray_name( 'coarse', 'w'  ,'fine', 'w',  ierr )
+       CALL pmc_set_dataarray_name( 'coarse', 'e'  ,'fine', 'e',  ierr )
+       CALL pmc_set_dataarray_name( 'coarse', 'pt' ,'fine', 'pt', ierr )
+       IF ( humidity  .OR.  passive_scalar )  THEN
+          CALL pmc_set_dataarray_name( 'coarse', 'q'  ,'fine', 'q',  ierr )
+       ENDIF
+
+!
+!--    Update this list appropritely and also in create_client_arrays and in pmci_set_array_pointer.
+!--    If a variable is removed, it only has tobe removed from here.
+       CALL pmc_set_dataarray_name( lastentry = .true. )
+
+!
+!--    Send grid to Server
+       val(1)  = nx
+       val(2)  = ny
+       val(3)  = nz
+       val(4)  = dx
+       val(5)  = dy
+       fval(1) = zw(nzt+1)
+
+       IF ( myid == 0 )  THEN
+          CALL pmc_send_to_server( val, SIZE( val ), 0, 123, ierr )
+          CALL pmc_send_to_server( fval, SIZE( fval ), 0, 124, ierr )
+          CALL pmc_send_to_server( coord_x, nx + 1 + 2 * nbgp, 0, 11, ierr )
+          CALL pmc_send_to_server( coord_y, ny + 1 + 2 * nbgp, 0, 12, ierr )
+
+!
+!--       Receive Coarse grid information.
+          CALL pmc_recv_from_server( define_coarse_grid_real, 9, 0, 21, ierr )
+          CALL pmc_recv_from_server( define_coarse_grid_int,  3, 0, 22, ierr )
+
+!
+!--       Receive also the dz-,zu- and zw-arrays here.         
+          WRITE(0,*) 'Coarse grid from Server '
+          WRITE(0,*) 'startx_tot    = ',define_coarse_grid_real(1)
+          WRITE(0,*) 'starty_tot    = ',define_coarse_grid_real(2)
+          WRITE(0,*) 'endx_tot      = ',define_coarse_grid_real(7)
+          WRITE(0,*) 'endy_tot      = ',define_coarse_grid_real(8)
+          WRITE(0,*) 'dx            = ',define_coarse_grid_real(5)
+          WRITE(0,*) 'dy            = ',define_coarse_grid_real(6)
+          WRITE(0,*) 'dz            = ',define_coarse_grid_real(9)
+          WRITE(0,*) 'nx_coarse     = ',define_coarse_grid_int(1)
+          WRITE(0,*) 'ny_coarse     = ',define_coarse_grid_int(2)
+          WRITE(0,*) 'nz_coarse     = ',define_coarse_grid_int(3)        
+       ENDIF
+
+       CALL MPI_Bcast( define_coarse_grid_real, 9, MPI_REAL, 0, comm2d, ierr )
+       CALL MPI_Bcast( define_coarse_grid_int,  3, MPI_INTEGER, 0, comm2d, ierr )
+
+       cg%dx = define_coarse_grid_real(5)
+       cg%dy = define_coarse_grid_real(6)
+       cg%dz = define_coarse_grid_real(9)
+       cg%nx = define_coarse_grid_int(1)
+       cg%ny = define_coarse_grid_int(2)
+       cg%nz = define_coarse_grid_int(3)
+
+!
+!--    Get Server coordinates on coarse grid
+       ALLOCATE( cg%coord_x(-nbgp:cg%nx+nbgp) )
+       ALLOCATE( cg%coord_y(-nbgp:cg%ny+nbgp) )
+      
+       ALLOCATE( cg%dzu(1:cg%nz+1) )
+       ALLOCATE( cg%dzw(1:cg%nz+1) )
+       ALLOCATE( cg%zu(0:cg%nz+1) )
+       ALLOCATE( cg%zw(0:cg%nz+1) )
+
+!
+!--    Get coarse grid coordinates and vales of the z-direction from server
+       IF ( myid == 0) THEN
+          CALL pmc_recv_from_server( cg%coord_x, cg%nx + 1 + 2 * nbgp, 0, 24, ierr )
+          CALL pmc_recv_from_server( cg%coord_y, cg%ny + 1 + 2 * nbgp, 0, 25, ierr )         
+          CALL pmc_recv_from_server( cg%dzu, cg%nz + 1, 0, 26, ierr )
+          CALL pmc_recv_from_server( cg%dzw, cg%nz + 1, 0, 27, ierr )
+          CALL pmc_recv_from_server( cg%zu, cg%nz + 2, 0, 28, ierr )
+          CALL pmc_recv_from_server( cg%zw, cg%nz + 2, 0, 29, ierr )
+       ENDIF
+
+!
+!--    and broadcast this information
+       CALL MPI_Bcast( cg%coord_x, cg%nx + 1 + 2 * nbgp, MPI_REAL, 0, comm2d, ierr )
+       CALL MPI_Bcast( cg%coord_y, cg%ny + 1 + 2 * nbgp, MPI_REAL, 0, comm2d, ierr )
+       CALL MPI_Bcast( cg%dzu, cg%nz + 1, MPI_REAL, 0, comm2d, ierr )
+       CALL MPI_Bcast( cg%dzw, cg%nz + 1, MPI_REAL, 0, comm2d, ierr )
+       CALL MPI_Bcast( cg%zu, cg%nz + 2,  MPI_REAL, 0, comm2d, ierr )
+       CALL MPI_Bcast( cg%zw, cg%nz + 2,  MPI_REAL, 0, comm2d, ierr )
+       
+       CALL pmci_map_fine_to_coarse_grid
+
+       CALL pmc_c_get_2d_index_list
+
+!
+!--    Include couple arrays into client content.
+       DO  WHILE ( pmc_c_getnextarray( myname ) )
+          CALL pmci_create_client_arrays ( myName, icl, icr, jcs, jcn,  cg%nz )   !  Klaus, why the c-arrays are still up to cg%nz??
+       ENDDO
+       CALL pmc_c_setind_and_allocmem
+
+!
+!--    Precompute interpolation coefficients and client-array indices.
+       CALL pmci_init_interp_tril
+
+!
+!--    Precompute the log-law correction index- and ratio-arrays 
+       CALL pmci_init_loglaw_correction 
+
+!
+!--    Define the SGS-TKE scaling factor based on the grid-spacing ratio. 
+       CALL pmci_init_tkefactor
+
+!
+!--    Two-way coupling      
+       IF ( nesting_mode == 'two-way' ) THEN
+          CALL pmci_init_anterp_tophat
+       ENDIF
+
+!
+!--    Finally, compute the total area of the top-boundary face of the domain.
+!--    This is needed in the pmc_ensure_nest_mass_conservation      
+       area_t_l = ( nxr + 1 - nxl ) * ( nyn + 1 - nys ) * dx * dy
+       IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
+       CALL MPI_ALLREDUCE( area_t_l, area_t, 1, MPI_REAL, MPI_SUM, comm2d, ierr )
+
+!
+!--    Why not just simply? test this!
+       !area_t_l = ( nx + 1 ) * (ny + 1 ) * dx * dy            
+
+    ENDIF   !  IF ( .not. PMC_is_RootModel ) 
+#endif
+
+
+ CONTAINS
+
+
+    SUBROUTINE pmci_map_fine_to_coarse_grid
+        IMPLICIT NONE
+        INTEGER(iwp), DIMENSION(5,numprocs)  ::  coarse_bound_all   !:
+        INTEGER(iwp), DIMENSION(2)           ::  size_of_array      !:
+                                              
+        REAL(wp)                             ::  coarse_dx   !:
+        REAL(wp)                             ::  coarse_dy   !:
+        REAL(wp)                             ::  loffset     !:
+        REAL(wp)                             ::  roffset     !:
+        REAL(wp)                             ::  noffset     !:
+        REAL(wp)                             ::  soffset     !:
+
+!
+!--     Determine indices of interpolation/anterpolation area in coarse grid.
+        coarse_dx = cg%dx
+        coarse_dy = cg%dy
+        
+        loffset = MOD( coord_x(nxl), coarse_dx )       !  If the fine- and coarse grid nodes do not match.
+        xexl    = coarse_dx + loffset
+        nhll    = CEILING( xexl / coarse_dx )          !  This is needed in the anterpolation phase.
+        xcs     = coord_x(nxl) - xexl
+        DO  i = 0, cg%nx
+           IF ( cg%coord_x(i) > xcs )  THEN
+              icl = MAX( -1, i-1 )  
+              EXIT
+           ENDIF
+        ENDDO
+
+        roffset = MOD( coord_x(nxr + 1), coarse_dx )   !  If the fine- and coarse grid nodes do not match.
+        xexr    = coarse_dx + roffset
+        nhlr    = CEILING( xexr / coarse_dx )          !  This is needed in the anterpolation phase.
+        xce     = coord_x(nxr) + xexr
+        DO  i = cg%nx, 0 , -1
+           IF ( cg%coord_x(i) < xce )  THEN
+              icr = MIN( cg%nx + 1, i + 1 )
+              EXIT
+           ENDIF
+        ENDDO
+
+        soffset = MOD( coord_y(nys), coarse_dy )       !  If the fine- and coarse grid nodes do not match
+        yexs    = coarse_dy + soffset
+        nhls    = CEILING( yexs / coarse_dy )          !  This is needed in the anterpolation phase.
+        ycs     = coord_y(nys) - yexs
+        DO  j = 0, cg%ny
+           IF ( cg%coord_y(j) > ycs )  THEN
+              jcs = MAX( -nbgp, j - 1 )  
+              EXIT
+           ENDIF
+        ENDDO
+
+        noffset = MOD( coord_y(nyn + 1), coarse_dy )   !  If the fine- and coarse grid nodes do not match
+        yexn    = coarse_dy + noffset
+        nhln    = CEILING( yexn / coarse_dy )          !  This is needed in the anterpolation phase.
+        yce     = coord_y(nyn) + yexn
+        DO  j = cg%ny, 0, -1
+           IF ( cg%coord_y(j) < yce )  THEN
+              jcn = MIN( cg%ny + nbgp, j + 1 )  
+              EXIT
+           ENDIF
+        ENDDO
+
+        WRITE( 0, * )  'Coarse area ', myid, icl, icr, jcs, jcn
+
+        coarse_bound(1) = icl
+        coarse_bound(2) = icr
+        coarse_bound(3) = jcs
+        coarse_bound(4) = jcn
+        coarse_bound(5) = myid
+!
+!--     Note that MPI_Gather receives data from all processes in the rank order. 
+        CALL MPI_Gather( coarse_bound, 5, MPI_INTEGER, coarse_bound_all, 5, &
+                         MPI_INTEGER, 0, comm2d, ierr )
+
+        IF ( myid == 0 )  THEN
+           size_of_array(1) = SIZE( coarse_bound_all, 1 )
+           size_of_array(2) = SIZE( coarse_bound_all, 2 )
+           CALL pmc_send_to_server( size_of_array, 2, 0, 40, ierr )
+           CALL pmc_send_to_server( coarse_bound_all, SIZE( coarse_bound_all ), 0, 41, ierr )
+        ENDIF
+
+   END SUBROUTINE pmci_map_fine_to_coarse_grid
+
+
+
+   SUBROUTINE pmci_init_interp_tril
+
+!
+!--   Precomputation of the interpolation coefficients and client-array indices 
+!--   to be used by the interpolation routines interp_tril_lr, interp_tril_ns and 
+!--   interp_tril_t. Constant dz is still assumed.
+!
+!--                                  Antti Hellsten 3.3.2015.
+!
+!--   Modified for variable dz, but not yet tested.
+!--                                  Antti Hellsten 27.3.2015.
+!
+      IMPLICIT NONE
+
+      INTEGER(iwp) ::  i       !:
+      INTEGER(iwp) ::  i1      !:
+      INTEGER(iwp) ::  j       !:
+      INTEGER(iwp) ::  j1      !:
+      INTEGER(iwp) ::  k       !:
+      INTEGER(iwp) ::  kc      !:
+
+      REAL(wp) ::  coarse_dx   !:
+      REAL(wp) ::  coarse_dy   !:
+      REAL(wp) ::  coarse_dz   !:
+      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        !:
+      
+
+      coarse_dx = cg%dx
+      coarse_dy = cg%dy
+      coarse_dz = cg%dz
+      xb        = nxl * dx 
+      yb        = nys * dy
+      
+      ALLOCATE( icu(nxlg:nxrg) )
+      ALLOCATE( ico(nxlg:nxrg) )
+      ALLOCATE( jcv(nysg:nyng) )
+      ALLOCATE( jco(nysg:nyng) )
+      ALLOCATE( kcw(nzb:nzt+1) )
+      ALLOCATE( kco(nzb:nzt+1) )
+      ALLOCATE( r1xu(nxlg:nxrg) )
+      ALLOCATE( r2xu(nxlg:nxrg) )
+      ALLOCATE( r1xo(nxlg:nxrg) )
+      ALLOCATE( r2xo(nxlg:nxrg) )
+      ALLOCATE( r1yv(nysg:nyng) )
+      ALLOCATE( r2yv(nysg:nyng) )
+      ALLOCATE( r1yo(nysg:nyng) )
+      ALLOCATE( r2yo(nysg:nyng) )
+      ALLOCATE( r1zw(nzb:nzt+1) )
+      ALLOCATE( r2zw(nzb:nzt+1) )
+      ALLOCATE( r1zo(nzb:nzt+1) )
+      ALLOCATE( r2zo(nzb:nzt+1) )
+
+!
+!--   Note that the node coordinates xfs... and xcs... are relative 
+!--   to the lower-left-bottom corner of the fc-array, not the actual 
+!--   client domain corner.
+      DO  i = nxlg, nxrg
+         xfsu    = coord_x(i) - ( lower_left_coord_x + xb - xexl )
+         xfso    = coord_x(i) + 0.5_wp * dx - ( lower_left_coord_x + xb - xexl )
+         icu(i)  = icl + FLOOR( xfsu / coarse_dx )
+         ico(i)  = icl + FLOOR( ( xfso - 0.5_wp * coarse_dx ) / coarse_dx )
+         xcsu    = ( icu(i) - icl ) * coarse_dx 
+         xcso    = ( ico(i) - icl ) * coarse_dx + 0.5_wp * coarse_dx
+         r2xu(i) = ( xfsu - xcsu ) / coarse_dx
+         r2xo(i) = ( xfso - xcso ) / coarse_dx
+         r1xu(i) = 1.0_wp - r2xu(i)
+         r1xo(i) = 1.0_wp - r2xo(i)
+      ENDDO
+
+      DO  j = nysg, nyng
+         yfsv    = coord_y(j) - ( lower_left_coord_y + yb - yexs )
+         yfso    = coord_y(j) + 0.5_wp * dy - ( lower_left_coord_y + yb - yexs )
+         jcv(j)  = jcs + FLOOR( yfsv/coarse_dy )           
+         jco(j)  = jcs + FLOOR( ( yfso -0.5_wp * coarse_dy ) / coarse_dy )
+         ycsv    = ( jcv(j) - jcs ) * coarse_dy
+         ycso    = ( jco(j) - jcs ) * coarse_dy + 0.5_wp * coarse_dy         
+         r2yv(j) = ( yfsv - ycsv ) / coarse_dy            
+         r2yo(j) = ( yfso - ycso ) / coarse_dy  
+         r1yv(j) = 1.0_wp - r2yv(j)
+         r1yo(j) = 1.0_wp - r2yo(j)        
+      ENDDO
+
+      DO  k = nzb, nzt + 1
+         zfsw = zw(k)
+         zfso = zu(k)
+
+         kc = 0
+         DO  WHILE ( cg%zw(kc) <= zfsw ) 
+            kc = kc + 1
+         ENDDO
+         kcw(k) = kc - 1
+         
+         kc = 0
+         DO  WHILE ( cg%zu(kc) <= zfso ) 
+            kc = kc + 1
+         ENDDO
+         kco(k) = kc - 1
+
+         zcsw    = cg%zw(kcw(k))
+         zcso    = cg%zu(kco(k))
+         r2zw(k) = ( zfsw - zcsw ) / cg%dzw(kcw(k) + 1 )
+         r2zo(k) = ( zfso - zcso ) / cg%dzu(kco(k) + 1 )
+         r1zw(k) = 1.0_wp - r2zw(k)
+         r1zo(k) = 1.0_wp - r2zo(k)
+      ENDDO
+      
+   END SUBROUTINE pmci_init_interp_tril
+
+
+
+   SUBROUTINE pmci_init_loglaw_correction
+
+!
+!--   Precomputation of the index and log-ratio arrays for the log-law corrections
+!--   for near-wall nodes after the nest-BC interpolation.
+!--   These are used by the interpolation routines interp_tril_lr and interp_tril_ns.
+!
+!--                                  Antti Hellsten 30.12.2015.
+!
+      IMPLICIT NONE
+      INTEGER(iwp) ::  direction    !:  Wall normal index: 1=k, 2=j, 3=i.  
+      INTEGER(iwp) ::  i            !:
+      INTEGER(iwp) ::  icorr        !:
+      INTEGER(iwp) ::  inc          !:  Wall outward-normal index increment -1 or 1, for direction=1, inc=1 always. 
+      INTEGER(iwp) ::  iw           !:
+      INTEGER(iwp) ::  j            !:
+      INTEGER(iwp) ::  jcorr        !:
+      INTEGER(iwp) ::  jw           !:
+      INTEGER(iwp) ::  k            !:
+      INTEGER(iwp) ::  kb           !:
+      INTEGER(iwp) ::  kcorr        !:
+      INTEGER(iwp) ::  lc           !:
+      INTEGER(iwp) ::  ni           !:
+      INTEGER(iwp) ::  nj           !:
+      INTEGER(iwp) ::  nk           !:
+      INTEGER(iwp) ::  nzt_topo_max !:
+      INTEGER(iwp) ::  wall_index   !:  Index of the wall-node coordinate
+
+      REAL(wp), ALLOCATABLE, DIMENSION(:) ::  lcr   !:
+      LOGICAL  ::  more             !:
+
+!
+!--   First determine the maximum k-index needed for the near-wall corrections.
+!--   This maximum is individual for each boundary to minimize the storage requirements
+!--   and to minimize the corresponding loop k-range in the interpolation routines.
+      nzt_topo_nestbc_l = nzb
+      IF ( nest_bound_l )  THEN
+         DO  i = nxl - 1, nxl
+            DO  j = nys, nyn
+               nzt_topo_nestbc_l = MAX( nzt_topo_nestbc_l, nzb_u_inner(j,i), nzb_v_inner(j,i), nzb_w_inner(j,i) )
+            ENDDO
+         ENDDO
+         nzt_topo_nestbc_l = nzt_topo_nestbc_l + 1
+      ENDIF
+      
+      nzt_topo_nestbc_r = nzb
+      IF ( nest_bound_r )  THEN
+         i = nxr + 1
+         DO  j = nys, nyn
+            nzt_topo_nestbc_r = MAX( nzt_topo_nestbc_r, nzb_u_inner(j,i), nzb_v_inner(j,i), nzb_w_inner(j,i) )
+         ENDDO
+         nzt_topo_nestbc_r = nzt_topo_nestbc_r + 1       
+      ENDIF
+
+      nzt_topo_nestbc_s = nzb
+      IF ( nest_bound_s )  THEN
+         DO  j = nys - 1, nys
+            DO  i = nxl, nxr
+               nzt_topo_nestbc_s = MAX( nzt_topo_nestbc_s, nzb_u_inner(j,i), nzb_v_inner(j,i), nzb_w_inner(j,i) )
+            ENDDO
+         ENDDO
+         nzt_topo_nestbc_s = nzt_topo_nestbc_s + 1      
+      ENDIF
+
+      nzt_topo_nestbc_n = nzb
+      IF ( nest_bound_n )  THEN
+         j = nyn + 1
+         DO  i = nxl, nxr
+            nzt_topo_nestbc_n = MAX( nzt_topo_nestbc_n, nzb_u_inner(j,i), nzb_v_inner(j,i), nzb_w_inner(j,i) )
+         ENDDO
+         nzt_topo_nestbc_n = nzt_topo_nestbc_n + 1
+      ENDIF
+
+!
+!--  Then determine the maximum number of near-wall nodes per wall point based on the grid-spacing ratios.
+      nzt_topo_max = MAX( nzt_topo_nestbc_l, nzt_topo_nestbc_r, nzt_topo_nestbc_s, nzt_topo_nestbc_n )
+      ni = CEILING( cg%dx / dx ) / 2   !  Note that the outer division must be integer division.
+      nj = CEILING( cg%dy / dy ) / 2   !  Note that the outer division must be integer division.
+      nk = 1
+      DO  k = 1, nzt_topo_max
+         nk = MAX( nk, CEILING( cg%dzu(k) / dzu(k) ) )
+      ENDDO
+      nk = nk / 2   !  Note that this must be integer division.
+      ncorr =  MAX( ni, nj, nk )
+
+      ALLOCATE( lcr(0:ncorr - 1) )
+      lcr = 1.0_wp
+
+!
+!--   First horizontal walls.
+!--   Left boundary.
+      IF ( nest_bound_l )   THEN
+         ALLOCATE( logc_u_l(nzb:nzt_topo_nestbc_l, nys:nyn, 1:2) )
+         ALLOCATE( logc_v_l(nzb:nzt_topo_nestbc_l, nys:nyn, 1:2) )
+         ALLOCATE( logc_ratio_u_l(nzb:nzt_topo_nestbc_l, nys:nyn, 1:2, 0:ncorr-1) )
+         ALLOCATE( logc_ratio_v_l(nzb:nzt_topo_nestbc_l, nys:nyn, 1:2, 0:ncorr-1) )
+         logc_u_l       = 0
+         logc_v_l       = 0
+         logc_ratio_u_l = 1.0_wp
+         logc_ratio_v_l = 1.0_wp
+         direction      = 1
+         inc            = 1
+
+         DO  j = nys, nyn      
+
+!
+!--         Left boundary for u.
+            i   = 0
+            kb  = nzb_u_inner(j,i)
+            k   = kb + 1
+            wall_index = kb 
+            CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j, inc, wall_index, z0(j,i), kb, direction, ncorr )
+            logc_u_l(k,j,1) = lc
+            logc_ratio_u_l(k,j,1,0:ncorr-1) = lcr(0:ncorr-1)
+            lcr(0:ncorr-1) = 1.0_wp
+
+!
+!--         Left boundary for v.
+            i   = -1
+            kb  =  nzb_v_inner(j,i)
+            k   =  kb + 1
+            wall_index = kb 
+            CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j, inc, wall_index, z0(j,i), kb, direction, ncorr )
+            logc_v_l(k,j,1) = lc
+            logc_ratio_v_l(k,j,1,0:ncorr-1) = lcr(0:ncorr-1)
+            lcr(0:ncorr-1) = 1.0_wp
+         ENDDO
+      ENDIF
+
+!
+!--   Right boundary.
+      IF ( nest_bound_r )  THEN
+         ALLOCATE( logc_u_r(nzb:nzt_topo_nestbc_r,nys:nyn,1:2) )
+         ALLOCATE( logc_v_r(nzb:nzt_topo_nestbc_r,nys:nyn,1:2) )
+         ALLOCATE( logc_ratio_u_r(nzb:nzt_topo_nestbc_r,nys:nyn,1:2,0:ncorr-1) )
+         ALLOCATE( logc_ratio_v_r(nzb:nzt_topo_nestbc_r,nys:nyn,1:2,0:ncorr-1) )
+         logc_u_r       = 0
+         logc_v_r       = 0
+         logc_ratio_u_r = 1.0_wp
+         logc_ratio_v_r = 1.0_wp
+         direction      = 1
+         inc            = 1  
+         DO  j = nys, nyn          
+
+!
+!--         Right boundary for u.
+            i   = nxr + 1
+            kb  = nzb_u_inner(j,i)
+            k   = kb + 1
+            wall_index = kb 
+            CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j, inc, wall_index, z0(j,i), kb, direction, ncorr )
+            logc_u_r(k,j,1) = lc
+            logc_ratio_u_r(k,j,1,0:ncorr-1) = lcr(0:ncorr-1)
+            lcr(0:ncorr-1) = 1.0_wp
+
+!
+!--         Right boundary for v.
+            i   = nxr + 1
+            kb  = nzb_v_inner(j,i)
+            k   = kb + 1
+            wall_index = kb 
+            CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j, inc, wall_index, z0(j,i), kb, direction, ncorr )
+            logc_v_r(k,j,1) = lc
+            logc_ratio_v_r(k,j,1,0:ncorr-1) = lcr(0:ncorr-1)
+            lcr(0:ncorr-1) = 1.0_wp
+         ENDDO
+      ENDIF
+
+!
+!--   South boundary.
+      IF ( nest_bound_s )  THEN
+         ALLOCATE( logc_u_s(nzb:nzt_topo_nestbc_s,nxl:nxr,1:2) )
+         ALLOCATE( logc_v_s(nzb:nzt_topo_nestbc_s,nxl:nxr,1:2) )
+         ALLOCATE( logc_ratio_u_s(nzb:nzt_topo_nestbc_s,nxl:nxr,1:2,0:ncorr-1) )
+         ALLOCATE( logc_ratio_v_s(nzb:nzt_topo_nestbc_s,nxl:nxr,1:2,0:ncorr-1) )
+         logc_u_s       = 0
+         logc_v_s       = 0
+         logc_ratio_u_s = 1.0_wp
+         logc_ratio_v_s = 1.0_wp
+         direction      = 1
+         inc            = 1 
+         DO  i = nxl, nxr
+
+!
+!--         South boundary for u.
+            j   = -1
+            kb  =  nzb_u_inner(j,i)
+            k   =  kb + 1
+            wall_index = kb 
+            CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j, inc, wall_index, z0(j,i), kb, direction, ncorr )
+            logc_u_s(k,i,1) = lc
+            logc_ratio_u_s(k,i,1,0:ncorr-1) = lcr(0:ncorr-1)
+            lcr(0:ncorr-1) = 1.0_wp
+
+!
+!--         South boundary for v.
+            j   = 0
+            kb  = nzb_v_inner(j,i)
+            k   = kb + 1
+            wall_index = kb 
+            CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j, inc, wall_index, z0(j,i), kb, direction, ncorr )
+            logc_v_s(k,i,1) = lc
+            logc_ratio_v_s(k,i,1,0:ncorr-1) = lcr(0:ncorr-1)
+            lcr(0:ncorr-1) = 1.0_wp
+         ENDDO
+      ENDIF
+
+!
+!--   North boundary.
+      IF ( nest_bound_n )  THEN
+         ALLOCATE( logc_u_n(nzb:nzt_topo_nestbc_n,nxl:nxr,1:2) )
+         ALLOCATE( logc_v_n(nzb:nzt_topo_nestbc_n,nxl:nxr,1:2) )
+         ALLOCATE( logc_ratio_u_n(nzb:nzt_topo_nestbc_n,nxl:nxr,1:2,0:ncorr-1) )
+         ALLOCATE( logc_ratio_v_n(nzb:nzt_topo_nestbc_n,nxl:nxr,1:2,0:ncorr-1) )
+         logc_u_n       = 0
+         logc_v_n       = 0
+         logc_ratio_u_n = 1.0_wp
+         logc_ratio_v_n = 1.0_wp 
+         direction      = 1
+         inc            = 1 
+         DO  i = nxl, nxr       
+
+!
+!--         North boundary for u.
+            j   = nyn + 1
+            kb  = nzb_u_inner(j,i)
+            k   = kb + 1
+            wall_index = kb 
+            CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j, inc, wall_index, z0(j,i), kb, direction, ncorr )
+            logc_u_n(k,i,1) = lc
+            logc_ratio_u_n(k,i,1,0:ncorr-1) = lcr(0:ncorr-1)
+            lcr(0:ncorr-1) = 1.0_wp
+
+!
+!--         North boundary for v.
+            j   = nyn + 1
+            kb  = nzb_v_inner(j,i)
+            k   = kb + 1
+            wall_index = kb 
+            CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j, inc, wall_index, z0(j,i), kb, direction, ncorr )
+            logc_v_n(k,i,1) = lc
+            logc_ratio_v_n(k,i,1,0:ncorr-1) = lcr(0:ncorr-1)
+            lcr(0:ncorr-1) = 1.0_wp
+         ENDDO
+      ENDIF
+
+!       
+!--   Then vertical walls and corners if necessary.
+      IF ( topography /= 'flat' ) THEN        
+         kb = 0       ! kb is not used when direction > 1
+!        
+!--      Left boundary
+         IF ( nest_bound_l )  THEN
+            ALLOCATE( logc_w_l(nzb:nzt_topo_nestbc_l,nys:nyn,1:2) )
+            ALLOCATE( logc_ratio_w_l(nzb:nzt_topo_nestbc_l,nys:nyn,1:2,0:ncorr-1) )
+            logc_w_l       = 0                   
+            logc_ratio_w_l = 1.0_wp
+            direction      = 2
+            DO  j = nys, nyn
+               DO  k = nzb, nzt_topo_nestbc_l
+
+!
+!--               Wall for u on the south side, but not on the north side.
+                  i  = 0
+                  IF ( ( nzb_u_outer(j,i) > nzb_u_outer(j+1,i) ) .AND.     &
+                       ( nzb_u_outer(j,i) == nzb_u_outer(j-1,i) ) )  THEN
+                     inc        =  1
+                     wall_index =  j 
+                     CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j, inc, wall_index, z0(j,i), kb, direction, ncorr )
+
+!
+!--                  The direction of the wall-normal index is stored as the sign of the logc-element. 
+                     logc_u_l(k,j,2) = inc * lc
+                     logc_ratio_u_l(k,j,2,0:ncorr-1) = lcr(0:ncorr-1)
+                     lcr(0:ncorr-1) = 1.0_wp
+                  ENDIF
+
+!
+!--               Wall for u on the north side, but not on the south side.
+                  i  = 0
+                  IF ( ( nzb_u_outer(j,i) > nzb_u_outer(j-1,i) ) .AND.     &
+                       ( nzb_u_outer(j,i) == nzb_u_outer(j+1,i) ) )  THEN
+                     inc        = -1                 
+                     wall_index =  j + 1
+                     CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j, inc, wall_index, z0(j,i), kb, direction, ncorr )
+
+!
+!--                  The direction of the wall-normal index is stored as the sign of the logc-element. 
+                     logc_u_l(k,j,2) = inc * lc
+                     logc_ratio_u_l(k,j,2,0:ncorr-1) = lcr(0:ncorr-1)
+                     lcr(0:ncorr-1) = 1.0_wp
+                  ENDIF
+
+!
+!--               Wall for w on the south side, but not on the north side.
+                  i  = -1
+                  IF ( ( nzb_w_outer(j,i) > nzb_w_outer(j+1,i) )  .AND.    &
+                       ( nzb_w_outer(j,i) == nzb_w_outer(j-1,i) ) )  THEN
+                     inc        =  1
+                     wall_index =  j 
+                     CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j, inc, wall_index, z0(j,i), kb, direction, ncorr )
+
+!
+!--                  The direction of the wall-normal index is stored as the sign of the logc-element. 
+                     logc_w_l(k,j,2) = inc * lc
+                     logc_ratio_w_l(k,j,2,0:ncorr-1) = lcr(0:ncorr-1)
+                     lcr(0:ncorr-1) = 1.0_wp
+                  ENDIF
+
+!
+!--               Wall for w on the north side, but not on the south side.
+                  i  = -1
+                  IF ( ( nzb_w_outer(j,i) > nzb_w_outer(j-1,i) ) .AND.     &
+                       ( nzb_w_outer(j,i) == nzb_w_outer(j+1,i) ) )  THEN
+                     inc        = -1
+                     wall_index =  j+1 
+                     CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j, inc, wall_index, z0(j,i), kb, direction, ncorr )
+
+!
+!--                  The direction of the wall-normal index is stored as the sign of the logc-element. 
+                     logc_w_l(k,j,2) = inc * lc
+                     logc_ratio_w_l(k,j,2,0:ncorr-1) = lcr(0:ncorr-1)
+                     lcr(0:ncorr-1) = 1.0_wp
+                  ENDIF
+               ENDDO
+            ENDDO
+         ENDIF   !  IF ( nest_bound_l )
+
+!        
+!--      Right boundary.
+         IF ( nest_bound_r )  THEN
+            ALLOCATE( logc_w_r(nzb:nzt_topo_nestbc_r,nys:nyn,1:2) )
+            ALLOCATE( logc_ratio_w_r(nzb:nzt_topo_nestbc_r,nys:nyn,1:2,0:ncorr-1) )
+            logc_w_r       = 0
+            logc_ratio_w_r = 1.0_wp
+            direction      = 2
+            i  = nxr + 1        
+            DO  j = nys, nyn
+               DO  k = nzb, nzt_topo_nestbc_r
+
+!
+!--               Wall for u on the south side, but not on the north side.
+                  IF ( ( nzb_u_outer(j,i) > nzb_u_outer(j+1,i) )  .AND.    &
+                       ( nzb_u_outer(j,i) == nzb_u_outer(j-1,i) ) )  THEN
+                     inc        = 1
+                     wall_index = j 
+                     CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j, inc, wall_index, z0(j,i), kb, direction, ncorr )
+
+!
+!--                  The direction of the wall-normal index is stored as the sign of the logc-element. 
+                     logc_u_r(k,j,2) = inc * lc
+                     logc_ratio_u_r(k,j,2,0:ncorr-1) = lcr(0:ncorr-1)
+                     lcr(0:ncorr-1) = 1.0_wp
+                  ENDIF
+
+!
+!--               Wall for u on the north side, but not on the south side.
+                  IF ( ( nzb_u_outer(j,i) > nzb_u_outer(j-1,i) )  .AND.    &
+                       ( nzb_u_outer(j,i) == nzb_u_outer(j+1,i) ) )  THEN
+                     inc        = -1                 
+                     wall_index =  j+1
+                     CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j, inc, wall_index, z0(j,i), kb, direction, ncorr )
+
+!
+!--                  The direction of the wall-normal index is stored as the sign of the logc-element. 
+                     logc_u_r(k,j,2) = inc * lc
+                     logc_ratio_u_r(k,j,2,0:ncorr-1) = lcr(0:ncorr-1)
+                     lcr(0:ncorr-1) = 1.0_wp
+                  ENDIF
+
+!
+!--               Wall for w on the south side, but not on the north side.
+                  IF ( ( nzb_w_outer(j,i) > nzb_w_outer(j+1,i) )  .AND.    &
+                       ( nzb_w_outer(j,i) == nzb_w_outer(j-1,i) ) )  THEN
+                     inc        =  1
+                     wall_index =  j 
+                     CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j, inc, wall_index, z0(j,i), kb, direction, ncorr )
+
+!
+!--                  The direction of the wall-normal index is stored as the sign of the logc-element. 
+                     logc_w_r(k,j,2) = inc * lc
+                     logc_ratio_w_r(k,j,2,0:ncorr-1) = lcr(0:ncorr-1)
+                     lcr(0:ncorr-1) = 1.0_wp
+                  ENDIF
+!
+!--               Wall for w on the north side, but not on the south side.
+                  IF ( ( nzb_w_outer(j,i) > nzb_w_outer(j-1,i) ) .AND.     &
+                       ( nzb_w_outer(j,i) == nzb_w_outer(j+1,i) ) )  THEN
+                     inc        = -1
+                     wall_index =  j+1 
+                     CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j, inc, wall_index, z0(j,i), kb, direction, ncorr )
+
+!
+!--                  The direction of the wall-normal index is stored as the sign of the logc-element.
+                     logc_w_r(k,j,2) = inc * lc
+                     logc_ratio_w_r(k,j,2,0:ncorr-1) = lcr(0:ncorr-1)
+                     lcr(0:ncorr-1) = 1.0_wp
+                  ENDIF
+               ENDDO
+            ENDDO
+         ENDIF   !  IF ( nest_bound_r )
+
+!        
+!--      South boundary.
+         IF ( nest_bound_s )  THEN
+            ALLOCATE( logc_w_s(nzb:nzt_topo_nestbc_s, nxl:nxr, 1:2) )
+            ALLOCATE( logc_ratio_w_s(nzb:nzt_topo_nestbc_s, nxl:nxr, 1:2, 0:ncorr-1) )
+            logc_w_s       = 0
+            logc_ratio_w_s = 1.0_wp  
+            direction      = 3
+            DO  i = nxl, nxr
+               DO  k = nzb, nzt_topo_nestbc_s
+
+!
+!--               Wall for v on the left side, but not on the right side.
+                  j  = 0
+                  IF ( ( nzb_v_outer(j,i) > nzb_v_outer(j,i+1) )  .AND.    &
+                       ( nzb_v_outer(j,i) == nzb_v_outer(j,i-1) ) )  THEN
+                     inc        =  1
+                     wall_index =  i 
+                     CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, i, inc, wall_index, z0(j,i), kb, direction, ncorr )
+
+!
+!--                  The direction of the wall-normal index is stored as the sign of the logc-element. 
+                     logc_v_s(k,i,2) = inc * lc
+                     logc_ratio_v_s(k,i,2,0:ncorr-1) = lcr(0:ncorr-1)
+                     lcr(0:ncorr-1) = 1.0_wp
+                  ENDIF
+!
+!--               Wall for v on the right side, but not on the left side.
+                  j  = 0
+                  IF ( ( nzb_v_outer(j,i) > nzb_v_outer(j,i-1) )  .AND.    &
+                       ( nzb_v_outer(j,i) == nzb_v_outer(j,i+1) ) )  THEN
+                     inc        = -1
+                     wall_index =  i+1
+                     CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, i, inc, wall_index, z0(j,i), kb, direction, ncorr )
+
+!
+!--                  The direction of the wall-normal index is stored as the sign of the logc-element. 
+                     logc_v_s(k,i,2) = inc * lc
+                     logc_ratio_v_s(k,i,2,0:ncorr-1) = lcr(0:ncorr-1)
+                     lcr(0:ncorr-1) = 1.0_wp
+                  ENDIF
+
+!
+!--               Wall for w on the left side, but not on the right side.
+                  j  = -1
+                  IF ( ( nzb_w_outer(j,i) > nzb_w_outer(j,i+1) )  .AND.    &
+                       ( nzb_w_outer(j,i) == nzb_w_outer(j,i-1) ) )  THEN
+                     inc        =  1
+                     wall_index =  i
+                     CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, i, inc, wall_index, z0(j,i), kb, direction, ncorr )
+
+!
+!--                  The direction of the wall-normal index is stored as the sign of the logc-element. 
+                     logc_w_s(k,i,2) = inc * lc
+                     logc_ratio_w_s(k,i,2,0:ncorr - 1) = lcr(0:ncorr-1)
+                     lcr(0:ncorr-1) = 1.0_wp
+                  ENDIF
+
+!
+!--               Wall for w on the right side, but not on the left side.
+                  j  = -1
+                  IF ( ( nzb_w_outer(j,i) > nzb_w_outer(j,i-1) )  .AND.    &
+                       ( nzb_w_outer(j,i) == nzb_w_outer(j,i+1) ) )  THEN
+                     inc        = -1
+                     wall_index =  i+1 
+                     CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, i, inc, wall_index, z0(j,i), kb, direction, ncorr )
+
+!
+!--                  The direction of the wall-normal index is stored as the sign of the logc-element. 
+                     logc_w_s(k,i,2) = inc * lc
+                     logc_ratio_w_s(k,i,2,0:ncorr-1) = lcr(0:ncorr-1)
+                     lcr(0:ncorr-1) = 1.0_wp
+                  ENDIF
+               ENDDO
+            ENDDO
+         ENDIF   !  IF (nest_bound_s )
+
+!        
+!--      North boundary.
+         IF ( nest_bound_n )  THEN
+            ALLOCATE( logc_w_n(nzb:nzt_topo_nestbc_n, nxl:nxr, 1:2) )
+            ALLOCATE( logc_ratio_w_n(nzb:nzt_topo_nestbc_n, nxl:nxr, 1:2, 0:ncorr-1) )
+            logc_w_n       = 0
+            logc_ratio_w_n = 1.0_wp
+            direction      = 3
+            j  = nyn + 1
+            DO  i = nxl, nxr
+               DO  k = nzb, nzt_topo_nestbc_n
+
+!
+!--               Wall for v on the left side, but not on the right side.
+                  IF ( ( nzb_v_outer(j,i) > nzb_v_outer(j,i+1) )  .AND.    &
+                       ( nzb_v_outer(j,i) == nzb_v_outer(j,i-1) ) )  THEN
+                     inc        = 1
+                     wall_index = i 
+                     CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, i, inc, wall_index, z0(j,i), kb, direction, ncorr )
+
+!
+!--                  The direction of the wall-normal index is stored as the sign of the logc-element. 
+                     logc_v_n(k,i,2) = inc * lc
+                     logc_ratio_v_n(k,i,2,0:ncorr-1) = lcr(0:ncorr-1)
+                     lcr(0:ncorr-1) = 1.0_wp
+                  ENDIF
+
+!
+!--               Wall for v on the right side, but not on the left side.
+                  IF ( ( nzb_v_outer(j,i) > nzb_v_outer(j,i-1) )  .AND.    &
+                       ( nzb_v_outer(j,i) == nzb_v_outer(j,i+1) ) )  THEN
+                     inc        = -1                 
+                     wall_index =  i + 1
+                     CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, i, inc, wall_index, z0(j,i), kb, direction, ncorr )
+
+!
+!--                  The direction of the wall-normal index is stored as the sign of the logc-element. 
+                     logc_v_n(k,i,2) = inc * lc
+                     logc_ratio_v_n(k,i,2,0:ncorr-1) = lcr(0:ncorr-1)
+                     lcr(0:ncorr-1) = 1.0_wp
+                  ENDIF
+
+!
+!--               Wall for w on the left side, but not on the right side.
+                  IF ( ( nzb_w_outer(j,i) > nzb_w_outer(j,i+1) )  .AND.    &
+                       ( nzb_w_outer(j,i) == nzb_w_outer(j,i-1) ) )  THEN
+                     inc        = 1
+                     wall_index = i
+                     CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, i, inc, wall_index, z0(j,i), kb, direction, ncorr )
+
+!
+!--                  The direction of the wall-normal index is stored as the sign of the logc-element. 
+                     logc_w_n(k,i,2) = inc * lc
+                     logc_ratio_w_n(k,i,2,0:ncorr-1) = lcr(0:ncorr-1)
+                     lcr(0:ncorr-1) = 1.0_wp
+                  ENDIF
+
+!
+!--               Wall for w on the right side, but not on the left side.
+                  IF ( ( nzb_w_outer(j,i) > nzb_w_outer(j,i-1) ) .AND.     &
+                       ( nzb_w_outer(j,i) == nzb_w_outer(j,i+1) ) )  THEN
+                     inc        = -1
+                     wall_index =  i+1 
+                     CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, i, inc, wall_index, z0(j,i), kb, direction, ncorr )
+
+!
+!--                  The direction of the wall-normal index is stored as the sign of the logc-element. 
+                     logc_w_n(k,i,2) = inc * lc
+                     logc_ratio_w_n(k,i,2,0:ncorr-1) = lcr(0:ncorr-1)
+                     lcr(0:ncorr-1) = 1.0_wp
+                  ENDIF
+               ENDDO
+            ENDDO
+         ENDIF   !  IF ( nest_bound_n )
+      ENDIF   !  IF ( topography /= 'flat' )
+
+   END SUBROUTINE pmci_init_loglaw_correction
+
+
+
+   SUBROUTINE pmci_define_loglaw_correction_parameters( lc, lcr, k, ij, inc, wall_index, z0_l, kb, direction, ncorr )
+      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                !:
+      REAL(wp), DIMENSION(0:ncorr-1), INTENT(OUT) ::  lcr     !:
+      REAL(wp), INTENT(IN)      ::  z0_l                      !:
+      
+      INTEGER(iwp) ::  alcorr       !:
+      INTEGER(iwp) ::  corr_index   !:
+      INTEGER(iwp) ::  lcorr        !:
+      REAL(wp)     ::  logvelc1     !:
+      LOGICAL      ::  more         !:
+      
+
+      SELECT CASE ( direction )
+
+         CASE (1)   !  k
+            more = .TRUE.
+            lcorr = 0
+            DO  WHILE ( more .AND. lcorr <= ncorr - 1 )
+               corr_index = k + lcorr 
+               IF ( lcorr == 0 )  THEN
+                  CALL pmci_find_logc_pivot_k( lc, logvelc1, z0_l, kb )
+               ENDIF
+               
+               IF ( corr_index < lc )  THEN
+                  lcr(lcorr) = LOG( ( zu(k) - zw(kb) ) / z0_l ) / logvelc1
+                  more = .TRUE.
+               ELSE
+                  lcr(lcorr) = 1.0
+                  more = .FALSE.
+               ENDIF
+               lcorr = lcorr + 1              
+            ENDDO
+
+         CASE (2)   !  j 
+            more = .TRUE.
+            lcorr  = 0
+            alcorr = 0
+            DO  WHILE ( more  .AND.  alcorr <= ncorr - 1 )
+               corr_index = ij + lcorr   !  In this case (direction = 2) ij is j
+               IF ( lcorr == 0 )  THEN
+                  CALL pmci_find_logc_pivot_j( lc, logvelc1, ij, wall_index, z0_l, inc )
+               ENDIF
+
+!
+!--            The role of inc here is to make the comparison operation "<" valid in both directions.
+               IF ( inc * corr_index < inc * lc )  THEN 
+                  lcr(alcorr) = LOG( ABS( coord_y(corr_index) + 0.5_wp * dy  &
+                              - coord_y(wall_index) ) / z0_l ) / logvelc1
+                  more = .TRUE.
+               ELSE
+                  lcr(alcorr) = 1.0_wp
+                  more = .FALSE.
+               ENDIF
+               lcorr  = lcorr + inc
+               alcorr = ABS( lcorr )
+            ENDDO
+
+         CASE (3)   !  i          
+            more = .TRUE.
+            lcorr  = 0
+            alcorr = 0
+            DO  WHILE ( more  .AND.  alcorr <= ncorr - 1 )
+               corr_index = ij + lcorr   !  In this case (direction = 3) ij is i
+               IF ( lcorr == 0 )  THEN
+                  CALL pmci_find_logc_pivot_i( lc, logvelc1, ij, wall_index, z0_l, inc )
+               ENDIF
+
+!
+!--            The role of inc here is to make the comparison operation "<" valid in both directions.
+               IF ( inc * corr_index < inc * lc )  THEN 
+                  lcr(alcorr) = LOG( ABS( coord_x(corr_index) + 0.5_wp * dx &
+                       - coord_x(wall_index) ) / z0_l ) / logvelc1
+                  more = .TRUE.
+               ELSE
+                  lcr(alcorr) = 1.0_wp
+                  more = .FALSE.
+               ENDIF
+               lcorr  = lcorr + inc
+               alcorr = ABS( lcorr )
+            ENDDO
+ 
+      END SELECT
+
+   END SUBROUTINE pmci_define_loglaw_correction_parameters
+
+
+
+   SUBROUTINE pmci_find_logc_pivot_k( lc, logzc1, z0_l, kb )
+
+!
+!--   Finds the pivot node and te log-law factor for near-wall nodes for 
+!--   which the wall-parallel velocity components will be log-law corrected 
+!--   after interpolation. This subroutine is only for horizontal walls.
+!
+!--                               Antti Hellsten 30.12.2015
+      IMPLICIT NONE
+      REAL(wp),INTENT(OUT)  ::  logzc1     !:
+      REAL(wp), INTENT(IN)  ::  z0_l       !:
+      INTEGER(iwp), INTENT(IN)    ::  kb   !:
+      INTEGER(iwp), INTENT(OUT)   ::  lc   !:
+      
+      REAL(wp)     ::  zuc1   !:
+      INTEGER(iwp) ::  kbc    !:
+      INTEGER(iwp) ::  k1     !:
+
+
+      kbc = nzb + 1
+      DO  WHILE ( cg%zu(kbc) < zu(kb) )   !  kbc is the first coarse-grid point above the surface.
+         kbc = kbc + 1
+      ENDDO
+      zuc1  = cg%zu(kbc)
+      k1    = kb + 1  
+      DO  WHILE ( zu(k1) < zuc1 )         !  Important: must be <, not <=
+         k1 = k1 + 1
+      ENDDO
+      logzc1 = LOG( (zu(k1) - zw(kb) ) / z0_l )
+      lc = k1
+
+   END SUBROUTINE pmci_find_logc_pivot_k
+
+
+
+   SUBROUTINE pmci_find_logc_pivot_j( lc, logyc1, j, jw, z0_l, inc )
+
+!
+!--   Finds the pivot node and te log-law factor for near-wall nodes for 
+!--   which the wall-parallel velocity components will be log-law corrected 
+!--   after interpolation. This subroutine is only for vertical walls on 
+!--   south/north sides of the node.
+!
+!--                               Antti Hellsten 5.1.2016
+      IMPLICIT NONE
+      REAL(wp), INTENT(IN)      ::  z0_l   !:
+      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     !:
+      
+      REAL(wp)     ::  logyc1   !:
+      REAL(wp)     ::  yc1      !:
+      INTEGER(iwp) ::  j1       !:
+
+!
+!--   yc1 is the y-coordinate of the first coarse-grid u- and w-nodes out from the wall.
+      yc1  = coord_y(jw) + 0.5_wp * inc * cg%dy  
+
+!
+!--   j1 is the first fine-grid index futher away from the wall than yc1.
+      j1 = j   
+      DO  WHILE ( inc * ( coord_y(j1) + 0.5_wp * dy ) < inc * yc1 )   !  Important: must be <, not <=
+         j1 = j1 + inc
+      ENDDO
+
+      logyc1 = LOG( ABS( coord_y(j1) + 0.5_wp * dy - coord_y(jw) ) / z0_l )
+      lc = j1
+
+   END SUBROUTINE pmci_find_logc_pivot_j
+
+
+
+   SUBROUTINE pmci_find_logc_pivot_i( lc, logxc1, i, iw, z0_l, inc )
+
+!
+!--   Finds the pivot node and the log-law factor for near-wall nodes for 
+!--   which the wall-parallel velocity components will be log-law corrected 
+!--   after interpolation. This subroutine is only for vertical walls on 
+!--   south/north sides of the node.
+!
+!--                               Antti Hellsten 8.1.2016
+
+      IMPLICIT NONE
+      REAL(wp), INTENT(IN)      ::  z0_l   !:
+      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     !:
+
+      REAL(wp)     ::  logxc1   !:
+      REAL(wp)     ::  xc1      !:
+      INTEGER(iwp) ::  i1       !:
+
+!
+!--   xc1 is the x-coordinate of the first coarse-grid v- and w-nodes out from the wall.
+      xc1  = coord_x(iw) + 0.5_wp *inc * cg%dx  
+
+!
+!--   i1 is the first fine-grid index futher away from the wall than xc1.
+      i1 = i   
+      DO  WHILE ( inc * ( coord_x(i1) + 0.5_wp *dx ) < inc *xc1 )   !  Important: must be <, not <=
+         i1 = i1 + inc
+      ENDDO
+      
+      logxc1 = LOG( ABS( coord_x(i1) + 0.5_wp*dx - coord_x(iw) ) / z0_l )
+      lc = i1
+
+   END SUBROUTINE pmci_find_logc_pivot_i
+
+
+
+   SUBROUTINE pmci_init_anterp_tophat
+!
+!--   Precomputation of the client-array indices for 
+!--   corresponding coarse-grid array index and the 
+!--   Under-relaxation coefficients to be used by anterp_tophat.
+!
+!--                               Antti Hellsten 9.10.2015.
+      IMPLICIT NONE
+      INTEGER(iwp) ::  i        !:
+      INTEGER(iwp) ::  istart   !:
+      INTEGER(iwp) ::  j        !:
+      INTEGER(iwp) ::  jstart   !:
+      INTEGER(iwp) ::  k        !:
+      INTEGER(iwp) ::  kstart   !:
+      INTEGER(iwp) ::  l        !:
+      INTEGER(iwp) ::  m        !:
+      INTEGER(iwp) ::  n        !:
+      REAL(wp)     ::  xi       !:
+      REAL(wp)     ::  eta      !:
+      REAL(wp)     ::  zeta     !:
+     
+!
+!--   Default values:
+      IF ( anterp_relax_length_l < 0.0_wp )  THEN
+         anterp_relax_length_l = 0.1_wp * ( nx + 1 ) * dx
+      ENDIF
+      IF ( anterp_relax_length_r < 0.0_wp )  THEN
+         anterp_relax_length_r = 0.1_wp * ( nx + 1 ) * dx
+      ENDIF
+      IF ( anterp_relax_length_s < 0.0_wp )  THEN
+         anterp_relax_length_s = 0.1_wp * ( ny + 1 ) * dy
+      ENDIF
+      IF ( anterp_relax_length_n < 0.0_wp )  THEN
+         anterp_relax_length_n = 0.1_wp * ( ny + 1 ) * dy
+      ENDIF
+      IF ( anterp_relax_length_t < 0.0_wp )  THEN
+         anterp_relax_length_t = 0.1_wp * zu(nzt)
+      ENDIF
+
+!
+!--   First determine kceu and kcew that are the coarse-grid upper bounds for index k.
+      n = 0
+      DO  WHILE ( cg%zu(n) < zu(nzt) )
+         n = n + 1
+      ENDDO
+      kceu = n - 1 
+
+      n = 0
+      DO  WHILE ( cg%zw(n) < zw(nzt-1) )
+         n = n + 1
+      ENDDO
+      kcew = n - 1 
+
+      ALLOCATE( iflu(icl:icr) )
+      ALLOCATE( iflo(icl:icr) )
+      ALLOCATE( ifuu(icl:icr) )
+      ALLOCATE( ifuo(icl:icr) )
+      ALLOCATE( jflv(jcs:jcn) )
+      ALLOCATE( jflo(jcs:jcn) )
+      ALLOCATE( jfuv(jcs:jcn) )
+      ALLOCATE( jfuo(jcs:jcn) )
+      ALLOCATE( kflw(0:kcew) )
+      ALLOCATE( kflo(0:kceu) )
+      ALLOCATE( kfuw(0:kcew) )
+      ALLOCATE( kfuo(0:kceu) )
+
+!
+!--   i-indices of u for each l-index value.    
+      istart = nxlg
+      DO  l = icl, icr  
+         i = istart
+         DO  WHILE ( ( coord_x(i)  <  cg%coord_x(l) - 0.5_wp * cg%dx )  .AND.  ( i < nxrg ) ) 
+            i = i + 1
+         ENDDO
+         iflu(l) = MIN( MAX( i, nxlg ), nxrg )
+         DO  WHILE ( ( coord_x(i)  <  cg%coord_x(l) + 0.5_wp * cg%dx )  .AND.  ( i < nxrg ) ) 
+            i = i + 1
+         ENDDO
+         ifuu(l) = MIN( MAX( i, nxlg ), nxrg )
+         istart = iflu(l)
+      ENDDO
+
+!
+!--   i-indices of others for each l-index value.
+      istart = nxlg
+      DO  l = icl, icr   
+         i = istart
+         DO  WHILE ( ( coord_x(i) + 0.5_wp * dx  <  cg%coord_x(l) )  .AND.  ( i < nxrg ) ) 
+            i = i + 1
+         ENDDO
+         iflo(l) = MIN( MAX( i, nxlg ), nxrg )
+         DO  WHILE ( ( coord_x(i) + 0.5_wp * dx  <  cg%coord_x(l) + cg%dx )  .AND.  ( i < nxrg ) ) 
+            i = i + 1
+         ENDDO
+         ifuo(l) = MIN(MAX(i,nxlg),nxrg)
+         istart = iflo(l)
+      ENDDO
+
+!
+!--   j-indices of v for each m-index value.
+      jstart = nysg
+      DO  m = jcs, jcn
+         j = jstart
+         DO  WHILE ( ( coord_y(j)  <  cg%coord_y(m) - 0.5_wp * cg%dy )  .AND.  ( j < nyng ) ) 
+            j = j + 1
+         ENDDO
+         jflv(m) = MIN( MAX( j, nysg ), nyng ) 
+         DO  WHILE ( ( coord_y(j)  <  cg%coord_y(m) + 0.5_wp * cg%dy )  .AND.  ( j < nyng ) ) 
+            j = j + 1
+         ENDDO
+         jfuv(m) = MIN( MAX( j, nysg ), nyng )
+         jstart = jflv(m)
+      ENDDO
+
+!
+!--   j-indices of others for each m-index value.
+      jstart = nysg
+      DO  m = jcs, jcn
+         j = jstart
+         DO  WHILE ( ( coord_y(j) + 0.5_wp * dy  <  cg%coord_y(m) )  .AND.  ( j < nyng ) )  
+            j = j + 1
+         ENDDO
+         jflo(m) = MIN( MAX( j, nysg ), nyng )
+         DO  WHILE ( ( coord_y(j) + 0.5_wp * dy  <  cg%coord_y(m) + cg%dy )  .AND.  ( j < nyng ) ) 
+            j = j + 1
+         ENDDO
+         jfuo(m) = MIN( MAX( j, nysg ), nyng )
+         jstart = jflv(m)
+      ENDDO
+
+!
+!--   k-indices of w for each n-index value.
+      kstart  = 0
+      kflw(0) = 0
+      kfuw(0) = 0
+      DO  n = 1, kcew
+         k = kstart
+         DO  WHILE ( ( zw(k) < cg%zw(n) - 0.5_wp * cg%dzw(n) )  .AND.  ( k < nzt ) ) 
+            k = k + 1
+         ENDDO
+         kflw(n) = MIN( MAX( k, 1 ), nzt + 1 )
+         DO  WHILE ( ( zw(k) < cg%zw(n) + 0.5_wp * cg%dzw(n+1) )  .AND.  ( k < nzt ) ) 
+            k = k + 1
+         ENDDO
+         kfuw(n) = MIN( MAX( k, 1 ), nzt + 1 )
+         kstart = kflw(n)
+      ENDDO
+
+!
+!--   k-indices of others for each n-index value.
+      kstart  = 0
+      kflo(0) = 0
+      kfuo(0) = 0
+      DO  n = 1, kceu
+         k = kstart
+         DO  WHILE ( ( zu(k) < cg%zu(n) - 0.5_wp * cg%dzu(n) )  .AND.  ( k < nzt ) ) 
+            k = k + 1
+         ENDDO
+         kflo(n) = MIN( MAX( k, 1 ), nzt + 1 )
+         DO  WHILE ( ( zu(k) < cg%zu(n) + 0.5_wp * cg%dzu(n+1) )  .AND.  ( k < nzt ) )  
+            k = k + 1
+         ENDDO
+         kfuo(n) = MIN( MAX( k-1, 1 ), nzt + 1 )
+         kstart = kflo(n)
+      ENDDO
+     
+!
+!--   Spatial under-relaxation coefficients
+      ALLOCATE( frax(icl:icr) )
+      DO  l = icl, icr
+         IF ( nest_bound_l ) THEN
+            xi   = ( ( cg%coord_x(l) - lower_left_coord_x ) / anterp_relax_length_l )**4
+         ELSEIF ( nest_bound_r ) THEN
+            xi   = ( ( lower_left_coord_x + ( nx + 1 ) * dx - cg%coord_x(l) ) / anterp_relax_length_r )**4
+         ELSE
+            xi   = 999999.9_wp
+         ENDIF
+         frax(l)  = xi / ( 1.0_wp + xi )
+      ENDDO
+
+      ALLOCATE( fray(jcs:jcn) )
+      DO  m = jcs, jcn
+         IF ( nest_bound_s ) THEN           
+            eta  = ( ( cg%coord_y(m) - lower_left_coord_y ) / anterp_relax_length_s )**4
+         ELSEIF ( nest_bound_n ) THEN
+            eta  = ( (lower_left_coord_y + ( ny + 1 ) * dy - cg%coord_y(m)) / anterp_relax_length_n )**4
+         ELSE
+            eta  = 999999.9_wp
+         ENDIF
+         fray(m)  = eta / ( 1.0_wp + eta )
+      ENDDO
+      
+      ALLOCATE( fraz(0:kceu) )
+      DO  n = 0, kceu        
+         zeta = ( ( zu(nzt) - cg%zu(n) ) / anterp_relax_length_t )**4       
+         fraz(n) = zeta / ( 1.0_wp + zeta )
+      ENDDO
+
+   END SUBROUTINE pmci_init_anterp_tophat
+
+
+
+   SUBROUTINE pmci_init_tkefactor
+
+!
+!--   Computes the scaling factor for the SGS TKE from coarse grid to be used 
+!--   as BC for the fine grid. Based on the Kolmogorov energy spectrum
+!--   for the inertial subrange and assumption of sharp cut-off of the resolved 
+!--   energy spectrum. Near the surface, the reduction of TKE is made 
+!--   smaller than further away from the surface.
+!
+!                      Antti Hellsten 4.3.2015
+!
+!--   Extended for non-flat topography and variable dz.
+! 
+!                      Antti Hellsten 26.3.2015
+!
+!--   The current near-wall adaptation can be replaced by a new one which
+!--   uses a step function [0,1] based on the logc-arrays. AH 30.12.2015
+      IMPLICIT NONE
+      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                     !:
+      INTEGER(iwp)         ::  kc                    !:
+        
+
+      IF ( nest_bound_l )  THEN
+         ALLOCATE( tkefactor_l(nzb:nzt+1,nysg:nyng) )    
+         tkefactor_l = 0.0_wp
+         i = nxl - 1 
+         DO  j = nysg, nyng
+            DO  k = nzb_s_inner(j,i) + 1, nzt
+               kc     = kco(k+1)
+               glsf   = ( dx * dy * dzu(k) )**p13
+               glsc   = ( cg%dx * cg%dy *cg%dzu(kc) )**p13
+               height = zu(k) - zu(nzb_s_inner(j,i))
+               fw     = EXP( -cfw * height / glsf )
+               tkefactor_l(k,j) = c_tkef * ( fw0 * fw + ( 1.0_wp - fw ) * ( glsf / glsc )**p23 )
+            ENDDO
+            tkefactor_l(nzb_s_inner(j,i),j) = c_tkef * fw0
+         ENDDO
+      ENDIF
+
+      IF ( nest_bound_r )  THEN
+         ALLOCATE( tkefactor_r(nzb:nzt+1,nysg:nyng) )    
+         tkefactor_r = 0.0_wp
+         i = nxr + 1
+         DO  j = nysg, nyng
+            DO  k = nzb_s_inner(j,i) + 1, nzt
+               kc     = kco(k+1)
+               glsf   = ( dx * dy * dzu(k) )**p13
+               glsc   = ( cg%dx * cg%dy * cg%dzu(kc) )**p13
+               height = zu(k) - zu(nzb_s_inner(j,i))
+               fw     = EXP( -cfw * height / glsf )
+               tkefactor_r(k,j) = c_tkef * (fw0 * fw + ( 1.0_wp - fw ) * ( glsf / glsc )**p23 )
+            ENDDO
+            tkefactor_r(nzb_s_inner(j,i),j) = c_tkef * fw0
+         ENDDO
+      ENDIF
+
+      IF ( nest_bound_s )  THEN
+         ALLOCATE( tkefactor_s(nzb:nzt+1,nxlg:nxrg) )
+         tkefactor_s = 0.0_wp
+         j = nys - 1
+         DO  i = nxlg, nxrg
+            DO  k = nzb_s_inner(j,i) + 1, nzt
+               kc     = kco(k+1)
+               glsf   = ( dx * dy * dzu(k) )**p13
+               glsc   = ( cg%dx * cg%dy * cg%dzu(kc) ) ** p13
+               height = zu(k) - zu(nzb_s_inner(j,i))
+               fw     = EXP( -cfw*height / glsf )
+               tkefactor_s(k,i) = c_tkef * ( fw0 * fw + ( 1.0_wp - fw ) * ( glsf / glsc )**p23 )
+            ENDDO
+            tkefactor_s(nzb_s_inner(j,i),i) = c_tkef * fw0
+         ENDDO
+      ENDIF
+
+      IF ( nest_bound_n )  THEN
+         ALLOCATE( tkefactor_n(nzb:nzt+1,nxlg:nxrg) )
+         tkefactor_n = 0.0_wp    
+         j = nyn + 1
+         DO  i = nxlg, nxrg
+            DO  k = nzb_s_inner(j,i)+1, nzt
+               kc     = kco(k+1)
+               glsf   = ( dx * dy * dzu(k) )**p13
+               glsc   = ( cg%dx * cg%dy * cg%dzu(kc) )**p13
+               height = zu(k) - zu(nzb_s_inner(j,i))
+               fw     = EXP( -cfw * height / glsf )
+               tkefactor_n(k,i) = c_tkef * ( fw0 * fw + ( 1.0_wp - fw ) * ( glsf / glsc )**p23 )
+            ENDDO
+            tkefactor_n(nzb_s_inner(j,i),i) = c_tkef * fw0
+         ENDDO
+      ENDIF
+
+      ALLOCATE( tkefactor_t(nysg:nyng,nxlg:nxrg) )
+      k = nzt
+      DO  i = nxlg, nxrg
+         DO  j = nysg, nyng
+            kc     = kco(k+1)
+            glsf   = ( dx * dy * dzu(k) )**p13
+            glsc   = ( cg%dx * cg%dy * cg%dzu(kc) )**p13
+            height = zu(k) - zu(nzb_s_inner(j,i))
+            fw     = EXP( -cfw * height / glsf )
+            tkefactor_t(j,i) = c_tkef * ( fw0 * fw + ( 1.0_wp - fw ) * ( glsf / glsc )**p23 )
+         ENDDO
+      ENDDO
+      
+    END SUBROUTINE pmci_init_tkefactor
+
+
+ END SUBROUTINE pmci_setup_client
+
+
+
+ SUBROUTINE pmci_setup_coordinates
+    IMPLICIT NONE
+    INTEGER(iwp) ::  i   !:
+    INTEGER(iwp) ::  j   !:
+
+!
+!-- Create coordinate arrays.
+    ALLOCATE( coord_x(-nbgp:nx+nbgp) )
+    ALLOCATE( coord_y(-nbgp:ny+nbgp) )
+     
+    DO  i = -nbgp, nx + nbgp
+       coord_x(i) = lower_left_coord_x + i * dx
+    ENDDO
+     
+    DO  j = -nbgp, ny + nbgp
+       coord_y(j) = lower_left_coord_y + j * dy
+    ENDDO
+     
+ END SUBROUTINE pmci_setup_coordinates
+
+
+
+ SUBROUTINE pmci_server_synchronize
+
+!
+!-- Unify the time steps for each model and synchronize.
+!-- This is based on the assumption that the native time step
+!-- (original dt_3d) of any server is always larger than the smallest 
+!-- native time step of it s clients. 
+    IMPLICIT NONE
+    INTEGER(iwp)           ::  client_id   !:
+    REAL(wp), DIMENSION(1) ::  dtc         !:
+    REAL(wp), DIMENSION(1) ::  dtl         !:
+    INTEGER(iwp)           ::  ierr        !:
+    INTEGER(iwp)           ::  m           !:    
+
+!
+!-- First find the smallest native time step of all the clients of the current server.
+    dtl(1) = 999999.9_wp
+    DO  m = 1, SIZE( PMC_Server_for_Client ) - 1
+       client_id = PMC_Server_for_Client(m)
+       IF ( myid == 0 )  THEN
+          CALL pmc_recv_from_client( client_id, dtc, SIZE( dtc ), 0, 101, ierr )
+          dtl(1) = MIN( dtl(1), dtc(1) )
+          dt_3d   = dtl(1)
+       ENDIF
+    ENDDO
+
+!
+!-- Broadcast the unified time step to all server processes.
+    CALL MPI_Bcast( dt_3d, 1, MPI_REAL, 0, comm2d, ierr )
+
+!
+!-- Send the new time step to all the clients of the current server.
+    DO  m = 1, SIZE( PMC_Server_for_Client ) - 1
+       client_id = PMC_Server_for_Client(m)
+       IF ( myid == 0 )  THEN
+          CALL pmc_send_to_client( client_id, dtl, SIZE( dtl ), 0, 102, ierr )
+       ENDIF
+    ENDDO
+    
+ END SUBROUTINE pmci_server_synchronize
+
+
+
+ SUBROUTINE pmci_client_synchronize
+
+!
+!-- Unify the time steps for each model and synchronize.
+!-- This is based on the assumption that the native time step
+!-- (original dt_3d) of any server is always larger than the smallest 
+!-- native time step of it s clients. 
+
+    IMPLICIT NONE
+    REAL(wp), DIMENSION(1) ::  dtl    !:
+    REAL(wp), DIMENSION(1) ::  dts    !:
+    INTEGER(iwp)           ::  ierr   !:
+    
+
+    dtl(1) = dt_3d
+    IF ( cpl_id > 1 )  THEN   !  Root id is never a client
+       IF ( myid==0 )  THEN
+          CALL pmc_send_to_server( dtl, SIZE( dtl ), 0, 101, ierr )
+          CALL pmc_recv_from_server( dts, SIZE( dts ), 0, 102, ierr )
+          dt_3d = dts(1)
+       ENDIF
+
+!
+!--    Broadcast the unified time step to all server processes.
+       CALL MPI_Bcast( dt_3d, 1, MPI_REAL, 0, comm2d, ierr )
+    ENDIF
+
+ END SUBROUTINE pmci_client_synchronize
+                
+
+
+ SUBROUTINE pmci_server_datatrans( direction )
+    IMPLICIT NONE
+    INTEGER(iwp),INTENT(IN) ::  direction   !:
+    INTEGER(iwp)            ::  client_id   !:
+    INTEGER(iwp)            ::  i           !:
+    INTEGER(iwp)            ::  j           !:
+    INTEGER(iwp)            ::  ierr        !:
+    INTEGER(iwp)            ::  m           !:
+    REAL(wp)                ::  waittime    !:
+    REAL(wp), DIMENSION(1)  ::  dtc         !:
+    REAL(wp), DIMENSION(1)  ::  dtl         !:
+
+!
+!-- First find the smallest native time step of all the clients of the current server.
+    dtl(1) = 999999.9_wp
+    DO  m = 1, SIZE( PMC_Server_for_Client ) - 1
+       client_id = PMC_Server_for_Client(m)
+       IF ( myid==0 )  THEN
+          CALL pmc_recv_from_client( client_id, dtc, SIZE( dtc ), 0, 101, ierr )
+          dtl(1) = MIN( dtl(1), dtc(1) )
+          dt_3d  = dtl(1)
+       ENDIF
+    ENDDO
+
+!
+!-- Broadcast the unified time step to all server processes.
+    CALL MPI_Bcast( dt_3d, 1, MPI_REAL, 0, comm2d, ierr )
+
+    DO  m = 1, SIZE( PMC_Server_for_Client ) - 1
+       client_id = PMC_Server_for_Client(m)
+       CALL cpu_log( log_point_s(70), 'PMC model sync', 'start' )
+
+!
+!--    Send the new time step to all the clients of the current server.
+       IF ( myid == 0 ) THEN
+          CALL pmc_send_to_client( client_id, dtl, SIZE( dtl ), 0, 102, ierr )
+       ENDIF
+       CALL cpu_log( log_point_s(70), 'PMC model sync', 'stop' )
+       
+       IF ( direction == server_to_client )  THEN
+          CALL cpu_log( log_point_s(71), 'PMC Server Send', 'start' )
+          CALL pmc_s_fillbuffer( client_id, waittime=waittime )
+          CALL cpu_log( log_point_s(71), 'PMC Server Send', 'stop' )
+       ELSE   !  Communication from client to server.
+          CALL cpu_log( log_point_s(72), 'PMC Server Recv', 'start' )
+          client_id = pmc_server_for_client(m)
+          CALL pmc_s_getdata_from_buffer( client_id )
+          CALL cpu_log( log_point_s(72), 'PMC Server Recv', 'stop' )        
+
+!
+!--       The anterpolated data is now available in u etc.
+          IF ( topography /= 'flat' )  THEN
+
+!
+!--          Inside buildings/topography reset velocities and TKE back to zero.
+!--          Other scalars (pt, q, s, km, kh, p, sa, ...) are ignored at present,
+!--          maybe revise later.
+             DO   i = nxlg, nxrg
+                DO   j = nysg, nyng
+                   u(nzb:nzb_u_inner(j,i),j,i)     = 0.0_wp
+                   v(nzb:nzb_v_inner(j,i),j,i)     = 0.0_wp
+                   w(nzb:nzb_w_inner(j,i),j,i)     = 0.0_wp
+                   e(nzb:nzb_w_inner(j,i),j,i)     = 0.0_wp
+                   tu_m(nzb:nzb_u_inner(j,i),j,i)  = 0.0_wp
+                   tv_m(nzb:nzb_v_inner(j,i),j,i)  = 0.0_wp
+                   tw_m(nzb:nzb_w_inner(j,i),j,i)  = 0.0_wp
+                   te_m(nzb:nzb_w_inner(j,i),j,i)  = 0.0_wp
+                ENDDO
+             ENDDO
+          ENDIF
+       ENDIF
+    ENDDO
+
+ END SUBROUTINE pmci_server_datatrans
+
+
+
+ SUBROUTINE pmci_client_datatrans( direction )
+    IMPLICIT NONE
+    INTEGER(iwp), INTENT(IN) ::  direction   !:
+    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)                 ::  waittime    !:
+
+
+    dtl = dt_3d
+    IF ( cpl_id > 1 )  THEN   !  Root id is never a client      
+       CALL cpu_log( log_point_s(70), 'PMC model sync', 'start' )
+       IF ( myid==0 )  THEN
+          CALL pmc_send_to_server( dtl, SIZE( dtl ), 0, 101, ierr )
+          CALL pmc_recv_from_server( dts, SIZE( dts ), 0, 102, ierr )
+          dt_3d = dts(1)
+       ENDIF
+
+!
+!--    Broadcast the unified time step to all server processes.
+       CALL MPI_Bcast( dt_3d, 1, MPI_REAL, 0, comm2d, ierr )
+       CALL cpu_log( log_point_s(70), 'PMC model sync', 'stop' )
+
+!
+!--    Client domain boundaries in the server indice space.
+       icl = coarse_bound(1)
+       icr = coarse_bound(2)
+       jcs = coarse_bound(3)
+       jcn = coarse_bound(4)
+
+       IF ( direction == server_to_client )  THEN
+          CALL cpu_log( log_point_s(73), 'PMC Client Recv', 'start' )
+          CALL pmc_c_getbuffer( WaitTime = WaitTime )
+          CALL cpu_log( log_point_s(73), 'PMC Client Recv', 'stop' )
+
+!
+!--       The interpolation. Add IF-condition here: IF not vertical nesting
+          IF ( nest_bound_l )  THEN   !  Left border pe
+             CALL pmci_interp_tril_lr( u,  uc,  icu, jco, kco, r1xu, r2xu, r1yo, r2yo, r1zo, r2zo,          &
+                                       nzb_u_inner, 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,          &
+                                       nzb_v_inner, 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,          &
+                                       nzb_w_inner, 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,          &
+                                       nzb_s_inner, logc_u_l, logc_ratio_u_l, nzt_topo_nestbc_l, 'l', 'e' )
+             CALL pmci_interp_tril_lr( pt, ptc, ico, jco, kco, r1xo, r2xo, r1yo, r2yo, r1zo, r2zo,          &
+                                       nzb_s_inner, logc_u_l, logc_ratio_u_l, nzt_topo_nestbc_l, 'l', 's' )
+             IF ( humidity  .OR.  passive_scalar )  THEN
+                CALL pmci_interp_tril_lr( q, qc, ico, jco, kco, r1xo, r2xo, r1yo, r2yo, r1zo, r2zo,         &
+                                          nzb_s_inner, logc_u_l, logc_ratio_u_l, nzt_topo_nestbc_l, 'l', 's' )
+             ENDIF
+             IF ( nesting_mode == 'one-way' )  THEN
+                CALL pmci_extrap_ifoutflow_lr( u, nzb_u_inner, 'l', 'u' )
+                CALL pmci_extrap_ifoutflow_lr( v, nzb_v_inner, 'l', 'v' )
+                CALL pmci_extrap_ifoutflow_lr( w, nzb_w_inner, 'l', 'w' )
+                CALL pmci_extrap_ifoutflow_lr( e, nzb_s_inner, 'l', 'e' )
+                CALL pmci_extrap_ifoutflow_lr( pt,nzb_s_inner, 'l', 's' )
+                IF ( humidity  .OR.  passive_scalar )  THEN
+                   CALL pmci_extrap_ifoutflow_lr( q, nzb_s_inner, 'l', 's' )
+                ENDIF
+             ENDIF
+          ENDIF
+          IF ( nest_bound_r )  THEN   !  Right border pe
+             CALL pmci_interp_tril_lr( u,  uc,  icu, jco, kco, r1xu, r2xu, r1yo, r2yo, r1zo, r2zo,          &
+                                       nzb_u_inner, 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,          &
+                                       nzb_v_inner, 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,          &
+                                       nzb_w_inner, 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,          &
+                                       nzb_s_inner, logc_u_r, logc_ratio_u_r, nzt_topo_nestbc_r, 'r', 'e' )
+             CALL pmci_interp_tril_lr( pt, ptc, ico, jco, kco, r1xo, r2xo, r1yo, r2yo, r1zo, r2zo,          &
+                                       nzb_s_inner, logc_u_r, logc_ratio_u_r, nzt_topo_nestbc_r, 'r', 's' )
+             IF ( humidity  .OR.  passive_scalar )  THEN
+                CALL pmci_interp_tril_lr( q, qc, ico, jco, kco, r1xo, r2xo, r1yo, r2yo, r1zo, r2zo,         &
+                                          nzb_s_inner, logc_u_r, logc_ratio_u_r, nzt_topo_nestbc_r, 'r', 's' )
+             ENDIF
+             IF ( nesting_mode == 'one-way' )  THEN
+                CALL pmci_extrap_ifoutflow_lr( u, nzb_u_inner, 'r', 'u' )
+                CALL pmci_extrap_ifoutflow_lr( v, nzb_v_inner, 'r', 'v' )
+                CALL pmci_extrap_ifoutflow_lr( w, nzb_w_inner, 'r', 'w' )
+                CALL pmci_extrap_ifoutflow_lr( e, nzb_s_inner, 'r', 'e' )
+                CALL pmci_extrap_ifoutflow_lr( pt,nzb_s_inner, 'r', 's' )
+                IF ( humidity  .OR.  passive_scalar )  THEN
+                   CALL pmci_extrap_ifoutflow_lr( q, nzb_s_inner, 'r', 's' )
+                ENDIF
+             ENDIF
+          ENDIF
+          IF ( nest_bound_s )  THEN   !  South border pe
+             CALL pmci_interp_tril_sn( u,  uc,  icu, jco, kco, r1xu, r2xu, r1yo, r2yo, r1zo, r2zo,          &
+                                       nzb_u_inner, 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,          &
+                                       nzb_v_inner, 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,          &
+                                       nzb_w_inner, 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,          &
+                                       nzb_s_inner, logc_u_s, logc_ratio_u_s, nzt_topo_nestbc_s, 's', 'e' )
+             CALL pmci_interp_tril_sn( pt, ptc, ico, jco, kco, r1xo, r2xo, r1yo, r2yo, r1zo, r2zo,          &
+                                       nzb_s_inner, logc_u_s, logc_ratio_u_s, nzt_topo_nestbc_s, 's', 's' )
+             IF ( humidity  .OR.  passive_scalar )  THEN
+                CALL pmci_interp_tril_sn( q, qc, ico, jco, kco, r1xo, r2xo, r1yo, r2yo, r1zo, r2zo,         &
+                                          nzb_s_inner, logc_u_s, logc_ratio_u_s, nzt_topo_nestbc_s, 's', 's' )
+             ENDIF
+             IF ( nesting_mode == 'one-way' )  THEN
+                CALL pmci_extrap_ifoutflow_sn( u, nzb_u_inner, 's', 'u' )
+                CALL pmci_extrap_ifoutflow_sn( v, nzb_v_inner, 's', 'v' )
+                CALL pmci_extrap_ifoutflow_sn( w, nzb_w_inner, 's', 'w' )
+                CALL pmci_extrap_ifoutflow_sn( e, nzb_s_inner, 's', 'e' )
+                CALL pmci_extrap_ifoutflow_sn( pt,nzb_s_inner, 's', 's' )
+                IF ( humidity  .OR.  passive_scalar )  THEN
+                   CALL pmci_extrap_ifoutflow_sn( q, nzb_s_inner, 's', 's' )
+                ENDIF
+             ENDIF
+          ENDIF
+          IF ( nest_bound_n )  THEN   !  North border pe
+             CALL pmci_interp_tril_sn( u,  uc,  icu, jco, kco, r1xu, r2xu, r1yo, r2yo, r1zo, r2zo,          &
+                                       nzb_u_inner, 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,          &
+                                       nzb_v_inner, 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,          &
+                                       nzb_w_inner, 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,                  &
+                                       nzb_s_inner, logc_u_n, logc_ratio_u_n, nzt_topo_nestbc_n, 'n', 'e' )
+             CALL pmci_interp_tril_sn( pt, ptc, ico, jco, kco, r1xo, r2xo, r1yo, r2yo, r1zo, r2zo,          &
+                                       nzb_s_inner, logc_u_n, logc_ratio_u_n, nzt_topo_nestbc_n, 'n', 's' )
+             IF ( humidity  .OR.  passive_scalar )  THEN
+                CALL pmci_interp_tril_sn( q, qc, ico,jco,kco,r1xo,r2xo,r1yo,r2yo,r1zo,r2zo,                 &
+                                          nzb_s_inner, logc_u_n, logc_ratio_u_n, nzt_topo_nestbc_n, 'n', 's' )
+             ENDIF
+             IF ( nesting_mode == 'one-way' )  THEN             
+                CALL pmci_extrap_ifoutflow_sn( u, nzb_u_inner, 'n', 'u' )
+                CALL pmci_extrap_ifoutflow_sn( v, nzb_v_inner, 'n', 'v' )
+                CALL pmci_extrap_ifoutflow_sn( w, nzb_w_inner, 'n', 'w' )
+                CALL pmci_extrap_ifoutflow_sn( e, nzb_s_inner, 'n', 'e' )
+                CALL pmci_extrap_ifoutflow_sn( pt,nzb_s_inner, 'n', 's' )
+                IF ( humidity  .OR.  passive_scalar )  THEN
+                   CALL pmci_extrap_ifoutflow_sn( q, nzb_s_inner, 'n', 's' )
+                ENDIF
+             ENDIF
+          ENDIF
+
+!
+!--       All PEs are top-border PEs
+          CALL pmci_interp_tril_t( u,  uc,  icu, jco, kco, r1xu, r2xu, r1yo, r2yo, r1zo, r2zo, 'u' )
+          CALL pmci_interp_tril_t( v,  vc,  ico, jcv, kco, r1xo, r2xo, r1yv, r2yv, r1zo, r2zo, 'v' )
+          CALL pmci_interp_tril_t( w,  wc,  ico, jco, kcw, r1xo, r2xo, r1yo, r2yo, r1zw, r2zw, 'w' )
+          CALL pmci_interp_tril_t( e,  ec,  ico, jco, kco, r1xo, r2xo, r1yo, r2yo, r1zo, r2zo, 'e' )
+          CALL pmci_interp_tril_t( pt, ptc, ico, jco, kco, r1xo, r2xo, r1yo, r2yo, r1zo, r2zo, 's' )
+          IF ( humidity  .OR.  passive_scalar )  THEN
+             CALL pmci_interp_tril_t( q, qc, ico, jco, kco, r1xo, r2xo, r1yo, r2yo, r1zo, r2zo, 's' )
+          ENDIF
+          IF ( nesting_mode == 'one-way' )  THEN
+             CALL pmci_extrap_ifoutflow_t( u,  'u' )
+             CALL pmci_extrap_ifoutflow_t( v,  'v' )
+             CALL pmci_extrap_ifoutflow_t( w,  'w' )
+             CALL pmci_extrap_ifoutflow_t( e,  'e' )
+             CALL pmci_extrap_ifoutflow_t( pt, 's' )
+             IF ( humidity  .OR.  passive_scalar )  THEN
+                CALL pmci_extrap_ifoutflow_t( q, 's' )
+             ENDIF
+          ENDIF
+       ELSE    !  IF ( direction == server_to_client ) 
+          CALL pmci_anterp_tophat( u,  uc,  kceu, iflu, ifuu, jflo, jfuo, kflo, kfuo, nzb_u_inner, 'u' )
+          CALL pmci_anterp_tophat( v,  vc,  kceu, iflo, ifuo, jflv, jfuv, kflo, kfuo, nzb_v_inner, 'v' )
+          CALL pmci_anterp_tophat( w,  wc,  kcew, iflo, ifuo, jflo, jfuo, kflw, kfuw, nzb_w_inner, 'w' )
+          CALL pmci_anterp_tophat( pt, ptc, kceu, iflo, ifuo, jflo, jfuo, kflo, kfuo, nzb_s_inner, 's' )
+          IF ( humidity  .OR.  passive_scalar )  THEN
+             CALL pmci_anterp_tophat( q, qc, kceu, iflo, ifuo, jflo, jfuo, kflo, kfuo, nzb_s_inner, 's' )
+          ENDIF
+          CALL cpu_log( log_point_s(74), 'PMC Client Send', 'start' )
+          CALL pmc_c_putbuffer( WaitTime = WaitTime )
+          CALL cpu_log( log_point_s(74), 'PMC Client Send', 'stop' )
+       ENDIF
+    ENDIF
+    
+ CONTAINS
+
+
+
+   SUBROUTINE pmci_interp_tril_lr( f, fc, ic, jc, kc, r1x, r2x, r1y, r2y, r1z, r2z, kb, logc, logc_ratio, &
+                                  nzt_topo_nestbc, edge, var )
+
+!
+!--   Interpolation of ghost-node values used as the client-domain boundary
+!--   conditions. This subroutine handles the left and right boundaries. 
+!--   This subroutine is based on trilinear interpolation.
+!--   Constant dz is still assumed.
+!
+!--                                   Antti Hellsten 22.2.2015.
+!
+!--   Rewritten so that all the coefficients and client-array indices are 
+!--   precomputed in the initialization phase by pmci_init_interp_tril.
+!
+!                                     Antti Hellsten 3.3.2015.
+!
+!--   Constant dz no more assumed.
+!                                     Antti Hellsten 23.3.2015.
+!
+!--   Adapted for non-flat topography. However, the near-wall velocities 
+!--   are log-corrected only over horizontal surfaces, not yet near vertical 
+!--   walls.
+!--                                   Antti Hellsten 26.3.2015.
+!
+!--   Indexing in the principal direction (i) is changed. Now, the nest-boundary 
+!--   values are interpolated only into the first ghost-node layers on each later 
+!--   boundary. These values are then simply copied to the second ghost-node layer.
+!
+!--                                   Antti Hellsten 6.10.2015.
+      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(nzb:nzt_topo_nestbc,nys:nyn,1:2,0:ncorr-1), 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(nysg:nyng,nxlg:nxrg), INTENT(IN)                   ::  kb           !:
+      INTEGER(iwp), DIMENSION(nzb:nzt+1), INTENT(IN)                             ::  kc           !: 
+      INTEGER(iwp), DIMENSION(nzb:nzt_topo_nestbc,nys:nyn,1:2), 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) ::  iw      !:
+      INTEGER(iwp) ::  j       !:
+      INTEGER(iwp) ::  jco     !:
+      INTEGER(iwp) ::  jcorr   !:
+      INTEGER(iwp) ::  jinc    !:
+      INTEGER(iwp) ::  jw      !:
+      INTEGER(iwp) ::  j1      !:
+      INTEGER(iwp) ::  k       !:
+      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         !:
+      
+! 
+!--   Check which edge is to be handled: left or right. Note the assumption that the same PE never 
+!--   holds both left and right nest boundaries. Should this be changed?
+      IF ( edge == 'l' )  THEN
+         IF ( var == 'u' )  THEN   !  For u, nxl is a ghost node, but not for the other variables.
+            i  = nxl
+            ib = nxl - 1 
+         ELSE
+            i  = nxl - 1
+            ib = nxl - 2
+         ENDIF
+      ELSEIF ( edge == 'r' )  THEN
+         i  = nxr + 1
+         ib = nxr + 2
+      ENDIF
+      
+      DO  j = nys, nyn + 1
+         DO  k = kb(j,i), nzt + 1
+            l = ic(i)
+            m = jc(j)
+            n = kc(k)
+            fkj      = r1x(i) * fc(n,m,l)     + r2x(i) * fc(n,m,l+1)
+            fkjp     = r1x(i) * fc(n,m+1,l)   + r2x(i) * fc(n,m+1,l+1)
+            fkpj     = r1x(i) * fc(n+1,m,l)   + r2x(i) * fc(n+1,m,l+1)
+            fkpjp    = r1x(i) * fc(n+1,m+1,l) + r2x(i) * fc(n+1,m+1,l+1)
+            fk       = r1y(j) * fkj  + r2y(j) * fkjp
+            fkp      = r1y(j) * fkpj + r2y(j) * fkpjp
+            f(k,j,i) = r1z(k) * fk   + r2z(k) * fkp
+         ENDDO
+      ENDDO
+
+!
+!--   Generalized log-law-correction algorithm.
+!--   Doubly two-dimensional index arrays logc(:,:,1:2) and log-ratio arrays 
+!--   logc_ratio(:,:,1:2,0:ncorr-1) have been precomputed in subroutine pmci_init_loglaw_correction.
+!
+!--   Solid surface below the node 
+      IF ( var == 'u' .OR. var == 'v' )  THEN           
+         DO  j = nys, nyn
+            k = kb(j,i) + 1
+            IF ( ( logc(k,j,1) /= 0 )  .AND.  ( logc(k,j,2) == 0 ) )  THEN
+               k1 = logc(k,j,1)
+               DO  kcorr=0,ncorr - 1
+                  kco = k + kcorr
+                  f(kco,j,i) = logc_ratio(k,j,1,kcorr) * f(k1,j,i)
+               ENDDO
+            ENDIF
+         ENDDO
+      ENDIF
+
+!
+!--   In case of non-flat topography, also vertical walls and corners need to be treated.
+!--   Only single and double wall nodes are corrected. Triple and higher-multiple wall nodes 
+!--   are not corrected as the log law would not be valid anyway in such locations.
+      IF ( topography /= 'flat' )  THEN
+         IF ( var == 'u' .OR. var == 'w' )  THEN                 
+
+!
+!--         Solid surface only on south/north side of the node                   
+            DO  j = nys, nyn
+               DO  k = kb(j,i) + 1, nzt_topo_nestbc
+                  IF ( ( logc(k,j,2) /= 0 )  .AND.  ( logc(k,j,1) == 0 ) )  THEN
+
+!
+!--                  Direction of the wall-normal index is carried in as the sign of logc.            
+                     jinc = SIGN( 1, logc(k,j,2) )
+                     j1   = ABS( logc(k,j,2) )
+                     DO  jcorr=0, ncorr - 1
+                        jco = j + jinc * jcorr
+                        f(k,jco,i) = logc_ratio(k,j,2,jcorr) * f(k,j1,i)
+                     ENDDO
+                  ENDIF
+               ENDDO
+            ENDDO
+         ENDIF
+
+!
+!--      Solid surface on both below and on south/north side of the node           
+         IF ( var == 'u' )  THEN
+            DO  j = nys, nyn
+               k = kb(j,i) + 1
+               IF ( ( logc(k,j,2) /= 0 )  .AND.  ( logc(k,j,1) /= 0 ) )  THEN
+                  k1   = logc(k,j,1)                 
+                  jinc = SIGN( 1, logc(k,j,2) )
+                  j1   = ABS( logc(k,j,2) )                 
+                  DO  jcorr = 0, ncorr - 1
+                     jco = j + jinc * jcorr
+                     DO  kcorr = 0, ncorr - 1
+                        kco = k + kcorr
+                        f(kco,jco,i) = 0.5_wp * ( logc_ratio(k,j,1,kcorr) * f(k1,j,i)  &
+                                     + logc_ratio(k,j,2,jcorr) * f(k,j1,i) )
+                     ENDDO
+                  ENDDO
+               ENDIF
+            ENDDO
+         ENDIF
+
+      ENDIF  ! ( topography /= 'flat' )
+
+!
+!--   Rescale if f is the TKE.
+      IF ( var == 'e')  THEN
+         IF ( edge == 'l' )  THEN
+            DO  j = nys, nyn + 1
+               DO  k = kb(j,i), nzt + 1
+                  f(k,j,i) = tkefactor_l(k,j) * f(k,j,i)
+               ENDDO
+            ENDDO
+         ELSEIF ( edge == 'r' )  THEN           
+            DO  j = nys, nyn + 1
+               DO  k = kb(j,i), nzt + 1
+                  f(k,j,i) = tkefactor_r(k,j) * f(k,j,i)
+               ENDDO
+            ENDDO
+         ENDIF
+      ENDIF
+
+!
+!--   Store the boundary values also into the second ghost node layer.
+      f(0:nzt+1,nys:nyn+1,ib) = f(0:nzt+1,nys:nyn+1,i)
+
+   END SUBROUTINE pmci_interp_tril_lr
+
+
+
+   SUBROUTINE pmci_interp_tril_sn( f, fc, ic, jc, kc, r1x, r2x, r1y, r2y, r1z, r2z, kb, logc, logc_ratio, &
+                                  nzt_topo_nestbc, edge, var )
+
+!
+!--   Interpolation of ghost-node values used as the client-domain boundary
+!--   conditions. This subroutine handles the south and north boundaries. 
+!--   This subroutine is based on trilinear interpolation.
+!--   Constant dz is still assumed.
+!
+!--                                      Antti Hellsten 22.2.2015.
+!
+!--   Rewritten so that all the coefficients and client-array indices are 
+!--   precomputed in the initialization phase by pmci_init_interp_tril.
+!
+!--                                      Antti Hellsten 3.3.2015.
+!
+!--   Constant dz no more assumed.
+!--                                      Antti Hellsten 23.3.2015.
+!
+!--   Adapted for non-flat topography. However, the near-wall velocities 
+!--   are log-corrected only over horifontal surfaces, not yet near vertical 
+!--   walls.
+!--                                      Antti Hellsten 26.3.2015.
+!
+!--   Indexing in the principal direction (j) is changed. Now, the nest-boundary 
+!--   values are interpolated only into the first ghost-node layers on each later 
+!--   boundary. These values are then simply copied to the second ghost-node layer.
+!
+!--                                      Antti Hellsten 6.10.2015.
+      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(nzb:nzt_topo_nestbc,nxl:nxr,1:2,0:ncorr-1), 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(nysg:nyng,nxlg:nxrg), INTENT(IN)                   ::  kb                !:
+      INTEGER(iwp), DIMENSION(nzb:nzt+1), INTENT(IN)                             ::  kc                !:
+      INTEGER(iwp), DIMENSION(nzb:nzt_topo_nestbc,nxl:nxr,1:2), 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) ::  k       !:
+      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         !:
+      
+!
+!--   Check which edge is to be handled: south or north. Note the assumption that the same PE never 
+!--   holds both south and north nest boundaries. Should this be changed?
+      IF ( edge == 's' )  THEN
+         IF ( var == 'v' )  THEN   !  For v, nys is a ghost node, but not for the other variables.
+            j  = nys
+            jb = nys - 1 
+         ELSE
+            j  = nys - 1
+            jb = nys - 2
+         ENDIF
+      ELSEIF ( edge == 'n' )  THEN
+         j  = nyn + 1
+         jb = nyn + 2
+      ENDIF
+
+      DO  i = nxl, nxr + 1
+         DO  k = kb(j,i), nzt + 1
+            l = ic(i)
+            m = jc(j)
+            n = kc(k)              
+            fkj      = r1x(i) * fc(n,m,l)     + r2x(i) * fc(n,m,l+1)
+            fkjp     = r1x(i) * fc(n,m+1,l)   + r2x(i) * fc(n,m+1,l+1)
+            fkpj     = r1x(i) * fc(n+1,m,l)   + r2x(i) * fc(n+1,m,l+1)
+            fkpjp    = r1x(i) * fc(n+1,m+1,l) + r2x(i) * fc(n+1,m+1,l+1)
+            fk       = r1y(j) * fkj  + r2y(j) * fkjp
+            fkp      = r1y(j) * fkpj + r2y(j) * fkpjp
+            f(k,j,i) = r1z(k) * fk   + r2z(k) * fkp
+         ENDDO
+      ENDDO
+
+!
+!--   Generalized log-law-correction algorithm.
+!--   Multiply two-dimensional index arrays logc(:,:,1:2) and log-ratio arrays 
+!--   logc_ratio(:,:,1:2,0:ncorr-1) have been precomputed in subroutine pmci_init_loglaw_correction.
+!
+!--   Solid surface below the node 
+      IF ( var == 'u'  .OR.  var == 'v' )  THEN           
+         DO  i = nxl, nxr
+            k = kb(j,i) + 1
+            IF ( ( logc(k,i,1) /= 0 )  .AND.  ( logc(k,i,2) == 0 ) )  THEN
+               k1 = logc(k,i,1)
+               DO  kcorr = 0, ncorr - 1
+                  kco = k + kcorr
+                  f(kco,j,i) = logc_ratio(k,i,1,kcorr) * f(k1,j,i)
+               ENDDO
+            ENDIF
+         ENDDO
+      ENDIF
+
+!
+!--   In case of non-flat topography, also vertical walls and corners need to be treated.
+!--   Only single and double wall nodes are corrected. 
+!--   Triple and higher-multiple wall nodes are not corrected as it would be extremely complicated 
+!--   and the log law would not be valid anyway in such locations.
+      IF ( topography /= 'flat' )  THEN
+         IF ( var == 'v' .OR. var == 'w' )  THEN
+            DO  i = nxl, nxr
+               DO  k = kb(j,i), nzt_topo_nestbc
+
+!
+!--               Solid surface only on left/right side of the node           
+                  IF ( ( logc(k,i,2) /= 0 )  .AND.  ( logc(k,i,1) == 0 ) )  THEN
+
+!
+!--                  Direction of the wall-normal index is carried in as the sign of logc.            
+                     iinc = SIGN( 1, logc(k,i,2) )
+                     i1  = ABS( logc(k,i,2) )
+                     DO  icorr = 0, ncorr - 1
+                        ico = i + iinc * icorr
+                        f(k,j,ico) = logc_ratio(k,i,2,icorr) * f(k,j,i1)
+                     ENDDO
+                  ENDIF
+               ENDDO
+            ENDDO
+         ENDIF
+
+!
+!--      Solid surface on both below and on left/right side of the node           
+         IF ( var == 'v' )  THEN
+            DO  i = nxl, nxr
+               k = kb(j,i) + 1
+               IF ( ( logc(k,i,2) /= 0 )  .AND.  ( logc(k,i,1) /= 0 ) )  THEN
+                  k1   = logc(k,i,1)         
+                  iinc = SIGN( 1, logc(k,i,2) )
+                  i1   = ABS( logc(k,i,2) )
+                  DO  icorr = 0, ncorr - 1
+                     ico = i + iinc * icorr
+                     DO  kcorr = 0, ncorr - 1
+                        kco = k + kcorr
+                        f(kco,i,ico) = 0.5_wp * ( logc_ratio(k,i,1,kcorr) * f(k1,j,i)  &
+                                     + logc_ratio(k,i,2,icorr) * f(k,j,i1) )
+                     ENDDO
+                  ENDDO
+               ENDIF
+            ENDDO
+         ENDIF
+         
+      ENDIF  ! ( topography /= 'flat' )
+
+!
+!--   Rescale if f is the TKE.
+      IF ( var == 'e')  THEN
+         IF ( edge == 's' )  THEN
+            DO  i = nxl, nxr + 1
+               DO  k = kb(j,i), nzt + 1
+                  f(k,j,i) = tkefactor_s(k,i) * f(k,j,i)
+               ENDDO
+            ENDDO
+         ELSEIF ( edge == 'n' )  THEN
+            DO  i = nxl, nxr + 1
+               DO  k = kb(j,i), nzt + 1
+                  f(k,j,i) = tkefactor_n(k,i) * f(k,j,i)
+               ENDDO
+            ENDDO
+         ENDIF
+      ENDIF
+
+!
+!--   Store the boundary values also into the second ghost node layer.
+      f(0:nzt+1,jb,nxl:nxr+1) = f(0:nzt+1,j,nxl:nxr+1)
+
+   END SUBROUTINE pmci_interp_tril_sn
+
+ 
+
+   SUBROUTINE pmci_interp_tril_t( f, fc, ic, jc, kc, r1x, r2x, r1y, r2y, r1z, r2z, var )
+
+!
+!--   Interpolation of ghost-node values used as the client-domain boundary
+!--   conditions. This subroutine handles the top boundary. 
+!--   This subroutine is based on trilinear interpolation.
+!--   Constant dz is still assumed.
+!
+!--                                      Antti Hellsten 23.2.2015.
+!
+!
+!--   Rewritten so that all the coefficients and client-array indices are 
+!--   precomputed in the initialization phase by pmci_init_interp_tril.
+!
+!--                                      Antti Hellsten 3.3.2015.
+!
+!--   Constant dz no more assumed.
+!--                                      Antti Hellsten 23.3.2015.
+!
+!--   Indexing in the principal direction (k) is changed. Now, the nest-boundary 
+!--   values are interpolated only into the first ghost-node layer. Actually there is 
+!--   only one ghost-node layer in the k-direction.  
+!
+!--                                      Antti Hellsten 6.10.2015.
+!
+      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   !:
+      
+      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) ::  j   !:
+      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         !:
+
+      
+      IF ( var == 'w' )  THEN
+         k  = nzt
+      ELSE
+         k  = nzt + 1
+      ENDIF
+     
+      DO  i = nxl - 1, nxr + 1
+         DO  j = nys - 1, nyn + 1
+            l = ic(i)
+            m = jc(j)
+            n = kc(k)              
+            fkj      = r1x(i) * fc(n,m,l)     + r2x(i) * fc(n,m,l+1)
+            fkjp     = r1x(i) * fc(n,m+1,l)   + r2x(i) * fc(n,m+1,l+1)
+            fkpj     = r1x(i) * fc(n+1,m,l)   + r2x(i) * fc(n+1,m,l+1)
+            fkpjp    = r1x(i) * fc(n+1,m+1,l) + r2x(i) * fc(n+1,m+1,l+1)
+            fk       = r1y(j) * fkj  + r2y(j) * fkjp
+            fkp      = r1y(j) * fkpj + r2y(j) * fkpjp
+            f(k,j,i) = r1z(k) * fk   + r2z(k) * fkp
+         ENDDO
+      ENDDO
+
+!
+!--   Just fill up the second ghost-node layer for w.
+      IF ( var == 'w' )  THEN
+         f(nzt+1,:,:) = f(nzt,:,:)
+      ENDIF
+
+!
+!--   Rescale if f is the TKE.
+!--   It is assumed that the bottom surface never reaches the top 
+!---  boundary of a nest domain. 
+      IF ( var == 'e')  THEN
+         DO  i = nxl, nxr
+            DO  j = nys, nyn
+               f(k,j,i) = tkefactor_t(j,i) * f(k,j,i)
+            ENDDO
+         ENDDO
+      ENDIF
+
+   END SUBROUTINE pmci_interp_tril_t
+
+
+
+   SUBROUTINE pmci_extrap_ifoutflow_lr( f, kb, edge, var )
+
+!
+!--   After the interpolation of ghost-node values for the client-domain boundary
+!--   conditions, this subroutine checks if there is a local outflow through the 
+!--   boundary. In that case this subroutine overwrites the interpolated values 
+!--   by values extrapolated from the domain. This subroutine handles the left and 
+!--   right boundaries.
+!--   However, this operation is only needed in case of one-way coupling.
+!
+!--                                       Antti Hellsten 9.3.2015.
+!
+!--   Indexing in the principal direction (i) is changed. Now, the nest-boundary 
+!--   values are interpolated only into the first ghost-node layers on each later 
+!--   boundary. These values are then simply copied to the second ghost-node layer.
+!
+!--                                       Antti Hellsten 6.10.2015.
+!
+      IMPLICIT NONE
+      REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(INOUT) ::  f    !:
+      INTEGER(iwp), DIMENSION(nysg:nyng,nxlg:nxrg), INTENT(IN)          ::  kb   !:
+
+      CHARACTER(LEN=1),INTENT(IN) ::  edge   !:
+      CHARACTER(LEN=1),INTENT(IN) ::  var    !:
+
+      INTEGER(iwp) ::  i     !:
+      INTEGER(iwp) ::  ib    !:
+      INTEGER(iwp) ::  ied   !:
+      INTEGER(iwp) ::  j     !:
+      INTEGER(iwp) ::  k     !:
+      
+      REAL(wp) ::  outnor    !:
+      REAL(wp) ::  vdotnor   !:
+
+!
+!--   Check which edge is to be handled: left or right. 
+      IF ( edge == 'l' )  THEN
+         IF ( var == 'u' )  THEN
+            i   = nxl
+            ib  = nxl - 1
+            ied = nxl + 1
+         ELSE
+            i   = nxl - 1
+            ib  = nxl - 2
+            ied = nxl
+         ENDIF
+         outnor = -1.0_wp
+      ELSEIF ( edge == 'r' )  THEN
+         i      = nxr + 1
+         ib     = nxr + 2
+         ied    = nxr
+         outnor = 1.0_wp
+      ENDIF
+
+      DO  j = nys, nyn + 1
+         DO  k = kb(j,i), nzt +1
+            vdotnor = outnor * u(k,j,ied)
+            IF ( vdotnor > 0.0_wp )  THEN   !  Local outflow.
+               f(k,j,i) = f(k,j,ied)
+            ENDIF
+         ENDDO
+         IF ( (var == 'u' )  .OR.  (var == 'v' )  .OR.  (var == 'w') )  THEN
+            f(kb(j,i),j,i) = 0.0_wp
+         ENDIF
+      ENDDO
+
+!
+!--   Store the updated boundary values also into the second ghost node layer.
+      f(0:nzt,nys:nyn+1,ib) = f(0:nzt,nys:nyn+1,i)
+
+   END SUBROUTINE pmci_extrap_ifoutflow_lr
+
+
+
+   SUBROUTINE pmci_extrap_ifoutflow_sn( f, kb, edge, var )
+!
+!--   After  the interpolation of ghost-node values for the client-domain boundary
+!--   conditions, this subroutine checks if there is a local outflow through the 
+!--   boundary. In that case this subroutine overwrites the interpolated values 
+!--   by values extrapolated from the domain. This subroutine handles the south and 
+!--   north boundaries. 
+!
+!--                                       Antti Hellsten 9.3.2015.
+!
+!--   Indexing in the principal direction (j) is changed. Now, the nest-boundary 
+!--   values are interpolated only into the first ghost-node layers on each later 
+!--   boundary. These values are then simply copied to the second ghost-node layer.
+!
+!--                                       Antti Hellsten 6.10.2015.
+
+      IMPLICIT NONE
+      REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(INOUT) ::  f    !:
+      INTEGER(iwp), DIMENSION(nysg:nyng,nxlg:nxrg), INTENT(IN)          ::  kb   !:
+      CHARACTER(LEN=1), INTENT(IN) ::  edge   !:
+      CHARACTER(LEN=1), INTENT(IN) ::  var    !:
+      
+      INTEGER(iwp) ::  i         !:
+      INTEGER(iwp) ::  j         !:
+      INTEGER(iwp) ::  jb        !:
+      INTEGER(iwp) ::  jed       !:
+      INTEGER(iwp) ::  k         !:
+      REAL(wp)     ::  outnor    !:
+      REAL(wp)     ::  vdotnor   !:
+
+!
+!--   Check which edge is to be handled: left or right. 
+      IF ( edge == 's' )  THEN
+         IF ( var == 'v' )  THEN
+            j   = nys
+            jb  = nys - 1
+            jed = nys + 1
+         ELSE
+            j   = nys - 1
+            jb  = nys - 2
+            jed = nys
+         ENDIF
+         outnor = -1.0_wp
+      ELSEIF ( edge == 'n' )  THEN
+         j      = nyn + 1
+         jb     = nyn + 2
+         jed    = nyn
+         outnor = 1.0_wp
+      ENDIF
+
+      DO  i = nxl, nxr + 1
+         DO  k = kb(j,i), nzt + 1
+            vdotnor = outnor * v(k,jed,i)
+            IF ( vdotnor > 0.0_wp )  THEN   !  Local outflow.
+               f(k,j,i) = f(k,jed,i)                 
+            ENDIF
+         ENDDO
+         IF ( (var == 'u' )  .OR.  (var == 'v' )  .OR.  (var == 'w') )  THEN
+            f(kb(j,i),j,i) = 0.0_wp
+         ENDIF
+      ENDDO
+
+!
+!--   Store the updated boundary values also into the second ghost node layer.
+      f(0:nzt,jb,nxl:nxr+1) = f(0:nzt,j,nxl:nxr+1)
+
+   END SUBROUTINE pmci_extrap_ifoutflow_sn
+
+ 
+
+   SUBROUTINE pmci_extrap_ifoutflow_t( f, var )
+
+!
+!--   Interpolation of ghost-node values used as the client-domain boundary
+!--   conditions. This subroutine handles the top boundary. 
+!--   This subroutine is based on trilinear interpolation.
+!     
+!--                                       Antti Hellsten 23.2.2015.
+!     
+!     
+!--   Rewritten so that all the coefficients and client-array indices are 
+!--   precomputed in the initialization phase by init_interp_tril.
+!     
+!--                                       Antti Hellsten 3.3.2015. 
+!     
+!--   Indexing in the principal direction (k) is changed. Now, the nest-boundary 
+!--   values are extrapolated only into the first ghost-node layer. Actually there is 
+!--   only one ghost-node layer in the k-direction.  
+!     
+!--                                       Antti Hellsten 6.10.2015.
+      IMPLICIT NONE
+      REAL(wp), DIMENSION(nzb:nzt+1,nys-nbgp:nyn+nbgp,nxl-nbgp:nxr+nbgp), INTENT(INOUT) ::  f   !:
+      CHARACTER(LEN=1), INTENT(IN) ::  var   !:
+      
+      INTEGER(iwp) ::  i     !:
+      INTEGER(iwp) ::  j     !:
+      INTEGER(iwp) ::  k     !:
+      INTEGER(iwp) ::  ked   !:
+      REAL(wp) ::  vdotnor   !:
+     
+
+      IF ( var == 'w' )  THEN
+         k    = nzt
+         ked  = nzt - 1
+      ELSE
+         k    = nzt + 1  
+         ked  = nzt
+      ENDIF
+
+      DO  i = nxl, nxr
+         DO  j = nys, nyn
+            vdotnor = w(ked,j,i)
+            IF ( vdotnor > 0.0_wp )  THEN   !:  Local outflow.              
+               f(k,j,i) = f(ked,j,i)
+            ENDIF
+         ENDDO
+      ENDDO
+
+!
+!--   Just fill up the second ghost-node layer for w.
+      IF ( var == 'w' )  THEN
+         f(nzt+1,:,:) = f(nzt,:,:)
+      ENDIF
+
+   END SUBROUTINE pmci_extrap_ifoutflow_t
+
+
+
+   SUBROUTINE pmci_anterp_tophat( f, fc, kce, ifl, ifu, jfl, jfu, kfl, kfu, kb, var )
+!
+!--   Anterpolation of internal-node values to be used as the server-domain 
+!--   values. This subroutine is based on the first-order numerical 
+!--   integration of the fine-grid values contained within the coarse-grid
+!--   cell. 
+!     
+!--                                        Antti Hellsten 16.9.2015.
+!
+      IMPLICIT NONE
+      REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(IN)  ::  f     !:
+      REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr), INTENT(INOUT)   ::  fc    !:
+      INTEGER(iwp), DIMENSION(icl:icr), INTENT(IN)                    ::  ifl   !:
+      INTEGER(iwp), DIMENSION(icl:icr), INTENT(IN)                    ::  ifu   !:
+      INTEGER(iwp), DIMENSION(jcs:jcn), INTENT(IN)                    ::  jfl   !:
+      INTEGER(iwp), DIMENSION(jcs:jcn), INTENT(IN)                    ::  jfu   !:
+      INTEGER(iwp), DIMENSION(nysg:nyng,nxlg:nxrg), INTENT(IN)        ::  kb    !: may be unnecessary
+      INTEGER(iwp), INTENT(IN)                                        ::  kce   !:
+      INTEGER(iwp), DIMENSION(0:kce), INTENT(IN)                      ::  kfl   !:
+      INTEGER(iwp), DIMENSION(0:kce), INTENT(IN)                      ::  kfu   !:
+      CHARACTER(LEN=1), INTENT(IN)                                    ::  var   !:                            
+
+      INTEGER(iwp) ::  i         !:
+      INTEGER(iwp) ::  icb       !:
+      INTEGER(iwp) ::  ice       !:
+      INTEGER(iwp) ::  ifc       !:
+      INTEGER(iwp) ::  ijfc      !:
+      INTEGER(iwp) ::  j         !:
+      INTEGER(iwp) ::  jcb       !:
+      INTEGER(iwp) ::  jce       !:
+      INTEGER(iwp) ::  k         !:
+      INTEGER(iwp) ::  kcb       !:
+      INTEGER(iwp) ::  l         !:
+      INTEGER(iwp) ::  m         !:
+      INTEGER(iwp) ::  n         !:
+      INTEGER(iwp) ::  nfc       !:
+      REAL(wp)     ::  cellsum   !:
+      REAL(wp)     ::  f1f       !:
+      REAL(wp)     ::  fra       !:
+  
+
+      icb = icl 
+      ice = icr 
+      jcb = jcs 
+      jce = jcn 
+
+!
+!--   Define the index bounds icb, ice, jcb and jce. 
+!--   Note that kcb is simply zero and kce enters here as a parameter and it is 
+!--   determined in init_anterp_tophat  
+      IF ( nest_bound_l )  THEN
+         IF ( var == 'u' )  THEN
+            icb = icl + nhll + 1
+         ELSE
+            icb = icl + nhll
+         ENDIF
+      ENDIF
+      IF ( nest_bound_r )  THEN
+         ice = icr - nhlr
+      ENDIF
+
+      IF ( nest_bound_s )  THEN
+         IF ( var == 'v' )  THEN
+            jcb = jcs + nhls + 1
+         ELSE
+            jcb = jcs + nhls
+         ENDIF
+      ENDIF
+      IF ( nest_bound_n )  THEN
+         jce = jcn - nhln
+      ENDIF
+      kcb = 0 
+
+!
+!--   Note that l,m, and n are coarse-grid indices and i,j, and k are fine-grid indices.
+      DO  l = icb, ice
+         ifc = ifu(l) - ifl(l) + 1
+         DO  m = jcb, jce
+            ijfc = ifc * ( jfu(m) - jfl(m) +1 )
+
+!
+!--         How to deal with the lower bound of k in case of non-flat topography?
+            !kcb = MIN( kb(jfl(m),ifl(l)), kb(jfu(m),ifl(l)), kb(jfl(m),ifu(l)), kb(jfu(m),ifu(l)) ) ! Something wrong with this.
+            DO  n = kcb, kce
+               nfc =  ijfc * ( kfu(n) - kfl(n) + 1 )
+               cellsum = 0.0
+               DO  i = ifl(l), ifu(l)
+                  DO  j = jfl(m), jfu(m)
+                     DO  k = kfl(n), kfu(n)
+                        cellsum = cellsum + f(k,j,i)
+                     ENDDO
+                  ENDDO
+               ENDDO
+
+!
+!--            Spatial under-relaxation.
+               fra  = frax(l) * fray(m) * fraz(n)
+               fc(n,m,l) = ( 1.0_wp - fra ) * fc(n,m,l) + fra * cellsum / REAL( nfc, KIND=KIND(cellsum) )  
+            ENDDO
+         ENDDO
+      ENDDO
+
+   END SUBROUTINE pmci_anterp_tophat
+
+
+ END SUBROUTINE pmci_client_datatrans
+
+
+
+ SUBROUTINE pmci_update_new
+
+!
+!-- Copy the interpolated/anterpolated boundary values to the _p 
+!-- arrays, too, to make sure the interpolated/anterpolated boundary
+!-- values are carried over from one RK inner step to another.
+!-- So far works only with the cpp-switch __nopointer.
+!
+!--                 Antti Hellsten 8.3.2015 
+!
+
+!-- Just debugging
+    w(nzt+1,:,:) = w(nzt,:,:)
+
+#if defined( __nopointer )
+
+    u_p  = u
+    v_p  = v
+    w_p  = w
+    e_p  = e
+    pt_p = pt
+    IF ( humidity  .OR.  passive_scalar )  THEN
+       q_p = q
+    ENDIF
+
+#endif
+
+!
+!-- Find out later if nesting would work without __nopointer.
+
+ END SUBROUTINE pmci_update_new
+
+
+
+ SUBROUTINE pmci_set_array_pointer( name, client_id, nz_cl )
+    IMPLICIT NONE
+
+    INTEGER, INTENT(IN)                  ::  client_id   !:
+    INTEGER, INTENT(IN)                  ::  nz_cl       !:
+    CHARACTER(LEN=*), INTENT(IN)         ::  name        !:
+    
+    REAL(wp), POINTER, DIMENSION(:,:)    ::  p_2d        !:
+    REAL(wp), POINTER, DIMENSION(:,:,:)  ::  p_3d        !:
+    INTEGER(iwp)                         ::  ierr        !:
+    INTEGER(iwp)                         ::  istat       !:
+    
+
+#if defined PMC_ACTIVE
+    NULLIFY( p_3d )
+    NULLIFY( p_2d )
+
+!
+!-- List of array names, which can be coupled
+    IF ( TRIM(name) == "u" )     p_3d => u
+    IF ( TRIM(name) == "v" )     p_3d => v
+    IF ( TRIM(name) == "w" )     p_3d => w
+    IF ( TRIM(name) == "e" )     p_3d => e
+    IF ( TRIM(name) == "pt" )    p_3d => pt
+    IF ( TRIM(name) == "q" )     p_3d => q
+    !IF ( TRIM(name) == "z0" )    p_2d => z0
+
+    IF ( ASSOCIATED( p_3d ) )  THEN
+       CALL pmc_s_set_dataarray( client_id, p_3d, nz_cl, nz )
+    ELSEIF ( ASSOCIATED( p_2d ) )  THEN
+       CALL pmc_s_set_dataarray( client_id, p_2d )
+    ELSE
+       IF ( myid == 0 ) WRITE( 0, * )  'PMC set_array_Pointer -> no pointer p_2d or p_3d associated '
+       CALL MPI_Abort( MPI_COMM_WORLD, istat, ierr )
+    ENDIF
+
+#endif
+
+ END SUBROUTINE pmci_set_array_pointer
+
+
+
+ SUBROUTINE pmci_create_client_arrays( name, is, ie, js, je, nzc  )
+    IMPLICIT NONE
+    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    !:
+     
+    REAL(wp), POINTER,DIMENSION(:,:)      ::  p_2d    !:
+    REAL(wp), POINTER,DIMENSION(:,:,:)    ::  p_3d    !:
+    INTEGER(iwp)                          ::  ierr    !:
+    INTEGER(iwp)                          ::  istat   !:
+
+
+#if defined PMC_ACTIVE
+    NULLIFY( p_3d )
+    NULLIFY( p_2d )
+
+!
+!-- List of array names, which can be coupled.
+!-- AH: Note that the k-range of the *c arrays is changed from 1:nz to 0:nz+1.
+    IF ( TRIM( name ) == "u" )  THEN
+       IF ( .NOT. ALLOCATED( uc ) )  ALLOCATE( uc(0:nzc+1, js:je, is:ie) )
+       p_3d => uc
+    ELSEIF ( TRIM( name ) == "v" )  THEN
+       IF ( .NOT. ALLOCATED( vc ) )  ALLOCATE( vc(0:nzc+1, js:je, is:ie) )
+       p_3d => vc
+    ELSEIF ( TRIM( name ) == "w" )  THEN
+       IF ( .NOT. ALLOCATED( wc ) )  ALLOCATE( wc(0:nzc+1, js:je, is:ie) )
+       p_3d => wc
+    ELSEIF ( TRIM( name ) == "e" )  THEN
+       IF ( .NOT. ALLOCATED( ec ) )  ALLOCATE( ec(0:nzc+1, js:je, is:ie) )
+       p_3d => ec
+    ELSEIF ( TRIM( name ) == "pt")  THEN
+       IF ( .NOT. ALLOCATED( ptc ) ) ALLOCATE( ptc(0:nzc+1, js:je, is:ie) )
+       p_3d => ptc
+    ELSEIF ( TRIM( name ) == "q")  THEN
+       IF ( .NOT. ALLOCATED( qc ) ) ALLOCATE( qc(0:nzc+1, js:je, is:ie) )
+       p_3d => qc
+    !ELSEIF (trim(name) == "z0") then
+       !IF (.not.allocated(z0c))  allocate(z0c(js:je, is:ie))
+       !p_2d => z0c
+    ENDIF
+
+    IF ( ASSOCIATED( p_3d ) )  THEN
+       CALL pmc_c_set_dataarray( p_3d )
+    ELSEIF ( ASSOCIATED( p_2d ) )  THEN
+       CALL pmc_c_set_dataarray( p_2d )
+    ELSE
+       IF ( myid == 0 ) WRITE( 0 , * )  'PMC create_client_arrays -> no pointer p_2d or p_3d associated '
+       CALL MPI_Abort( MPI_COMM_WORLD, istat, ierr )
+    ENDIF
+#endif
+
+ END SUBROUTINE pmci_create_client_arrays
+
+
+
+ SUBROUTINE pmci_server_initialize
+    IMPLICIT NONE
+    INTEGER(iwp)   ::  client_id   !:
+    INTEGER(iwp)   ::  m           !:
+    REAL(wp)       ::  waittime    !:
+
+
+    DO  m = 1, SIZE( pmc_server_for_client ) - 1
+       client_id = pmc_server_for_client(m)
+       CALL pmc_s_fillbuffer( client_id, waittime=waittime )
+    ENDDO
+
+ END SUBROUTINE pmci_server_initialize
+
+
+
+ SUBROUTINE pmci_client_initialize
+
+    IMPLICIT NONE
+    INTEGER(iwp)   ::  i          !:
+    INTEGER(iwp)   ::  icl        !:
+    INTEGER(iwp)   ::  icr        !:
+    INTEGER(iwp)   ::  j          !:
+    INTEGER(iwp)   ::  jcn        !:
+    INTEGER(iwp)   ::  jcs        !:
+    REAL(wp)       ::  waittime   !:
+
+
+    IF ( cpl_id > 1 )  THEN   !  Root id is never a client      
+
+!
+!--    Client domain boundaries in the server indice space.
+       icl = coarse_bound(1)
+       icr = coarse_bound(2)
+       jcs = coarse_bound(3)
+       jcn = coarse_bound(4)
+
+!
+!--    Get data from server      
+       CALL pmc_c_getbuffer( waittime = waittime )
+
+!
+!--    The interpolation.
+       CALL pmci_interp_tril_all ( u,  uc,  icu, jco, kco, r1xu, r2xu, r1yo, r2yo, r1zo, r2zo, nzb_u_inner, 'u' )
+       CALL pmci_interp_tril_all ( v,  vc,  ico, jcv, kco, r1xo, r2xo, r1yv, r2yv, r1zo, r2zo, nzb_v_inner, 'v' )
+       CALL pmci_interp_tril_all ( w,  wc,  ico, jco, kcw, r1xo, r2xo, r1yo, r2yo, r1zw, r2zw, nzb_w_inner, 'w' )
+       CALL pmci_interp_tril_all ( e,  ec,  ico, jco, kco, r1xo, r2xo, r1yo, r2yo, r1zo, r2zo, nzb_s_inner, 'e' )
+       CALL pmci_interp_tril_all ( pt, ptc, ico, jco, kco, r1xo, r2xo, r1yo, r2yo, r1zo, r2zo, nzb_s_inner, 's' )
+       IF ( humidity  .OR.  passive_scalar )  THEN
+          CALL pmci_interp_tril_all ( q, qc, ico, jco, kco, r1xo, r2xo, r1yo, r2yo, r1zo, r2zo, nzb_s_inner, 's' )
+       ENDIF
+
+       IF ( topography /= 'flat' )  THEN
+
+!
+!--       Inside buildings set velocities and TKE back to zero.
+!--       Other scalars (pt, q, s, km, kh, p, sa, ...) are ignored at present,
+!--       maybe revise later.
+          DO   i = nxlg, nxrg
+             DO   j = nysg, nyng
+                u(nzb:nzb_u_inner(j,i),j,i)     = 0.0_wp
+                v(nzb:nzb_v_inner(j,i),j,i)     = 0.0_wp
+                w(nzb:nzb_w_inner(j,i),j,i)     = 0.0_wp
+                e(nzb:nzb_w_inner(j,i),j,i)     = 0.0_wp              
+                tu_m(nzb:nzb_u_inner(j,i),j,i)  = 0.0_wp
+                tv_m(nzb:nzb_v_inner(j,i),j,i)  = 0.0_wp
+                tw_m(nzb:nzb_w_inner(j,i),j,i)  = 0.0_wp
+                te_m(nzb:nzb_w_inner(j,i),j,i)  = 0.0_wp
+             ENDDO
+          ENDDO
+       ENDIF
+    ENDIF
+    
+
+ CONTAINS
+
+
+   SUBROUTINE pmci_interp_tril_all( f, fc, ic, jc, kc, r1x, r2x, r1y, r2y, r1z, r2z, kb, var )
+
+!
+!-- Interpolation of the internal values for the client-domain initialization.
+!-- This subroutine is based on trilinear interpolation.
+!-- Coding based on interp_tril_lr/sn/t
+!
+!--                                     Antti Hellsten 20.10.2015.
+      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   !:
+      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(nysg:nyng,nxlg:nxrg), INTENT(IN)          ::  kb    !:
+      CHARACTER(LEN=1), INTENT(IN) :: var  !:
+      
+      INTEGER(iwp) ::  i      !:
+      INTEGER(iwp) ::  ib     !:
+      INTEGER(iwp) ::  j      !:
+      INTEGER(iwp) ::  jb     !:
+      INTEGER(iwp) ::  k      !:
+      INTEGER(iwp) ::  k1     !:
+      INTEGER(iwp) ::  kbc    !:
+      INTEGER(iwp) ::  l      !:
+      INTEGER(iwp) ::  m      !:
+      INTEGER(iwp) ::  n      !:
+      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       !:
+      
+      
+      ib = nxl
+      jb = nys     
+      IF ( nest_bound_l )  THEN
+         IF ( var == 'u' )  THEN   !  For u, nxl is a ghost node, but not for the other variables.
+            ib = nxl + 1
+         ENDIF
+      ENDIF
+      IF ( nest_bound_s )  THEN
+         IF ( var == 'v' )  THEN   !  For v, nys is a ghost node, but not for the other variables.
+            jb = nys + 1
+         ENDIF
+      ENDIF
+
+!
+!--   Trilinear interpolation.
+      DO  i = ib, nxr
+         DO  j = jb, nyn
+            DO  k = kb(j,i), nzt 
+               l = ic(i)
+               m = jc(j)
+               n = kc(k)
+               fkj      = r1x(i) * fc(n,m,l)     + r2x(i) * fc(n,m,l+1)
+               fkjp     = r1x(i) * fc(n,m+1,l)   + r2x(i) * fc(n,m+1,l+1)
+               fkpj     = r1x(i) * fc(n+1,m,l)   + r2x(i) * fc(n+1,m,l+1)
+               fkpjp    = r1x(i) * fc(n+1,m+1,l) + r2x(i) * fc(n+1,m+1,l+1)
+               fk       = r1y(j) * fkj  + r2y(j) * fkjp
+               fkp      = r1y(j) * fkpj + r2y(j) * fkpjp
+               f(k,j,i) = r1z(k) * fk   + r2z(k) * fkp
+            ENDDO
+         ENDDO
+      ENDDO
+
+!
+!--   Correct the interpolated values of u and v in near-wall nodes, i.e. in 
+!--   the nodes below the coarse-grid nodes with k=1. The corrction is only made 
+!--   over horizontal wall surfaces in this phase. For the nest boundary conditions,
+!--   a corresponding corrections is made for all vertical walls, too. 
+      IF ( var == 'u' .OR. var == 'v' )  THEN
+         DO  i = ib, nxr
+            DO  j = jb, nyn              
+               kbc = 1
+               DO  WHILE ( cg%zu(kbc) < zu(kb(j,i)) )   !  kbc is the first coarse-grid point above the surface.
+                  kbc = kbc + 1
+               ENDDO
+               zuc1    = cg%zu(kbc)
+               k1      = kb(j,i) + 1  
+               DO  WHILE ( zu(k1) < zuc1 )
+                  k1 = k1 + 1
+               ENDDO
+               logzuc1 = LOG( ( zu(k1) - zu(kb(j,i)) ) / z0(j,i) )
+               
+               k = kb(j,i) + 1
+               DO  WHILE ( zu(k) < zuc1 ) 
+                  logratio = ( LOG( ( zu(k) - zu(kb(j,i)) ) / z0(j,i)) ) / logzuc1 
+                  f(k,j,i) = logratio * f(k1,j,i)
+                  k  = k + 1
+               ENDDO
+               f(kb(j,i),j,i) = 0.0_wp
+            ENDDO
+         ENDDO
+      ELSEIF ( var == 'w' )  THEN
+         DO  i = ib, nxr
+            DO  j = jb, nyn
+               f(kb(j,i),j,i) = 0.0_wp
+            ENDDO
+         ENDDO
+      ENDIF
+      
+   END SUBROUTINE pmci_interp_tril_all
+
+ END SUBROUTINE pmci_client_initialize
+
+
+
+ SUBROUTINE pmci_ensure_nest_mass_conservation
+
+!
+!-- Adjust the volume-flow rate through the top boundary 
+!-- so that the net volume flow through all boundaries 
+!-- of the current nest domain becomes zero.
+    IMPLICIT NONE
+
+    INTEGER(iwp)  ::  i                          !:
+    INTEGER(iwp)  ::  ierr                       !:
+    INTEGER(iwp)  ::  j                          !:
+    INTEGER(iwp)  ::  k                          !:
+    REAL(wp) ::  dxdy                            !:
+    REAL(wp) ::  innor                           !:
+    REAL(wp), DIMENSION(1:3) ::  volume_flow_l   !:
+    REAL(wp) ::  w_lt                            !:
+
+!
+!-- Sum up the volume flow through the left/right boundaries.
+    volume_flow(1)   = 0.0_wp
+    volume_flow_l(1) = 0.0_wp
+
+    IF ( nest_bound_l )  THEN
+       i = 0 
+       innor = dy
+       DO   j = nys, nyn
+          DO   k = nzb_u_inner(j,i) + 1, nzt
+             volume_flow_l(1) = volume_flow_l(1) + innor * u(k,j,i) * dzw(k)            
+          ENDDO
+       ENDDO
+    ENDIF
+
+    IF ( nest_bound_r )  THEN     
+       i = nx + 1
+       innor = -dy
+       DO   j = nys, nyn
+          DO   k = nzb_u_inner(j,i) + 1, nzt
+             volume_flow_l(1) = volume_flow_l(1) + innor * u(k,j,i) * dzw(k)            
+          ENDDO
+       ENDDO
+    ENDIF
+      
+#if defined( __parallel )   
+    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
+    CALL MPI_ALLREDUCE( volume_flow_l(1), volume_flow(1), 1, MPI_REAL, &
+                        MPI_SUM, comm2d, ierr )
+#else
+    volume_flow(1) = volume_flow_l(1)
+#endif
+
+!
+!-- Sum up the volume flow through the south/north boundaries.
+    volume_flow(2)   = 0.0_wp
+    volume_flow_l(2) = 0.0_wp
+
+    IF ( nest_bound_s )  THEN
+       j = 0
+       innor = dx
+       DO   i = nxl, nxr
+          DO   k = nzb_v_inner(j,i) + 1, nzt
+             volume_flow_l(2) = volume_flow_l(2) + innor * v(k,j,i) * dzw(k)
+          ENDDO
+       ENDDO
+    ENDIF
+
+    IF ( nest_bound_n )  THEN
+       j = ny + 1
+       innor = -dx
+       DO   i = nxl, nxr
+          DO   k = nzb_v_inner(j,i)+1, nzt
+             volume_flow_l(2) = volume_flow_l(2) + innor * v(k,j,i) * dzw(k)
+          ENDDO
+       ENDDO
+    ENDIF
+
+#if defined( __parallel )   
+    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
+    CALL MPI_ALLREDUCE( volume_flow_l(2), volume_flow(2), 1, MPI_REAL, &
+                        MPI_SUM, comm2d, ierr )   
+#else
+    volume_flow(2) = volume_flow_l(2)
+#endif
+      
+!
+!-- Sum up the volume flow through the top boundary.
+    volume_flow(3)   = 0.0_wp
+    volume_flow_l(3) = 0.0_wp
+    dxdy = dx * dy
+    k = nzt 
+    DO   i = nxl, nxr
+       DO   j = nys, nyn
+          volume_flow_l(3) = volume_flow_l(3) - w(k,j,i) * dxdy
+       ENDDO
+    ENDDO
+       
+#if defined( __parallel )   
+    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
+    CALL MPI_ALLREDUCE( volume_flow_l(3), volume_flow(3), 1, MPI_REAL, &
+                        MPI_SUM, comm2d, ierr )   
+#else
+    volume_flow(3) = volume_flow_l(3)
+#endif
+
+!
+!-- Correct the top-boundary value of w.
+    w_lt = (volume_flow(1) + volume_flow(2) + volume_flow(3)) / area_t
+    DO   i = nxl, nxr
+       DO   j = nys, nyn
+          DO  k = nzt, nzt + 1
+             w(k,j,i) = w(k,j,i) + w_lt
+          ENDDO
+       ENDDO
+    ENDDO
+
+ END SUBROUTINE pmci_ensure_nest_mass_conservation
+
+END MODULE pmc_interface
Index: palm/trunk/SOURCE/pmc_mpi_wrapper.f90
===================================================================
--- palm/trunk/SOURCE/pmc_mpi_wrapper.f90	(revision 1762)
+++ palm/trunk/SOURCE/pmc_mpi_wrapper.f90	(revision 1762)
@@ -0,0 +1,516 @@
+MODULE pmc_mpi_wrapper
+
+!--------------------------------------------------------------------------------!
+! 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-2015 Leibniz Universitaet Hannover
+!--------------------------------------------------------------------------------!
+!
+! Current revisions:
+! ------------------
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! Intoduction of the pure FORTRAN Palm Model Coupler     (PMC)  12.11.2015  K. Ketelsen
+!
+! Description:
+! ------------
+!
+! MPI Wrapper of Palm Model Coupler
+!------------------------------------------------------------------------------!
+
+   use, intrinsic :: iso_c_binding
+
+   USE  mpi
+   USE  kinds,         ONLY: wp
+   USE  PMC_handle_communicator, ONLY: m_to_server_comm, m_to_client_comm, m_model_comm, m_model_rank
+   IMPLICIT none
+   PRIVATE
+   SAVE
+
+   INTEGER, PARAMETER :: dp = wp
+
+
+   ! INTERFACE section
+
+   INTERFACE PMC_Send_to_Server
+      MODULE PROCEDURE PMC_Send_to_Server_INTEGER
+      MODULE PROCEDURE PMC_Send_to_Server_INTEGER_2
+      MODULE PROCEDURE PMC_Send_to_Server_real_r1
+      MODULE PROCEDURE PMC_Send_to_Server_real_r2
+      MODULE PROCEDURE PMC_Send_to_Server_real_r3
+   END INTERFACE PMC_Send_to_Server
+
+   INTERFACE PMC_Recv_from_Server
+      MODULE PROCEDURE PMC_Recv_from_Server_INTEGER
+      MODULE PROCEDURE PMC_Recv_from_Server_real_r1
+      MODULE PROCEDURE PMC_Recv_from_Server_real_r2
+      MODULE PROCEDURE PMC_Recv_from_Server_real_r3
+   END INTERFACE PMC_Recv_from_Server
+
+   INTERFACE PMC_Send_to_Client
+      MODULE PROCEDURE PMC_Send_to_Client_INTEGER
+      MODULE PROCEDURE PMC_Send_to_Client_real_r1
+      MODULE PROCEDURE PMC_Send_to_Client_real_r2
+      MODULE PROCEDURE PMC_Send_to_Client_real_r3
+   END INTERFACE PMC_Send_to_Client
+
+   INTERFACE PMC_Recv_from_Client
+      MODULE PROCEDURE PMC_Recv_from_Client_INTEGER
+      MODULE PROCEDURE PMC_Recv_from_Client_INTEGER_2
+      MODULE PROCEDURE PMC_Recv_from_Client_real_r1
+      MODULE PROCEDURE PMC_Recv_from_Client_real_r2
+      MODULE PROCEDURE PMC_Recv_from_Client_real_r3
+   END INTERFACE PMC_Recv_from_Client
+
+   INTERFACE PMC_Bcast
+      MODULE PROCEDURE PMC_Bcast_INTEGER
+      MODULE PROCEDURE PMC_Bcast_character
+   END INTERFACE PMC_Bcast
+
+   INTERFACE PMC_Inter_Bcast
+      MODULE PROCEDURE PMC_Inter_Bcast_INTEGER_1
+   END INTERFACE PMC_Inter_Bcast
+
+   INTERFACE PMC_Alloc_mem
+      MODULE PROCEDURE PMC_Alloc_mem_INTEGER_1
+      MODULE PROCEDURE PMC_Alloc_mem_Real_1
+   END INTERFACE PMC_Alloc_mem
+
+   INTERFACE PMC_TIME
+      MODULE PROCEDURE PMC_TIME
+   END INTERFACE PMC_TIME
+
+   PUBLIC PMC_Send_to_Server, PMC_Recv_from_Server
+   PUBLIC PMC_Send_to_Client, PMC_Recv_from_Client
+   PUBLIC PMC_Bcast, PMC_Inter_Bcast, PMC_Alloc_mem
+   PUBLIC PMC_TIME
+
+CONTAINS
+
+   SUBROUTINE  PMC_Send_to_Server_INTEGER (buf, n, Server_rank, tag, ierr)
+      IMPLICIT     none
+      INTEGER, DIMENSION(:), INTENT(IN)         :: buf
+      INTEGER, INTENT(IN)                       :: n
+      INTEGER, INTENT(IN)                       :: Server_rank
+      INTEGER, INTENT(IN)                       :: tag
+      INTEGER, INTENT(OUT)                      :: ierr
+    
+      ierr = 0
+      CALL MPI_Send (buf, n, MPI_INTEGER, Server_rank, tag, m_to_server_comm, ierr)
+    
+      return
+   END SUBROUTINE  PMC_Send_to_Server_INTEGER
+
+   SUBROUTINE  PMC_Recv_from_Server_INTEGER (buf, n, Server_rank, tag, ierr)
+      IMPLICIT     none
+      INTEGER, DIMENSION(:), INTENT(OUT)        :: buf
+      INTEGER, INTENT(IN)                       :: n
+      INTEGER, INTENT(IN)                       :: Server_rank
+      INTEGER, INTENT(IN)                       :: tag
+      INTEGER, INTENT(OUT)                      :: ierr
+
+      ierr = 0
+      CALL MPI_Recv (buf, n, MPI_INTEGER, Server_rank, tag, m_to_server_comm, &
+         MPI_STATUS_IGNORE, ierr)
+
+      return
+   END SUBROUTINE  PMC_Recv_from_Server_INTEGER
+
+   SUBROUTINE  PMC_Send_to_Server_INTEGER_2 (buf, n, Server_rank, tag, ierr)
+      IMPLICIT     none
+      INTEGER, DIMENSION(:,:), INTENT(IN)       :: buf
+      INTEGER, INTENT(IN)                       :: n
+      INTEGER, INTENT(IN)                       :: Server_rank
+      INTEGER, INTENT(IN)                       :: tag
+      INTEGER, INTENT(OUT)                      :: ierr
+
+      ierr = 0
+      CALL MPI_Send (buf, n, MPI_INTEGER, Server_rank, tag, m_to_server_comm, ierr)
+
+      return
+   END SUBROUTINE  PMC_Send_to_Server_INTEGER_2
+
+   SUBROUTINE  PMC_Send_to_Server_real_r1 (buf, n, Server_rank, tag, ierr)
+      IMPLICIT     none
+      REAL(kind=dp), DIMENSION(:), INTENT(IN)   :: buf
+      INTEGER, INTENT(IN)                       :: n
+      INTEGER, INTENT(IN)                       :: Server_rank
+      INTEGER, INTENT(IN)                       :: tag
+      INTEGER, INTENT(OUT)                      :: ierr
+
+      ierr = 0
+      CALL MPI_Send (buf, n, MPI_DOUBLE_PRECISION, Server_rank, tag, m_to_server_comm, ierr)
+
+      return
+   END SUBROUTINE  PMC_Send_to_Server_real_r1
+
+   SUBROUTINE  PMC_Recv_from_Server_real_r1 (buf, n, Server_rank, tag, ierr)
+      IMPLICIT     none
+      REAL(kind=dp), DIMENSION(:), INTENT(OUT)  :: buf
+      INTEGER, INTENT(IN)                       :: n
+      INTEGER, INTENT(IN)                       :: Server_rank
+      INTEGER, INTENT(IN)                       :: tag
+      INTEGER, INTENT(OUT)                      :: ierr
+
+      ierr = 0
+      CALL MPI_Recv (buf, n, MPI_DOUBLE_PRECISION, Server_rank, tag, m_to_server_comm, &
+         MPI_STATUS_IGNORE, ierr)
+
+      return
+   END SUBROUTINE  PMC_Recv_from_Server_real_r1
+
+   SUBROUTINE  PMC_Send_to_Server_real_r2 (buf, n, Server_rank, tag, ierr)
+      IMPLICIT     none
+      REAL(kind=dp), DIMENSION(:,:), INTENT(IN) :: buf
+      INTEGER, INTENT(IN)                       :: n
+      INTEGER, INTENT(IN)                       :: Server_rank
+      INTEGER, INTENT(IN)                       :: tag
+      INTEGER, INTENT(OUT)                      :: ierr
+
+      ierr = 0
+      CALL MPI_Send (buf, n, MPI_DOUBLE_PRECISION, Server_rank, tag, m_to_server_comm, ierr)
+
+      return
+   END SUBROUTINE  PMC_Send_to_Server_real_r2
+
+   SUBROUTINE  PMC_Recv_from_Server_real_r2 (buf, n, Server_rank, tag, ierr)
+      IMPLICIT     none
+      REAL(kind=dp), DIMENSION(:,:),INTENT(OUT) :: buf
+      INTEGER, INTENT(IN)                       :: n
+      INTEGER, INTENT(IN)                       :: Server_rank
+      INTEGER, INTENT(IN)                       :: tag
+      INTEGER, INTENT(OUT)                      :: ierr
+
+      ierr = 0
+      CALL MPI_Recv (buf, n, MPI_DOUBLE_PRECISION, Server_rank, tag, m_to_server_comm, &
+         MPI_STATUS_IGNORE, ierr)
+
+      return
+   END SUBROUTINE  PMC_Recv_from_Server_real_r2
+
+   SUBROUTINE  PMC_Send_to_Server_real_r3 (buf, n, Server_rank, tag, ierr)
+      IMPLICIT     none
+      REAL(kind=dp), DIMENSION(:,:,:), INTENT(IN) :: buf
+      INTEGER, INTENT(IN)                         :: n
+      INTEGER, INTENT(IN)                         :: Server_rank
+      INTEGER, INTENT(IN)                         :: tag
+      INTEGER, INTENT(OUT)                        :: ierr
+
+      ierr = 0
+      CALL MPI_Send (buf, n, MPI_DOUBLE_PRECISION, Server_rank, tag, m_to_server_comm, ierr)
+
+      return
+   END SUBROUTINE  PMC_Send_to_Server_real_r3
+
+   SUBROUTINE  PMC_Recv_from_Server_real_r3 (buf, n, Server_rank, tag, ierr)
+      IMPLICIT     none
+      REAL(kind=dp), DIMENSION(:,:,:),INTENT(OUT) :: buf
+      INTEGER, INTENT(IN)                         :: n
+      INTEGER, INTENT(IN)                         :: Server_rank
+      INTEGER, INTENT(IN)                         :: tag
+      INTEGER, INTENT(OUT)                        :: ierr
+
+      ierr = 0
+      CALL MPI_Recv (buf, n, MPI_DOUBLE_PRECISION, Server_rank, tag, m_to_server_comm, &
+         MPI_STATUS_IGNORE, ierr)
+
+      return
+   END SUBROUTINE  PMC_Recv_from_Server_real_r3
+
+
+   SUBROUTINE  PMC_Send_to_Client_INTEGER (Client_id, buf, n, Client_rank, tag, ierr)
+      IMPLICIT     none
+      INTEGER, INTENT(IN)                       :: Client_id
+      INTEGER, DIMENSION(:), INTENT(IN)         :: buf
+      INTEGER, INTENT(IN)                       :: n
+      INTEGER, INTENT(IN)                       :: Client_rank
+      INTEGER, INTENT(IN)                       :: tag
+      INTEGER, INTENT(OUT)                      :: ierr
+
+      ierr = 0
+      CALL MPI_Send (buf, n, MPI_INTEGER, Client_rank, tag, m_to_client_comm(Client_id), ierr)
+
+      return
+   END SUBROUTINE  PMC_Send_to_Client_INTEGER
+
+   SUBROUTINE  PMC_Recv_from_Client_INTEGER (Client_id, buf, n, Client_rank, tag, ierr)
+      IMPLICIT     none
+      INTEGER, INTENT(IN)                       :: Client_id
+      INTEGER, DIMENSION(:), INTENT(INOUT)      :: buf
+      INTEGER, INTENT(IN)                       :: n
+      INTEGER, INTENT(IN)                       :: Client_rank
+      INTEGER, INTENT(IN)                       :: tag
+      INTEGER, INTENT(OUT)                      :: ierr
+
+      ierr = 0
+      CALL MPI_Recv (buf, n, MPI_INTEGER, Client_rank, tag, m_to_client_comm(Client_id), &
+         MPI_STATUS_IGNORE, ierr)
+
+      return
+   END SUBROUTINE  PMC_Recv_from_Client_INTEGER
+
+   SUBROUTINE  PMC_Recv_from_Client_INTEGER_2 (Client_id, buf, n, Client_rank, tag, ierr)
+      IMPLICIT     none
+      INTEGER, INTENT(IN)                       :: Client_id
+      INTEGER, DIMENSION(:,:), INTENT(OUT)      :: buf
+      INTEGER, INTENT(IN)                       :: n
+      INTEGER, INTENT(IN)                       :: Client_rank
+      INTEGER, INTENT(IN)                       :: tag
+      INTEGER, INTENT(OUT)                      :: ierr
+
+      ierr = 0
+      CALL MPI_Recv (buf, n, MPI_INTEGER, Client_rank, tag, m_to_client_comm(Client_id), &
+         MPI_STATUS_IGNORE, ierr)
+
+      return
+   END SUBROUTINE  PMC_Recv_from_Client_INTEGER_2
+
+   SUBROUTINE  PMC_Send_to_Client_real_r1 (Client_id, buf, n, Client_rank, tag, ierr)
+      IMPLICIT     none
+      INTEGER, INTENT(IN)                       :: Client_id
+      REAL(kind=dp), DIMENSION(:), INTENT(IN)   :: buf
+      INTEGER, INTENT(IN)                       :: n
+      INTEGER, INTENT(IN)                       :: Client_rank
+      INTEGER, INTENT(IN)                       :: tag
+      INTEGER, INTENT(OUT)                      :: ierr
+
+      ierr = 0
+      CALL MPI_Send (buf, n, MPI_DOUBLE_PRECISION, Client_rank, tag, m_to_client_comm(Client_id), &
+         ierr)
+
+      return
+   END SUBROUTINE  PMC_Send_to_Client_real_r1
+
+   SUBROUTINE  PMC_Recv_from_Client_real_r1 (Client_id, buf, n, Client_rank, tag, ierr)
+      IMPLICIT     none
+      INTEGER, INTENT(IN)                       :: Client_id
+      REAL(kind=dp), DIMENSION(:), INTENT(INOUT):: buf
+      INTEGER, INTENT(IN)                       :: n
+      INTEGER, INTENT(IN)                       :: Client_rank
+      INTEGER, INTENT(IN)                       :: tag
+      INTEGER, INTENT(OUT)                      :: ierr
+
+      ierr = 0
+      CALL MPI_Recv (buf, n, MPI_DOUBLE_PRECISION, Client_rank, tag, m_to_client_comm(Client_id), &
+         MPI_STATUS_IGNORE, ierr)
+
+      return
+   END SUBROUTINE  PMC_Recv_from_Client_real_r1
+
+   SUBROUTINE  PMC_Send_to_Client_real_r2 (Client_id, buf, n, Client_rank, tag, ierr)
+      IMPLICIT     none
+      INTEGER, INTENT(IN)                       :: Client_id
+      REAL(kind=dp), DIMENSION(:,:), INTENT(IN) :: buf
+      INTEGER, INTENT(IN)                       :: n
+      INTEGER, INTENT(IN)                       :: Client_rank
+      INTEGER, INTENT(IN)                       :: tag
+      INTEGER, INTENT(OUT)                      :: ierr
+
+      ierr = 0
+      CALL MPI_Send (buf, n, MPI_DOUBLE_PRECISION, Client_rank, tag, m_to_client_comm(Client_id), &
+         ierr)
+
+      return
+   END SUBROUTINE  PMC_Send_to_Client_real_r2
+
+   SUBROUTINE  PMC_Recv_from_Client_real_r2 (Client_id, buf, n, Client_rank, tag, ierr)
+      IMPLICIT     none
+      INTEGER, INTENT(IN)                       :: Client_id
+      REAL(kind=dp), DIMENSION(:,:), INTENT(OUT):: buf
+      INTEGER, INTENT(IN)                       :: n
+      INTEGER, INTENT(IN)                       :: Client_rank
+      INTEGER, INTENT(IN)                       :: tag
+      INTEGER, INTENT(OUT)                      :: ierr
+
+      ierr = 0
+      CALL MPI_Recv (buf, n, MPI_DOUBLE_PRECISION, Client_rank, tag, m_to_client_comm(Client_id), &
+         MPI_STATUS_IGNORE, ierr)
+
+      return
+   END SUBROUTINE  PMC_Recv_from_Client_real_r2
+
+   SUBROUTINE  PMC_Send_to_Client_real_r3 (Client_id, buf, n, Client_rank, tag, ierr)
+      IMPLICIT     none
+      INTEGER, INTENT(IN)                         :: Client_id
+      REAL(kind=dp), DIMENSION(:,:,:), INTENT(IN) :: buf
+      INTEGER, INTENT(IN)                         :: n
+      INTEGER, INTENT(IN)                         :: Client_rank
+      INTEGER, INTENT(IN)                         :: tag
+      INTEGER, INTENT(OUT)                        :: ierr
+
+      ierr = 0
+      CALL MPI_Send (buf, n, MPI_DOUBLE_PRECISION, Client_rank, tag, m_to_client_comm(Client_id), &
+         ierr)
+
+      return
+   END SUBROUTINE  PMC_Send_to_Client_real_r3
+
+   SUBROUTINE  PMC_Recv_from_Client_real_r3 (Client_id, buf, n, Client_rank, tag, ierr)
+      IMPLICIT     none
+      INTEGER, INTENT(IN)                         :: Client_id
+      REAL(kind=dp), DIMENSION(:,:,:), INTENT(OUT):: buf
+      INTEGER, INTENT(IN)                         :: n
+      INTEGER, INTENT(IN)                         :: Client_rank
+      INTEGER, INTENT(IN)                         :: tag
+      INTEGER, INTENT(OUT)                        :: ierr
+
+      ierr = 0
+      CALL MPI_Recv (buf, n, MPI_DOUBLE_PRECISION, Client_rank, tag, m_to_client_comm(Client_id), &
+         MPI_STATUS_IGNORE, ierr)
+
+      return
+   END SUBROUTINE  PMC_Recv_from_Client_real_r3
+
+   SUBROUTINE  PMC_Bcast_INTEGER (buf, root_pe, comm, ierr)
+      IMPLICIT     none
+      INTEGER, INTENT(INOUT)                      :: buf
+      INTEGER, INTENT(IN)                         :: root_pe
+      INTEGER, INTENT(IN),optional                :: comm
+      INTEGER, INTENT(OUT),optional               :: ierr
+      !-- local variables
+      INTEGER                                     :: myComm
+      INTEGER                                     :: myErr
+
+      if(present (comm))  then
+         myComm = comm
+      else
+         myComm = m_model_comm
+      end if
+
+      CALL MPI_Bcast (buf, 1, MPI_INTEGER, root_pe, myComm, myErr)
+
+      if(present (ierr))  then
+         ierr = myErr
+      end if
+
+      return
+   END SUBROUTINE  PMC_Bcast_INTEGER
+
+   SUBROUTINE  PMC_Bcast_character (buf, root_pe, comm, ierr)
+      IMPLICIT     none
+      character(len=*), INTENT(INOUT)             :: buf
+      INTEGER, INTENT(IN)                         :: root_pe
+      INTEGER, INTENT(IN),optional                :: comm
+      INTEGER, INTENT(OUT),optional               :: ierr
+      !-- local variables
+      INTEGER                                     :: myComm
+      INTEGER                                     :: myErr
+
+      if(present (comm))  then
+         myComm = comm
+      else
+         myComm = m_model_comm
+      end if
+
+      CALL MPI_Bcast (buf, len(buf), MPI_Character, root_pe, myComm, myErr)
+
+      if(present (ierr))  then
+         ierr = myErr
+      end if
+
+      return
+   END SUBROUTINE  PMC_Bcast_character
+
+   SUBROUTINE  PMC_Inter_Bcast_INTEGER_1 (buf, Client_id, ierr)
+      IMPLICIT     none
+      INTEGER, INTENT(INOUT),DIMENSION(:)         :: buf
+      INTEGER, INTENT(IN),optional                :: Client_id
+      INTEGER, INTENT(OUT),optional               :: ierr
+      !-- local variables
+      INTEGER                                     :: myComm
+      INTEGER                                     :: myErr
+      INTEGER                                     :: root_pe
+
+      !   PE 0 Server Broadcast to all Client PE's
+
+      if(present (Client_id))  then
+         myComm  = m_to_client_comm(Client_id)
+         if(m_model_rank == 0)  then
+            root_pe = MPI_ROOT
+         else
+            root_pe = MPI_PROC_NULL
+         end if
+      else
+         myComm  = m_to_server_comm
+         root_pe = 0
+      end if
+
+      CALL MPI_Bcast (buf, size(buf), MPI_INTEGER, root_pe, myComm, myErr)
+
+      if(present (ierr))  then
+         ierr = myErr
+      end if
+
+      return
+   END SUBROUTINE  PMC_Inter_Bcast_INTEGER_1
+
+!  Allocate  Memory with MPI_Alloc_mem using intermediate C-pointer
+
+   SUBROUTINE  PMC_Alloc_mem_INTEGER_1 (iarray, idim1)
+      IMPLICIT     none
+      INTEGER,DIMENSION(:),POINTER,INTENT(INOUT) :: iarray
+      INTEGER,INTENT(IN)                         :: idim1
+
+      Type(c_ptr)                             :: p_myInd
+      INTEGER,DIMENSION(1)                    :: aShape
+      INTEGER(KIND=MPI_ADDRESS_KIND)          :: WinSize
+      INTEGER                                 :: ierr
+
+      WinSize = idim1*c_sizeof(ierr)                          ! Length of INTEGER
+
+      CALL MPI_Alloc_mem  (WinSize , MPI_INFO_NULL, p_myInd, ierr);
+      aShape(1) = idim1
+      CALL c_f_pointer(p_myInd,iarray,aShape)
+
+      return
+   END SUBROUTINE  PMC_Alloc_mem_INTEGER_1
+
+   SUBROUTINE  PMC_Alloc_mem_Real_1 (array, idim1, base_ptr)
+      IMPLICIT     none
+      REAL(kind=wp),DIMENSION(:),POINTER,INTENT(INOUT) :: array
+      INTEGER(kind=8),INTENT(IN)                       :: idim1
+      Type(c_ptr),INTENT(OUT),optional                 :: base_ptr
+
+
+      Type(c_ptr)                             :: p_myInd
+      INTEGER,DIMENSION(1)                    :: aShape
+      INTEGER(KIND=MPI_ADDRESS_KIND)          :: WinSize
+      INTEGER                                 :: ierr
+
+      WinSize = idim1*wp                          ! Length of INTEGER
+
+      CALL MPI_Alloc_mem  (WinSize , MPI_INFO_NULL, p_myInd, ierr);
+      aShape(1) = idim1
+      CALL c_f_pointer(p_myInd,array,aShape)
+
+      if(present(base_ptr))   then
+         base_ptr = p_myInd
+      end if
+
+      return
+   END SUBROUTINE  PMC_Alloc_mem_Real_1
+
+   FUNCTION PMC_TIME ()
+      REAL(kind=wp)          :: PMC_TIME
+
+      PMC_TIME = MPI_Wtime ()
+
+      return
+
+    END FUNCTION PMC_TIME
+
+ END MODULE pmc_mpi_wrapper
Index: palm/trunk/SOURCE/pmc_server.f90
===================================================================
--- palm/trunk/SOURCE/pmc_server.f90	(revision 1762)
+++ palm/trunk/SOURCE/pmc_server.f90	(revision 1762)
@@ -0,0 +1,624 @@
+MODULE pmc_server
+
+!--------------------------------------------------------------------------------!
+! 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-2015 Leibniz Universitaet Hannover
+!--------------------------------------------------------------------------------!
+!
+! Current revisions:
+! ------------------
+!
+! Former revisions:
+! -----------------
+! $Id$
+!
+! Intoduction of the pure FORTRAN Palm Model Coupler     (PMC)  12.11.2015  K. Ketelsen
+!
+! Description:
+! ------------
+!
+! Server part of Palm Model Coupler
+!------------------------------------------------------------------------------!
+
+   use, intrinsic :: iso_c_binding
+
+   USE  mpi
+   USE  kinds,                     ONLY: wp, iwp
+   USE  PMC_general,               ONLY: ClientDef, PMC_MAX_MODELL,PMC_sort, DA_NameDef, DA_Desclen, DA_Namelen,       &
+                                         PMC_G_SetName, PMC_G_GetName, PeDef, ArrayDef
+   USE  PMC_handle_communicator,   ONLY: m_model_comm,m_model_rank,m_model_npes, m_to_client_comm,                     &
+                                         PMC_Server_for_Client, m_world_rank
+   USE   PMC_MPI_wrapper,          ONLY: PMC_Send_to_Client, PMC_Recv_from_Client, PMC_Bcast, PMC_Inter_Bcast,         &
+                                         PMC_Alloc_mem, PMC_Time
+
+   IMPLICIT none
+   PRIVATE
+   SAVE
+
+   TYPE ClientIndexDef
+      INTEGER                                        :: NrPoints
+      INTEGER,DIMENSION(:,:),allocatable             :: index_list_2d
+   END TYPE ClientIndexDef
+
+   TYPE(ClientDef),DIMENSION(PMC_MAX_MODELL)          :: Clients
+   TYPE(ClientIndexDef),DIMENSION(PMC_MAX_MODELL)     :: indClients
+
+   PUBLIC PMC_Server_for_Client
+
+   INTEGER, PARAMETER :: dp = wp
+
+   ! INTERFACE section
+
+   INTERFACE PMC_ServerInit
+      MODULE procedure  PMC_ServerInit
+   END INTERFACE PMC_ServerInit
+
+    INTERFACE PMC_S_Set_2D_index_list
+        MODULE procedure PMC_S_Set_2D_index_list
+    END INTERFACE PMC_S_Set_2D_index_list
+
+    INTERFACE PMC_S_GetNextArray
+        MODULE procedure PMC_S_GetNextArray
+    END INTERFACE PMC_S_GetNextArray
+
+    INTERFACE PMC_S_Set_DataArray
+        MODULE procedure PMC_S_Set_DataArray_2d
+        MODULE procedure PMC_S_Set_DataArray_3d
+    END INTERFACE PMC_S_Set_DataArray
+
+    INTERFACE PMC_S_setInd_and_AllocMem
+        MODULE procedure PMC_S_setInd_and_AllocMem
+    END INTERFACE PMC_S_setInd_and_AllocMem
+
+    INTERFACE PMC_S_FillBuffer
+        MODULE procedure PMC_S_FillBuffer
+    END INTERFACE PMC_S_FillBuffer
+
+    INTERFACE PMC_S_GetData_from_Buffer
+        MODULE procedure PMC_S_GetData_from_Buffer
+    END INTERFACE PMC_S_GetData_from_Buffer
+
+    ! PUBLIC section
+
+    PUBLIC PMC_ServerInit, PMC_S_Set_2D_index_list, PMC_S_GetNextArray, PMC_S_Set_DataArray
+    PUBLIC PMC_S_setInd_and_AllocMem, PMC_S_FillBuffer, PMC_S_GetData_from_Buffer
+
+CONTAINS
+
+   SUBROUTINE PMC_ServerInit
+      IMPLICIT none
+      INTEGER                 :: i
+      INTEGER                 :: j
+      INTEGER                 :: ClientId
+      INTEGER                 :: istat
+
+      do i=1,size(PMC_Server_for_Client)-1
+         if(m_model_comm == 0) write(0,*) 'PMC_Server: Initialize client Id',PMC_Server_for_Client(i)
+
+         ClientId = PMC_Server_for_Client(i)
+
+         Clients(ClientId)%model_comm = m_model_comm
+         Clients(ClientId)%inter_comm = m_to_client_comm(ClientId)
+
+         ! Get rank and size
+         CALL MPI_Comm_rank (Clients(ClientId)%model_comm, Clients(ClientId)%model_rank, istat);
+         CALL MPI_Comm_size (Clients(ClientId)%model_comm, Clients(ClientId)%model_npes, istat);
+         CALL MPI_Comm_remote_size (Clients(ClientId)%inter_comm, Clients(ClientId)%inter_npes, istat);
+
+         ! Intra communicater is used for MPI_Get
+         CALL MPI_Intercomm_merge (Clients(ClientId)%inter_comm, .false., Clients(ClientId)%intra_comm, istat);
+         CALL MPI_Comm_rank (Clients(ClientId)%intra_comm, Clients(ClientId)%intra_rank, istat);
+
+         write(9,*) 'ClientId ',i,ClientId,m_world_rank, Clients(ClientId)%inter_npes
+
+         ALLOCATE (Clients(ClientId)%PEs(Clients(ClientId)%inter_npes))
+
+         do j=1,Clients(ClientId)%inter_npes                                ! Loop over all client PEs
+           NULLIFY(Clients(ClientId)%PEs(j)%Arrays)
+         end do
+
+         CALL Get_DA_names_from_client (ClientId)
+      end do
+
+      return
+   END SUBROUTINE PMC_ServerInit
+
+    SUBROUTINE PMC_S_Set_2D_index_list (ClientId, index_list)
+        IMPLICIT none
+        INTEGER,INTENT(IN)                         :: ClientId
+        INTEGER,DIMENSION(:,:),INTENT(INOUT)       :: index_list      !Index list will be modified in sort, therefore INOUT
+
+        !-- Local variables
+        INTEGER                 :: ip,is,ie,ian,ic,n
+        INTEGER                 :: istat
+
+        if(m_model_rank == 0)   then
+            CALL PMC_sort (index_list, 6)                       ! Sort to ascending Server PE
+            is = 1
+
+            do ip=0,m_model_npes-1
+
+                !       Split into Server PEs
+                ie = is-1                                     !there may be no entry for this PE
+                if(is <= size(index_list,2) .and. ie >= 0)  then
+                    do while ( index_list(6,ie+1) == ip)
+                        ie = ie+1
+                        if( ie == size(index_list,2)) EXIT
+                    end do
+
+                    ian = ie-is+1
+                else
+                    is  = -1
+                    ie  = -2
+                    ian = 0
+                end if
+
+                !       Send data to other server PEs
+
+                if(ip == 0)   then
+                    indClients(ClientId)%NrPoints = ian
+                    if(ian > 0)   then
+                        ALLOCATE (indClients(ClientId)%index_list_2d(6,ian))
+                        indClients(ClientId)%index_list_2d(:,1:ian) = index_list(:,is:ie)
+                    end if
+                else
+                    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, 1001,                  &
+                            m_model_comm, istat)
+                    end if
+                end if
+                is = ie+1
+            end do
+        else
+            CALL MPI_Recv (indClients(ClientId)%NrPoints, 1, MPI_INTEGER, 0, 1000, m_model_comm,     &
+                MPI_STATUS_IGNORE, istat)
+            ian = indClients(ClientId)%NrPoints
+             if(ian > 0) then
+                ALLOCATE(indClients(ClientId)%index_list_2d(6,ian))
+                CALL MPI_RECV (indClients(ClientId)%index_list_2d, 6*ian, MPI_INTEGER, 0, 1001,        &
+                    m_model_comm, MPI_STATUS_IGNORE, istat)
+            end if
+        end if
+
+        CALL Set_PE_index_list (ClientId,Clients(ClientId),indClients(ClientId)%index_list_2d,indClients(ClientId)%NrPoints)
+
+        return
+    END SUBROUTINE PMC_S_Set_2D_index_list
+
+    logical function PMC_S_GetNextArray (ClientId, myName,Client_PeIndex)
+        INTEGER,INTENT(IN)                         :: ClientId
+        CHARACTER(len=*),INTENT(OUT)               :: myName
+
+        !-- local variables
+        INTEGER                      :: MyCoupleIndex
+        logical                      :: MyLast
+        CHARACTER(len=DA_Namelen)    :: loName
+        INTEGER,INTENT(IN),optional  :: Client_PeIndex
+
+        loName = ' '
+
+        CALL PMC_G_GetName (clients(ClientId), MyCoupleIndex, loName, MyLast, Client_PeIndex)
+
+        myName    = loName
+
+        PMC_S_GetNextArray = .NOT. MyLast                   ! Return true if valid array
+
+        return
+    END function PMC_S_GetNextArray
+
+    SUBROUTINE PMC_S_Set_DataArray_2d (ClientId, array)
+        IMPLICIT none
+        INTEGER,INTENT(IN)                         :: ClientId
+        REAL(kind=dp),INTENT(IN),DIMENSION(:,:)    :: array
+        !-- local variables
+        INTEGER                           :: NrDims
+        INTEGER,DIMENSION (4)             :: dims
+        INTEGER                           :: dim_order
+        TYPE(c_ptr)                       :: array_adr
+
+        dims = 1
+
+        NrDims    = 2
+        dims(1)   = size(array,1)
+        dims(2)   = size(array,2)
+        dim_order = 2
+
+        array_adr = c_loc(array)
+
+        CALL PMC_S_SetArray (ClientId, NrDims, dims, dim_order, array_adr)
+
+        return
+    END SUBROUTINE PMC_S_Set_DataArray_2d
+
+    SUBROUTINE PMC_S_Set_DataArray_3d (ClientId, array, nz_cl, nz)
+        IMPLICIT none
+        INTEGER,INTENT(IN)                         :: ClientId
+        REAL(kind=dp),INTENT(IN),DIMENSION(:,:,:)  :: array
+        INTEGER,INTENT(IN)                         :: nz_cl
+        INTEGER,INTENT(IN)                         :: nz
+        !-- local variables
+        INTEGER                           :: NrDims
+        INTEGER,DIMENSION (4)             :: dims
+        INTEGER                           :: dim_order
+        TYPE(c_ptr)                       :: array_adr
+
+        dims = 1
+
+        dims      = 0
+        NrDims    = 3
+        dims(1)   = size(array,1)
+        dims(2)   = size(array,2)
+        dims(3)   = size(array,3)
+        dim_order = 33
+        dims(4)   = nz_cl+dims(1)-nz                        ! works for first dimension 1:nz and 0:nz+1
+
+        array_adr = c_loc(array)
+
+        CALL PMC_S_SetArray (ClientId, NrDims, dims, dim_order, array_adr)
+
+        return
+   END SUBROUTINE PMC_S_Set_DataArray_3d
+
+   SUBROUTINE PMC_S_setInd_and_AllocMem (ClientId)
+      IMPLICIT none
+      INTEGER,INTENT(IN)                      :: ClientId
+
+      INTEGER                                 :: i, istat, ierr
+      INTEGER                                 :: arlen, myIndex, tag
+      INTEGER                                 :: rCount                    ! count MPI requests
+      INTEGER(kind=8)                         :: bufsize                   ! Size of MPI data Window
+      TYPE(PeDef),POINTER                     :: aPE
+      TYPE(ArrayDef),POINTER                  :: ar
+      CHARACTER(len=DA_Namelen)               :: myName
+      INTEGER,DIMENSION(1024)                 :: req
+      Type(c_ptr)                             :: base_ptr
+      REAL(kind=wp),DIMENSION(:),POINTER      :: base_array
+      INTEGER(KIND=MPI_ADDRESS_KIND)          :: WinSize
+
+      myIndex = 1
+      rCount  = 0
+      bufsize = 8
+
+      ! First stride, Compute size and set index
+
+      do i=1,Clients(ClientId)%inter_npes
+         aPE => Clients(ClientId)%PEs(i)
+         tag = 200
+         do while (PMC_S_GetNextArray ( ClientId, myName,i))
+            ar  => aPE%Arrays
+            if(ar%dim_order == 2) then
+               arlen     = aPE%NrEle;                             ! 2D
+            else if(ar%dim_order == 33) then
+               arlen     = aPE%NrEle * ar%A_dim(4);               ! PALM 3D
+            else
+               arlen     = -1
+            end if
+            ar%BufIndex = myIndex
+
+            tag    = tag+1
+            rCount = rCount+1
+            CALL MPI_Isend (myIndex, 1, MPI_INTEGER, i-1, tag, Clients(ClientId)%inter_comm, req(rCount),ierr)
+
+            if(rCount == 1024) then                                  ! Maximum of 1024 outstanding requests
+               CALL MPI_Waitall (rCount, req, MPI_STATUSES_IGNORE, ierr)
+               rCount = 0;
+            end if
+
+            myIndex = myIndex+arlen
+            bufsize = bufsize+arlen
+            ar%BufSize = arlen
+
+         end do
+         if(rCount > 0) then                                          ! Wait for all send completed
+            CALL MPI_Waitall (rCount, req, MPI_STATUSES_IGNORE, ierr)
+         end if
+      end do
+
+      ! Create RMA (One Sided Communication) window for data buffer
+
+      CALL PMC_Alloc_mem (base_array, bufsize, base_ptr)
+      Clients(ClientId)%TotalBufferSize = bufsize*wp       !Total buffer size in Byte
+
+      WinSize = bufsize*wp
+!      write(9,*) 'PMC_S_SetInd_and_Mem ',m_model_rank,Clients(ClientId)%inter_npes,WinSize,bufsize
+      CALL MPI_Win_create (base_array, WinSize, wp, MPI_INFO_NULL, Clients(ClientId)%intra_comm, Clients(ClientId)%BufWin, ierr);
+      CALL MPI_Win_fence (0, Clients(ClientId)%BufWin, ierr);                    !  Open Window to set data
+      CALL MPI_Barrier(Clients(ClientId)%intra_comm, ierr)
+
+      ! Second stride, Set Buffer pointer
+
+      do i=1,Clients(ClientId)%inter_npes
+         aPE => Clients(ClientId)%PEs(i)
+         do while (PMC_S_GetNextArray ( ClientId, myName,i))
+            ar  => aPE%Arrays
+            ar%SendBuf = c_loc(base_array(ar%BufIndex))                         !kk Adressrechnung ueberlegen
+            if(ar%BufIndex+ar%BufSize > bufsize) then
+               write(0,'(a,i4,4i7,1x,a)') 'Buffer too small ',i,ar%BufIndex,ar%BufSize,ar%BufIndex+ar%BufSize,bufsize,trim(myName)
+               CALL MPI_Abort (MPI_COMM_WORLD, istat, ierr)
+            end if
+         end do
+      end do
+
+      return
+   END SUBROUTINE PMC_S_setInd_and_AllocMem
+
+   SUBROUTINE PMC_S_FillBuffer (ClientId, WaitTime)
+      IMPLICIT none
+      INTEGER,INTENT(IN)                      :: ClientId
+      REAL(kind=dp),INTENT(OUT),optional      :: WaitTime
+
+      !-- local variables
+      INTEGER                                 :: ip,ij,istat,ierr
+      INTEGER                                 :: myIndex
+      REAL(kind=dp)                           :: t1,t2
+      TYPE(PeDef),POINTER                     :: aPE
+      TYPE(ArrayDef),POINTER                  :: ar
+      CHARACTER(len=DA_Namelen)               :: myName
+      INTEGER,DIMENSION(1)                    :: buf_shape
+      REAL(kind=wp),POINTER,DIMENSION(:)      :: buf
+      REAL(kind=wp),POINTER,DIMENSION(:,:)    :: data_2d
+      REAL(kind=wp),POINTER,DIMENSION(:,:,:)  :: data_3d
+
+      t1 = PMC_Time()
+      CALL MPI_Barrier(Clients(ClientId)%intra_comm, ierr)              ! Wait for buffer empty
+      t2 = PMC_Time()
+      if(present(WaitTime)) WaitTime = t2-t1
+
+      do ip=1,Clients(ClientId)%inter_npes
+         aPE => Clients(ClientId)%PEs(ip)
+         do while (PMC_S_GetNextArray ( ClientId, myName,ip))
+            ar  => aPE%Arrays
+            myIndex=1
+            if(ar%dim_order == 2) then
+               buf_shape(1) = aPE%NrEle
+               CALL c_f_pointer(ar%SendBuf, buf, buf_shape)
+               CALL c_f_pointer(ar%data, data_2d, ar%A_dim(1:2))
+               do ij=1,aPE%NrEle
+                  buf(myIndex) = data_2d(aPE%locInd(ij)%j,aPE%locInd(ij)%i)
+                  myIndex = myIndex+1
+               end do
+            else if(ar%dim_order == 33) then
+               buf_shape(1) = aPE%NrEle*ar%A_dim(4)
+               CALL c_f_pointer(ar%SendBuf, buf, buf_shape)
+               CALL c_f_pointer(ar%data, data_3d, ar%A_dim(1:3))
+               do ij=1,aPE%NrEle
+                  buf(myIndex:myIndex+ar%A_dim(4)-1) = data_3d(1:ar%A_dim(4),aPE%locInd(ij)%j,aPE%locInd(ij)%i)
+                  myIndex = myIndex+ar%A_dim(4)
+               end do
+            else
+               write(0,*) "Illegal Order of Dimension ",ar%dim_order
+               CALL MPI_Abort (MPI_COMM_WORLD, istat, ierr);
+
+            end if
+          end do
+      end do
+
+      CALL MPI_Barrier(Clients(ClientId)%intra_comm, ierr)              ! buffer is full
+
+      return
+   END SUBROUTINE PMC_S_FillBuffer
+
+   SUBROUTINE PMC_S_GetData_from_Buffer (ClientId, WaitTime)
+      IMPLICIT none
+      INTEGER,INTENT(IN)                      :: ClientId
+      REAL(kind=dp),INTENT(OUT),optional      :: WaitTime
+
+      !-- local variables
+      INTEGER                                 :: ip,ij,istat,ierr
+      INTEGER                                 :: myIndex
+      REAL(kind=dp)                           :: t1,t2
+      TYPE(PeDef),POINTER                     :: aPE
+      TYPE(ArrayDef),POINTER                  :: ar
+      CHARACTER(len=DA_Namelen)               :: myName
+      INTEGER,DIMENSION(1)                    :: buf_shape
+      REAL(kind=wp),POINTER,DIMENSION(:)      :: buf
+      REAL(kind=wp),POINTER,DIMENSION(:,:)    :: data_2d
+      REAL(kind=wp),POINTER,DIMENSION(:,:,:)  :: data_3d
+
+      t1 = PMC_Time()
+      CALL MPI_Barrier(Clients(ClientId)%intra_comm, ierr)              ! Wait for MPI_Put from client
+      t2 = PMC_Time()
+      if(present(WaitTime)) WaitTime = t2-t1
+
+      do ip=1,Clients(ClientId)%inter_npes
+         aPE => Clients(ClientId)%PEs(ip)
+         do while (PMC_S_GetNextArray ( ClientId, myName,ip))
+            ar  => aPE%Arrays
+            myIndex=1
+            if(ar%dim_order == 2) then
+               buf_shape(1) = aPE%NrEle
+               CALL c_f_pointer(ar%SendBuf, buf, buf_shape)
+               CALL c_f_pointer(ar%data, data_2d, ar%A_dim(1:2))
+               do ij=1,aPE%NrEle
+                  data_2d(aPE%locInd(ij)%j,aPE%locInd(ij)%i) = buf(myIndex)
+                  myIndex = myIndex+1
+               end do
+            else if(ar%dim_order == 33) then
+               buf_shape(1) = aPE%NrEle*ar%A_dim(4)
+               CALL c_f_pointer(ar%SendBuf, buf, buf_shape)
+               CALL c_f_pointer(ar%data, data_3d, ar%A_dim(1:3))
+               do ij=1,aPE%NrEle
+                  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)
+               end do
+            else
+               write(0,*) "Illegal Order of Dimension ",ar%dim_order
+               CALL MPI_Abort (MPI_COMM_WORLD, istat, ierr);
+
+            end if
+          end do
+      end do
+
+      CALL MPI_Barrier(Clients(ClientId)%intra_comm, ierr)              ! data copy finished, buffer is free for use agein
+
+        return
+   END SUBROUTINE PMC_S_GetData_from_Buffer
+
+! Private SUBROUTINEs
+
+   SUBROUTINE Get_DA_names_from_client (ClientId)
+        IMPLICIT none
+        INTEGER,INTENT(IN)                    :: ClientId
+        !-- local variables
+        type(DA_NameDef)                      :: myName
+
+        !   Get Data Array Description and Name from Client
+
+        do
+            CALL PMC_Bcast ( myName%couple_index, 0, comm=m_to_client_comm(ClientId))
+            if(myName%couple_index == -1) EXIT
+            CALL PMC_Bcast ( myName%ServerDesc,   0, comm=m_to_client_comm(ClientId))
+            CALL PMC_Bcast ( myName%NameOnServer, 0, comm=m_to_client_comm(ClientId))
+            CALL PMC_Bcast ( myName%ClientDesc,   0, comm=m_to_client_comm(ClientId))
+            CALL PMC_Bcast ( myName%NameOnClient, 0, comm=m_to_client_comm(ClientId))
+
+            CALL PMC_G_SetName (clients(ClientID), myName%couple_index, myName%NameOnServer )
+        end do
+
+        return
+   END SUBROUTINE Get_DA_names_from_client
+
+   SUBROUTINE PMC_S_SetArray (ClientId, NrDims, dims, dim_order, array_adr)
+      IMPLICIT none
+
+      INTEGER,INTENT(IN)                      :: ClientId
+      INTEGER,INTENT(IN)                      :: NrDims
+      INTEGER,INTENT(IN),DIMENSION(:)         :: dims
+      INTEGER,INTENT(IN)                      :: dim_order
+      TYPE(c_ptr),INTENT(IN)                  :: array_adr
+
+      INTEGER                                 :: i
+      TYPE(PeDef),POINTER                     :: aPE
+      TYPE(ArrayDef),POINTER                  :: ar
+      CHARACTER(len=DA_Namelen)               :: myName
+
+      !  Set Array for Client interPE 0
+
+       do i=1,Clients(ClientId)%inter_npes
+          aPE => Clients(ClientId)%PEs(i)
+          ar  => aPE%Arrays
+          ar%NrDims    = NrDims
+          ar%A_dim     = dims
+          ar%dim_order = dim_order
+          ar%data      = array_adr
+       end do
+
+      return
+   END SUBROUTINE PMC_S_SetArray
+
+
+    SUBROUTINE Set_PE_index_list (ClientId, myClient,index_list,NrP)
+       IMPLICIT none
+
+       INTEGER,INTENT(IN)                      :: ClientId
+       TYPE(ClientDef),INTENT(INOUT)           :: myClient
+       INTEGER,INTENT(IN),DIMENSION(:,:)       :: index_list
+       INTEGER,INTENT(IN)                      :: NrP
+
+!--    local variables
+       INTEGER                                 :: i,j,ind,ierr,i2
+       TYPE(PeDef),POINTER                     :: aPE
+       INTEGER                                 :: RemPE
+       INTEGER,DIMENSION(myClient%inter_npes)  :: RemInd
+       INTEGER,DIMENSION(:),POINTER            :: RemIndw
+       INTEGER,DIMENSION(:),POINTER            :: RLdef
+       INTEGER(KIND=MPI_ADDRESS_KIND)          :: WinSize
+       INTEGER                                 :: indWin,indWin2
+
+       ! First, count entries for every remote client PE
+
+       do i=1,myClient%inter_npes
+          aPE => myClient%PEs(i)
+          aPE%NrEle = 0
+       end do
+
+       do j=1,NrP                                ! loop over number of cells coarse grid
+          RemPE = index_list(5,j)+1              ! Pe number remote PE
+          aPE => myClient%PEs(RemPE)
+          aPE% NrEle = aPE% NrEle+1              ! Increment Number of elements for this client Pe
+       end do
+
+       do i=1,myClient%inter_npes
+          aPE => myClient%PEs(i)
+          ALLOCATE(aPE%locInd(aPE%NrEle))
+       end do
+
+       RemInd = 0
+
+       ! Second, Create lists
+
+       do j=1,NrP                                ! loop over number of cells coarse grid
+          RemPE = index_list(5,j)+1              ! Pe number remote PE
+          aPE => myClient%PEs(RemPE)
+          RemInd(RemPE)     = RemInd(RemPE)+1
+          ind               = RemInd(RemPE)
+          aPE%locInd(ind)%i = index_list(1,j)
+          aPE%locInd(ind)%j = index_list(2,j)
+       end do
+
+       !  Prepare Number of Elements for Client PEs
+       CALL PMC_Alloc_mem (RLdef, myClient%inter_npes*2)
+       WinSize = myClient%inter_npes*c_sizeof(i)*2   ! Number of Client PEs * size of INTEGER (i just arbitrary INTEGER)
+
+       CALL MPI_Win_create (RLdef, WinSize, iwp, MPI_INFO_NULL, myClient%intra_comm, indWin, ierr);
+       CALL MPI_Win_fence (0, indWin, ierr);         !  Open Window to set data
+
+       RLdef(1) = 0                                  ! Index on Remote PE 0
+       RLdef(2) = RemInd(1)                          ! Number of Elements on Rem PE 0
+
+       do i=2,myClient%inter_npes                    ! Reserve Buffer for index array
+          i2          = (i-1)*2+1
+          RLdef(i2)   = RLdef(i2-2) + RLdef(i2-1)*2  ! Index on Remote PE
+          RLdef(i2+1) = RemInd(i)                    ! Number of Elements on Remote PE
+       end do
+
+       CALL MPI_Win_fence (0, indWin, ierr);         ! Close Window to allow client to access data
+       CALL MPI_Win_fence (0, indWin, ierr);         ! Client has retrieved data
+
+       i2 = 2*myClient%inter_npes-1
+       WinSize = (RLdef(i2)+RLdef(i2+1))*2
+       WinSize = max(WinSize,1)                      ! Make sure, MPI_Alloc_mem works
+
+       CALL PMC_Alloc_mem (RemIndw, int(WinSize))
+
+       CALL MPI_Barrier (m_model_comm, ierr)
+       CALL MPI_Win_create (RemIndw, WinSize*c_sizeof(i), iwp, MPI_INFO_NULL, myClient%intra_comm, indWin2, ierr);
+
+       CALL MPI_Win_fence (0, indWin2, ierr);         !  Open Window to set data
+       do j=1,NrP                                ! this loop creates the 2D index list
+          RemPE = index_list(5,j)+1              ! Pe number remote PE
+          aPE => myClient%PEs(RemPE)
+          i2    = RemPE*2-1
+          ind   = RLdef(i2)+1
+          RemIndw(ind)   = index_list(3,j)
+          RemIndw(ind+1) = index_list(4,j)
+          RLdef(i2) = RLdef(i2)+2
+       end do
+       CALL MPI_Win_fence (0, indWin2, ierr);      !all data set
+
+       CALL MPI_Barrier(myClient%intra_comm, ierr) ! Dont know why, but this barrier is necessary before we can free the windows
+
+       CALL MPI_Win_free(indWin, ierr)
+       CALL MPI_Win_free(indWin2, ierr)
+
+!      Sollte funktionieren, Problem mit MPI implementation
+!      https://www.lrz.de/services/software/parallel/mpi/onesided
+!       CALL MPI_Free_mem (RemIndw, ierr)
+
+       return
+    END SUBROUTINE Set_PE_index_list
+
+END MODULE pmc_server
Index: palm/trunk/SOURCE/poismg.f90
===================================================================
--- palm/trunk/SOURCE/poismg.f90	(revision 1761)
+++ palm/trunk/SOURCE/poismg.f90	(revision 1762)
@@ -19,5 +19,5 @@
 ! Current revisions:
 ! -----------------
-! 
+! Introduction of nested domain feature
 ! 
 ! Former revisions:
@@ -259,5 +259,6 @@
     USE control_parameters,                                                    &
         ONLY:  bc_lr_cyc, bc_ns_cyc, grid_level, ibc_p_b, ibc_p_t, inflow_l,   &
-               inflow_n, inflow_r, inflow_s, outflow_l, outflow_n, outflow_r,  &
+               inflow_n, inflow_r, inflow_s, nest_bound_l, nest_bound_n,       &
+               nest_bound_r, nest_bound_s, outflow_l, outflow_n, outflow_r,    &
                outflow_s
 
@@ -353,11 +354,19 @@
 
     IF ( .NOT. bc_lr_cyc )  THEN
-       IF ( inflow_l .OR. outflow_l )  r(:,:,nxl_mg(l)-1) = r(:,:,nxl_mg(l))
-       IF ( inflow_r .OR. outflow_r )  r(:,:,nxr_mg(l)+1) = r(:,:,nxr_mg(l))
+       IF ( inflow_l .OR. outflow_l .OR. nest_bound_l )  THEN
+          r(:,:,nxl_mg(l)-1) = r(:,:,nxl_mg(l))
+       ENDIF
+       IF ( inflow_r .OR. outflow_r .OR. nest_bound_r )  THEN
+          r(:,:,nxr_mg(l)+1) = r(:,:,nxr_mg(l))
+       ENDIF
     ENDIF
 
     IF ( .NOT. bc_ns_cyc )  THEN
-       IF ( inflow_n .OR. outflow_n )  r(:,nyn_mg(l)+1,:) = r(:,nyn_mg(l),:)
-       IF ( inflow_s .OR. outflow_s )  r(:,nys_mg(l)-1,:) = r(:,nys_mg(l),:)
+       IF ( inflow_n .OR. outflow_n .OR. nest_bound_n )  THEN
+          r(:,nyn_mg(l)+1,:) = r(:,nyn_mg(l),:)
+       ENDIF
+       IF ( inflow_s .OR. outflow_s .OR. nest_bound_s )  THEN
+          r(:,nys_mg(l)-1,:) = r(:,nys_mg(l),:)
+       ENDIF
     ENDIF
 
@@ -393,5 +402,6 @@
     USE control_parameters,                                                    &
         ONLY:  bc_lr_cyc, bc_ns_cyc, grid_level, ibc_p_b, ibc_p_t, inflow_l,   &
-               inflow_n, inflow_r, inflow_s, outflow_l, outflow_n, outflow_r,  &
+               inflow_n, inflow_r, inflow_s, nest_bound_l, nest_bound_n,       &
+               nest_bound_r, nest_bound_s, outflow_l, outflow_n, outflow_r,    &
                outflow_s
 
@@ -560,11 +570,19 @@
 
     IF ( .NOT. bc_lr_cyc )  THEN
-       IF (inflow_l .OR. outflow_l)  f_mg(:,:,nxl_mg(l)-1) = f_mg(:,:,nxl_mg(l))
-       IF (inflow_r .OR. outflow_r)  f_mg(:,:,nxr_mg(l)+1) = f_mg(:,:,nxr_mg(l))
+       IF ( inflow_l .OR. outflow_l .OR. nest_bound_l )  THEN
+          f_mg(:,:,nxl_mg(l)-1) = f_mg(:,:,nxl_mg(l))
+       ENDIF
+       IF ( inflow_r .OR. outflow_r .OR. nest_bound_r )  THEN
+          f_mg(:,:,nxr_mg(l)+1) = f_mg(:,:,nxr_mg(l))
+       ENDIF
     ENDIF
 
     IF ( .NOT. bc_ns_cyc )  THEN
-       IF (inflow_n .OR. outflow_n)  f_mg(:,nyn_mg(l)+1,:) = f_mg(:,nyn_mg(l),:)
-       IF (inflow_s .OR. outflow_s)  f_mg(:,nys_mg(l)-1,:) = f_mg(:,nys_mg(l),:)
+       IF ( inflow_n .OR. outflow_n .OR. nest_bound_n )  THEN
+          f_mg(:,nyn_mg(l)+1,:) = f_mg(:,nyn_mg(l),:)
+       ENDIF
+       IF ( inflow_s .OR. outflow_s .OR. nest_bound_s )  THEN
+          f_mg(:,nys_mg(l)-1,:) = f_mg(:,nys_mg(l),:)
+       ENDIF
     ENDIF
 
@@ -600,5 +618,6 @@
     USE control_parameters,                                                    &
         ONLY:  bc_lr_cyc, bc_ns_cyc, grid_level, ibc_p_b, ibc_p_t, inflow_l,   &
-               inflow_n, inflow_r, inflow_s, outflow_l, outflow_n, outflow_r,  &
+               inflow_n, inflow_r, inflow_s, nest_bound_l, nest_bound_n,       &
+               nest_bound_r, nest_bound_s, outflow_l, outflow_n, outflow_r,    &
                outflow_s
 
@@ -668,11 +687,19 @@
 
     IF ( .NOT. bc_lr_cyc )  THEN
-       IF (inflow_l .OR. outflow_l)  temp(:,:,nxl_mg(l)-1) = temp(:,:,nxl_mg(l))
-       IF (inflow_r .OR. outflow_r)  temp(:,:,nxr_mg(l)+1) = temp(:,:,nxr_mg(l))
+       IF ( inflow_l .OR. outflow_l .OR. nest_bound_l )  THEN
+          temp(:,:,nxl_mg(l)-1) = temp(:,:,nxl_mg(l))
+       ENDIF
+       IF ( inflow_r .OR. outflow_r .OR. nest_bound_r )  THEN
+          temp(:,:,nxr_mg(l)+1) = temp(:,:,nxr_mg(l))
+       ENDIF
     ENDIF
 
     IF ( .NOT. bc_ns_cyc )  THEN
-       IF (inflow_n .OR. outflow_n)  temp(:,nyn_mg(l)+1,:) = temp(:,nyn_mg(l),:)
-       IF (inflow_s .OR. outflow_s)  temp(:,nys_mg(l)-1,:) = temp(:,nys_mg(l),:)
+       IF ( inflow_n .OR. outflow_n .OR. nest_bound_n )  THEN
+          temp(:,nyn_mg(l)+1,:) = temp(:,nyn_mg(l),:)
+       ENDIF
+       IF ( inflow_s .OR. outflow_s .OR. nest_bound_s )  THEN
+          temp(:,nys_mg(l)-1,:) = temp(:,nys_mg(l),:)
+       ENDIF
     ENDIF
 
@@ -709,5 +736,6 @@
     USE control_parameters,                                                    &
         ONLY:  bc_lr_cyc, bc_ns_cyc, grid_level, ibc_p_b, ibc_p_t, inflow_l,   &
-               inflow_n, inflow_r, inflow_s, ngsrb, outflow_l, outflow_n,      &
+               inflow_n, inflow_r, inflow_s, ngsrb, nest_bound_l,              &
+               nest_bound_n, nest_bound_r, nest_bound_s, outflow_l, outflow_n, &
                outflow_r, outflow_s
 
@@ -1068,8 +1096,8 @@
 
           IF ( .NOT. bc_lr_cyc )  THEN
-             IF ( inflow_l .OR. outflow_l )  THEN
+             IF ( inflow_l .OR. outflow_l .OR. nest_bound_l )  THEN
                 p_mg(:,:,nxl_mg(l)-1) = p_mg(:,:,nxl_mg(l))
              ENDIF
-             IF ( inflow_r .OR. outflow_r )  THEN
+             IF ( inflow_r .OR. outflow_r .OR. nest_bound_r )  THEN
                 p_mg(:,:,nxr_mg(l)+1) = p_mg(:,:,nxr_mg(l))
              ENDIF
@@ -1077,8 +1105,8 @@
 
           IF ( .NOT. bc_ns_cyc )  THEN
-             IF ( inflow_n .OR. outflow_n )  THEN
+             IF ( inflow_n .OR. outflow_n .OR. nest_bound_n )  THEN
                 p_mg(:,nyn_mg(l)+1,:) = p_mg(:,nyn_mg(l),:)
              ENDIF
-             IF ( inflow_s .OR. outflow_s )  THEN
+             IF ( inflow_s .OR. outflow_s .OR. nest_bound_s )  THEN
                 p_mg(:,nys_mg(l)-1,:) = p_mg(:,nys_mg(l),:)
              ENDIF
@@ -1296,6 +1324,7 @@
                gamma_mg, grid_level, grid_level_count, ibc_p_b, ibc_p_t,       &
                inflow_l, inflow_n, inflow_r, inflow_s, maximum_grid_level,     &
-               mg_switch_to_pe0_level, mg_switch_to_pe0, ngsrb, outflow_l,     &
-               outflow_n, outflow_r, outflow_s
+               mg_switch_to_pe0_level, mg_switch_to_pe0, nest_domain,          &
+               nest_bound_l, nest_bound_n, nest_bound_r, nest_bound_s, ngsrb,  &
+               outflow_l, outflow_n, outflow_r, outflow_s
 
 
@@ -1446,4 +1475,7 @@
              outflow_l = .TRUE.
              outflow_r = .FALSE.
+          ELSEIF ( nest_domain )  THEN
+             nest_bound_l = .TRUE.
+             nest_bound_r = .TRUE.
           ENDIF
 
@@ -1458,4 +1490,7 @@
              outflow_n = .TRUE.
              outflow_s = .FALSE.
+          ELSEIF ( nest_domain )  THEN
+             nest_bound_s = .TRUE.
+             nest_bound_n = .TRUE.
           ENDIF
 
@@ -1528,4 +1563,6 @@
              ELSEIF ( bc_lr_raddir )  THEN
                 outflow_l = .TRUE.
+             ELSEIF ( nest_domain )  THEN
+                nest_bound_l = .TRUE.
              ENDIF
           ENDIF
@@ -1536,4 +1573,6 @@
              ELSEIF ( bc_lr_raddir )  THEN
                 inflow_r  = .TRUE.
+             ELSEIF ( nest_domain )  THEN
+                nest_bound_r = .TRUE.
              ENDIF
           ENDIF
@@ -1544,4 +1583,6 @@
              ELSEIF ( bc_ns_raddir )  THEN
                 inflow_s  = .TRUE.
+             ELSEIF ( nest_domain )  THEN
+                nest_bound_s = .TRUE.
              ENDIF
           ENDIF
@@ -1552,4 +1593,6 @@
              ELSEIF ( bc_ns_raddir )  THEN
                 outflow_n = .TRUE.
+             ELSEIF ( nest_domain )  THEN
+                nest_bound_n = .TRUE.
              ENDIF
           ENDIF
Index: palm/trunk/SOURCE/poismg_fast.f90
===================================================================
--- palm/trunk/SOURCE/poismg_fast.f90	(revision 1761)
+++ palm/trunk/SOURCE/poismg_fast.f90	(revision 1762)
@@ -19,5 +19,5 @@
 ! Current revisions:
 ! -----------------
-! 
+! Introduction of nested domain feature
 ! 
 ! Former revisions:
@@ -240,5 +240,6 @@
        USE control_parameters,                                                 &
            ONLY:  bc_lr_cyc, bc_ns_cyc, grid_level, ibc_p_b, ibc_p_t, inflow_l,&
-                  inflow_n, inflow_r, inflow_s, masking_method, outflow_l,     &
+                  inflow_n, inflow_r, inflow_s, masking_method, nest_bound_l,  &
+                  nest_bound_n, nest_bound_r, nest_bound_s, outflow_l,         &
                   outflow_n, outflow_r, outflow_s, topography
 
@@ -393,11 +394,19 @@
 
        IF ( .NOT. bc_lr_cyc )  THEN
-          IF ( inflow_l .OR. outflow_l )  r(:,:,nxl_mg(l)-1) = r(:,:,nxl_mg(l))
-          IF ( inflow_r .OR. outflow_r )  r(:,:,nxr_mg(l)+1) = r(:,:,nxr_mg(l))
+          IF ( inflow_l .OR. outflow_l .OR. nest_bound_l )  THEN
+             r(:,:,nxl_mg(l)-1) = r(:,:,nxl_mg(l))
+          ENDIF
+          IF ( inflow_r .OR. outflow_r .OR. nest_bound_r )  THEN
+             r(:,:,nxr_mg(l)+1) = r(:,:,nxr_mg(l))
+          ENDIF
        ENDIF
 
        IF ( .NOT. bc_ns_cyc )  THEN
-          IF ( inflow_n .OR. outflow_n )  r(:,nyn_mg(l)+1,:) = r(:,nyn_mg(l),:)
-          IF ( inflow_s .OR. outflow_s )  r(:,nys_mg(l)-1,:) = r(:,nys_mg(l),:)
+          IF ( inflow_n .OR. outflow_n .OR. nest_bound_n )  THEN
+             r(:,nyn_mg(l)+1,:) = r(:,nyn_mg(l),:)
+          ENDIF
+          IF ( inflow_s .OR. outflow_s .OR. nest_bound_s )  THEN
+             r(:,nys_mg(l)-1,:) = r(:,nys_mg(l),:)
+          ENDIF
        ENDIF
 
@@ -434,5 +443,6 @@
        USE control_parameters,                                                 &
            ONLY:  bc_lr_cyc, bc_ns_cyc, grid_level, ibc_p_b, ibc_p_t, inflow_l,&
-                  inflow_n, inflow_r, inflow_s, masking_method, outflow_l,     &
+                  inflow_n, inflow_r, inflow_s, masking_method, nest_bound_l,  &
+                  nest_bound_n, nest_bound_r, nest_bound_s, outflow_l,         &
                   outflow_n, outflow_r, outflow_s, topography
 
@@ -635,11 +645,19 @@
 
        IF ( .NOT. bc_lr_cyc )  THEN
-          IF (inflow_l .OR. outflow_l)  f_mg(:,:,nxl_mg(l)-1) = f_mg(:,:,nxl_mg(l))
-          IF (inflow_r .OR. outflow_r)  f_mg(:,:,nxr_mg(l)+1) = f_mg(:,:,nxr_mg(l))
+          IF ( inflow_l .OR. outflow_l .OR. nest_bound_l )  THEN
+             f_mg(:,:,nxl_mg(l)-1) = f_mg(:,:,nxl_mg(l))
+          ENDIF
+          IF ( inflow_r .OR. outflow_r .OR. nest_bound_r )  THEN
+             f_mg(:,:,nxr_mg(l)+1) = f_mg(:,:,nxr_mg(l))
+          ENDIF
        ENDIF
 
        IF ( .NOT. bc_ns_cyc )  THEN
-          IF (inflow_n .OR. outflow_n)  f_mg(:,nyn_mg(l)+1,:) = f_mg(:,nyn_mg(l),:)
-          IF (inflow_s .OR. outflow_s)  f_mg(:,nys_mg(l)-1,:) = f_mg(:,nys_mg(l),:)
+          IF ( inflow_n .OR. outflow_n .OR. nest_bound_n )  THEN
+             f_mg(:,nyn_mg(l)+1,:) = f_mg(:,nyn_mg(l),:)
+          ENDIF
+          IF ( inflow_s .OR. outflow_s .OR. nest_bound_s )  THEN
+             f_mg(:,nys_mg(l)-1,:) = f_mg(:,nys_mg(l),:)
+          ENDIF
        ENDIF
 
@@ -679,5 +697,6 @@
        USE control_parameters,                                                 &
            ONLY:  bc_lr_cyc, bc_ns_cyc, grid_level, ibc_p_b, ibc_p_t, inflow_l,&
-                  inflow_n, inflow_r, inflow_s, outflow_l, outflow_n,          &
+                  inflow_n, inflow_r, inflow_s, nest_bound_l, nest_bound_n,    &
+                  nest_bound_r, nest_bound_s, outflow_l, outflow_n,            &
                   outflow_r, outflow_s
 
@@ -790,11 +809,19 @@
 
        IF ( .NOT. bc_lr_cyc )  THEN
-          IF (inflow_l .OR. outflow_l)  temp(:,:,nxl_mg(l)-1) = temp(:,:,nxl_mg(l))
-          IF (inflow_r .OR. outflow_r)  temp(:,:,nxr_mg(l)+1) = temp(:,:,nxr_mg(l))
+          IF ( inflow_l .OR. outflow_l .OR. nest_bound_l )  THEN
+             temp(:,:,nxl_mg(l)-1) = temp(:,:,nxl_mg(l))
+          ENDIF
+          IF ( inflow_r .OR. outflow_r .OR. nest_bound_r )  THEN
+             temp(:,:,nxr_mg(l)+1) = temp(:,:,nxr_mg(l))
+          ENDIF
        ENDIF
 
        IF ( .NOT. bc_ns_cyc )  THEN
-          IF (inflow_n .OR. outflow_n)  temp(:,nyn_mg(l)+1,:) = temp(:,nyn_mg(l),:)
-          IF (inflow_s .OR. outflow_s)  temp(:,nys_mg(l)-1,:) = temp(:,nys_mg(l),:)
+          IF ( inflow_n .OR. outflow_n .OR. nest_bound_n )  THEN
+             temp(:,nyn_mg(l)+1,:) = temp(:,nyn_mg(l),:)
+          ENDIF
+          IF ( inflow_s .OR. outflow_s .OR. nest_bound_s )  THEN
+             temp(:,nys_mg(l)-1,:) = temp(:,nys_mg(l),:)
+          ENDIF
        ENDIF
 
@@ -832,5 +859,6 @@
        USE control_parameters,                                                 &
            ONLY:  bc_lr_cyc, bc_ns_cyc, grid_level, ibc_p_b, ibc_p_t, inflow_l,&
-                  inflow_n, inflow_r, inflow_s, masking_method, ngsrb,         &
+                  inflow_n, inflow_r, inflow_s, masking_method, nest_bound_l,  &
+                  nest_bound_n, nest_bound_r, nest_bound_s, ngsrb,             &
                   outflow_l, outflow_n, outflow_r, outflow_s, topography
 
@@ -1411,9 +1439,9 @@
              CALL special_exchange_horiz( p_mg, color )
 
-              IF ( .NOT. bc_lr_cyc )  THEN
-                IF ( inflow_l .OR. outflow_l )  THEN
+             IF ( .NOT. bc_lr_cyc )  THEN
+                IF ( inflow_l .OR. outflow_l .OR. nest_bound_l )  THEN
                    p_mg(:,:,nxl_mg(l)-1) = p_mg(:,:,nxl_mg(l))
                 ENDIF
-                IF ( inflow_r .OR. outflow_r )  THEN
+                IF ( inflow_r .OR. outflow_r .OR. nest_bound_r )  THEN
                    p_mg(:,:,nxr_mg(l)+1) = p_mg(:,:,nxr_mg(l))
                 ENDIF
@@ -1421,8 +1449,8 @@
 
              IF ( .NOT. bc_ns_cyc )  THEN
-                IF ( inflow_n .OR. outflow_n )  THEN
+                IF ( inflow_n .OR. outflow_n .OR. nest_bound_n )  THEN
                    p_mg(:,nyn_mg(l)+1,:) = p_mg(:,nyn_mg(l),:)
                 ENDIF
-                IF ( inflow_s .OR. outflow_s )  THEN
+                IF ( inflow_s .OR. outflow_s .OR. nest_bound_s )  THEN
                    p_mg(:,nys_mg(l)-1,:) = p_mg(:,nys_mg(l),:)
                 ENDIF
@@ -1913,6 +1941,7 @@
                   gamma_mg, grid_level, grid_level_count, ibc_p_b, ibc_p_t,    &
                   inflow_l, inflow_n, inflow_r, inflow_s, maximum_grid_level,  &
-                  mg_switch_to_pe0_level, mg_switch_to_pe0, ngsrb, outflow_l,  &
-                  outflow_n, outflow_r, outflow_s
+                  mg_switch_to_pe0_level, mg_switch_to_pe0, nest_domain,       &
+                  nest_bound_l, nest_bound_n, nest_bound_r, nest_bound_s,      &
+                  ngsrb, outflow_l, outflow_n, outflow_r, outflow_s
 
        USE indices,                                                            &
@@ -2062,4 +2091,7 @@
                 outflow_l = .TRUE.
                 outflow_r = .FALSE.
+             ELSEIF ( nest_domain )  THEN
+                nest_bound_l = .TRUE.
+                nest_bound_r = .TRUE.
              ENDIF
 
@@ -2074,4 +2106,7 @@
                 outflow_n = .TRUE.
                 outflow_s = .FALSE.
+             ELSEIF ( nest_domain )  THEN
+                nest_bound_s = .TRUE.
+                nest_bound_n = .TRUE.
              ENDIF
 
@@ -2146,4 +2181,6 @@
                 ELSEIF ( bc_lr_raddir )  THEN
                    outflow_l = .TRUE.
+                ELSEIF ( nest_domain )  THEN
+                   nest_bound_l = .TRUE.
                 ENDIF
              ENDIF
@@ -2154,4 +2191,6 @@
                 ELSEIF ( bc_lr_raddir )  THEN
                    inflow_r  = .TRUE.
+                ELSEIF ( nest_domain )  THEN
+                   nest_bound_r = .TRUE.
                 ENDIF
              ENDIF
@@ -2162,4 +2201,6 @@
                 ELSEIF ( bc_ns_raddir )  THEN
                    inflow_s  = .TRUE.
+                ELSEIF ( nest_domain )  THEN
+                   nest_bound_s = .TRUE.
                 ENDIF
              ENDIF
@@ -2170,4 +2211,6 @@
                 ELSEIF ( bc_ns_raddir )  THEN
                    outflow_n = .TRUE.
+                ELSEIF ( nest_domain )  THEN
+                   nest_bound_n = .TRUE.
                 ENDIF
              ENDIF
Index: palm/trunk/SOURCE/pres.f90
===================================================================
--- palm/trunk/SOURCE/pres.f90	(revision 1761)
+++ palm/trunk/SOURCE/pres.f90	(revision 1762)
@@ -19,5 +19,5 @@
 ! Current revisions:
 ! ------------------
-! 
+! Introduction of nested domain feature
 ! 
 ! Former revisions:
@@ -98,7 +98,9 @@
         ONLY:  bc_lr_cyc, bc_ns_cyc, conserve_volume_flow, dt_3d,              &
                gathered_size, ibc_p_b, ibc_p_t, intermediate_timestep_count,   &
-               mg_switch_to_pe0_level, on_device, outflow_l, outflow_n,        &
-               outflow_r, outflow_s, psolver, simulated_time, subdomain_size,  &
-               topography, volume_flow, volume_flow_area, volume_flow_initial
+               mg_switch_to_pe0_level, nest_domain, nest_bound_l,              &
+               nest_bound_n, nest_bound_r, nest_bound_s, on_device, outflow_l, &
+               outflow_n, outflow_r, outflow_s, psolver, simulated_time,       &
+               subdomain_size, topography, volume_flow, volume_flow_area,      &
+               volume_flow_initial
 
     USE cpulog,                                                                &
@@ -138,6 +140,6 @@
     REAL(wp)     ::  d_weight_pres  !<
 
-    REAL(wp), DIMENSION(1:2)   ::  volume_flow_l       !<
-    REAL(wp), DIMENSION(1:2)   ::  volume_flow_offset  !<
+    REAL(wp), DIMENSION(1:3)   ::  volume_flow_l       !<
+    REAL(wp), DIMENSION(1:3)   ::  volume_flow_offset  !<
     REAL(wp), DIMENSION(1:nzt) ::  w_l                 !<
     REAL(wp), DIMENSION(1:nzt) ::  w_l_l               !<
@@ -162,5 +164,5 @@
 !--    cannot be used in the iterative solver. Therefore, its initial value is
 !--    stored on p_loc, which is then iteratively advanced in every substep.
-       IF ( intermediate_timestep_count == 1 )  THEN
+       IF ( intermediate_timestep_count <= 1 )  THEN
           DO  i = nxl-1, nxr+1
              DO  j = nys-1, nyn+1
@@ -267,6 +269,7 @@
 
 !
-!-- Remove mean vertical velocity
-    IF ( ibc_p_b == 1  .AND.  ibc_p_t == 1 )  THEN
+!-- Remove mean vertical velocity in case that Neumann conditions are
+!-- used both at bottom and top boundary, and if not a nested domain
+    IF ( ibc_p_b == 1  .AND.  ibc_p_t == 1  .AND.  .NOT. nest_domain)  THEN
        IF ( simulated_time > 0.0_wp )  THEN ! otherwise nzb_w_inner not yet known
           w_l = 0.0_wp;  w_l_l = 0.0_wp
@@ -561,5 +564,5 @@
        !$OMP END PARALLEL
 
-    ELSE 
+    ELSEIF ( intermediate_timestep_count > 1 )  THEN
        !$OMP PARALLEL PRIVATE (i,j,k)
        !$OMP DO
Index: palm/trunk/SOURCE/sor.f90
===================================================================
--- palm/trunk/SOURCE/sor.f90	(revision 1761)
+++ palm/trunk/SOURCE/sor.f90	(revision 1762)
@@ -19,5 +19,5 @@
 ! Current revisions:
 ! -----------------
-! 
+! Introduction of nested domain feature
 ! 
 ! Former revisions:
@@ -64,5 +64,6 @@
     USE control_parameters,                                                    &
         ONLY:  bc_lr_cyc, bc_ns_cyc, ibc_p_b, ibc_p_t, inflow_l, inflow_n,     &
-               inflow_r, inflow_s, n_sor, omega_sor, outflow_l, outflow_n,     &
+               inflow_r, inflow_s, nest_bound_l, nest_bound_n, nest_bound_r,   &
+               nest_bound_s, n_sor, omega_sor, outflow_l, outflow_n,           &
                outflow_r, outflow_s
 
@@ -154,10 +155,10 @@
 !--    Horizontal (Neumann) boundary conditions in case of non-cyclic boundaries
        IF ( .NOT. bc_lr_cyc )  THEN
-          IF ( inflow_l .OR. outflow_l )  p(:,:,nxl-1) = p(:,:,nxl)
-          IF ( inflow_r .OR. outflow_r )  p(:,:,nxr+1) = p(:,:,nxr)
+          IF ( inflow_l .OR. outflow_l .OR. nest_bound_l )  p(:,:,nxl-1) = p(:,:,nxl)
+          IF ( inflow_r .OR. outflow_r .OR. nest_bound_r )  p(:,:,nxr+1) = p(:,:,nxr)
        ENDIF
        IF ( .NOT. bc_ns_cyc )  THEN
-          IF ( inflow_n .OR. outflow_n )  p(:,nyn+1,:) = p(:,nyn,:)
-          IF ( inflow_s .OR. outflow_s )  p(:,nys-1,:) = p(:,nys,:)
+          IF ( inflow_n .OR. outflow_n .OR. nest_bound_n )  p(:,nyn+1,:) = p(:,nyn,:)
+          IF ( inflow_s .OR. outflow_s .OR. nest_bound_s )  p(:,nys-1,:) = p(:,nys,:)
        ENDIF
 
@@ -216,10 +217,10 @@
 !--    Horizontal (Neumann) boundary conditions in case of non-cyclic boundaries
        IF ( .NOT. bc_lr_cyc )  THEN
-          IF ( inflow_l .OR. outflow_l )  p(:,:,nxl-1) = p(:,:,nxl)
-          IF ( inflow_r .OR. outflow_r )  p(:,:,nxr+1) = p(:,:,nxr)
+          IF ( inflow_l .OR. outflow_l .OR. nest_bound_l )  p(:,:,nxl-1) = p(:,:,nxl)
+          IF ( inflow_r .OR. outflow_r .OR. nest_bound_r )  p(:,:,nxr+1) = p(:,:,nxr)
        ENDIF
        IF ( .NOT. bc_ns_cyc )  THEN
-          IF ( inflow_n .OR. outflow_n )  p(:,nyn+1,:) = p(:,nyn,:)
-          IF ( inflow_s .OR. outflow_s )  p(:,nys-1,:) = p(:,nys,:)
+          IF ( inflow_n .OR. outflow_n .OR. nest_bound_n )  p(:,nyn+1,:) = p(:,nyn,:)
+          IF ( inflow_s .OR. outflow_s .OR. nest_bound_s )  p(:,nys-1,:) = p(:,nys,:)
        ENDIF
 
Index: palm/trunk/SOURCE/time_integration.f90
===================================================================
--- palm/trunk/SOURCE/time_integration.f90	(revision 1761)
+++ palm/trunk/SOURCE/time_integration.f90	(revision 1762)
@@ -19,5 +19,5 @@
 ! Current revisions:
 ! ------------------
-! 
+! Introduction of nested domain feature
 !
 ! Former revisions:
@@ -165,7 +165,7 @@
 
     USE arrays_3d,                                                             &
-        ONLY:  diss, dzu, e_p, nr_p, prho, pt, pt_p, pt_init, q_init, q, ql,   &
-               ql_c, ql_v, ql_vp, qr_p, q_p, ref_state, rho, sa_p, tend, u,    &
-               u_p, v, vpt, v_p, w_p
+        ONLY:  diss, dzu, e, e_p, nr_p, prho, pt, pt_p, pt_init, q_init, q,    &
+               ql, ql_c, ql_v, ql_vp, qr_p, q_p, ref_state, rho, sa_p, tend,   &
+               u, u_p, v, vpt, v_p, w, w_p
 
     USE calc_mean_profile_mod,                                                 &
@@ -188,5 +188,5 @@
                icloud_scheme, intermediate_timestep_count,                     &
                intermediate_timestep_count_max, large_scale_forcing,           &
-               loop_optimization, lsf_surf, lsf_vert, masks, mid,              &
+               loop_optimization, lsf_surf, lsf_vert, masks, mid, nest_domain, &
                netcdf_data_format, neutral, nr_timesteps_this_run, nudging,    &
                ocean, on_device, passive_scalar, precipitation,                &
@@ -235,4 +235,13 @@
     USE pegrid
 
+#if defined( PMC_ACTIVE )
+    USE pmc_interface,                                                         &
+        ONLY:  client_to_server, nesting_mode,                                 &
+               pmci_ensure_nest_mass_conservation, pmci_client_datatrans,      &
+               pmci_client_initialize, pmci_client_synchronize,                &
+               pmci_server_datatrans, pmci_server_initialize,                  &
+               pmci_server_synchronize, pmci_update_new, server_to_client
+#endif
+
     USE production_e_mod,                                                      &
         ONLY:  production_e_init
@@ -290,4 +299,48 @@
     ENDIF
 
+#if defined( PMC_ACTIVE )
+!
+!-- TO_DO: try to give more meaningful comments here
+!-- Domain nesting: From server to client commmunication
+!-- ( direction=SERVER_TO_CLIENT )
+!-- Nest initial conditions
+!
+!-- Send initial condition data from server to client
+    CALL pmci_server_initialize
+!
+!-- Receive and interpolate initial data on client
+    CALL pmci_client_initialize
+!
+!-- TO_DO, maybe removed
+!-- Obs. Nesting may be unnecessary at this point.
+!
+!-- Nest boundary conditions
+    CALL pmci_server_datatrans( server_to_client )
+    CALL pmci_client_datatrans( server_to_client )
+
+    IF ( nesting_mode == 'two-way' )  THEN
+       CALL pmci_server_datatrans( client_to_server )
+       CALL pmci_client_datatrans( client_to_server )
+!
+!--    Exchange_horiz is needed for all server-domains after the anterpolation
+       CALL exchange_horiz( u, nbgp )
+       CALL exchange_horiz( v, nbgp )
+       CALL exchange_horiz( w, nbgp )
+       CALL exchange_horiz( pt, nbgp )
+       IF ( .NOT. constant_diffusion )  CALL exchange_horiz( e, nbgp )
+       intermediate_timestep_count = 0
+       CALL pres
+    ENDIF
+!
+!-- Correct the w top-BC in nest domains to ensure mass conservation.
+!-- Copy the interpolated/anterpolated boundary values to the _p
+!-- arrays, too, to make sure the interpolated/anterpolated boundary
+!-- values are carried over from one RK inner step to another.
+!-- These actions must not be done for the root domain.
+    IF ( nest_domain )  THEN
+       CALL pmci_ensure_nest_mass_conservation
+       CALL pmci_update_new
+    ENDIF
+#endif
 
 #if defined( __dvrp_graphics )
@@ -309,5 +362,14 @@
        IF ( simulated_time /= 0.0_wp )  THEN
           CALL timestep
-       ENDIF
+
+#if defined( PMC_ACTIVE )
+!
+!--       TO_DO: try to give more detailed and meaningful comments here
+!--       Server side must be called first
+          CALL pmci_server_synchronize
+          CALL pmci_client_synchronize
+#endif
+       ENDIF
+
 
 !
@@ -628,4 +690,46 @@
 !--       Swap the time levels in preparation for the next time step.
           CALL swap_timelevel
+
+#if defined( PMC_ACTIVE )
+!
+!--       TO_DO: try to give more meaningful comments here
+!--       Domain nesting
+!--       Note that the nesting operations are omitted intentionally on the
+!--       first two RK-substeps.
+          CALL cpu_log( log_point(60), 'nesting', 'start' )
+!
+!--       From server to client commmunication ( direction=SERVER_TO_CLIENT )
+          CALL pmci_server_datatrans( server_to_client )
+          CALL pmci_client_datatrans( server_to_client )
+
+          IF ( nesting_mode == 'two-way' )  THEN
+!
+!--          From client to server commmunication ( direction=CLIENT_TO_SERVER )
+             CALL pmci_server_datatrans( client_to_server )
+             CALL pmci_client_datatrans( client_to_server )
+!
+!--          Exchange_horiz is needed for all server-domains after the
+!--          anterpolation
+             CALL exchange_horiz( u, nbgp )
+             CALL exchange_horiz( v, nbgp )
+             CALL exchange_horiz( w, nbgp )
+             CALL exchange_horiz( pt, nbgp )
+             IF ( humidity  .OR.  passive_scalar )  THEN
+                CALL exchange_horiz( q, nbgp )
+             ENDIF
+             IF ( .NOT. constant_diffusion )  CALL exchange_horiz( e, nbgp )
+          ENDIF
+!
+!--       Correct the w top-BC in nest domains to ensure mass conservation.
+!--       This action must never be done for the root domain.
+          IF ( nest_domain )  THEN
+             CALL pmci_ensure_nest_mass_conservation
+!
+!--          pmc_update_new is not necessary if nesting is made at each substep.
+             CALL pmci_update_new
+          ENDIF
+
+          CALL cpu_log( log_point(60), 'nesting', 'stop' )
+#endif
 
 !
@@ -1041,5 +1145,8 @@
 !
 !--    Output elapsed simulated time in form of a progress bar on stdout
+!--    TO_DO: should be done by root domain later
+#if ! defined( PMC_ACTIVE )
        IF ( myid == 0 )  CALL output_progress_bar
+#endif
 
        CALL cpu_log( log_point_s(10), 'timesteps', 'stop' )
@@ -1048,5 +1155,8 @@
     ENDDO   ! time loop
 
+!-- TO_DO: should be done by root domain later
+#if ! defined( PMC_ACTIVE )
     IF ( myid == 0 )  CALL finish_progress_bar
+#endif
 
 #if defined( __dvrp_graphics )
