Index: palm/trunk/SCRIPTS/inifor_script
===================================================================
--- palm/trunk/SCRIPTS/inifor_script	(revision 3791)
+++ palm/trunk/SCRIPTS/inifor_script	(revision 3792)
@@ -22,9 +22,12 @@
 # Current revisions:
 # ------------------
-# initial revision
+# 
 # 
 # Former revisions:
 # -----------------
 # $Id$
+# initial revision
+# 
+# 
 # 
 #--------------------------------------------------------------------------------#
Index: palm/trunk/SOURCE/pmc_interface_mod.f90
===================================================================
--- palm/trunk/SOURCE/pmc_interface_mod.f90	(revision 3791)
+++ palm/trunk/SOURCE/pmc_interface_mod.f90	(revision 3792)
@@ -25,4 +25,8 @@
 ! -----------------
 ! $Id$
+! Interpolations improved. Large number of obsolete subroutines removed.
+! All unused variables removed. 
+! 
+! 3741 2019-02-13 16:24:49Z hellstea
 ! Interpolations and child initialization adjusted to handle set ups with child 
 ! pe-subdomain dimension not integer divisible by the grid-spacing ratio in the 
@@ -448,4 +452,6 @@
     INTEGER(iwp), PARAMETER ::  child_to_parent = 2   !<
     INTEGER(iwp), PARAMETER ::  parent_to_child = 1   !<
+    INTEGER(iwp), PARAMETER ::  interpolation_scheme_lrsn = 2  !< Interpolation scheme to be used on lateral boundaries (to be made user parameter)
+    INTEGER(iwp), PARAMETER ::  interpolation_scheme_t    = 3  !< Interpolation scheme to be used on top boundary (to be made user parameter)
 !
 !-- Coupler setup
@@ -457,18 +463,9 @@
 !
 !-- Control parameters
-    CHARACTER(LEN=7), SAVE ::  nesting_datatransfer_mode = 'mixed'  !< steering
-                                                         !< parameter for data-
-                                                         !< transfer mode
-    CHARACTER(LEN=8), SAVE ::  nesting_mode = 'two-way'  !< steering parameter
-                                                         !< for 1- or 2-way nesting
+    CHARACTER(LEN=7), SAVE ::  nesting_datatransfer_mode = 'mixed'  !< steering parameter for data-transfer mode
+    CHARACTER(LEN=8), SAVE ::  nesting_mode = 'two-way'             !< steering parameter for 1- or 2-way nesting
 
     LOGICAL, SAVE ::  nested_run = .FALSE.  !< general switch
     LOGICAL       ::  rans_mode_parent = .FALSE. !< mode of parent model (.F. - LES mode, .T. - RANS mode)
-
-    REAL(wp), SAVE ::  anterp_relax_length_l = -1.0_wp   !<
-    REAL(wp), SAVE ::  anterp_relax_length_r = -1.0_wp   !<
-    REAL(wp), SAVE ::  anterp_relax_length_s = -1.0_wp   !<
-    REAL(wp), SAVE ::  anterp_relax_length_n = -1.0_wp   !<
-    REAL(wp), SAVE ::  anterp_relax_length_t = -1.0_wp   !<
 !
 !-- Geometry
@@ -477,5 +474,4 @@
     REAL(wp), SAVE, PUBLIC                            ::  lower_left_coord_x !<
     REAL(wp), SAVE, PUBLIC                            ::  lower_left_coord_y !<
-
 !
 !-- Children's parent-grid arrays
@@ -484,105 +480,29 @@
     INTEGER(iwp), SAVE, DIMENSION(4), PUBLIC    ::  coarse_bound_w      !< subdomain index bounds for children's parent-grid work arrays
 
-    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  dissc !< coarse grid array on child domain - dissipation rate
-    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ec   !<
-    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ptc  !<
-    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  uc   !<
-    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  vc   !<
-    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  wc   !<
-    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  q_c  !<
-    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  qcc  !<
-    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  qrc  !<
-    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  nrc  !<
-    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ncc  !<
-    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  sc   !<
+    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  dissc !< Parent-grid array on child domain - dissipation rate
+    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ec    !< Parent-grid array on child domain - SGS TKE
+    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ptc   !< Parent-grid array on child domain - potential temperature
+    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  uc    !< Parent-grid array on child domain - velocity component u
+    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  vc    !< Parent-grid array on child domain - velocity component v
+    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  wc    !< Parent-grid array on child domain - velocity component w
+    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  q_c   !< Parent-grid array on child domain - 
+    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  qcc   !< Parent-grid array on child domain - 
+    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  qrc   !< Parent-grid array on child domain - 
+    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  nrc   !< Parent-grid array on child domain - 
+    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ncc   !< Parent-grid array on child domain - 
+    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  sc    !< Parent-grid array on child domain - 
     INTEGER(idp), SAVE, DIMENSION(:,:), ALLOCATABLE, TARGET, PUBLIC ::  nr_partc    !<
     INTEGER(idp), SAVE, DIMENSION(:,:), ALLOCATABLE, TARGET, PUBLIC ::  part_adrc   !<
 
-    REAL(wp), SAVE, DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  chem_spec_c !< coarse grid array on child domain - chemical species
-
-!
-!-- Child interpolation coefficients and child-array indices to be 
-!-- precomputed and stored.
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  ico    !<
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  icu    !<
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  jco    !<
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  jcv    !<
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  kco    !<
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  kcw    !<
-    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  celltmpd !<
-    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r1xo   !<
-    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r2xo   !<
-    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r1xu   !<
-    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r2xu   !<
-    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r1yo   !<
-    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r2yo   !<
-    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r1yv   !<
-    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r2yv   !<
-    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r1zo   !<
-    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r2zo   !<
-    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r1zw   !<
-    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r2zw   !<
-
-!
-!-- Child index arrays and log-ratio arrays for the log-law near-wall
-!-- corrections. These are not truly 3-D arrays but multiple 2-D arrays.
-    INTEGER(iwp), SAVE :: ncorr  !< 4th dimension of the log_ratio-arrays
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_u_l   !<
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_u_n   !<
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_u_r   !<
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_u_s   !<
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_v_l   !<
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_v_n   !<
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_v_r   !<
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_v_s   !<
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_w_l   !<
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_w_n   !<
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_w_r   !<
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_w_s   !<
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:)   ::  logc_kbounds_u_l !<
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:)   ::  logc_kbounds_u_n !<
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:)   ::  logc_kbounds_u_r !<
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:)   ::  logc_kbounds_u_s !<
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:)   ::  logc_kbounds_v_l !<    
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:)   ::  logc_kbounds_v_n !<
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:)   ::  logc_kbounds_v_r !<    
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:)   ::  logc_kbounds_v_s !<
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:)   ::  logc_kbounds_w_l !<    
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:)   ::  logc_kbounds_w_n !<
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:)   ::  logc_kbounds_w_r !<    
-    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:)   ::  logc_kbounds_w_s !<        
-    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_u_l   !<
-    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_u_n   !<
-    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_u_r   !<
-    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_u_s   !<
-    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_v_l   !<
-    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_v_n   !<
-    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_v_r   !<
-    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_v_s   !<
-    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_w_l   !<
-    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_w_n   !<
-    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_w_r   !<
-    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_w_s   !<
-!
+    REAL(wp), SAVE, DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  chem_spec_c !< Parent-grid array on child domain - chemical species
+!
+!-- Grid-spacing ratios.
     INTEGER(iwp), SAVE ::  igsr     !< Integer grid-spacing ratio in i-direction 
     INTEGER(iwp), SAVE ::  jgsr     !< Integer grid-spacing ratio in j-direction 
     INTEGER(iwp), SAVE ::  kgsr     !< Integer grid-spacing ratio in k-direction 
+!
+!-- Highest prognostic parent-grid k-indices.
     INTEGER(iwp), SAVE ::  kcto     !< Upper bound for k in anterpolation of variables other than w.
     INTEGER(iwp), SAVE ::  kctw     !< Upper bound for k in anterpolation of w.
-    INTEGER(iwp), SAVE ::  nxlfc    !< Lower index limit in x-direction for fine-to-coarse index mapping and interpolaton coefficient arrays
-    INTEGER(iwp), SAVE ::  nxrfc    !< Upper index limit in x-direction for fine-to-coarse index mapping and interpolaton coefficient arrays
-    INTEGER(iwp), SAVE ::  nynfc    !< Upper index limit in y-direction for fine-to-coarse index mapping and interpolaton coefficient arrays
-    INTEGER(iwp), SAVE ::  nysfc    !< Lower index limit in y-direction for fine-to-coarse index mapping and interpolaton coefficient arrays
-!
-!-- Upper bound for k in log-law correction in interpolation.
-    INTEGER(iwp), SAVE ::  nzt_topo_nestbc_l   !<
-    INTEGER(iwp), SAVE ::  nzt_topo_nestbc_n   !<
-    INTEGER(iwp), SAVE ::  nzt_topo_nestbc_r   !<
-    INTEGER(iwp), SAVE ::  nzt_topo_nestbc_s   !<
-!
-!-- Spatial under-relaxation coefficients for anterpolation.
-    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) ::  frax   !<
-    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) ::  fray   !<
-    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) ::  fraz   !<
 !
 !-- Child-array indices to be precomputed and stored for anterpolation.
@@ -606,5 +526,14 @@
     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  ijkfc_w  !< number of child grid boxes contribution to a parent grid box, w-grid
     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  ijkfc_s  !< number of child grid boxes contribution to a parent grid box, scalar-grid
-    
+!    
+!-- Work arrays for interpolation and user-defined type definitions for horizontal work-array exchange    
+    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: workarrc_lr
+    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: workarrc_sn
+    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: workarrc_t
+    INTEGER(iwp) :: workarrc_lr_exchange_type
+    INTEGER(iwp) :: workarrc_sn_exchange_type
+    INTEGER(iwp) :: workarrc_t_exchange_type_x
+    INTEGER(iwp) :: workarrc_t_exchange_type_y
+ 
     INTEGER(iwp), DIMENSION(3)          ::  parent_grid_info_int    !<
     REAL(wp), DIMENSION(7)              ::  parent_grid_info_real   !<
@@ -652,17 +581,5 @@
     INTEGER(idp),ALLOCATABLE,DIMENSION(:,:),PUBLIC,TARGET    :: part_adr !<
 
-!AH 
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: workarr_lr
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: workarr_sn
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: workarr_t
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: workarrc_lr
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: workarrc_sn
-    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: workarrc_t
-    INTEGER(iwp) :: workarrc_lr_exchange_type
-    INTEGER(iwp) :: workarrc_sn_exchange_type
-    INTEGER(iwp) :: workarrc_t_exchange_type_x
-    INTEGER(iwp) :: workarrc_t_exchange_type_y
-!AH
-    
+   
     INTERFACE pmci_boundary_conds
        MODULE PROCEDURE pmci_boundary_conds
@@ -713,14 +630,10 @@
     END  INTERFACE get_child_gridspacing
 
-
     INTERFACE pmci_set_swaplevel
        MODULE PROCEDURE pmci_set_swaplevel
     END INTERFACE pmci_set_swaplevel
 
-    PUBLIC anterp_relax_length_l, anterp_relax_length_r,                       &
-           anterp_relax_length_s, anterp_relax_length_n,                       &
-           anterp_relax_length_t, child_to_parent, comm_world_nesting,         &
-           cpl_id, nested_run, nesting_datatransfer_mode, nesting_mode,        &
-           parent_to_child, rans_mode_parent
+    PUBLIC child_to_parent, comm_world_nesting, cpl_id, nested_run,                                 &
+           nesting_datatransfer_mode, nesting_mode, parent_to_child, rans_mode_parent
 
     PUBLIC pmci_boundary_conds
@@ -733,5 +646,4 @@
     PUBLIC pmci_set_swaplevel
     PUBLIC get_number_of_childs, get_childid, get_child_edges, get_child_gridspacing
-
 
 
@@ -903,7 +815,5 @@
     REAL(wp) ::  xez              !<
     REAL(wp) ::  yez              !<
-
-    REAL(wp), DIMENSION(5) ::  fval             !<
-
+    REAL(wp), DIMENSION(5) ::  fval                      !<
     REAL(wp), DIMENSION(:), ALLOCATABLE ::  cl_coord_x   !<
     REAL(wp), DIMENSION(:), ALLOCATABLE ::  cl_coord_y   !<
@@ -912,5 +822,4 @@
 !   Initialize the pmc parent
     CALL pmc_parentinit
-
 !
 !-- Corners of all children of the present parent
@@ -924,5 +833,4 @@
        ALLOCATE( childgrid(1:SIZE( pmc_parent_for_child ) - 1) )
     ENDIF
-
 !
 !-- Get coordinates from all children
@@ -948,5 +856,7 @@
 !--       transfer
           DO  k = 1, nz                 
-             IF ( zw(k) > fval(1) )  THEN
+!AH  Let's try to make the parent-grid arrays higher by one parent dz 
+!AH             IF ( zw(k) > fval(1) )  THEN
+             IF ( zw(k) > fval(1)+dz(1) )  THEN
                 nz_cl = k
                 EXIT
@@ -954,6 +864,11 @@
           ENDDO
 
-          zmax_coarse = fval(1:2)
-          cl_height   = fval(1)
+!AH  Let's make the parent-grid arrays higher by one parent dz 
+!AH          zmax_coarse = fval(1:2)
+!AH          cl_height   = fval(1)
+          zmax_coarse(1) = fval(1) + dz(1)
+          zmax_coarse(2) = fval(2) + dz(1)
+          cl_height   = fval(1) + dz(1)
+!AH
 
 !    
@@ -1008,5 +923,4 @@
 !--       that the top ghost layer of the child grid does not exceed 
 !--       the parent domain top boundary.
-
           IF ( cl_height > zw(nz) ) THEN
              nomatch = 1
@@ -1092,5 +1006,4 @@
 !--    for coupling are stored once into the pmc context. While data transfer, the array do not
 !--    have to be specified again
-
        CALL pmc_s_clear_next_array_list
        DO  WHILE ( pmc_s_getnextarray( child_id, myname ) )
@@ -1118,5 +1031,5 @@
 
 
-   SUBROUTINE pmci_create_index_list
+    SUBROUTINE pmci_create_index_list
 
        IMPLICIT NONE
@@ -1220,4 +1133,6 @@
      END SUBROUTINE pmci_create_index_list
 
+
+
      SUBROUTINE set_child_edge_coords
         IMPLICIT  NONE
@@ -1254,12 +1169,9 @@
  SUBROUTINE pmci_setup_child
 
-
 #if defined( __parallel )
     IMPLICIT NONE
 
-    CHARACTER(LEN=da_namelen) ::  myname     !<
-
-    INTEGER(iwp) ::  i          !<
-    INTEGER(iwp) ::  ierr       !< 
+    CHARACTER(LEN=da_namelen) ::  myname     !< 
+    INTEGER(iwp) ::  ierr       !< MPI error code
     INTEGER(iwp) ::  icl        !< Left index limit for children's parent-grid arrays
     INTEGER(iwp) ::  icla       !< Left index limit for allocation of index-mapping and other auxiliary arrays
@@ -1268,5 +1180,4 @@
     INTEGER(iwp) ::  icra       !< Right index limit for allocation of index-mapping and other auxiliary arrays
     INTEGER(iwp) ::  icrw       !< Right index limit for children's parent-grid work arrays
-    INTEGER(iwp) ::  j          !< 
     INTEGER(iwp) ::  jcn        !< North index limit for children's parent-grid arrays
     INTEGER(iwp) ::  jcna       !< North index limit for allocation of index-mapping and other auxiliary arrays
@@ -1276,7 +1187,5 @@
     INTEGER(iwp) ::  jcsw       !< South index limit for children's parent-grid work arrays
     INTEGER(iwp) ::  n          !< Running index for number of chemical species
-
     INTEGER(iwp), DIMENSION(5) ::  val        !<
-    
     REAL(wp) ::  xcs        !<
     REAL(wp) ::  xce        !<
@@ -1289,11 +1198,10 @@
 !-- Child setup
 !-- Root model does not have a parent and is not a child, therefore no child setup on root model
-
     IF ( .NOT. pmc_is_rootmodel() )  THEN
 
        CALL pmc_childinit
 !
-!--    Here AND ONLY HERE the arrays are defined, which actualy will be
-!--    exchanged between child and parent.
+!--    The arrays, which actually will be exchanged between child and parent
+!--    are defined Here AND ONLY HERE.
 !--    If a variable is removed, it only has to be removed from here.
 !--    Please check, if the arrays are in the list of POSSIBLE exchange arrays
@@ -1382,22 +1290,9 @@
           CALL pmc_recv_from_parent( rans_mode_parent, 1, 0, 19, ierr )
 !
-!
 !--       Receive Coarse grid information.
           CALL pmc_recv_from_parent( parent_grid_info_real,                    &
                                      SIZE(parent_grid_info_real), 0, 21, ierr )
           CALL pmc_recv_from_parent( parent_grid_info_int,  3, 0, 22, ierr )
-!
-!--        Debug-printouts - keep them
-!           WRITE(0,*) 'Coarse grid from parent '
-!           WRITE(0,*) 'startx_tot    = ',parent_grid_info_real(1)
-!           WRITE(0,*) 'starty_tot    = ',parent_grid_info_real(2)
-!           WRITE(0,*) 'endx_tot      = ',parent_grid_info_real(5)
-!           WRITE(0,*) 'endy_tot      = ',parent_grid_info_real(6)
-!           WRITE(0,*) 'dx            = ',parent_grid_info_real(3)
-!           WRITE(0,*) 'dy            = ',parent_grid_info_real(4)
-!           WRITE(0,*) 'dz            = ',parent_grid_info_real(7)
-!           WRITE(0,*) 'nx_coarse     = ',parent_grid_info_int(1)
-!           WRITE(0,*) 'ny_coarse     = ',parent_grid_info_int(2)
-!           WRITE(0,*) 'nz_coarse     = ',parent_grid_info_int(3)
+
        ENDIF
 
@@ -1416,5 +1311,4 @@
        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) )
@@ -1469,22 +1363,8 @@
        CALL pmc_c_setind_and_allocmem
 !
-!--    Precompute interpolation coefficients and child-array indices
-       CALL pmci_init_interp_tril
-!
-!--    Precompute the log-law correction index- and ratio-arrays 
-       IF ( constant_flux_layer )  THEN
-          CALL pmci_init_loglaw_correction
-       ENDIF
-!
-!--    Two-way coupling for general and vertical nesting.
-!--    Precompute the index arrays and relaxation functions for the
-!--    anterpolation
-!
-!--    Note that the anterpolation index bounds are needed also in case
-!--    of one-way coupling because of the reversibility correction
-!--    included in the interpolation algorithms.
-       CALL pmci_init_anterp_tophat
-!
-!--    Check that the child and parent grid lines match 
+!--    Precompute the index-mapping arrays
+       CALL pmci_define_index_mapping
+!
+!--    Check that the child and parent grid lines do match 
        CALL pmci_check_grid_matching 
 
@@ -1502,5 +1382,4 @@
        INTEGER(iwp), DIMENSION(5,numprocs) ::  coarse_bound_all   !<
        INTEGER(iwp), DIMENSION(2)          ::  size_of_array      !<
-                                   
        INTEGER(iwp) :: i        !< 
        INTEGER(iwp) :: iauxl    !<
@@ -1515,60 +1394,4 @@
        REAL(wp) ::  yexn        !< Parent-grid array exceedance behind the north edge of the child PE subdomain
 
-!AH!
-!AH!--    If the fine- and coarse grid nodes do not match:
-!AH       loffset = MOD( coord_x(nxl), cg%dx )
-!AH       xexl    = cg%dx + loffset
-!AH       xcs  = coord_x(nxl) - xexl
-!AH       DO  i = 0, cg%nx
-!AH          IF ( cg%coord_x(i) > xcs )  THEN
-!AH             icl = MAX( -1, i-1 )
-!AH             EXIT
-!AH          ENDIF
-!AH       ENDDO
-!AH!
-!AH!--    If the fine- and coarse grid nodes do not match
-!AH       roffset = MOD( coord_x(nxr+1), cg%dx )
-!AH       xexr    = cg%dx + roffset
-!AH       xce  = coord_x(nxr+1)
-!AH       IF ( nxr == nx )  THEN
-!AH          xce = xce + xexr
-!AH       ENDIF
-!AH       DO  i = cg%nx, 0 , -1
-!AH          IF ( cg%coord_x(i) < xce )  THEN
-!AH             icr = MIN( cg%nx+1, i+1 )
-!AH             EXIT
-!AH          ENDIF
-!AH       ENDDO
-!AH!
-!AH!--    If the fine- and coarse grid nodes do not match
-!AH       soffset = MOD( coord_y(nys), cg%dy )
-!AH       yexs    = cg%dy + soffset
-!AH       ycs  = coord_y(nys) - yexs
-!AH       DO  j = 0, cg%ny
-!AH          IF ( cg%coord_y(j) > ycs )  THEN
-!AH             jcs = MAX( -nbgp, j-1 )
-!AH             EXIT
-!AH          ENDIF
-!AH       ENDDO
-!AH!
-!AH!--    If the fine- and coarse grid nodes do not match
-!AH       noffset = MOD( coord_y(nyn+1), cg%dy )
-!AH       yexn    = cg%dy + noffset
-!AH       yce  = coord_y(nyn+1)
-!AH       IF ( nyn == ny )  THEN
-!AH          yce = yce + yexn
-!AH       ENDIF
-!AH       DO  j = cg%ny, 0, -1
-!AH          IF ( cg%coord_y(j) < yce )  THEN
-!AH             jcn = MIN( cg%ny + nbgp, j+1 )
-!AH             EXIT
-!AH          ENDIF
-!AH       ENDDO
-!AH
-!AH       coarse_bound(1) = icl
-!AH       coarse_bound(2) = icr
-!AH       coarse_bound(3) = jcs
-!AH       coarse_bound(4) = jcn
-!AH       coarse_bound(5) = myid
 !
 !--    Determine the anterpolation index limits. If at least half of the 
@@ -1578,5 +1401,4 @@
 !--    anterpolation domain, or not included at all if we are at the outer 
 !--    edge of the child domain.
-
 !
 !--    Left
@@ -1698,1784 +1520,43 @@
     END SUBROUTINE pmci_map_fine_to_coarse_grid
 
-
-
-    SUBROUTINE pmci_init_interp_tril
-!
-!--    Precomputation of the interpolation coefficients and child-array indices
-!--    to be used by the interpolation routines interp_tril_lr, interp_tril_ns
-!--    and interp_tril_t.
+     
+      
+    SUBROUTINE pmci_define_index_mapping
+!
+!--    Precomputation of the mapping of the child- and parent-grid indices.
 
        IMPLICIT NONE
 
-       INTEGER(iwp) ::  acsize   !< Maximum dimension of anterpolation cell.
-       INTEGER(iwp) ::  i        !< Child-grid i-index
-       INTEGER(iwp) ::  ierr     !< MPI error code
-       INTEGER(iwp) ::  j        !< Child-grid j-index
-       INTEGER(iwp) ::  k        !< Child-grid k-index
-       INTEGER(iwp) ::  kc       !< 
-       INTEGER(iwp) ::  kdzo     !<
-       INTEGER(iwp) ::  kdzw     !<
-       INTEGER(iwp) ::  moff     !< Parent-grid bound offset in j-direction
-       INTEGER(iwp) ::  loff     !< Parent-grid bound offset in i-direction
-
-       REAL(wp) ::  dzmin        !<
-       REAL(wp) ::  parentdzmax  !<
-       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         !<
-      
-       
-!AH
+       INTEGER(iwp) ::  i         !< Child-grid index
+       INTEGER(iwp) ::  ii        !< Parent-grid index
+       INTEGER(iwp) ::  istart    !<
+       INTEGER(iwp) ::  ir        !<
+       INTEGER(iwp) ::  iw        !< Child-grid index limited to -1 <= iw <= nx+1
+       INTEGER(iwp) ::  j         !< Child-grid index
+       INTEGER(iwp) ::  jj        !< Parent-grid index
+       INTEGER(iwp) ::  jstart    !<
+       INTEGER(iwp) ::  jr        !<
+       INTEGER(iwp) ::  jw        !< Child-grid index limited to -1 <= jw <= ny+1
+       INTEGER(iwp) ::  k         !< Child-grid index
+       INTEGER(iwp) ::  kk        !< Parent-grid index
+       INTEGER(iwp) ::  kstart    !<
+       INTEGER(iwp) ::  kw        !< Child-grid index limited to kw <= nzt+1
+       REAL(wp)     ::  tolerance !<
+     
 !
 !--    Allocate child-grid work arrays for interpolation.
-       CALL pmci_allocate_finegrid_workarrays
+       igsr = NINT( cg%dx / dx, iwp )
+       jgsr = NINT( cg%dy / dy, iwp )
+       kgsr = NINT( cg%dzw(1) / dzw(1), iwp )
+       WRITE(9,"('igsr, jgsr, kgsr: ',3(i3,2x))") igsr, jgsr, kgsr
+       FLUSH(9)
 !       
 !--    Determine index bounds for the parent-grid work arrays for
 !--    interpolation and allocate them.
-       CALL pmci_allocate_coarsegrid_workarrays
+       CALL pmci_allocate_workarrays
 !       
 !--    Define the MPI-datatypes for parent-grid work array 
 !--    exchange between the PE-subdomains.
-       CALL pmci_create_coarsegrid_workarray_exchange_datatypes
-!
-!--    Determine index bounds for the fine-to-coarse grid index mapping arrays 
-!--    and interpolation-coefficient arrays and allocate them.       
-       CALL pmci_allocate_fine_to_coarse_mapping_arrays
-!AH       
-!
-       xb   = nxl * dx
-       IF  ( bc_dirichlet_l )  THEN
-          loff = 2
-       ELSE
-          loff = 0
-       ENDIF
-!AH       DO  i = nxlg, nxrg
-       DO  i = nxl-1, nxr+1
-          xfsu    = coord_x(i) - ( lower_left_coord_x + xb )
-          xfso    = coord_x(i) + 0.5_wp * dx - ( lower_left_coord_x + xb )
-!
-!--       icl points to 2 parent-grid cells left form the left nest boundary,
-!--       thence icl + loff points to the left nest boundary.
-          icu(i)  = icl + loff + FLOOR( xfsu / cg%dx )
-          ico(i)  = icl + loff + FLOOR( ( xfso - 0.5_wp * cg%dx ) / cg%dx )
-          xcsu    = ( icu(i) - ( icl + loff ) ) * cg%dx
-          xcso    = ( ico(i) - ( icl + loff ) + 0.5_wp ) * cg%dx
-          r2xu(i) = ( xfsu - xcsu ) / cg%dx
-          r2xo(i) = ( xfso - xcso ) / cg%dx
-          r1xu(i) = 1.0_wp - r2xu(i)
-          r1xo(i) = 1.0_wp - r2xo(i)
-       ENDDO
-!       
-!--    Fill up the values behind nest boundaries by copying from inside 
-!--    the domain.
-       IF  ( bc_dirichlet_l )  THEN
-          icu(nxlfc:nxl-1)  = icu(nxlfc+igsr:nxl-1+igsr) - 1
-          r1xu(nxlfc:nxl-1) = r1xu(nxlfc+igsr:nxl-1+igsr)
-          r2xu(nxlfc:nxl-1) = r2xu(nxlfc+igsr:nxl-1+igsr)
-          ico(nxlfc:nxl-1)  = ico(nxlfc+igsr:nxl-1+igsr) - 1
-          r1xo(nxlfc:nxl-1) = r1xo(nxlfc+igsr:nxl-1+igsr)
-          r2xo(nxlfc:nxl-1) = r2xo(nxlfc+igsr:nxl-1+igsr)
-       ENDIF
-       
-       IF  ( bc_dirichlet_r )  THEN
-          icu(nxr+1:nxrfc)  = icu(nxr+1-igsr:nxrfc-igsr) + 1
-          r1xu(nxr+1:nxrfc) = r1xu(nxr+1-igsr:nxrfc-igsr)
-          r2xu(nxr+1:nxrfc) = r2xu(nxr+1-igsr:nxrfc-igsr)
-          ico(nxr+1:nxrfc)  = ico(nxr+1-igsr:nxrfc-igsr) + 1
-          r1xo(nxr+1:nxrfc) = r1xo(nxr+1-igsr:nxrfc-igsr)
-          r2xo(nxr+1:nxrfc) = r2xo(nxr+1-igsr:nxrfc-igsr)
-       ENDIF
-!
-!--    Print out the indices and coefficients for checking and debugging purposes
-       DO  i = nxlfc, nxrfc
-          WRITE(9,"('pmci_init_interp_tril: i, icu, r1xu r2xu ', 2(i4,2x),2(e12.5,2x))") &
-               i, icu(i), r1xu(i), r2xu(i)
-          FLUSH(9)
-       ENDDO
-       WRITE(9,*)
-       DO  i = nxlfc, nxrfc
-          WRITE(9,"('pmci_init_interp_tril: i, ico, r1xo r2xo ', 2(i4,2x),2(e12.5,2x))") &
-               i, ico(i), r1xo(i), r2xo(i)
-          FLUSH(9)
-       ENDDO
-       WRITE(9,*)
-
-       yb   = nys * dy
-       IF  ( bc_dirichlet_s )  THEN
-          moff = 2
-       ELSE
-          moff = 0
-       ENDIF
-!AH       DO  j = nysg, nyng
-       DO  j = nys-1, nyn+1
-          yfsv    = coord_y(j) - ( lower_left_coord_y + yb )
-          yfso    = coord_y(j) + 0.5_wp * dy - ( lower_left_coord_y + yb )
-!
-!--       jcs points to 2 parent-grid cells south form the south nest boundary,
-!--       thence jcs + moff points to the south nest boundary.
-          jcv(j)  = jcs + moff + FLOOR( yfsv / cg%dy )
-          jco(j)  = jcs + moff + FLOOR( ( yfso - 0.5_wp * cg%dy ) / cg%dy )
-          ycsv    = ( jcv(j) - ( jcs + moff ) ) * cg%dy
-          ycso    = ( jco(j) - ( jcs + moff ) + 0.5_wp ) * cg%dy
-          r2yv(j) = ( yfsv - ycsv ) / cg%dy
-          r2yo(j) = ( yfso - ycso ) / cg%dy
-          r1yv(j) = 1.0_wp - r2yv(j)
-          r1yo(j) = 1.0_wp - r2yo(j)
-       ENDDO
-!       
-!--    Fill up the values behind nest boundaries by copying from inside 
-!--    the domain.
-       IF  ( bc_dirichlet_s )  THEN
-          jcv(nysfc:nys-1)  = jcv(nysfc+jgsr:nys-1+jgsr) - 1
-          r1yv(nysfc:nys-1) = r1yv(nysfc+jgsr:nys-1+jgsr)
-          r2yv(nysfc:nys-1) = r2yv(nysfc+jgsr:nys-1+jgsr)
-          jco(nysfc:nys-1)  = jco(nysfc+jgsr:nys-1+jgsr) - 1
-          r1yo(nysfc:nys-1) = r1yo(nysfc+jgsr:nys-1+jgsr)
-          r2yo(nysfc:nys-1) = r2yo(nysfc+jgsr:nys-1+jgsr)
-       ENDIF
-       
-       IF  ( bc_dirichlet_n )  THEN
-          jcv(nyn+1:nynfc)  = jcv(nyn+1-jgsr:nynfc-jgsr) + 1
-          r1yv(nyn+1:nynfc) = r1yv(nyn+1-jgsr:nynfc-jgsr)
-          r2yv(nyn+1:nynfc) = r2yv(nyn+1-jgsr:nynfc-jgsr)
-          jco(nyn+1:nynfc)  = jco(nyn+1-jgsr:nynfc-jgsr) + 1
-          r1yo(nyn+1:nynfc) = r1yo(nyn+1-jgsr:nynfc-jgsr)
-          r2yo(nyn+1:nynfc) = r2yo(nyn+1-jgsr:nynfc-jgsr)
-       ENDIF
-!
-!--    Print out the indices and coefficients for checking and debugging purposes
-       DO  j = nysfc, nynfc
-          WRITE(9,"('pmci_init_interp_tril: j, jcv, r1yv r2yv ', 2(i4,2x),2(e12.5,2x))") &
-               j, jcv(j), r1yv(j), r2yv(j)
-          FLUSH(9)
-       ENDDO
-       WRITE(9,*)
-       DO  j = nysfc, nynfc
-          WRITE(9,"('pmci_init_interp_tril: j, jco, r1yo r2yo ', 2(i4,2x),2(e12.5,2x))") &
-               j, jco(j), r1yo(j), r2yo(j)
-          FLUSH(9)
-       ENDDO
-       WRITE(9,*)
-
-       DO  k = nzb, nzt + 1
-          zfsw = zw(k)
-          zfso = zu(k)
-
-          DO kc = 0, cg%nz+1
-             IF ( cg%zw(kc) > zfsw )  EXIT
-          ENDDO
-          kcw(k) = kc - 1
-          
-          DO kc = 0, cg%nz+1
-             IF ( cg%zu(kc) > zfso )  EXIT
-          ENDDO
-          kco(k) = kc - 1
-
-          zcsw    = cg%zw(kcw(k))
-          zcso    = cg%zu(kco(k))
-          kdzw    = MIN( kcw(k)+1, cg%nz+1 )
-          kdzo    = MIN( kco(k)+1, cg%nz+1 )
-          r2zw(k) = ( zfsw - zcsw ) / cg%dzw(kdzw)
-          r2zo(k) = ( zfso - zcso ) / cg%dzu(kdzo)
-          r1zw(k) = 1.0_wp - r2zw(k)
-          r1zo(k) = 1.0_wp - r2zo(k)
-       ENDDO
-!
-!--    Set the interpolation index- and coefficient-information to the 
-!--    child-grid cells within the uppermost parent-grid cell. This 
-!--    information is only needed for the reversibility correction.   
-       kco(nzt+2:nzt+kgsr)  = kco(nzt+1) + 1 
-       r1zo(nzt+2:nzt+kgsr) = r1zo(nzt+2-kgsr:nzt)
-       r2zo(nzt+2:nzt+kgsr) = r2zo(nzt+2-kgsr:nzt)
-! 
-!--    kcw, r1zw and r2zw are not needed when k > nzt+1
-       kcw(nzt+2:nzt+kgsr)  = 0
-       r1zw(nzt+2:nzt+kgsr) = 0.0_wp
-       r2zw(nzt+2:nzt+kgsr) = 0.0_wp
-!
-!--    Print out the indices and coefficients for checking and debugging purposes
-       DO  k = nzb, nzt+1
-          WRITE(9,"('pmci_init_interp_tril: k, kcw, r1zw r2zw ', 2(i4,2x),2(e12.5,2x))") &
-               k, kcw(k), r1zw(k), r2zw(k)
-          FLUSH(9)
-       ENDDO
-       WRITE(9,*)
-       DO  k = nzb, nzt + kgsr
-          WRITE(9,"('pmci_init_interp_tril: k, kco, r1zo r2zo ', 2(i4,2x),2(e12.5,2x))") &
-               k, kco(k), r1zo(k), r2zo(k)
-          FLUSH(9)
-       ENDDO
-       WRITE(9,*)
-!
-!--    Determine the maximum dimension of anterpolation cells and allocate the
-!--    work array celltmpd needed in the reversibility correction in the 
-!--    interpolation
-       dzmin = 999999.9_wp
-       DO k = 1, nzt+1
-          dzmin = MIN( dzmin, dzu(k), dzw(k) )
-       ENDDO
-       parentdzmax = 0.0_wp
-       DO k = 1, cg%nz+1
-          parentdzmax = MAX(parentdzmax , cg%dzu(k), cg%dzw(k) )
-       ENDDO
-       acsize = CEILING( cg%dx / dx ) * CEILING( cg%dy / dy ) *                 &
-            CEILING( parentdzmax / dzmin )
-       ALLOCATE( celltmpd(1:acsize) )
-
-    END SUBROUTINE pmci_init_interp_tril
-    
-
-
-    SUBROUTINE pmci_allocate_finegrid_workarrays
-!
-!--    Allocate child-grid work-arrays for interpolation
-       IMPLICIT NONE
-
-
-       igsr = NINT( cg%dx / dx, iwp )
-       jgsr = NINT( cg%dy / dy, iwp )
-       kgsr = NINT( cg%dzw(1) / dzw(1), iwp )
-       write(9,"('igsr, jgsr, kgsr: ',3(i3,2x))") igsr, jgsr, kgsr
-       flush(9)
-!       
-!--    Note that i-indexing for workarr_lr runs from 0 to igsr-1.
-!--    For u, only 0-element is used and all elements 0:igsr-1
-!--    are used for all other variables.
-       ALLOCATE( workarr_lr(nzb:nzt+1,nysg:nyng,0:igsr-1) )
-!       
-!--    Note that j-indexing for workarr_sn runs from 0 to jgsr-1.
-!--    For v, only 0-element is used and all elements 0:jgsr-1
-!--    are used for all other variables.
-       ALLOCATE( workarr_sn(nzb:nzt+1,0:jgsr-1,nxlg:nxrg) )
-!
-!--    Note that genuine k-indexing is used for workarr_t.
-!--    Only nzt-element is used for w and elements nzt+1:nzt+kgsr
-!--    are used for all other variables. 
-       ALLOCATE( workarr_t(nzt:nzt+kgsr,nysg:nyng,nxlg:nxrg) )
-
-    END SUBROUTINE pmci_allocate_finegrid_workarrays
-
-
-
-    SUBROUTINE pmci_allocate_coarsegrid_workarrays
-!
-!--    Allocate parent-grid work-arrays for interpolation
-       IMPLICIT NONE
-
-!
-!--    Determine and store the PE-subdomain dependent index bounds
-       IF  ( bc_dirichlet_l )  THEN
-          iclw = icl + 1
-       ELSE
-          iclw = icl - 1
-       ENDIF
-
-       IF  ( bc_dirichlet_r )  THEN
-          icrw = icr - 1
-       ELSE
-          icrw = icr + 1
-       ENDIF
-
-       IF  ( bc_dirichlet_s )  THEN
-          jcsw = jcs + 1
-       ELSE
-          jcsw = jcs - 1
-       ENDIF
-
-       IF  ( bc_dirichlet_n )  THEN
-          jcnw = jcn - 1
-       ELSE
-          jcnw = jcn + 1
-       ENDIF
-    
-       coarse_bound_w(1) = iclw
-       coarse_bound_w(2) = icrw
-       coarse_bound_w(3) = jcsw
-       coarse_bound_w(4) = jcnw
-!
-!--    Left and right boundaries.
-       ALLOCATE( workarrc_lr(0:cg%nz+1,jcsw:jcnw,0:2) )
-!
-!--    South and north boundaries.
-       ALLOCATE( workarrc_sn(0:cg%nz+1,0:2,iclw:icrw) )
-!
-!--    Top boundary.
-       ALLOCATE( workarrc_t(0:2,jcsw:jcnw,iclw:icrw) )
-
-    END SUBROUTINE pmci_allocate_coarsegrid_workarrays
-
-
-
-    SUBROUTINE pmci_create_coarsegrid_workarray_exchange_datatypes
-!
-!--    Define specific MPI types for workarrc-exhchange.
-       IMPLICIT NONE
-
-#if defined( __parallel )       
-!
-!--    For the left and right boundaries
-       CALL MPI_TYPE_VECTOR( 3, cg%nz+2, (jcnw-jcsw+1)*(cg%nz+2), MPI_REAL,     &
-            workarrc_lr_exchange_type, ierr )
-       CALL MPI_TYPE_COMMIT( workarrc_lr_exchange_type, ierr )
-!
-!--    For the south and north boundaries
-       CALL MPI_TYPE_VECTOR( 1, 3*(cg%nz+2), 3*(cg%nz+2), MPI_REAL,             &
-            workarrc_sn_exchange_type, ierr )
-       CALL MPI_TYPE_COMMIT( workarrc_sn_exchange_type, ierr )
-!
-!--    For the top-boundary x-slices
-       CALL MPI_TYPE_VECTOR( icrw-iclw+1, 3, 3*(jcnw-jcsw+1), MPI_REAL,         &
-            workarrc_t_exchange_type_x, ierr )
-       CALL MPI_TYPE_COMMIT( workarrc_t_exchange_type_x, ierr )
-!
-!--    For the top-boundary y-slices
-       CALL MPI_TYPE_VECTOR( 1, 3*(jcnw-jcsw+1), 3*(jcnw-jcsw+1), MPI_REAL,         &
-            workarrc_t_exchange_type_y, ierr )
-       CALL MPI_TYPE_COMMIT( workarrc_t_exchange_type_y, ierr )
-#endif
-       
-    END SUBROUTINE pmci_create_coarsegrid_workarray_exchange_datatypes
-
-
-
-    SUBROUTINE pmci_allocate_fine_to_coarse_mapping_arrays
-!
-!--    Define index limits and allocate the fine-to-coarse grid index mapping 
-!--    arrays and interpolation coefficient arrays.      
-       IMPLICIT NONE
-
-       
-       IF  ( bc_dirichlet_l )  THEN
-!AH          nxlfc = MIN( nxl-igsr, nxlg )          
-          nxlfc = nxl - igsr
-       ELSE
-!AH          nxlfc = nxlg
-          nxlfc = nxl - 1
-       ENDIF
-       IF  ( bc_dirichlet_r )  THEN
-!AH          nxrfc = MAX( nxr+igsr, nxrg )
-          nxrfc = nxr + igsr
-       ELSE
-!AH          nxrfc = nxrg
-          nxrfc = nxr + 1          
-       ENDIF
-
-       IF  ( bc_dirichlet_s )  THEN
-!AH          nysfc = MIN( nys-jgsr, nysg )
-          nysfc = nys - jgsr
-       ELSE
-!AH          nysfc = nysg
-          nysfc = nys - 1
-       ENDIF
-       IF  ( bc_dirichlet_n )  THEN
-!AH          nynfc = MAX( nyn+jgsr, nyng )
-          nynfc = nyn + jgsr
-       ELSE
-!AH          nynfc = nyng          
-          nynfc = nyn + 1          
-       ENDIF
-
-       ALLOCATE( icu(nxlfc:nxrfc) )       
-       ALLOCATE( ico(nxlfc:nxrfc) )
-       ALLOCATE( jcv(nysfc:nynfc) )
-       ALLOCATE( jco(nysfc:nynfc) )
-       ALLOCATE( kcw(nzb:nzt+kgsr) )
-       ALLOCATE( kco(nzb:nzt+kgsr) )
-
-       ALLOCATE( r1xu(nxlfc:nxrfc) )
-       ALLOCATE( r2xu(nxlfc:nxrfc) )
-       ALLOCATE( r1xo(nxlfc:nxrfc) )
-       ALLOCATE( r2xo(nxlfc:nxrfc) )
-       ALLOCATE( r1yv(nysfc:nynfc) )
-       ALLOCATE( r2yv(nysfc:nynfc) )
-       ALLOCATE( r1yo(nysfc:nynfc) )
-       ALLOCATE( r2yo(nysfc:nynfc) )
-       ALLOCATE( r1zw(nzb:nzt+kgsr) )
-       ALLOCATE( r2zw(nzb:nzt+kgsr) )
-       ALLOCATE( r1zo(nzb:nzt+kgsr) )
-       ALLOCATE( r2zo(nzb:nzt+kgsr) )
-
-    END SUBROUTINE pmci_allocate_fine_to_coarse_mapping_arrays
-
-     
-       
-    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.
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  direction      !< Wall normal index: 1=k, 2=j, 3=i.
-       INTEGER(iwp) ::  dum            !< dummy value for reduce operation
-       INTEGER(iwp) ::  i              !<
-       INTEGER(iwp) ::  ierr           !< MPI status
-       INTEGER(iwp) ::  inc            !< Wall outward-normal index increment -1
-                                       !< or 1, for direction=1, inc=1 always
-       INTEGER(iwp) ::  j              !<
-       INTEGER(iwp) ::  k              !<
-       INTEGER(iwp) ::  k_wall_u_ji    !< topography top index on u-grid
-       INTEGER(iwp) ::  k_wall_u_ji_p  !< topography top index on u-grid
-       INTEGER(iwp) ::  k_wall_u_ji_m  !< topography top index on u-grid
-       INTEGER(iwp) ::  k_wall_v_ji    !< topography top index on v-grid
-       INTEGER(iwp) ::  k_wall_v_ji_p  !< topography top index on v-grid
-       INTEGER(iwp) ::  k_wall_v_ji_m  !< topography top index on v-grid
-       INTEGER(iwp) ::  k_wall_w_ji    !< topography top index on w-grid
-       INTEGER(iwp) ::  k_wall_w_ji_p  !< topography top index on w-grid
-       INTEGER(iwp) ::  k_wall_w_ji_m  !< topography top index on w-grid
-       INTEGER(iwp) ::  kb             !<
-       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)     ::  z0_topo      !<  roughness at vertical walls
-       REAL(wp), ALLOCATABLE, DIMENSION(:) ::  lcr   !<
-
-!
-!--    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 ( bc_dirichlet_l )  THEN
-          DO  i = nxl-1, nxl
-             DO  j = nys, nyn
-!
-!--             Concept need to be reconsidered for 3D-topography
-!--             Determine largest topography index on scalar grid
-                nzt_topo_nestbc_l = MAX( nzt_topo_nestbc_l,                    &
-                                    get_topography_top_index_ji( j, i, 's' ) )
-!
-!--             Determine largest topography index on u grid
-                nzt_topo_nestbc_l = MAX( nzt_topo_nestbc_l,                    &
-                                    get_topography_top_index_ji( j, i, 'u' ) )
-!
-!--             Determine largest topography index on v grid
-                nzt_topo_nestbc_l = MAX( nzt_topo_nestbc_l,                    &
-                                    get_topography_top_index_ji( j, i, 'v' ) )
-!
-!--             Determine largest topography index on w grid
-                nzt_topo_nestbc_l = MAX( nzt_topo_nestbc_l,                    &
-                                    get_topography_top_index_ji( j, i, 'w' ) )
-             ENDDO
-          ENDDO
-          nzt_topo_nestbc_l = nzt_topo_nestbc_l + 1
-       ENDIF
-      
-       nzt_topo_nestbc_r = nzb
-       IF ( bc_dirichlet_r )  THEN
-          i = nxr + 1
-          DO  j = nys, nyn
-!
-!--             Concept need to be reconsidered for 3D-topography
-!--             Determine largest topography index on scalar grid
-                nzt_topo_nestbc_r = MAX( nzt_topo_nestbc_r,                    &
-                                    get_topography_top_index_ji( j, i, 's' ) )
-!
-!--             Determine largest topography index on u grid
-                nzt_topo_nestbc_r = MAX( nzt_topo_nestbc_r,                    &
-                                    get_topography_top_index_ji( j, i, 'u' ) )
-!
-!--             Determine largest topography index on v grid
-                nzt_topo_nestbc_r = MAX( nzt_topo_nestbc_r,                    &
-                                    get_topography_top_index_ji( j, i, 'v' ) )
-!
-!--             Determine largest topography index on w grid
-                nzt_topo_nestbc_r = MAX( nzt_topo_nestbc_r,                    &
-                                    get_topography_top_index_ji( j, i, 'w' ) )
-          ENDDO
-          nzt_topo_nestbc_r = nzt_topo_nestbc_r + 1
-       ENDIF
-
-       nzt_topo_nestbc_s = nzb
-       IF ( bc_dirichlet_s )  THEN
-          DO  j = nys-1, nys
-             DO  i = nxl, nxr
-!
-!--             Concept need to be reconsidered for 3D-topography
-!--             Determine largest topography index on scalar grid
-                nzt_topo_nestbc_s = MAX( nzt_topo_nestbc_s,                    &
-                                    get_topography_top_index_ji( j, i, 's' ) )
-!
-!--             Determine largest topography index on u grid
-                nzt_topo_nestbc_s = MAX( nzt_topo_nestbc_s,                    &
-                                    get_topography_top_index_ji( j, i, 'u' ) )
-!
-!--             Determine largest topography index on v grid
-                nzt_topo_nestbc_s = MAX( nzt_topo_nestbc_s,                    &
-                                    get_topography_top_index_ji( j, i, 'v' ) )
-!
-!--             Determine largest topography index on w grid
-                nzt_topo_nestbc_s = MAX( nzt_topo_nestbc_s,                    &
-                                    get_topography_top_index_ji( j, i, 'w' ) )
-             ENDDO
-          ENDDO
-          nzt_topo_nestbc_s = nzt_topo_nestbc_s + 1
-       ENDIF
-
-       nzt_topo_nestbc_n = nzb
-       IF ( bc_dirichlet_n )  THEN
-          j = nyn + 1
-          DO  i = nxl, nxr
-!
-!--             Concept need to be reconsidered for 3D-topography
-!--             Determine largest topography index on scalar grid
-                nzt_topo_nestbc_n = MAX( nzt_topo_nestbc_n,                    &
-                                    get_topography_top_index_ji( j, i, 's' ) )
-!
-!--             Determine largest topography index on u grid
-                nzt_topo_nestbc_n = MAX( nzt_topo_nestbc_n,                    &
-                                    get_topography_top_index_ji( j, i, 'u' ) )
-!
-!--             Determine largest topography index on v grid
-                nzt_topo_nestbc_n = MAX( nzt_topo_nestbc_n,                    &
-                                    get_topography_top_index_ji( j, i, 'v' ) )
-!
-!--             Determine largest topography index on w grid
-                nzt_topo_nestbc_n = MAX( nzt_topo_nestbc_n,                    &
-                                    get_topography_top_index_ji( j, i, 'w' ) )
-          ENDDO
-          nzt_topo_nestbc_n = nzt_topo_nestbc_n + 1
-       ENDIF
-
-#if defined( __parallel )
-!
-!--       Determine global topography-top index along child boundary. 
-          dum = nzb
-          CALL MPI_ALLREDUCE( nzt_topo_nestbc_l, dum, 1, MPI_INTEGER,          &
-                              MPI_MAX, comm1dy, ierr )
-          nzt_topo_nestbc_l = dum
-
-          dum = nzb
-          CALL MPI_ALLREDUCE( nzt_topo_nestbc_r, dum, 1, MPI_INTEGER,          &
-                              MPI_MAX, comm1dy, ierr )
-          nzt_topo_nestbc_r = dum
-
-          dum = nzb
-          CALL MPI_ALLREDUCE( nzt_topo_nestbc_n, dum, 1, MPI_INTEGER,          &
-                              MPI_MAX, comm1dx, ierr )
-          nzt_topo_nestbc_n = dum
-
-          dum = nzb
-          CALL MPI_ALLREDUCE( nzt_topo_nestbc_s, dum, 1, MPI_INTEGER,          &
-                              MPI_MAX, comm1dx, ierr )
-          nzt_topo_nestbc_s = dum
-#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 )
-!
-!--    Note that the outer division must be integer division.
-       ni = CEILING( cg%dx / dx ) / 2
-       nj = CEILING( cg%dy / dy ) / 2
-       nk = 1
-       DO  k = 1, nzt_topo_max
-          nk = MAX( nk, CEILING( cg%dzu(kco(k)+1) / 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
-
-       z0_topo = roughness_length
-!
-!--    First horizontal walls. Note that also logc_w_? and logc_ratio_w_? and
-!--    logc_kbounds_* need to be allocated and initialized here.
-!--    Left boundary
-       IF ( bc_dirichlet_l )  THEN
-
-          ALLOCATE( logc_u_l(1:2,nzb:nzt_topo_nestbc_l,nys:nyn) )
-          ALLOCATE( logc_v_l(1:2,nzb:nzt_topo_nestbc_l,nys:nyn) )
-          ALLOCATE( logc_w_l(1:2,nzb:nzt_topo_nestbc_l,nys:nyn) )
-          ALLOCATE( logc_kbounds_u_l(1:2,nys:nyn) )
-          ALLOCATE( logc_kbounds_v_l(1:2,nys:nyn) )
-          ALLOCATE( logc_kbounds_w_l(1:2,nys:nyn) )
-          ALLOCATE( logc_ratio_u_l(1:2,0:ncorr-1,nzb:nzt_topo_nestbc_l,nys:nyn) )
-          ALLOCATE( logc_ratio_v_l(1:2,0:ncorr-1,nzb:nzt_topo_nestbc_l,nys:nyn) )
-          ALLOCATE( logc_ratio_w_l(1:2,0:ncorr-1,nzb:nzt_topo_nestbc_l,nys:nyn) )
-          logc_u_l       = 0
-          logc_v_l       = 0
-          logc_w_l       = 0
-          logc_ratio_u_l = 1.0_wp
-          logc_ratio_v_l = 1.0_wp
-          logc_ratio_w_l = 1.0_wp
-          direction      = 1
-          inc            = 1
-
-          DO  j = nys, nyn
-!
-!--          Left boundary for u
-             i   = 0
-!
-!--          For loglaw correction the roughness z0 is required. z0, however, 
-!--          is part of the surfacetypes now. Set default roughness instead. 
-!--          Determine topography top index on u-grid
-             kb  = get_topography_top_index_ji( j, i, 'u' )
-             k   = kb + 1
-             wall_index = kb
-
-             CALL pmci_define_loglaw_correction_parameters( lc, lcr, k,        &
-                            j, inc, wall_index, z0_topo,                       &
-                            kb, direction, ncorr )
-
-             logc_u_l(1,k,j) = lc
-             logc_ratio_u_l(1,0:ncorr-1,k,j) = lcr(0:ncorr-1)
-             lcr(0:ncorr-1) = 1.0_wp
-!
-!--          Left boundary for v
-             i   = -1
-!
-!--          Determine topography top index on v-grid
-             kb  = get_topography_top_index_ji( j, i, 'v' )
-             k   = kb + 1
-             wall_index = kb
-
-             CALL pmci_define_loglaw_correction_parameters( lc, lcr, k,        &
-                            j, inc, wall_index, z0_topo,                       &
-                            kb, direction, ncorr )
-
-             logc_v_l(1,k,j) = lc
-             logc_ratio_v_l(1,0:ncorr-1,k,j) = lcr(0:ncorr-1)
-             lcr(0:ncorr-1) = 1.0_wp
-
-          ENDDO
-
-       ENDIF
-!
-!--    Right boundary
-       IF ( bc_dirichlet_r )  THEN
-           
-          ALLOCATE( logc_u_r(1:2,nzb:nzt_topo_nestbc_r,nys:nyn) )
-          ALLOCATE( logc_v_r(1:2,nzb:nzt_topo_nestbc_r,nys:nyn) )
-          ALLOCATE( logc_w_r(1:2,nzb:nzt_topo_nestbc_r,nys:nyn) )          
-          ALLOCATE( logc_kbounds_u_r(1:2,nys:nyn) )
-          ALLOCATE( logc_kbounds_v_r(1:2,nys:nyn) )
-          ALLOCATE( logc_kbounds_w_r(1:2,nys:nyn) )
-          ALLOCATE( logc_ratio_u_r(1:2,0:ncorr-1,nzb:nzt_topo_nestbc_r,nys:nyn) )
-          ALLOCATE( logc_ratio_v_r(1:2,0:ncorr-1,nzb:nzt_topo_nestbc_r,nys:nyn) )
-          ALLOCATE( logc_ratio_w_r(1:2,0:ncorr-1,nzb:nzt_topo_nestbc_r,nys:nyn) )
-          logc_u_r       = 0
-          logc_v_r       = 0
-          logc_w_r       = 0
-          logc_ratio_u_r = 1.0_wp
-          logc_ratio_v_r = 1.0_wp
-          logc_ratio_w_r = 1.0_wp
-          direction      = 1
-          inc            = 1
-
-          DO  j = nys, nyn
-!
-!--          Right boundary for u
-             i   = nxr + 1
-!
-!--          For loglaw correction the roughness z0 is required. z0, however, 
-!--          is part of the surfacetypes now, so call subroutine according
-!--          to the present surface tpye. 
-!--          Determine topography top index on u-grid
-             kb  = get_topography_top_index_ji( j, i, 'u' )
-             k   = kb + 1
-             wall_index = kb
-
-             CALL pmci_define_loglaw_correction_parameters( lc, lcr, k,        &
-                                                 j, inc, wall_index, z0_topo,  &
-                                                 kb, direction, ncorr )
-
-             logc_u_r(1,k,j) = lc
-             logc_ratio_u_r(1,0:ncorr-1,k,j) = lcr(0:ncorr-1)
-             lcr(0:ncorr-1) = 1.0_wp
-!
-!--          Right boundary for v
-             i   = nxr + 1
-!
-!--          Determine topography top index on v-grid
-             kb  = get_topography_top_index_ji( j, i, 'v' )
-             k   = kb + 1
-             wall_index = kb
-
-             CALL pmci_define_loglaw_correction_parameters( lc, lcr, k,        &
-                                                 j, inc, wall_index, z0_topo,  &
-                                                 kb, direction, ncorr )
-
-             logc_v_r(1,k,j) = lc
-             logc_ratio_v_r(1,0:ncorr-1,k,j) = lcr(0:ncorr-1)
-             lcr(0:ncorr-1) = 1.0_wp
-
-          ENDDO
-
-       ENDIF
-!
-!--    South boundary
-       IF ( bc_dirichlet_s )  THEN
-
-          ALLOCATE( logc_u_s(1:2,nzb:nzt_topo_nestbc_s,nxl:nxr) )
-          ALLOCATE( logc_v_s(1:2,nzb:nzt_topo_nestbc_s,nxl:nxr) )
-          ALLOCATE( logc_w_s(1:2,nzb:nzt_topo_nestbc_s,nxl:nxr) )
-          ALLOCATE( logc_kbounds_u_s(1:2,nxl:nxr) )
-          ALLOCATE( logc_kbounds_v_s(1:2,nxl:nxr) )
-          ALLOCATE( logc_kbounds_w_s(1:2,nxl:nxr) )
-          ALLOCATE( logc_ratio_u_s(1:2,0:ncorr-1,nzb:nzt_topo_nestbc_s,nxl:nxr) )
-          ALLOCATE( logc_ratio_v_s(1:2,0:ncorr-1,nzb:nzt_topo_nestbc_s,nxl:nxr) )
-          ALLOCATE( logc_ratio_w_s(1:2,0:ncorr-1,nzb:nzt_topo_nestbc_s,nxl:nxr) )
-          logc_u_s       = 0
-          logc_v_s       = 0
-          logc_w_s       = 0
-          logc_ratio_u_s = 1.0_wp
-          logc_ratio_v_s = 1.0_wp
-          logc_ratio_w_s = 1.0_wp
-          direction      = 1
-          inc            = 1
-
-          DO  i = nxl, nxr
-!
-!--          South boundary for u
-             j   = -1
-!
-!--          Determine topography top index on u-grid
-             kb  = get_topography_top_index_ji( j, i, 'u' )
-             k   = kb + 1
-             wall_index = kb
-
-             CALL pmci_define_loglaw_correction_parameters( lc, lcr, k,        &
-                                                 j, inc, wall_index, z0_topo,  &
-                                                 kb, direction, ncorr )
-
-             logc_u_s(1,k,i) = lc
-             logc_ratio_u_s(1,0:ncorr-1,k,i) = lcr(0:ncorr-1)
-             lcr(0:ncorr-1) = 1.0_wp
-!
-!--          South boundary for v
-             j   = 0
-!
-!--          Determine topography top index on v-grid
-             kb  = get_topography_top_index_ji( j, i, 'v' )
-             k   = kb + 1
-             wall_index = kb
-
-             CALL pmci_define_loglaw_correction_parameters( lc, lcr, k,        &
-                                                 j, inc, wall_index, z0_topo,  &
-                                                 kb, direction, ncorr )
-
-             logc_v_s(1,k,i) = lc
-             logc_ratio_v_s(1,0:ncorr-1,k,i) = lcr(0:ncorr-1)
-             lcr(0:ncorr-1) = 1.0_wp
-
-          ENDDO
-
-       ENDIF
-!
-!--    North boundary
-       IF ( bc_dirichlet_n )  THEN
-
-          ALLOCATE( logc_u_n(1:2,nzb:nzt_topo_nestbc_n,nxl:nxr) )
-          ALLOCATE( logc_v_n(1:2,nzb:nzt_topo_nestbc_n,nxl:nxr) )
-          ALLOCATE( logc_w_n(1:2,nzb:nzt_topo_nestbc_n,nxl:nxr) )
-          ALLOCATE( logc_kbounds_u_n(1:2,nxl:nxr) )
-          ALLOCATE( logc_kbounds_v_n(1:2,nxl:nxr) )
-          ALLOCATE( logc_kbounds_w_n(1:2,nxl:nxr) )
-          ALLOCATE( logc_ratio_u_n(1:2,0:ncorr-1,nzb:nzt_topo_nestbc_n,nxl:nxr) )
-          ALLOCATE( logc_ratio_v_n(1:2,0:ncorr-1,nzb:nzt_topo_nestbc_n,nxl:nxr) )
-          ALLOCATE( logc_ratio_w_n(1:2,0:ncorr-1,nzb:nzt_topo_nestbc_n,nxl:nxr) )
-          logc_u_n       = 0
-          logc_v_n       = 0
-          logc_w_n       = 0
-          logc_ratio_u_n = 1.0_wp
-          logc_ratio_v_n = 1.0_wp
-          logc_ratio_w_n = 1.0_wp
-          direction      = 1
-          inc            = 1
-
-          DO  i = nxl, nxr
-!
-!--          North boundary for u
-             j   = nyn + 1
-!
-!--          Determine topography top index on u-grid
-             kb  = get_topography_top_index_ji( j, i, 'u' )
-             k   = kb + 1
-             wall_index = kb
-
-             CALL pmci_define_loglaw_correction_parameters( lc, lcr, k,        &
-                                                 j, inc, wall_index, z0_topo,  &
-                                                 kb, direction, ncorr )
-
-             logc_u_n(1,k,i) = lc
-             logc_ratio_u_n(1,0:ncorr-1,k,i) = lcr(0:ncorr-1)
-             lcr(0:ncorr-1) = 1.0_wp
-!
-!--          North boundary for v
-             j   = nyn + 1
-!
-!--          Determine topography top index on v-grid
-             kb  = get_topography_top_index_ji( j, i, 'v' )
-             k   = kb + 1
-             wall_index = kb
-
-             CALL pmci_define_loglaw_correction_parameters( lc, lcr, k,        &
-                                                 j, inc, wall_index, z0_topo,  &
-                                                 kb, direction, ncorr )
-             logc_v_n(1,k,i) = lc
-             logc_ratio_v_n(1,0:ncorr-1,k,i) = lcr(0:ncorr-1)
-             lcr(0:ncorr-1) = 1.0_wp
-
-          ENDDO
-
-       ENDIF
-!       
-!--    Then vertical walls and corners if necessary
-       IF ( topography /= 'flat' )  THEN
-!
-!--       Workaround, set z0 at vertical surfaces simply to the given roughness
-!--       lenth, which is required to determine the logarithmic correction 
-!--       factors at the child boundaries, which are at the ghost-points. 
-!--       The surface data type for vertical surfaces, however, is not defined 
-!--       at ghost-points, so that no z0 can be retrieved at this point. 
-!--       Maybe, revise this later and define vertical surface datattype also
-!--       at ghost-points.
-          z0_topo = roughness_length
-
-          kb = 0       ! kb is not used when direction > 1        
-!        
-!--       Left boundary
-          IF ( bc_dirichlet_l )  THEN
-             logc_kbounds_u_l(1:2,nys:nyn) = 0
-             logc_kbounds_v_l(1:2,nys:nyn) = 0             
-             logc_kbounds_w_l(1:2,nys:nyn) = 0
-             
-             direction  = 2
-
-             DO  j = nys, nyn
-!
-!--             Determine the lowest k-indices for u at j,i, j+1,i and j-1,i. 
-                i             = 0
-                k_wall_u_ji   = get_topography_top_index_ji( j,   i, 'u' )
-                k_wall_u_ji_p = get_topography_top_index_ji( j+1, i, 'u' )
-                k_wall_u_ji_m = get_topography_top_index_ji( j-1, i, 'u' )
-!
-!--             Wall for u on the south side.
-                IF ( ( k_wall_u_ji <  k_wall_u_ji_m ) .AND.                    &
-                     ( k_wall_u_ji >= k_wall_u_ji_p ) )  THEN
-                   inc        =  1
-                   wall_index =  j
-!
-!--                Store the kbounds for use in pmci_interp_tril_lr.
-                   logc_kbounds_u_l(1,j) = k_wall_u_ji + 1
-                   logc_kbounds_u_l(2,j) = k_wall_u_ji_m
-                   DO  k = logc_kbounds_u_l(1,j), logc_kbounds_u_l(2,j)
-                      CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
-                           k, j, inc, wall_index, z0_topo, kb, direction,      &
-                           ncorr )
-                      IF ( lc == -99 )  THEN
-!                         
-!--                      The pivot point is out of subdomain, skip the correction. 
-                         logc_u_l(2,k,j) = 0
-                         logc_ratio_u_l(2,0:ncorr-1,k,j) = 1.0_wp
-                      ELSE
-!
-!--                      The direction of the wall-normal index is stored as the
-!--                      sign of the logc-element.
-                         logc_u_l(2,k,j) = inc * lc
-                         logc_ratio_u_l(2,0:ncorr-1,k,j) = lcr(0:ncorr-1)
-                      ENDIF
-                      lcr(0:ncorr-1) = 1.0_wp
-                   ENDDO
-                ENDIF
-!
-!--             Wall for u on the north side.
-                IF ( ( k_wall_u_ji <  k_wall_u_ji_p ) .AND.                    &
-                     ( k_wall_u_ji >= k_wall_u_ji_m ) )  THEN
-                   inc        = -1
-                   wall_index =  j + 1
-!
-!--                Store the kbounds for use in pmci_interp_tril_lr.                   
-                   logc_kbounds_u_l(1,j) = k_wall_u_ji + 1
-                   logc_kbounds_u_l(2,j) = k_wall_u_ji_p
-                   DO  k = logc_kbounds_u_l(1,j), logc_kbounds_u_l(2,j)
-                      CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
-                           k, j, inc, wall_index, z0_topo, kb, direction,      &
-                           ncorr )
-                      IF ( lc == -99 )  THEN
-!                         
-!--                      The pivot point is out of subdomain, skip the correction. 
-                         logc_u_l(2,k,j) = 0
-                         logc_ratio_u_l(2,0:ncorr-1,k,j) = 1.0_wp
-                      ELSE
-!
-!--                      The direction of the wall-normal index is stored as the
-!--                      sign of the logc-element.
-                         logc_u_l(2,k,j) = inc * lc
-                         logc_ratio_u_l(2,0:ncorr-1,k,j) = lcr(0:ncorr-1)
-                      ENDIF
-                      lcr(0:ncorr-1) = 1.0_wp
-                   ENDDO
-                ENDIF
-!
-!--             Determine the lowest k-indices for w at j,i, j+1,i and j-1,i. 
-                i             = -1
-                k_wall_w_ji   = get_topography_top_index_ji( j,   i, 'w' )
-                k_wall_w_ji_p = get_topography_top_index_ji( j+1, i, 'w' )
-                k_wall_w_ji_m = get_topography_top_index_ji( j-1, i, 'w' )
-!
-!--             Wall for w on the south side.                
-                IF ( ( k_wall_w_ji <  k_wall_w_ji_m ) .AND.                    &
-                     ( k_wall_w_ji >= k_wall_w_ji_p ) )  THEN
-                   inc        =  1
-                   wall_index =  j
-!
-!--                Store the kbounds for use in pmci_interp_tril_lr.
-                   logc_kbounds_w_l(1,j) = k_wall_w_ji + 1
-                   logc_kbounds_w_l(2,j) = k_wall_w_ji_m
-                   DO  k = logc_kbounds_w_l(1,j), logc_kbounds_w_l(2,j)
-                      CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
-                           k, j, inc, wall_index, z0_topo, kb, direction,      &
-                           ncorr )
-                      IF ( lc == -99 )  THEN
-!                         
-!--                      The pivot point is out of subdomain, skip the correction. 
-                         logc_w_l(2,k,j) = 0
-                         logc_ratio_w_l(2,0:ncorr-1,k,j) = 1.0_wp
-                      ELSE
-!
-!--                      The direction of the wall-normal index is stored as the
-!--                      sign of the logc-element.
-                         logc_w_l(2,k,j) = inc * lc
-                         logc_ratio_w_l(2,0:ncorr-1,k,j) = lcr(0:ncorr-1)
-                      ENDIF
-                      lcr(0:ncorr-1) = 1.0_wp
-                   ENDDO
-                ENDIF
-!
-!--             Wall for w on the north side.
-                IF ( ( k_wall_w_ji <  k_wall_w_ji_p ) .AND.                    &
-                     ( k_wall_w_ji >= k_wall_w_ji_m ) )  THEN
-                   inc        = -1
-                   wall_index =  j+1
-!
-!--                Store the kbounds for use in pmci_interp_tril_lr.
-                   logc_kbounds_w_l(1,j) = k_wall_w_ji + 1
-                   logc_kbounds_w_l(2,j) = k_wall_w_ji_p
-                   DO  k = logc_kbounds_w_l(1,j), logc_kbounds_w_l(2,j)
-                      CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
-                           k, j, inc, wall_index, z0_topo, kb, direction,      &
-                           ncorr )
-                      IF ( lc == -99 )  THEN
-!                         
-!--                      The pivot point is out of subdomain, skip the correction. 
-                         logc_w_l(2,k,j) = 0
-                         logc_ratio_w_l(2,0:ncorr-1,k,j) = 1.0_wp
-                      ELSE
-!
-!--                      The direction of the wall-normal index is stored as the
-!--                      sign of the logc-element.
-                         logc_w_l(2,k,j) = inc * lc
-                         logc_ratio_w_l(2,0:ncorr-1,k,j) = lcr(0:ncorr-1)
-                      ENDIF
-                      lcr(0:ncorr-1) = 1.0_wp
-                   ENDDO
-                ENDIF
-                   
-             ENDDO
-
-          ENDIF   !  IF ( bc_dirichlet_l )
-!        
-!--       Right boundary
-          IF ( bc_dirichlet_r )  THEN
-             logc_kbounds_u_r(1:2,nys:nyn) = 0
-             logc_kbounds_v_r(1:2,nys:nyn) = 0             
-             logc_kbounds_w_r(1:2,nys:nyn) = 0
-
-             direction  = 2
-             i  = nx + 1
-
-             DO  j = nys, nyn
-!
-!--             Determine the lowest k-indices for u at j,i, j+1,i and j-1,i. 
-                k_wall_u_ji   = get_topography_top_index_ji( j,   i, 'u' )
-                k_wall_u_ji_p = get_topography_top_index_ji( j+1, i, 'u' )
-                k_wall_u_ji_m = get_topography_top_index_ji( j-1, i, 'u' )
-!
-!--             Wall for u on the south side.
-                IF ( ( k_wall_u_ji <  k_wall_u_ji_m ) .AND.                    &
-                     ( k_wall_u_ji >= k_wall_u_ji_p ) )  THEN
-                   inc        =  1
-                   wall_index =  j
-!
-!--                Store the kbounds for use in pmci_interp_tril_lr.                  
-                   logc_kbounds_u_r(1,j) = k_wall_u_ji + 1
-                   logc_kbounds_u_r(2,j) = k_wall_u_ji_m
-                   DO  k = logc_kbounds_u_r(1,j), logc_kbounds_u_r(2,j)
-                      CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
-                           k, j, inc, wall_index, z0_topo, kb, direction, ncorr )
-                      IF ( lc == -99 )  THEN
-!                         
-!--                      The pivot point is out of subdomain, skip the correction. 
-                         logc_u_r(2,k,j) = 0
-                         logc_ratio_u_r(2,0:ncorr-1,k,j) = 1.0_wp
-                      ELSE
-!
-!--                      The direction of the wall-normal index is stored as the
-!--                      sign of the logc-element.
-                         logc_u_r(2,k,j) = inc * lc
-                         logc_ratio_u_r(2,0:ncorr-1,k,j) = lcr(0:ncorr-1)
-                      ENDIF
-                      lcr(0:ncorr-1) = 1.0_wp
-                   ENDDO
-                ENDIF
-!
-!--             Wall for u on the south side.
-                IF ( ( k_wall_u_ji <  k_wall_u_ji_p ) .AND.                    &
-                     ( k_wall_u_ji >= k_wall_u_ji_m ) )  THEN
-                   inc        = -1
-                   wall_index =  j + 1                 
-!
-!--                Store the kbounds for use in pmci_interp_tril_lr.                   
-                   logc_kbounds_u_r(1,j) = k_wall_u_ji + 1
-                   logc_kbounds_u_r(2,j) = k_wall_u_ji_p
-                   DO  k = logc_kbounds_u_r(1,j), logc_kbounds_u_r(2,j)
-                      CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
-                           k, j, inc, wall_index, z0_topo, kb, direction,      &
-                           ncorr )
-                      IF ( lc == -99 )  THEN
-!                         
-!--                      The pivot point is out of subdomain, skip the correction. 
-                         logc_u_r(2,k,j) = 0
-                         logc_ratio_u_r(2,0:ncorr-1,k,j) = 1.0_wp
-                      ELSE
-!
-!--                      The direction of the wall-normal index is stored as the
-!--                      sign of the logc-element.
-                         logc_u_r(2,k,j) = inc * lc
-                         logc_ratio_u_r(2,0:ncorr-1,k,j) = lcr(0:ncorr-1)
-                      ENDIF
-                      lcr(0:ncorr-1) = 1.0_wp
-                   ENDDO
-                ENDIF
-!
-!--             Determine the lowest k-indices for w at j,i, j+1,i and j-1,i. 
-                k_wall_w_ji   = get_topography_top_index_ji( j,   i, 'w' )
-                k_wall_w_ji_p = get_topography_top_index_ji( j+1, i, 'w' )
-                k_wall_w_ji_m = get_topography_top_index_ji( j-1, i, 'w' )
-!
-!--             Wall for w on the south side.                
-                IF ( ( k_wall_w_ji <  k_wall_w_ji_m ) .AND.                    &
-                     ( k_wall_w_ji >= k_wall_w_ji_p ) )  THEN
-                   inc        =  1
-                   wall_index =  j
-!
-!--                Store the kbounds for use in pmci_interp_tril_lr.                    
-                   logc_kbounds_w_r(1,j) = k_wall_w_ji + 1
-                   logc_kbounds_w_r(2,j) = k_wall_w_ji_m
-                   DO  k = logc_kbounds_w_r(1,j), logc_kbounds_w_r(2,j)
-                      CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
-                           k, j, inc, wall_index, z0_topo, kb, direction,      &
-                           ncorr )
-                      IF ( lc == -99 )  THEN
-!                         
-!--                      The pivot point is out of subdomain, skip the correction. 
-                         logc_w_r(2,k,j) = 0
-                         logc_ratio_w_r(2,0:ncorr-1,k,j) = 1.0_wp
-                      ELSE
-!
-!--                      The direction of the wall-normal index is stored as the
-!--                      sign of the logc-element.
-                         logc_w_r(2,k,j) = inc * lc
-                         logc_ratio_w_r(2,0:ncorr-1,k,j) = lcr(0:ncorr-1)
-                      ENDIF
-                      lcr(0:ncorr-1) = 1.0_wp
-                   ENDDO
-                ENDIF
-!
-!--             Wall for w on the north side.
-                IF ( ( k_wall_w_ji <  k_wall_w_ji_p ) .AND.                    &
-                     ( k_wall_w_ji >= k_wall_w_ji_m ) )  THEN
-                   inc        = -1
-                   wall_index =  j+1
-!
-!--                Store the kbounds for use in pmci_interp_tril_lr.                   
-                   logc_kbounds_w_r(1,j) = k_wall_w_ji + 1
-                   logc_kbounds_w_r(2,j) = k_wall_w_ji_p
-                   DO  k = logc_kbounds_w_r(1,j), logc_kbounds_w_r(2,j)
-                      CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
-                           k, j, inc, wall_index, z0_topo, kb, direction,      &
-                           ncorr )
-                      IF ( lc == -99 )  THEN
-!                         
-!--                      The pivot point is out of subdomain, skip the correction. 
-                         logc_w_r(2,k,j) = 0
-                         logc_ratio_w_r(2,0:ncorr-1,k,j) = 1.0_wp
-                      ELSE
-!
-!--                      The direction of the wall-normal index is stored as the
-!--                      sign of the logc-element.
-                         logc_w_r(2,k,j) = inc * lc
-                         logc_ratio_w_r(2,0:ncorr-1,k,j) = lcr(0:ncorr-1)
-                      ENDIF
-                      lcr(0:ncorr-1) = 1.0_wp
-                   ENDDO
-                ENDIF
-                   
-             ENDDO
-             
-          ENDIF   !  IF ( bc_dirichlet_r )
-!        
-!--       South boundary
-          IF ( bc_dirichlet_s )  THEN
-             logc_kbounds_u_s(1:2,nxl:nxr) = 0
-             logc_kbounds_v_s(1:2,nxl:nxr) = 0
-             logc_kbounds_w_s(1:2,nxl:nxr) = 0
-
-             direction  = 3
-
-             DO  i = nxl, nxr
-!
-!--             Determine the lowest k-indices for v at j,i, j,i+1 and j,i-1.
-                j             = 0                
-                k_wall_v_ji   = get_topography_top_index_ji( j, i,   'v' )
-                k_wall_v_ji_p = get_topography_top_index_ji( j, i+1, 'v' )
-                k_wall_v_ji_m = get_topography_top_index_ji( j, i-1, 'v' )
-!
-!--             Wall for v on the left side.
-                IF ( ( k_wall_v_ji <  k_wall_v_ji_m ) .AND.                    &
-                     ( k_wall_v_ji >= k_wall_v_ji_p ) )  THEN
-                   inc        =  1
-                   wall_index =  i
-!
-!--                Store the kbounds for use in pmci_interp_tril_sn.                    
-                   logc_kbounds_v_s(1,i) = k_wall_v_ji + 1
-                   logc_kbounds_v_s(2,i) = k_wall_v_ji_m
-                   DO  k = logc_kbounds_v_s(1,i), logc_kbounds_v_s(2,i)
-                      CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
-                           k, i, inc, wall_index, z0_topo, kb, direction,      &
-                           ncorr )
-                      IF ( lc == -99 )  THEN
-!                         
-!--                      The pivot point is out of subdomain, skip the correction. 
-                         logc_v_s(2,k,i) = 0
-                         logc_ratio_v_s(2,0:ncorr-1,k,i) = 1.0_wp
-                      ELSE
-!
-!--                      The direction of the wall-normal index is stored as the
-!--                      sign of the logc-element.
-                         logc_v_s(2,k,i) = inc * lc
-                         logc_ratio_v_s(2,0:ncorr-1,k,i) = lcr(0:ncorr-1)
-                      ENDIF
-                      lcr(0:ncorr-1) = 1.0_wp
-                   ENDDO
-                ENDIF
-!
-!--             Wall for v on the right side.
-                IF ( ( k_wall_v_ji <  k_wall_v_ji_p ) .AND.                    &
-                     ( k_wall_v_ji >= k_wall_v_ji_m ) )  THEN
-                   inc        = -1
-                   wall_index =  i+1
-!
-!--                Store the kbounds for use in pmci_interp_tril_sn.                   
-                   logc_kbounds_v_s(1,i) = k_wall_v_ji + 1
-                   logc_kbounds_v_s(2,i) = k_wall_v_ji_p
-                   DO  k = logc_kbounds_v_s(1,i), logc_kbounds_v_s(2,i)
-                      CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
-                           k, i, inc, wall_index, z0_topo, kb, direction,      &
-                           ncorr )
-                      IF ( lc == -99 )  THEN
-!                         
-!--                      The pivot point is out of subdomain, skip the correction. 
-                         logc_v_s(2,k,i) = 0
-                         logc_ratio_v_s(2,0:ncorr-1,k,i) = 1.0_wp
-                      ELSE
-!
-!--                      The direction of the wall-normal index is stored as the
-!--                      sign of the logc-element.
-                         logc_v_s(2,k,i) = inc * lc
-                         logc_ratio_v_s(2,0:ncorr-1,k,i) = lcr(0:ncorr-1)
-                      ENDIF
-                      lcr(0:ncorr-1) = 1.0_wp
-                   ENDDO
-                ENDIF
-!
-!--             Determine the lowest k-indices for w at j,i, j,i+1 and j,i-1. 
-                j             = -1
-                k_wall_w_ji   = get_topography_top_index_ji( j, i,   'w' )
-                k_wall_w_ji_p = get_topography_top_index_ji( j, i+1, 'w' )
-                k_wall_w_ji_m = get_topography_top_index_ji( j, i-1, 'w' )
-!
-!--             Wall for w on the left side.
-                IF ( ( k_wall_w_ji <  k_wall_w_ji_m ) .AND.                    &
-                     ( k_wall_w_ji >= k_wall_w_ji_p ) )  THEN
-                   inc        =  1
-                   wall_index =  i
-!
-!--                Store the kbounds for use in pmci_interp_tril_sn.
-                   logc_kbounds_w_s(1,i) = k_wall_w_ji + 1
-                   logc_kbounds_w_s(2,i) = k_wall_w_ji_m
-                   DO  k = logc_kbounds_w_s(1,i), logc_kbounds_w_s(2,i)
-                      CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
-                           k, i, inc, wall_index, z0_topo, kb, direction,      &
-                           ncorr )
-                      IF ( lc == -99 )  THEN
-!                         
-!--                      The pivot point is out of subdomain, skip the correction. 
-                         logc_w_s(2,k,i) = 0
-                         logc_ratio_w_s(2,0:ncorr-1,k,i) = 1.0_wp
-                      ELSE
-!
-!--                      The direction of the wall-normal index is stored as the
-!--                      sign of the logc-element.
-                         logc_w_s(2,k,i) = inc * lc
-                         logc_ratio_w_s(2,0:ncorr-1,k,i) = lcr(0:ncorr-1)
-                      ENDIF
-                      lcr(0:ncorr-1) = 1.0_wp
-                   ENDDO
-                ENDIF
-!
-!--             Wall for w on the right side.
-                IF ( ( k_wall_w_ji <  k_wall_w_ji_p ) .AND.                    &
-                     ( k_wall_w_ji >= k_wall_w_ji_m ) )  THEN
-                   inc        = -1
-                   wall_index =  i+1
-!
-!--                Store the kbounds for use in pmci_interp_tril_sn.
-                   logc_kbounds_w_s(1,i) = k_wall_w_ji + 1
-                   logc_kbounds_w_s(2,i) = k_wall_w_ji_p
-                   DO  k = logc_kbounds_w_s(1,i), logc_kbounds_w_s(2,i)
-                      CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
-                           k, i, inc, wall_index, z0_topo, kb, direction,      &
-                           ncorr )
-                      IF ( lc == -99 )  THEN
-!                         
-!--                      The pivot point is out of subdomain, skip the correction. 
-                         logc_w_s(2,k,i) = 0
-                         logc_ratio_w_s(2,0:ncorr-1,k,i) = 1.0_wp
-                      ELSE
-!
-!--                      The direction of the wall-normal index is stored as the
-!--                      sign of the logc-element.
-                         logc_w_s(2,k,i) = inc * lc
-                         logc_ratio_w_s(2,0:ncorr-1,k,i) = lcr(0:ncorr-1)
-                      ENDIF
-                      lcr(0:ncorr-1) = 1.0_wp
-                   ENDDO
-                ENDIF
-
-             ENDDO
-
-          ENDIF   !  IF (bc_dirichlet_s )
-!        
-!--       North boundary
-          IF ( bc_dirichlet_n )  THEN
-             logc_kbounds_u_n(1:2,nxl:nxr) = 0             
-             logc_kbounds_v_n(1:2,nxl:nxr) = 0
-             logc_kbounds_w_n(1:2,nxl:nxr) = 0
-
-             direction  = 3
-             j  = ny + 1
-
-             DO  i = nxl, nxr
-!
-!--             Determine the lowest k-indices for v at j,i, j,i+1 and j,i-1
-                k_wall_v_ji   = get_topography_top_index_ji( j, i,   'v' )
-                k_wall_v_ji_p = get_topography_top_index_ji( j, i+1, 'v' )
-                k_wall_v_ji_m = get_topography_top_index_ji( j, i-1, 'v' )
-!
-!--             Wall for v on the left side.
-                IF ( ( k_wall_v_ji <  k_wall_v_ji_m ) .AND.                    &
-                     ( k_wall_v_ji >= k_wall_v_ji_p ) )  THEN
-                   inc        = 1
-                   wall_index = i                   
-!
-!--                Store the kbounds for use in pmci_interp_tril_sn.
-                   logc_kbounds_v_n(1,i) = k_wall_v_ji + 1
-                   logc_kbounds_v_n(2,i) = k_wall_v_ji_m
-                   DO  k = logc_kbounds_v_n(1,i), logc_kbounds_v_n(2,i)
-                      CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
-                           k, i, inc, wall_index, z0_topo, kb, direction,      &
-                           ncorr )
-                      IF ( lc == -99 )  THEN
-!                         
-!--                      The pivot point is out of subdomain, skip the correction. 
-                         logc_v_n(2,k,i) = 0
-                         logc_ratio_v_n(2,0:ncorr-1,k,i) = 1.0_wp
-                      ELSE
-!
-!--                      The direction of the wall-normal index is stored as the
-!--                      sign of the logc-element.
-                         logc_v_n(2,k,i) = inc * lc
-                         logc_ratio_v_n(2,0:ncorr-1,k,i) = lcr(0:ncorr-1)
-                      ENDIF
-                      lcr(0:ncorr-1) = 1.0_wp
-                   ENDDO
-                ENDIF
-!
-!--             Wall for v on the right side.
-                IF ( ( k_wall_v_ji <  k_wall_v_ji_p ) .AND.                    &
-                     ( k_wall_v_ji >= k_wall_v_ji_m ) )  THEN
-                   inc        = -1
-                   wall_index =  i + 1
-!
-!--                Store the kbounds for use in pmci_interp_tril_sn.
-                   logc_kbounds_v_n(1,i) = k_wall_v_ji + 1
-                   logc_kbounds_v_n(2,i) = k_wall_v_ji_p
-                   DO  k = logc_kbounds_v_n(1,i), logc_kbounds_v_n(2,i)
-                      CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
-                           k, i, inc, wall_index, z0_topo, kb, direction,      &
-                           ncorr )
-                      IF ( lc == -99 )  THEN
-!                         
-!--                      The pivot point is out of subdomain, skip the correction. 
-                         logc_v_n(2,k,i) = 0
-                         logc_ratio_v_n(2,0:ncorr-1,k,i) = 1.0_wp
-                      ELSE
-!
-!--                      The direction of the wall-normal index is stored as the
-!--                      sign of the logc-element.
-                         logc_v_n(2,k,i) = inc * lc
-                         logc_ratio_v_n(2,0:ncorr-1,k,i) = lcr(0:ncorr-1)
-                      ENDIF
-                      lcr(0:ncorr-1) = 1.0_wp
-                   ENDDO
-                ENDIF
-!
-!--             Determine the lowest k-indices for w at j,i, j,i+1 and j,i-1.
-                k_wall_w_ji   = get_topography_top_index_ji( j, i,   'w' )
-                k_wall_w_ji_p = get_topography_top_index_ji( j, i+1, 'w' )
-                k_wall_w_ji_m = get_topography_top_index_ji( j, i-1, 'w' )                   
-!
-!--             Wall for w on the left side.
-                IF ( ( k_wall_w_ji <  k_wall_w_ji_m ) .AND.                    &
-                     ( k_wall_w_ji >= k_wall_w_ji_p ) )  THEN
-                   inc        = 1
-                   wall_index = i
-!
-!--                Store the kbounds for use in pmci_interp_tril_sn.
-                   logc_kbounds_w_n(1,i) = k_wall_w_ji + 1
-                   logc_kbounds_w_n(2,i) = k_wall_w_ji_m
-                   DO  k = logc_kbounds_w_n(1,i), logc_kbounds_w_n(2,i)
-                      CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
-                           k, i, inc, wall_index, z0_topo, kb, direction,      &
-                           ncorr )
-                      IF ( lc == -99 )  THEN
-!                         
-!--                      The pivot point is out of subdomain, skip the correction. 
-                         logc_w_n(2,k,i) = 0
-                         logc_ratio_w_n(2,0:ncorr-1,k,i) = 1.0_wp
-                      ELSE
-!
-!--                      The direction of the wall-normal index is stored as the
-!--                      sign of the logc-element.
-                         logc_w_n(2,k,i) = inc * lc
-                         logc_ratio_w_n(2,0:ncorr-1,k,i) = lcr(0:ncorr-1)
-                      ENDIF
-                      lcr(0:ncorr-1) = 1.0_wp
-                   ENDDO
-                ENDIF
-!
-!--             Wall for w on the right side, but not on the left side
-                IF ( ( k_wall_w_ji <  k_wall_w_ji_p ) .AND.                    &
-                     ( k_wall_w_ji >= k_wall_w_ji_m ) )  THEN
-                   inc        = -1
-                   wall_index =  i+1
-!
-!--                Store the kbounds for use in pmci_interp_tril_sn.
-                   logc_kbounds_w_n(1,i) = k_wall_w_ji + 1
-                   logc_kbounds_w_n(2,i) = k_wall_w_ji_p
-                   DO  k = logc_kbounds_w_n(1,i), logc_kbounds_w_n(2,i)
-                      CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
-                           k, i, inc, wall_index, z0_topo, kb, direction,      &
-                           ncorr )
-                      IF ( lc == -99 )  THEN
-!                         
-!--                      The pivot point is out of subdomain, skip the correction. 
-                         logc_w_n(2,k,i) = 0
-                         logc_ratio_w_n(2,0:ncorr-1,k,i) = 1.0_wp
-                      ELSE
-!
-!--                      The direction of the wall-normal index is stored as the
-!--                      sign of the logc-element.
-                         logc_w_n(2,k,i) = inc * lc
-                         logc_ratio_w_n(2,0:ncorr-1,k,i) = lcr(0:ncorr-1)
-                      ENDIF
-                      lcr(0:ncorr-1) = 1.0_wp
-                   ENDDO
-                ENDIF
-
-             ENDDO
-
-          ENDIF   !  IF ( bc_dirichlet_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                !<
-
-       INTEGER(iwp) ::  alcorr                                 !<
-       INTEGER(iwp) ::  corr_index                             !<
-       INTEGER(iwp) ::  lcorr                                  !<
-
-       LOGICAL      ::  more                                   !<             
-
-       REAL(wp), DIMENSION(0:ncorr-1), INTENT(INOUT) ::  lcr   !<
-       REAL(wp), INTENT(IN)      ::  z0_l                      !<
-      
-       REAL(wp)     ::  logvelc1                               !<
-      
-
-       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_wp
-                   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 ) .AND. ( lc /= -99 ) )  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 ) .AND. ( lc /= -99 ) )  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 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 horizontal walls.
-
-       IMPLICIT NONE
-
-       INTEGER(iwp), INTENT(IN)  ::  kb   !<
-       INTEGER(iwp), INTENT(OUT) ::  lc   !<
-
-       INTEGER(iwp) ::  kbc               !<
-       INTEGER(iwp) ::  k1                !<
-
-       REAL(wp), INTENT(OUT) ::  logzc1   !<
-       REAL(wp), INTENT(IN)  ::  z0_l     !<
-
-       REAL(wp) ::  zuc1                  !<
-
-!
-!--    kbc is the first coarse-grid point above the surface
-       kbc = nzb + 1
-       DO  WHILE ( cg%zu(kbc) < zu(kb) )
-          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 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. If the pivot node is found to be outside 
-!--    the subdomain, a marker value of -99 is set to lc and this tells 
-!--    pmci_init_loglaw_correction to not do the correction in this case.
-      
-       IMPLICIT NONE
-
-       INTEGER(iwp), INTENT(IN)  ::  inc    !<  increment must be 1 or -1.
-       INTEGER(iwp), INTENT(IN)  ::  j      !<
-       INTEGER(iwp), INTENT(IN)  ::  jw     !<
-       INTEGER(iwp), INTENT(OUT) ::  lc     !<
-
-       INTEGER(iwp) ::  jwc                 !<
-       INTEGER(iwp) ::  j1                  !<
-
-       REAL(wp), INTENT(IN)  ::  z0_l       !<
-       REAL(wp), INTENT(OUT) ::  logyc1     !<
-
-       REAL(wp) ::  ycb                     !<       
-       REAL(wp) ::  yc1                     !<
-       
-!
-!--    yc1 is the y-coordinate of the first coarse-grid u- and w-nodes out from
-!--    the wall. Here we assume that the wall index in the coarse grid is the
-!--    closest one if they don't match.
-       jwc  = pmci_find_nearest_coarse_grid_index_j( jw )
-       yc1  = cg%coord_y(jwc) - lower_left_coord_y + 0.5_wp * inc * cg%dy
-!       
-!--    Check if yc1 is out of the subdomain y-range. In such case set the marker 
-!--    value -99 for lc in order to skip the loglaw-correction locally.
-       IF ( yc1 < ( REAL( nysg, KIND=wp ) + 0.5_wp ) * dy  )  THEN
-          lc = -99
-          logyc1 = 1.0_wp
-       ELSE IF ( yc1 > ( REAL( nyng, KIND=wp ) + 0.5_wp ) * dy )  THEN
-          lc = -99
-          logyc1 = 1.0_wp
-       ELSE
-!
-!--       j1 is the first fine-grid index further away from the wall than yc1
-          j1 = j
-!
-!--       Important: the binary relation must be <, not <=
-          ycb = 0.5_wp * dy - lower_left_coord_y
-          DO  WHILE ( inc * ( coord_y(j1) + ycb ) < inc * yc1 )
-             j1 = j1 + inc
-          ENDDO
-          
-          logyc1 = LOG( ABS( coord_y(j1) + 0.5_wp * dy - coord_y(jw) ) / z0_l )
-          lc = j1
-       ENDIF
-       
-    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
-!--    left/right sides of the node. If the pivot node is found to be outside 
-!--    the subdomain, a marker value of -99 is set to lc and this tells 
-!--    pmci_init_loglaw_correction to not do the correction in this case.
-
-       IMPLICIT NONE
-
-       INTEGER(iwp), INTENT(IN)  ::  i      !<
-       INTEGER(iwp), INTENT(IN)  ::  inc    !< increment must be 1 or -1.
-       INTEGER(iwp), INTENT(IN)  ::  iw     !<
-       INTEGER(iwp), INTENT(OUT) ::  lc     !<
-
-       INTEGER(iwp) ::  iwc                 !<
-       INTEGER(iwp) ::  i1                  !<
-
-       REAL(wp), INTENT(IN)  ::  z0_l       !<
-       REAL(wp), INTENT(OUT) ::  logxc1     !<
-
-       REAL(wp) ::  xcb                     !<
-       REAL(wp) ::  xc1                     !<
-
-!
-!--    xc1 is the x-coordinate of the first coarse-grid v- and w-nodes out from
-!--    the wall. Here we assume that the wall index in the coarse grid is the
-!--    closest one if they don't match.
-       iwc  = pmci_find_nearest_coarse_grid_index_i( iw )
-       xc1  = cg%coord_x(iwc) - lower_left_coord_x + 0.5_wp * inc * cg%dx
-!       
-!--    Check if xc1 is out of the subdomain x-range. In such case set the marker 
-!--    value -99 for lc in order to skip the loglaw-correction locally.        
-       IF ( xc1 < ( REAL( nxlg, KIND=wp ) + 0.5_wp ) * dx  )  THEN
-          lc = -99
-          logxc1 = 1.0_wp
-       ELSE IF ( xc1 > ( REAL( nxrg, KIND=wp ) + 0.5_wp ) * dx )  THEN
-          lc = -99
-          logxc1 = 1.0_wp
-       ELSE    
-!
-!--       i1 is the first fine-grid index futher away from the wall than xc1.
-          i1 = i
-!
-!--       Important: the binary relation must be <, not <= 
-          xcb = 0.5_wp * dx - lower_left_coord_x
-          DO  WHILE ( inc * ( coord_x(i1) + xcb ) < inc * xc1 )
-             i1 = i1 + inc
-          ENDDO
-      
-          logxc1 = LOG( ABS( coord_x(i1) + 0.5_wp*dx - coord_x(iw) ) / z0_l )
-          lc = i1
-       ENDIF
-       
-    END SUBROUTINE pmci_find_logc_pivot_i
-
-
-    
-    FUNCTION pmci_find_nearest_coarse_grid_index_j( jw ) 
-
-      IMPLICIT NONE
-      INTEGER(iwp) :: jw         !< Fine-grid wall index
-
-      INTEGER(iwp) :: jc
-      INTEGER(iwp) :: pmci_find_nearest_coarse_grid_index_j
-      REAL(wp) :: dist
-      REAL(wp) :: newdist
-
-      
-      dist = coord_y(nyn) - coord_y(nys)
-      DO jc = jcs, jcn
-         newdist = ABS( cg%coord_y(jc) - coord_y(jw) )
-         IF ( newdist < dist )  THEN
-            pmci_find_nearest_coarse_grid_index_j = jc
-            dist = newdist
-         ENDIF
-      ENDDO
-      
-    END FUNCTION pmci_find_nearest_coarse_grid_index_j
-
-
-    
-    FUNCTION pmci_find_nearest_coarse_grid_index_i( iw ) 
-
-      IMPLICIT NONE
-      INTEGER(iwp) :: iw         !< Fine-grid wall index
-
-      INTEGER(iwp) :: ic
-      INTEGER(iwp) :: pmci_find_nearest_coarse_grid_index_i
-      REAL(wp) :: dist
-      REAL(wp) :: newdist
-
-      
-      dist = coord_x(nxr) - coord_x(nxl)
-      DO ic = icl, icr
-         newdist = ABS( cg%coord_x(ic) - coord_x(iw) )
-         IF ( newdist < dist )  THEN
-            pmci_find_nearest_coarse_grid_index_i = ic
-            dist = newdist
-         ENDIF
-      ENDDO
-      
-    END FUNCTION pmci_find_nearest_coarse_grid_index_i
-
-    
-      
-    SUBROUTINE pmci_init_anterp_tophat
-!
-!--    Precomputation of the child-array indices for
-!--    corresponding coarse-grid array index and the
-!--    Under-relaxation coefficients to be used by anterp_tophat.
-
-       IMPLICIT NONE
-
-       INTEGER(iwp) ::  i        !< Fine-grid index
-       INTEGER(iwp) ::  ii       !< Coarse-grid index
-       INTEGER(iwp) ::  istart   !<
-       INTEGER(iwp) ::  ir       !<
-       INTEGER(iwp) ::  iw       !< Fine-grid index limited to -1 <= iw <= nx+1
-       INTEGER(iwp) ::  j        !< Fine-grid index
-       INTEGER(iwp) ::  jj       !< Coarse-grid index
-       INTEGER(iwp) ::  jstart   !<
-       INTEGER(iwp) ::  jr       !<
-       INTEGER(iwp) ::  jw       !< Fine-grid index limited to -1 <= jw <= ny+1
-       INTEGER(iwp) ::  k        !< Fine-grid index
-       INTEGER(iwp) ::  kk       !< Coarse-grid index
-       INTEGER(iwp) ::  kstart   !<
-       INTEGER(iwp) ::  kw       !< Fine-grid index limited to kw <= nzt+1
-       REAL(wp)     ::  xi       !<
-       REAL(wp)     ::  eta      !<
-       REAL(wp)     ::  tolerance !<
-       REAL(wp)     ::  zeta     !<
-     
-!
-!--    Default values for under-relaxation lengths:
-       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
+       CALL pmci_create_workarray_exchange_datatypes
 !
 !--    First determine kcto and kctw which refer to the uppermost 
@@ -3492,26 +1573,8 @@
        ENDDO
        kctw = kk - 1
-!AH
-       write(9,"('kcto, kctw = ', 2(i3,2x))") kcto, kctw
-
-!AH
-!       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( iflu(icl-1:icr+1) )
-!       ALLOCATE( iflo(icl-1:icr+1) )
-!       ALLOCATE( ifuu(icl-1:icr+1) )
-!       ALLOCATE( ifuo(icl-1:icr+1) )
-!       ALLOCATE( jflv(jcs-1:jcn+1) )
-!       ALLOCATE( jflo(jcs-1:jcn+1) )
-!       ALLOCATE( jfuv(jcs-1:jcn+1) )
-!       ALLOCATE( jfuo(jcs-1:jcn+1) )
-!
+
+       WRITE(9,"('kcto, kctw = ', 2(i3,2x))") kcto, kctw
+       FLUSH(9)
+       
        icla = coarse_bound_aux(1)
        icra = coarse_bound_aux(2)
@@ -3526,25 +1589,12 @@
        ALLOCATE( jfuv(jcsa:jcna) )
        ALLOCATE( jfuo(jcsa:jcna) )       
-!AH
        ALLOCATE( kflw(0:cg%nz+1) )
        ALLOCATE( kflo(0:cg%nz+1) )
        ALLOCATE( kfuw(0:cg%nz+1) )
        ALLOCATE( kfuo(0:cg%nz+1) )
-!AH
-!       ALLOCATE( ijkfc_u(0:cg%nz+1,jcs:jcn,icl:icr) )
-!       ALLOCATE( ijkfc_v(0:cg%nz+1,jcs:jcn,icl:icr) )
-!       ALLOCATE( ijkfc_w(0:cg%nz+1,jcs:jcn,icl:icr) )
-!       ALLOCATE( ijkfc_s(0:cg%nz+1,jcs:jcn,icl:icr) )
-!
-!       ALLOCATE( ijkfc_u(0:cg%nz+1,jcs-1:jcn+1,icl-1:icr+1) )
-!       ALLOCATE( ijkfc_v(0:cg%nz+1,jcs-1:jcn+1,icl-1:icr+1) )
-!       ALLOCATE( ijkfc_w(0:cg%nz+1,jcs-1:jcn+1,icl-1:icr+1) )
-!       ALLOCATE( ijkfc_s(0:cg%nz+1,jcs-1:jcn+1,icl-1:icr+1) )
-!
        ALLOCATE( ijkfc_u(0:cg%nz+1,jcsa:jcna,icla:icra) )
        ALLOCATE( ijkfc_v(0:cg%nz+1,jcsa:jcna,icla:icra) )
        ALLOCATE( ijkfc_w(0:cg%nz+1,jcsa:jcna,icla:icra) )
        ALLOCATE( ijkfc_s(0:cg%nz+1,jcsa:jcna,icla:icra) )
-!AH
 
        ijkfc_u = 0
@@ -3568,10 +1618,9 @@
 !
 !--       Print out the index bounds for checking and debugging purposes
-          write(9,"('pmci_init_anterp_tophat, ii, iflu, ifuu: ', 3(i4,2x))")    &
+          WRITE(9,"('pmci_init_anterp_tophat, ii, iflu, ifuu: ', 3(i4,2x))")    &
                ii, iflu(ii), ifuu(ii)
-          flush(9)
-
+          FLUSH(9)
        ENDDO
-       write(9,*)
+       WRITE(9,*)
 !
 !--    i-indices of others for each ii-index value
@@ -3594,9 +1643,9 @@
 !
 !--       Print out the index bounds for checking and debugging purposes
-          write(9,"('pmci_init_anterp_tophat, ii, iflo, ifuo: ', 3(i4,2x))")    &
+          WRITE(9,"('pmci_init_anterp_tophat, ii, iflo, ifuo: ', 3(i4,2x))")    &
                ii, iflo(ii), ifuo(ii)
-          flush(9)
+          FLUSH(9)
        ENDDO
-       write(9,*)
+       WRITE(9,*)
 !
 !--    j-indices of v for each jj-index value
@@ -3615,9 +1664,9 @@
 !
 !--       Print out the index bounds for checking and debugging purposes
-          write(9,"('pmci_init_anterp_tophat, jj, jflv, jfuv: ', 3(i4,2x))")    &
+          WRITE(9,"('pmci_init_anterp_tophat, jj, jflv, jfuv: ', 3(i4,2x))")    &
                jj, jflv(jj), jfuv(jj)
-          flush(9)
+          FLUSH(9)
        ENDDO
-       write(9,*)
+       WRITE(9,*)
 !
 !--    j-indices of others for each jj-index value
@@ -3640,9 +1689,9 @@
 !
 !--       Print out the index bounds for checking and debugging purposes
-          write(9,"('pmci_init_anterp_tophat, jj, jflo, jfuo: ', 3(i4,2x))")    &
+          WRITE(9,"('pmci_init_anterp_tophat, jj, jflo, jfuo: ', 3(i4,2x))")    &
                jj, jflo(jj), jfuo(jj)
-          flush(9)
+          FLUSH(9)
        ENDDO
-       write(9,*)
+       WRITE(9,*)
 !
 !--    k-indices of w for each kk-index value
@@ -3665,9 +1714,9 @@
 !
 !--       Print out the index bounds for checking and debugging purposes
-          write(9,"('pmci_init_anterp_tophat, kk, kflw, kfuw: ', 4(i4,2x), 2(e12.5,2x))") &
+          WRITE(9,"('pmci_init_anterp_tophat, kk, kflw, kfuw: ', 4(i4,2x), 2(e12.5,2x))") &
                kk, kflw(kk), kfuw(kk), nzt,  cg%zu(kk), cg%zw(kk)
-          flush(9)
+          FLUSH(9)
        ENDDO
-       write(9,*)
+       WRITE(9,*)
 !
 !--    k-indices of others for each kk-index value
@@ -3692,29 +1741,23 @@
        ENDDO
 !
-!--    Set the k-index bounds separately for the parent-grid cells cg%nz and cg%nz+1. 
-!--    Index bounds for cg%nz are needed for the reversibility correction.
-       kflo(cg%nz)   = nzt+1    ! Needed for the reversibility correction
-       kfuo(cg%nz)   = nzt+kgsr ! Needed for the reversibility correction
-       kflo(cg%nz+1) = nzt+kgsr ! Obsolete
-       kfuo(cg%nz+1) = nzt+kgsr ! Obsolete 
-!
-!--       Print out the index bounds for checking and debugging purposes
+!--    Set the k-index bounds separately for the parent-grid cells cg%nz and cg%nz+1       
+!--    although they are not actually needed.
+       kflo(cg%nz)   = nzt+1    
+       kfuo(cg%nz)   = nzt+kgsr 
+       kflo(cg%nz+1) = nzt+kgsr 
+       kfuo(cg%nz+1) = nzt+kgsr 
+!
+!--    Print out the index bounds for checking and debugging purposes
        DO  kk = 1, cg%nz+1
-          write(9,"('pmci_init_anterp_tophat, kk, kflo, kfuo: ', 4(i4,2x), 2(e12.5,2x))") &
+          WRITE(9,"('pmci_init_anterp_tophat, kk, kflo, kfuo: ', 4(i4,2x), 2(e12.5,2x))") &
                kk, kflo(kk), kfuo(kk), nzt,  cg%zu(kk), cg%zw(kk)
-          flush(9)
+          FLUSH(9)
        ENDDO
-       write(9,*)
+       WRITE(9,*)
 !
 !--    Precomputation of number of fine-grid nodes inside parent-grid cells.
 !--    Note that ii, jj, and kk are parent-grid indices. 
 !--    This information is needed in anterpolation and in reversibility 
-!--    correction in interpolation. For the reversibility correction, ijkfc-
-!--    information is needed also beyond the indices for wall_flags_0-masking 
-!--    must be modified here in the boundary-normal direction (iw, jw, kw). 
-!AH       DO  ii = icl, icr
-!AH          DO  jj = jcs, jcn
-!AH       DO  ii = icl-1, icr+1
-!AH          DO  jj = jcs-1, jcn+1
+!--    correction in interpolation. 
        DO  ii = icla, icra
           DO  jj = jcsa, jcna
@@ -3776,48 +1819,92 @@
           ENDDO  ! jj
        ENDDO  ! ii
-!
-!--    Spatial under-relaxation coefficients
-       ALLOCATE( frax(icl:icr) )
-       ALLOCATE( fray(jcs:jcn) )
+
+    END SUBROUTINE pmci_define_index_mapping
+    
+
+
+    SUBROUTINE pmci_allocate_workarrays
+!
+!--    Allocate parent-grid work-arrays for interpolation
+       IMPLICIT NONE
+
+!
+!--    Determine and store the PE-subdomain dependent index bounds
+       IF  ( bc_dirichlet_l )  THEN
+          iclw = icl + 1
+       ELSE
+          iclw = icl - 1
+       ENDIF
+
+       IF  ( bc_dirichlet_r )  THEN
+          icrw = icr - 1
+       ELSE
+          icrw = icr + 1
+       ENDIF
+
+       IF  ( bc_dirichlet_s )  THEN
+          jcsw = jcs + 1
+       ELSE
+          jcsw = jcs - 1
+       ENDIF
+
+       IF  ( bc_dirichlet_n )  THEN
+          jcnw = jcn - 1
+       ELSE
+          jcnw = jcn + 1
+       ENDIF
+    
+       coarse_bound_w(1) = iclw
+       coarse_bound_w(2) = icrw
+       coarse_bound_w(3) = jcsw
+       coarse_bound_w(4) = jcnw
+!
+!--    Left and right boundaries.
+       ALLOCATE( workarrc_lr(0:cg%nz+1,jcsw:jcnw,0:2) )
+!
+!--    South and north boundaries.
+       ALLOCATE( workarrc_sn(0:cg%nz+1,0:2,iclw:icrw) )
+!
+!--    Top boundary.
+!AH       ALLOCATE( workarrc_t(0:2,jcsw:jcnw,iclw:icrw) )
+       ALLOCATE( workarrc_t(-2:3,jcsw:jcnw,iclw:icrw) )
+
+    END SUBROUTINE pmci_allocate_workarrays
+
+
+
+    SUBROUTINE pmci_create_workarray_exchange_datatypes
+!
+!--    Define specific MPI types for workarrc-exhchange.
+       IMPLICIT NONE
+
+#if defined( __parallel )       
+!
+!--    For the left and right boundaries
+       CALL MPI_TYPE_VECTOR( 3, cg%nz+2, (jcnw-jcsw+1)*(cg%nz+2), MPI_REAL,     &
+            workarrc_lr_exchange_type, ierr )
+       CALL MPI_TYPE_COMMIT( workarrc_lr_exchange_type, ierr )
+!
+!--    For the south and north boundaries
+       CALL MPI_TYPE_VECTOR( 1, 3*(cg%nz+2), 3*(cg%nz+2), MPI_REAL,             &
+            workarrc_sn_exchange_type, ierr )
+       CALL MPI_TYPE_COMMIT( workarrc_sn_exchange_type, ierr )
+!
+!--    For the top-boundary x-slices
+!AH       CALL MPI_TYPE_VECTOR( icrw-iclw+1, 3, 3*(jcnw-jcsw+1), MPI_REAL,         &
+!AH            workarrc_t_exchange_type_x, ierr )
+       CALL MPI_TYPE_VECTOR( icrw-iclw+1, 6, 6*(jcnw-jcsw+1), MPI_REAL,         &
+            workarrc_t_exchange_type_x, ierr )
+       CALL MPI_TYPE_COMMIT( workarrc_t_exchange_type_x, ierr )
+!
+!--    For the top-boundary y-slices
+!AH       CALL MPI_TYPE_VECTOR( 1, 3*(jcnw-jcsw+1), 3*(jcnw-jcsw+1), MPI_REAL,     &
+!AH            workarrc_t_exchange_type_y, ierr )
+       CALL MPI_TYPE_VECTOR( 1, 6*(jcnw-jcsw+1), 6*(jcnw-jcsw+1), MPI_REAL,     &
+            workarrc_t_exchange_type_y, ierr )
+       CALL MPI_TYPE_COMMIT( workarrc_t_exchange_type_y, ierr )
+#endif
        
-       frax(icl:icr) = 1.0_wp
-       fray(jcs:jcn) = 1.0_wp
-
-!AH       IF ( nesting_mode /= 'vertical' )  THEN
-!AH          DO  ii = icl, icr
-!AH             IF ( ifuu(ii) < ( nx + 1 ) / 2 )  THEN   
-!AH                xi = ( MAX( 0.0_wp, ( cg%coord_x(ii) -                         &
-!AH                     lower_left_coord_x ) ) / anterp_relax_length_l )**4
-!AH                frax(ii) = xi / ( 1.0_wp + xi )
-!AH             ELSE
-!AH                xi = ( MAX( 0.0_wp, ( lower_left_coord_x + ( nx + 1 ) * dx -   &
-!AH                                      cg%coord_x(ii) ) ) /                     &
-!AH                       anterp_relax_length_r )**4
-!AH                frax(ii) = xi / ( 1.0_wp + xi )                
-!AH             ENDIF
-!AH          ENDDO
-!AH
-!AH          DO  jj = jcs, jcn
-!AH             IF ( jfuv(jj) < ( ny + 1 ) / 2 )  THEN 
-!AH                eta = ( MAX( 0.0_wp, ( cg%coord_y(jj) -                        &
-!AH                     lower_left_coord_y ) ) / anterp_relax_length_s )**4
-!AH                fray(jj) = eta / ( 1.0_wp + eta )
-!AH             ELSE
-!AH                eta = ( MAX( 0.0_wp, ( lower_left_coord_y + ( ny + 1 ) * dy -  &
-!AH                                       cg%coord_y(jj)) ) /                     &
-!AH                        anterp_relax_length_n )**4
-!AH                fray(jj) = eta / ( 1.0_wp + eta )
-!AH             ENDIF
-!AH          ENDDO
-!AH       ENDIF
-      
-       ALLOCATE( fraz(0:kcto) )
-       fraz(0:kcto) = 1.0_wp
-!AH       DO  kk = 0, kcto
-!AH          zeta = ( ( zu(nzt) - cg%zu(kk) ) / anterp_relax_length_t )**4
-!AH          fraz(kk) = zeta / ( 1.0_wp + zeta )
-!AH       ENDDO
-
-    END SUBROUTINE pmci_init_anterp_tophat
+    END SUBROUTINE pmci_create_workarray_exchange_datatypes
 
 
@@ -3921,5 +2008,4 @@
      END SUBROUTINE pmci_check_grid_matching
 
-
 #endif  
  END SUBROUTINE pmci_setup_child
@@ -4000,4 +2086,5 @@
        pmc_max_array = pmc_max_array + nspec
 #endif
+    
  END SUBROUTINE pmci_num_arrays
 
@@ -4012,8 +2099,8 @@
     INTEGER(iwp), INTENT(IN),OPTIONAL ::  n           !< index of chemical species
 
-    CHARACTER(LEN=*), INTENT(IN) ::  name        !<
+    CHARACTER(LEN=*), INTENT(IN) ::  name             !<
 
 #if defined( __parallel )
-    INTEGER(iwp) ::  ierr        !<
+    INTEGER(iwp) ::  ierr                            !< MPI error code
 
     REAL(wp), POINTER, DIMENSION(:,:)     ::  p_2d        !<
@@ -4027,5 +2114,4 @@
     NULLIFY( p_2d )
     NULLIFY( i_2d )
-
 !
 !-- List of array names, which can be coupled.
@@ -4046,10 +2132,8 @@
     IF ( TRIM(name) == "part_adr"   )  i_2d => part_adr
     IF ( INDEX( TRIM(name), "chem_" ) /= 0 )  p_3d => chem_species(n)%conc
-
 !
 !-- Next line is just an example for a 2D array (not active for coupling!)
 !-- Please note, that z0 has to be declared as TARGET array in modules.f90
 !    IF ( TRIM(name) == "z0" )    p_2d => z0
-
     IF ( TRIM(name) == "u"    )  p_3d_sec => u_2
     IF ( TRIM(name) == "v"    )  p_3d_sec => v_2
@@ -4094,5 +2178,5 @@
 
 
-INTEGER FUNCTION get_number_of_childs ()
+INTEGER FUNCTION get_number_of_childs ()     ! Change the name to "get_number_of_children"
 
    IMPLICIT NONE
@@ -4196,5 +2280,4 @@
     NULLIFY( p_2d )
     NULLIFY( i_2d )
-
 !
 !-- List of array names, which can be coupled
@@ -4286,5 +2369,4 @@
     INTEGER(iwp) ::  child_id    !<
     INTEGER(iwp) ::  m           !<
-
     REAL(wp) ::  waittime        !<
 
@@ -4324,5 +2406,4 @@
     INTEGER(iwp) ::  k          !< 
     INTEGER(iwp) ::  n          !< running index for chemical species
-
     REAL(wp) ::  waittime       !<
 
@@ -4350,60 +2431,34 @@
 !
 !--    The interpolation.
-       CALL pmci_interp_1sto_all ( u,  uc,  icu, jco, kco, r1xu, r2xu, r1yo,   &
-                                   r2yo, r1zo, r2zo, kcto, iflu, ifuu,         &
-                                   jflo, jfuo, kflo, kfuo, ijkfc_u, 'u' )
-       CALL pmci_interp_1sto_all ( v,  vc,  ico, jcv, kco, r1xo, r2xo, r1yv,   &
-                                   r2yv, r1zo, r2zo, kcto, iflo, ifuo,         &
-                                   jflv, jfuv, kflo, kfuo, ijkfc_v, 'v' )
-       CALL pmci_interp_1sto_all ( w,  wc,  ico, jco, kcw, r1xo, r2xo, r1yo,   &
-                                   r2yo, r1zw, r2zw, kctw, iflo, ifuo,         &
-                                   jflo, jfuo, kflw, kfuw, ijkfc_w, 'w' )
-
-       IF ( (        rans_mode_parent  .AND.         rans_mode )  .OR.          &
-            (  .NOT. rans_mode_parent  .AND.  .NOT.  rans_mode  .AND.           &
+       CALL pmci_interp_1sto_all ( u, uc, kcto, iflu, ifuu, jflo, jfuo, kflo, kfuo, 'u' )
+       CALL pmci_interp_1sto_all ( v, vc, kcto, iflo, ifuo, jflv, jfuv, kflo, kfuo, 'v' )
+       CALL pmci_interp_1sto_all ( w, wc, kctw, iflo, ifuo, jflo, jfuo, kflw, kfuw, 'w' )
+
+       IF ( (        rans_mode_parent  .AND.         rans_mode )  .OR.                              &
+            (  .NOT. rans_mode_parent  .AND.  .NOT.  rans_mode  .AND.                               &
                .NOT. constant_diffusion ) )  THEN
-          CALL pmci_interp_1sto_all ( e,  ec,  ico, jco, kco, r1xo, r2xo, r1yo, &
-                                      r2yo, r1zo, r2zo, kcto, iflo, ifuo,       &
-                                      jflo, jfuo, kflo, kfuo, ijkfc_s, 'e' )
+          CALL pmci_interp_1sto_all ( e, ec, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 'e' )
        ENDIF
 
        IF ( rans_mode_parent  .AND.  rans_mode  .AND.  rans_tke_e )  THEN
-          CALL pmci_interp_1sto_all ( diss,  dissc,  ico, jco, kco, r1xo, r2xo,&
-                                      r1yo, r2yo, r1zo, r2zo, kcto, iflo, ifuo,&
-                                      jflo, jfuo, kflo, kfuo, ijkfc_s, 's' )
+          CALL pmci_interp_1sto_all ( diss, dissc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 's' )
        ENDIF
 
        IF ( .NOT. neutral )  THEN
-          CALL pmci_interp_1sto_all ( pt, ptc, ico, jco, kco, r1xo, r2xo,      &
-                                      r1yo, r2yo, r1zo, r2zo, kcto, iflo, ifuo,&
-                                      jflo, jfuo, kflo, kfuo, ijkfc_s, 's' )
+          CALL pmci_interp_1sto_all ( pt, ptc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 's' )
        ENDIF
 
        IF ( humidity )  THEN
 
-          CALL pmci_interp_1sto_all ( q, q_c, ico, jco, kco, r1xo, r2xo, r1yo, &
-                                      r2yo, r1zo, r2zo, kcto, iflo, ifuo,      &
-                                      jflo, jfuo, kflo, kfuo, ijkfc_s, 's' )
+          CALL pmci_interp_1sto_all ( q, q_c, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 's' )
 
           IF ( bulk_cloud_model  .AND.  microphysics_morrison )  THEN
-             CALL pmci_interp_1sto_all ( qc, qcc, ico, jco, kco, r1xo, r2xo,   &
-                                         r1yo, r2yo, r1zo, r2zo, kcto,         &
-                                         iflo, ifuo, jflo, jfuo, kflo, kfuo,   &
-                                         ijkfc_s, 's' ) 
-             CALL pmci_interp_1sto_all ( nc, ncc, ico, jco, kco, r1xo, r2xo,   &
-                                         r1yo, r2yo, r1zo, r2zo, kcto,         &
-                                         iflo, ifuo, jflo, jfuo, kflo, kfuo,   &
-                                         ijkfc_s, 's' )   
+             CALL pmci_interp_1sto_all ( qc, qcc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 's' ) 
+             CALL pmci_interp_1sto_all ( nc, ncc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 's' )   
           ENDIF
 
           IF ( bulk_cloud_model  .AND.  microphysics_seifert )  THEN
-             CALL pmci_interp_1sto_all ( qr, qrc, ico, jco, kco, r1xo, r2xo,   &
-                                         r1yo, r2yo, r1zo, r2zo, kcto,         &
-                                         iflo, ifuo, jflo, jfuo, kflo, kfuo,   &
-                                         ijkfc_s, 's' )
-             CALL pmci_interp_1sto_all ( nr, nrc, ico, jco, kco, r1xo, r2xo,   &
-                                         r1yo, r2yo, r1zo, r2zo, kcto,         &
-                                         iflo, ifuo, jflo, jfuo, kflo, kfuo,   &
-                                         ijkfc_s, 's' )
+             CALL pmci_interp_1sto_all ( qr, qrc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 's' )
+             CALL pmci_interp_1sto_all ( nr, nrc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 's' )
           ENDIF
 
@@ -4411,16 +2466,11 @@
 
        IF ( passive_scalar )  THEN
-          CALL pmci_interp_1sto_all ( s, sc, ico, jco, kco, r1xo, r2xo, r1yo,  &
-                                      r2yo, r1zo, r2zo, kcto, iflo, ifuo,      &
-                                      jflo, jfuo, kflo, kfuo, ijkfc_s, 's' )
+          CALL pmci_interp_1sto_all ( s, sc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 's' )
        ENDIF
 
        IF ( air_chemistry  .AND.  nest_chemistry )  THEN
           DO  n = 1, nspec
-             CALL pmci_interp_1sto_all ( chem_species(n)%conc,                 &
-                                         chem_spec_c(:,:,:,n),                 &
-                                         ico, jco, kco, r1xo, r2xo, r1yo,      &
-                                         r2yo, r1zo, r2zo, kcto, iflo, ifuo,   &
-                                         jflo, jfuo, kflo, kfuo, ijkfc_s, 's' )
+             CALL pmci_interp_1sto_all ( chem_species(n)%conc, chem_spec_c(:,:,:,n),                &
+                                         kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 's' )
           ENDDO
        ENDIF
@@ -4460,43 +2510,21 @@
 
 
-    SUBROUTINE pmci_interp_1sto_all( f, fc, ic, jc, kc, r1x, r2x, r1y, r2y,    &
-                                     r1z, r2z, kct, ifl, ifu, jfl, jfu,        &
-                                     kfl, kfu, ijkfc, var )
+    SUBROUTINE pmci_interp_1sto_all( f, fc, kct, ifl, ifu, jfl, jfu, kfl, kfu, var )
 !
 !--    Interpolation of the internal values for the child-domain initialization
        IMPLICIT NONE
 
-       CHARACTER(LEN=1), INTENT(IN) :: var  !<
-
-       INTEGER(iwp), DIMENSION(nxlfc:nxrfc), INTENT(IN)         ::  ic    !<
-       INTEGER(iwp), DIMENSION(nysfc:nynfc), INTENT(IN)         ::  jc    !<
-!AH       INTEGER(iwp), DIMENSION(nzb:nzt+1), INTENT(IN)           ::  kc    !<
-       INTEGER(iwp), DIMENSION(nzb:nzt+kgsr), INTENT(IN)        ::  kc    !<
-
-       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(nxlfc:nxrfc), INTENT(IN)  :: r1x   !<
-       REAL(wp), DIMENSION(nxlfc:nxrfc), INTENT(IN)  :: r2x   !<
-       REAL(wp), DIMENSION(nysfc:nynfc), INTENT(IN)  :: r1y   !<
-       REAL(wp), DIMENSION(nysfc:nynfc), INTENT(IN)  :: r2y   !<
-       REAL(wp), DIMENSION(nzb:nzt+kgsr), INTENT(IN) :: r1z   !<
-       REAL(wp), DIMENSION(nzb:nzt+kgsr), INTENT(IN) :: r2z   !<
-
-       INTEGER(iwp) :: kct
-!AH       INTEGER(iwp), DIMENSION(icl:icr), INTENT(IN) ::  ifl !< Indicates start index of child cells belonging to certain parent cell - x direction
-!AH       INTEGER(iwp), DIMENSION(icl:icr), INTENT(IN) ::  ifu !< Indicates end index of child cells belonging to certain parent cell - x direction
-!AH       INTEGER(iwp), DIMENSION(jcs:jcn), INTENT(IN) ::  jfl !< Indicates start index of child cells belonging to certain parent cell - y direction
-!AH       INTEGER(iwp), DIMENSION(jcs:jcn), INTENT(IN) ::  jfu !< Indicates start index of child cells belonging to certain parent cell - y direction
+       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(INOUT) :: f  !< Child-grid array 
+       REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr), INTENT(IN) :: fc        !< Parent-grid array
+       INTEGER(iwp) :: kct                                    !< The parent-grid index in z-direction just below the boundary value node
        INTEGER(iwp), DIMENSION(icla:icra), INTENT(IN) ::  ifl !< Indicates start index of child cells belonging to certain parent cell - x direction
        INTEGER(iwp), DIMENSION(icla:icra), INTENT(IN) ::  ifu !< Indicates end index of child cells belonging to certain parent cell - x direction
        INTEGER(iwp), DIMENSION(jcsa:jcna), INTENT(IN) ::  jfl !< Indicates start index of child cells belonging to certain parent cell - y direction
-       INTEGER(iwp), DIMENSION(jcsa:jcna), INTENT(IN) ::  jfu !< Indicates start index of child cells belonging to certain parent cell - y direction
+       INTEGER(iwp), DIMENSION(jcsa:jcna), INTENT(IN) ::  jfu !< Indicates end index of child cells belonging to certain parent cell - y direction
        INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN) ::  kfl !< Indicates start index of child cells belonging to certain parent cell - z direction
-       INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN) ::  kfu !< Indicates start index of child cells belonging to certain parent cell - z direction
-!AH
-!       INTEGER(iwp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr), INTENT(IN) :: ijkfc !< number of child grid points contributing to a parent grid box
-       INTEGER(iwp), DIMENSION(0:cg%nz+1,jcsa:jcna,icla:icra), INTENT(IN) :: ijkfc !< number of child grid points contributing to a parent grid box
-!AH
-
+       INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN) ::  kfu !< Indicates end index of child cells belonging to certain parent cell - z direction
+       CHARACTER(LEN=1), INTENT(IN) :: var                    !< Variable symbol: 'u', 'v', 'w' or 's'
+!
+!--    Local variables:
        INTEGER(iwp) ::  i        !<
        INTEGER(iwp) ::  ib       !<
@@ -4517,5 +2545,4 @@
        INTEGER(iwp) ::  me       !<
        INTEGER(iwp) ::  n        !<
-       INTEGER(iwp) ::  var_flag !<
 
 
@@ -4558,16 +2585,5 @@
              jlast = nyn + 1
           ENDIF
-       ENDIF
-!
-!--    Is masking needed here, think about it.
-       IF ( var == 'u' )  THEN 
-          var_flag = 1 
-       ELSEIF ( var == 'v' )  THEN
-          var_flag = 2 
-       ELSEIF ( var == 'w' )  THEN
-          var_flag = 3
-       ELSE
-          var_flag = 0
-       ENDIF       
+       ENDIF      
 
        f(:,:,:) = 0.0_wp
@@ -5044,34 +3060,12 @@
           IF ( bc_dirichlet_l )  THEN
 
-             CALL pmci_interp_1sto_lr( u,  uc,  icu, jco, kco, r1xu, r2xu,      &
-                                       r1yo, r2yo, r1zo, r2zo,                  &
-                                       logc_u_l, logc_ratio_u_l,                &
-                                       logc_kbounds_u_l, nzt_topo_nestbc_l,     &
-                                       kcto, iflu, ifuu, jflo, jfuo, kflo,      &
-                                       kfuo, ijkfc_u, 'l', 'u' )
-
-             CALL pmci_interp_1sto_lr( v,  vc,  ico, jcv, kco, r1xo, r2xo,      &
-                                       r1yv, r2yv, r1zo, r2zo,                  &
-                                       logc_v_l, logc_ratio_v_l,                &
-                                       logc_kbounds_v_l, nzt_topo_nestbc_l,     &
-                                       kcto, iflo, ifuo, jflv, jfuv, kflo,      &
-                                       kfuo, ijkfc_v, 'l', 'v' )
-
-             CALL pmci_interp_1sto_lr( w,  wc,  ico, jco, kcw, r1xo, r2xo,      &
-                                       r1yo, r2yo, r1zw, r2zw,                  &
-                                       logc_w_l, logc_ratio_w_l,                &
-                                       logc_kbounds_w_l, nzt_topo_nestbc_l,     &
-                                       kctw, iflo, ifuo, jflo, jfuo, kflw,      &
-                                       kfuw, ijkfc_w, 'l', 'w' )
-
-             IF ( (        rans_mode_parent  .AND.         rans_mode )  .OR.   &
-                  (  .NOT. rans_mode_parent  .AND.  .NOT.  rans_mode  .AND.    &
+             CALL pmci_interp_1sto_lr( u, uc, kcto, jflo, jfuo, kflo, kfuo, 'l', 'u' )
+             CALL pmci_interp_1sto_lr( v, vc, kcto, jflv, jfuv, kflo, kfuo, 'l', 'v' )
+             CALL pmci_interp_1sto_lr( w, wc, kctw, jflo, jfuo, kflw, kfuw, 'l', 'w' )
+
+             IF ( (        rans_mode_parent  .AND.         rans_mode )  .OR.                        &
+                  (  .NOT. rans_mode_parent  .AND.  .NOT.  rans_mode  .AND.                         &
                      .NOT. constant_diffusion ) )  THEN
-!                CALL pmci_interp_1sto_lr( e,  ec,  ico, jco, kco, r1xo, r2xo,  &
-!                                          r1yo, r2yo, r1zo, r2zo,              &
-!                                          logc_w_l, logc_ratio_w_l,            &
-!                                          logc_kbounds_w_l, nzt_topo_nestbc_l, &
-!                                          kcto, iflo, ifuo, jflo, jfuo, kflo,  &
-!                                          kfuo, ijkfc_s, 'l', 'e' )
+!                CALL pmci_interp_1sto_lr( e, ec, kcto, jflo, jfuo, kflo, kfuo, 'l', 'e' )
 !
 !--             Interpolation of e is replaced by the Neumann condition. 
@@ -5083,64 +3077,23 @@
 
              IF ( rans_mode_parent  .AND.  rans_mode  .AND.  rans_tke_e )  THEN
-                CALL pmci_interp_1sto_lr( diss,  dissc,  ico, jco, kco, r1xo,  &
-                                          r2xo, r1yo, r2yo, r1zo, r2zo,        &
-                                          logc_w_l, logc_ratio_w_l,            &
-                                          logc_kbounds_w_l, nzt_topo_nestbc_l, &
-                                          kcto, iflo, ifuo, jflo, jfuo, kflo,  &
-                                          kfuo, ijkfc_s, 'l', 's' )
+                CALL pmci_interp_1sto_lr( diss, dissc, kcto, jflo, jfuo, kflo, kfuo, 'l', 's' )
              ENDIF
 
              IF ( .NOT. neutral )  THEN
-                CALL pmci_interp_1sto_lr( pt, ptc, ico, jco, kco, r1xo, r2xo,  &
-                                          r1yo, r2yo, r1zo, r2zo,              &
-                                          logc_w_l, logc_ratio_w_l,            &
-                                          logc_kbounds_w_l, nzt_topo_nestbc_l, &
-                                          kcto, iflo, ifuo, jflo, jfuo, kflo,  &
-                                          kfuo, ijkfc_s, 'l', 's' )
+                CALL pmci_interp_1sto_lr( pt, ptc, kcto, jflo, jfuo, kflo, kfuo, 'l', 's' )
              ENDIF
 
              IF ( humidity )  THEN
 
-                CALL pmci_interp_1sto_lr( q, q_c, ico, jco, kco, r1xo, r2xo,   &
-                                          r1yo, r2yo, r1zo, r2zo,              &
-                                          logc_w_l, logc_ratio_w_l,            &
-                                          logc_kbounds_w_l, nzt_topo_nestbc_l, &
-                                          kcto, iflo, ifuo, jflo, jfuo, kflo,  &
-                                          kfuo, ijkfc_s, 'l', 's' )
+                CALL pmci_interp_1sto_lr( q, q_c, kcto, jflo, jfuo, kflo, kfuo, 'l', 's' )
 
                 IF ( bulk_cloud_model  .AND.  microphysics_morrison )  THEN
-                   CALL pmci_interp_1sto_lr( qc, qcc, ico, jco, kco, r1xo,     &
-                                             r2xo, r1yo, r2yo, r1zo, r2zo,     &
-                                             logc_w_l, logc_ratio_w_l,         &
-                                             logc_kbounds_w_l,                 &
-                                             nzt_topo_nestbc_l,                &
-                                             kcto, iflo, ifuo, jflo, jfuo,     &
-                                             kflo, kfuo, ijkfc_s, 'l', 's' )  
-
-                   CALL pmci_interp_1sto_lr( nc, ncc, ico, jco, kco, r1xo,     &
-                                             r2xo, r1yo, r2yo, r1zo, r2zo,     &
-                                             logc_w_l, logc_ratio_w_l,         &
-                                             logc_kbounds_w_l,                 &
-                                             nzt_topo_nestbc_l,                &
-                                             kcto, iflo, ifuo, jflo, jfuo,     &
-                                             kflo, kfuo, ijkfc_s, 'l', 's' )          
+                   CALL pmci_interp_1sto_lr( qc, qcc, kcto, jflo, jfuo, kflo, kfuo, 'l', 's' )  
+                   CALL pmci_interp_1sto_lr( nc, ncc, kcto, jflo, jfuo, kflo, kfuo, 'l', 's' )          
                 ENDIF
 
                 IF ( bulk_cloud_model  .AND.  microphysics_seifert )  THEN
-                   CALL pmci_interp_1sto_lr( qr, qrc, ico, jco, kco, r1xo,     &
-                                             r2xo, r1yo, r2yo, r1zo, r2zo,     &
-                                             logc_w_l, logc_ratio_w_l,         &
-                                             logc_kbounds_w_l,                 &
-                                             nzt_topo_nestbc_l,                &
-                                             kcto, iflo, ifuo, jflo, jfuo,     &
-                                             kflo, kfuo, ijkfc_s, 'l', 's' ) 
-
-                   CALL pmci_interp_1sto_lr( nr, nrc, ico, jco, kco, r1xo,     &
-                                             r2xo, r1yo, r2yo, r1zo, r2zo,     &
-                                             logc_w_l, logc_ratio_w_l,         &
-                                             logc_kbounds_w_l,                 &
-                                             nzt_topo_nestbc_l,                &
-                                             kcto, iflo, ifuo, jflo, jfuo,     &
-                                             kflo, kfuo, ijkfc_s, 'l', 's' )             
+                   CALL pmci_interp_1sto_lr( qr, qrc, kcto, jflo, jfuo, kflo, kfuo, 'l', 's' ) 
+                   CALL pmci_interp_1sto_lr( nr, nrc, kcto, jflo, jfuo, kflo, kfuo, 'l', 's' )             
                 ENDIF
 
@@ -5148,24 +3101,11 @@
 
              IF ( passive_scalar )  THEN
-                CALL pmci_interp_1sto_lr( s, sc, ico, jco, kco, r1xo, r2xo,    &
-                                          r1yo, r2yo, r1zo, r2zo,              &
-                                          logc_w_l, logc_ratio_w_l,            &
-                                          logc_kbounds_w_l,                    & 
-                                          nzt_topo_nestbc_l,                   &
-                                          kcto, iflo, ifuo, jflo, jfuo,        &
-                                          kflo, kfuo, ijkfc_s, 'l', 's' )
+                CALL pmci_interp_1sto_lr( s, sc, kcto, jflo, jfuo, kflo, kfuo, 'l', 's' )
              ENDIF
 
              IF ( air_chemistry  .AND.  nest_chemistry )  THEN
                 DO  n = 1, nspec
-                   CALL pmci_interp_1sto_lr( chem_species(n)%conc,             &
-                                             chem_spec_c(:,:,:,n),             &
-                                             ico, jco, kco, r1xo, r2xo,        &
-                                             r1yo, r2yo, r1zo, r2zo,           &
-                                             logc_w_l, logc_ratio_w_l,         &
-                                             logc_kbounds_w_l,                 & 
-                                             nzt_topo_nestbc_l,                &
-                                             kcto, iflo, ifuo, jflo, jfuo,     &
-                                             kflo, kfuo, ijkfc_s, 'l', 's' )
+                   CALL pmci_interp_1sto_lr( chem_species(n)%conc, chem_spec_c(:,:,:,n),            &
+                        kcto, jflo, jfuo, kflo, kfuo, 'l', 's' )
                 ENDDO
              ENDIF
@@ -5176,34 +3116,12 @@
           IF ( bc_dirichlet_r )  THEN
              
-             CALL pmci_interp_1sto_lr( u,  uc,  icu, jco, kco, r1xu, r2xu,     &
-                                       r1yo, r2yo, r1zo, r2zo,                 &
-                                       logc_u_r, logc_ratio_u_r,               &
-                                       logc_kbounds_u_r, nzt_topo_nestbc_r,    &
-                                       kcto, iflu, ifuu, jflo, jfuo, kflo,     &
-                                       kfuo, ijkfc_u, 'r', 'u' )
-
-             CALL pmci_interp_1sto_lr( v,  vc,  ico, jcv, kco, r1xo, r2xo,     &
-                                       r1yv, r2yv, r1zo, r2zo,                 &
-                                       logc_v_r, logc_ratio_v_r,               &
-                                       logc_kbounds_v_r, nzt_topo_nestbc_r,    &
-                                       kcto, iflo, ifuo, jflv, jfuv, kflo,     &
-                                       kfuo, ijkfc_v, 'r', 'v' )
-
-             CALL pmci_interp_1sto_lr( w,  wc,  ico, jco, kcw, r1xo, r2xo,     &
-                                       r1yo, r2yo, r1zw, r2zw,                 &
-                                       logc_w_r, logc_ratio_w_r,               &
-                                       logc_kbounds_w_r, nzt_topo_nestbc_r,    &
-                                       kctw, iflo, ifuo, jflo, jfuo, kflw,     &
-                                       kfuw, ijkfc_w, 'r', 'w' )
-
-             IF ( (        rans_mode_parent  .AND.         rans_mode )  .OR.   &
-                  (  .NOT. rans_mode_parent  .AND.  .NOT.  rans_mode  .AND.    &
+             CALL pmci_interp_1sto_lr( u, uc, kcto, jflo, jfuo, kflo, kfuo, 'r', 'u' )
+             CALL pmci_interp_1sto_lr( v, vc, kcto, jflv, jfuv, kflo, kfuo, 'r', 'v' )
+             CALL pmci_interp_1sto_lr( w, wc, kctw, jflo, jfuo, kflw, kfuw, 'r', 'w' )
+
+             IF ( (        rans_mode_parent  .AND.         rans_mode )  .OR.                        &
+                  (  .NOT. rans_mode_parent  .AND.  .NOT.  rans_mode  .AND.                         &
                      .NOT. constant_diffusion ) )  THEN
-!                CALL pmci_interp_1sto_lr( e,  ec,  ico, jco, kco, r1xo, r2xo,  &
-!                                          r1yo,r2yo, r1zo, r2zo,               &
-!                                          logc_w_r, logc_ratio_w_r,            &
-!                                          logc_kbounds_w_r, nzt_topo_nestbc_r, &
-!                                          kcto, iflo, ifuo, jflo, jfuo, kflo,  &
-!                                          kfuo, ijkfc_s, 'r', 'e' )
+!                CALL pmci_interp_1sto_lr( e, ec, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 'r', 'e' )
 !
 !--             Interpolation of e is replaced by the Neumann condition. 
@@ -5214,70 +3132,23 @@
 
              IF ( rans_mode_parent  .AND.  rans_mode  .AND.  rans_tke_e )  THEN
-                CALL pmci_interp_1sto_lr( diss,  dissc,  ico, jco, kco, r1xo,  &
-                                          r2xo, r1yo,r2yo, r1zo, r2zo,         &
-                                          logc_w_r, logc_ratio_w_r,            &
-                                          logc_kbounds_w_r, nzt_topo_nestbc_r, &
-                                          kcto, iflo, ifuo, jflo, jfuo, kflo,  &
-                                          kfuo, ijkfc_s, 'r', 's' )
+                CALL pmci_interp_1sto_lr( diss, dissc, kcto, jflo, jfuo, kflo, kfuo, 'r', 's' )
 
              ENDIF
 
              IF ( .NOT. neutral )  THEN
-                CALL pmci_interp_1sto_lr( pt, ptc, ico, jco, kco, r1xo, r2xo,  &
-                                          r1yo, r2yo, r1zo, r2zo,              &
-                                          logc_w_r, logc_ratio_w_r,            &
-                                          logc_kbounds_w_r, nzt_topo_nestbc_r, &
-                                          kcto, iflo, ifuo, jflo, jfuo, kflo,  &
-                                          kfuo, ijkfc_s, 'r', 's' )
+                CALL pmci_interp_1sto_lr( pt, ptc, kcto, jflo, jfuo, kflo, kfuo, 'r', 's' )
              ENDIF
 
              IF ( humidity )  THEN
-                CALL pmci_interp_1sto_lr( q, q_c, ico, jco, kco, r1xo, r2xo,   &
-                                          r1yo, r2yo, r1zo, r2zo,              &
-                                          logc_w_r, logc_ratio_w_r,            &
-                                          logc_kbounds_w_r, nzt_topo_nestbc_r, &
-                                          kcto, iflo, ifuo, jflo, jfuo, kflo,  &
-                                          kfuo, ijkfc_s, 'r', 's' )
+                CALL pmci_interp_1sto_lr( q, q_c, kcto, jflo, jfuo, kflo, kfuo, 'r', 's' )
 
                 IF ( bulk_cloud_model  .AND.  microphysics_morrison )  THEN
-
-                   CALL pmci_interp_1sto_lr( qc, qcc, ico, jco, kco, r1xo,     &
-                                             r2xo, r1yo, r2yo, r1zo, r2zo,     &
-                                             logc_w_r, logc_ratio_w_r,         &
-                                             logc_kbounds_w_r,                 &
-                                             nzt_topo_nestbc_r,                &
-                                             kcto, iflo, ifuo, jflo, jfuo,     &
-                                             kflo, kfuo, ijkfc_s, 'r', 's' ) 
-     
-                   CALL pmci_interp_1sto_lr( nc, ncc, ico, jco, kco, r1xo,     &
-                                             r2xo, r1yo, r2yo, r1zo, r2zo,     &
-                                             logc_w_r, logc_ratio_w_r,         &
-                                             logc_kbounds_w_r,                 &
-                                             nzt_topo_nestbc_r,                &
-                                             kcto, iflo, ifuo, jflo, jfuo,     &
-                                             kflo, kfuo, ijkfc_s, 'r', 's' )
-
+                   CALL pmci_interp_1sto_lr( qc, qcc, kcto, jflo, jfuo, kflo, kfuo, 'r', 's' ) 
+                   CALL pmci_interp_1sto_lr( nc, ncc, kcto, jflo, jfuo, kflo, kfuo, 'r', 's' )
                 ENDIF
 
                 IF ( bulk_cloud_model  .AND.  microphysics_seifert )  THEN
-
-     
-                   CALL pmci_interp_1sto_lr( qr, qrc, ico, jco, kco, r1xo,     &
-                                             r2xo, r1yo, r2yo, r1zo, r2zo,     &
-                                             logc_w_r, logc_ratio_w_r,         &
-                                             logc_kbounds_w_r,                 &
-                                             nzt_topo_nestbc_r,                &
-                                             kcto, iflo, ifuo, jflo, jfuo,     &
-                                             kflo, kfuo, ijkfc_s,              &
-                                             'r', 's' ) 
-
-                   CALL pmci_interp_1sto_lr( nr, nrc, ico, jco, kco, r1xo,     &
-                                             r2xo, r1yo, r2yo, r1zo, r2zo,     &
-                                             logc_w_r, logc_ratio_w_r,         &
-                                             logc_kbounds_w_r,                 &
-                                             nzt_topo_nestbc_r,                &
-                                             kcto, iflo, ifuo, jflo, jfuo,     &
-                                             kflo, kfuo, ijkfc_s, 'r', 's' ) 
-
+                   CALL pmci_interp_1sto_lr( qr, qrc, kcto, jflo, jfuo, kflo, kfuo, 'r', 's' ) 
+                   CALL pmci_interp_1sto_lr( nr, nrc, kcto, jflo, jfuo, kflo, kfuo, 'r', 's' ) 
                 ENDIF
 
@@ -5285,24 +3156,11 @@
 
              IF ( passive_scalar )  THEN
-                CALL pmci_interp_1sto_lr( s, sc, ico, jco, kco, r1xo, r2xo,    &
-                                          r1yo, r2yo, r1zo, r2zo,              &
-                                          logc_w_r, logc_ratio_w_r,            &
-                                          logc_kbounds_w_r,                    &
-                                          nzt_topo_nestbc_r,                   &
-                                          kcto, iflo, ifuo, jflo, jfuo,        &
-                                          kflo, kfuo, ijkfc_s, 'r', 's' )
+                CALL pmci_interp_1sto_lr( s, sc, kcto, jflo, jfuo, kflo, kfuo, 'r', 's' )
              ENDIF
 
              IF ( air_chemistry  .AND.  nest_chemistry )  THEN
                 DO  n = 1, nspec
-                   CALL pmci_interp_1sto_lr( chem_species(n)%conc,             &
-                                             chem_spec_c(:,:,:,n),             &
-                                             ico, jco, kco, r1xo, r2xo,        &
-                                             r1yo, r2yo, r1zo, r2zo,           &
-                                             logc_w_r, logc_ratio_w_r,         &
-                                             logc_kbounds_w_r,                 &
-                                             nzt_topo_nestbc_r,                &
-                                             kcto, iflo, ifuo, jflo, jfuo,     &
-                                             kflo, kfuo, ijkfc_s, 'r', 's' )
+                   CALL pmci_interp_1sto_lr( chem_species(n)%conc, chem_spec_c(:,:,:,n),            &
+                        kcto, jflo, jfuo, kflo, kfuo, 'r', 's' )
                 ENDDO
              ENDIF
@@ -5312,34 +3170,12 @@
           IF ( bc_dirichlet_s )  THEN
 
-             CALL pmci_interp_1sto_sn( v,  vc,  ico, jcv, kco, r1xo, r2xo,     &
-                                       r1yv, r2yv, r1zo, r2zo,                 &
-                                       logc_v_s, logc_ratio_v_s,               &
-                                       logc_kbounds_v_s, nzt_topo_nestbc_s,    &
-                                       kcto, iflo, ifuo, jflv, jfuv, kflo,     &
-                                       kfuo, ijkfc_v, 's', 'v' )
-
-             CALL pmci_interp_1sto_sn( w,  wc,  ico, jco, kcw, r1xo, r2xo,     &
-                                       r1yo, r2yo, r1zw, r2zw,                 &
-                                       logc_w_s, logc_ratio_w_s,               &
-                                       logc_kbounds_w_s, nzt_topo_nestbc_s,    &
-                                       kctw, iflo, ifuo, jflo, jfuo, kflw,     &
-                                       kfuw, ijkfc_w, 's','w' )
-
-             CALL pmci_interp_1sto_sn( u,  uc,  icu, jco, kco, r1xu, r2xu,     &
-                                       r1yo, r2yo, r1zo, r2zo,                 &
-                                       logc_u_s, logc_ratio_u_s,               &
-                                       logc_kbounds_u_s, nzt_topo_nestbc_s,    &
-                                       kcto, iflu, ifuu, jflo, jfuo, kflo,     &
-                                       kfuo, ijkfc_u, 's', 'u' )
+             CALL pmci_interp_1sto_sn( v, vc, kcto, iflo, ifuo, kflo, kfuo, 's', 'v' )
+             CALL pmci_interp_1sto_sn( w, wc, kctw, iflo, ifuo, kflw, kfuw, 's', 'w' )
+             CALL pmci_interp_1sto_sn( u, uc, kcto, iflu, ifuu, kflo, kfuo, 's', 'u' )
 
              IF ( (        rans_mode_parent  .AND.         rans_mode )  .OR.   &
                   (  .NOT. rans_mode_parent  .AND.  .NOT.  rans_mode  .AND.    &
                      .NOT. constant_diffusion ) )  THEN
-!                CALL pmci_interp_1sto_sn( e,  ec,  ico, jco, kco, r1xo, r2xo,  &
-!                                          r1yo, r2yo, r1zo, r2zo,              &
-!                                          logc_w_s, logc_ratio_w_s,            &
-!                                          logc_kbounds_w_s, nzt_topo_nestbc_s, &
-!                                          kcto, iflo, ifuo, jflo, jfuo, kflo,  &
-!                                          kfuo, ijkfc_s, 's', 'e' )
+!                CALL pmci_interp_1sto_sn( e, ec, kcto, iflo, ifuo, kflo, kfuo, 's', 'e' )
 !
 !--             Interpolation of e is replaced by the Neumann condition. 
@@ -5350,67 +3186,22 @@
 
              IF ( rans_mode_parent  .AND.  rans_mode  .AND.  rans_tke_e )  THEN
-                CALL pmci_interp_1sto_sn( diss, dissc,  ico, jco, kco, r1xo,   &
-                                          r2xo, r1yo, r2yo, r1zo, r2zo,        &
-                                          logc_w_s, logc_ratio_w_s,            &
-                                          logc_kbounds_w_s, nzt_topo_nestbc_s, &
-                                          kcto, iflo, ifuo, jflo, jfuo, kflo,  &
-                                          kfuo, ijkfc_s, 's', 's' )
+                CALL pmci_interp_1sto_sn( diss, dissc, kcto, iflo, ifuo, kflo, kfuo, 's', 's' )
              ENDIF
 
              IF ( .NOT. neutral )  THEN
-                CALL pmci_interp_1sto_sn( pt, ptc, ico, jco, kco, r1xo, r2xo,  &
-                                          r1yo, r2yo, r1zo, r2zo,              &
-                                          logc_w_s, logc_ratio_w_s,            &
-                                          logc_kbounds_w_s, nzt_topo_nestbc_s, &
-                                          kcto, iflo, ifuo, jflo, jfuo, kflo,  &
-                                          kfuo, ijkfc_s, 's', 's' )
+                CALL pmci_interp_1sto_sn( pt, ptc, kcto, iflo, ifuo, kflo, kfuo, 's', 's' )
              ENDIF
 
              IF ( humidity )  THEN
-                CALL pmci_interp_1sto_sn( q, q_c, ico, jco, kco, r1xo, r2xo,   &
-                                          r1yo,r2yo, r1zo, r2zo,               &
-                                          logc_w_s, logc_ratio_w_s,            &
-                                          logc_kbounds_w_s, nzt_topo_nestbc_s, &
-                                          kcto, iflo, ifuo, jflo, jfuo, kflo,  &
-                                          kfuo, ijkfc_s, 's', 's' )
+                CALL pmci_interp_1sto_sn( q, q_c, kcto, iflo, ifuo, kflo, kfuo, 's', 's' )
 
                 IF ( bulk_cloud_model  .AND.  microphysics_morrison )  THEN
-
-                   CALL pmci_interp_1sto_sn( qc, qcc, ico, jco, kco, r1xo,     &
-                                             r2xo, r1yo,r2yo, r1zo, r2zo,      &
-                                             logc_w_s, logc_ratio_w_s,         &
-                                             logc_kbounds_w_s,                 &
-                                             nzt_topo_nestbc_s,                &
-                                             kcto, iflo, ifuo, jflo, jfuo,     &
-                                             kflo, kfuo, ijkfc_s, 's', 's' )
-
-                   CALL pmci_interp_1sto_sn( nc, ncc, ico, jco, kco, r1xo,     &
-                                             r2xo, r1yo,r2yo, r1zo, r2zo,      &
-                                             logc_w_s, logc_ratio_w_s,         &
-                                             logc_kbounds_w_s,                 &
-                                             nzt_topo_nestbc_s,                &
-                                             kcto, iflo, ifuo, jflo, jfuo,     &
-                                             kflo, kfuo, ijkfc_s, 's', 's' )
-
+                   CALL pmci_interp_1sto_sn( qc, qcc, kcto, iflo, ifuo, kflo, kfuo, 's', 's' )
+                   CALL pmci_interp_1sto_sn( nc, ncc, kcto, iflo, ifuo, kflo, kfuo, 's', 's' )
                 ENDIF
 
                 IF ( bulk_cloud_model  .AND.  microphysics_seifert )  THEN
-
-                   CALL pmci_interp_1sto_sn( qr, qrc, ico, jco, kco, r1xo,     &
-                                             r2xo, r1yo,r2yo, r1zo, r2zo,      &
-                                             logc_w_s, logc_ratio_w_s,         &
-                                             logc_kbounds_w_s,                 &
-                                             nzt_topo_nestbc_s,                &
-                                             kcto, iflo, ifuo, jflo, jfuo,     &
-                                             kflo, kfuo, ijkfc_s, 's', 's' )
-
-                   CALL pmci_interp_1sto_sn( nr, nrc, ico, jco, kco, r1xo,     &
-                                             r2xo, r1yo,r2yo, r1zo, r2zo,      &
-                                             logc_w_s, logc_ratio_w_s,         &
-                                             logc_kbounds_w_s,                 &
-                                             nzt_topo_nestbc_s,                &
-                                             kcto, iflo, ifuo, jflo, jfuo,     &
-                                             kflo, kfuo, ijkfc_s, 's', 's' )
-
+                   CALL pmci_interp_1sto_sn( qr, qrc, kcto, iflo, ifuo, kflo, kfuo, 's', 's' )
+                   CALL pmci_interp_1sto_sn( nr, nrc, kcto, iflo, ifuo, kflo, kfuo, 's', 's' )
                 ENDIF
 
@@ -5418,24 +3209,11 @@
 
              IF ( passive_scalar )  THEN
-                CALL pmci_interp_1sto_sn( s, sc, ico, jco, kco, r1xo, r2xo,    &
-                                          r1yo,r2yo, r1zo, r2zo,               &
-                                          logc_w_s, logc_ratio_w_s,            &
-                                          logc_kbounds_w_s,                    &
-                                          nzt_topo_nestbc_s,                   &
-                                          kcto, iflo, ifuo, jflo, jfuo,        &
-                                          kflo, kfuo, ijkfc_s, 's', 's' )
+                CALL pmci_interp_1sto_sn( s, sc, kcto, iflo, ifuo, kflo, kfuo, 's', 's' )
              ENDIF
 
              IF ( air_chemistry  .AND.  nest_chemistry )  THEN
                 DO  n = 1, nspec
-                   CALL pmci_interp_1sto_sn( chem_species(n)%conc,             &
-                                             chem_spec_c(:,:,:,n),             &
-                                             ico, jco, kco, r1xo, r2xo,        &
-                                             r1yo, r2yo, r1zo, r2zo,           &
-                                             logc_w_s, logc_ratio_w_s,         &
-                                             logc_kbounds_w_s,                 &
-                                             nzt_topo_nestbc_s,                &
-                                             kcto, iflo, ifuo, jflo, jfuo,     &
-                                             kflo, kfuo, ijkfc_s, 's', 's' )
+                   CALL pmci_interp_1sto_sn( chem_species(n)%conc, chem_spec_c(:,:,:,n),            &
+                        kcto, iflo, ifuo, kflo, kfuo, 's', 's' )
                 ENDDO
              ENDIF
@@ -5445,34 +3223,12 @@
           IF ( bc_dirichlet_n )  THEN
              
-             CALL pmci_interp_1sto_sn( u,  uc,  icu, jco, kco, r1xu, r2xu,     &
-                                       r1yo, r2yo, r1zo, r2zo,                 &
-                                       logc_u_n, logc_ratio_u_n,               &
-                                       logc_kbounds_u_n, nzt_topo_nestbc_n,    &
-                                       kcto, iflu, ifuu, jflo, jfuo, kflo,     &
-                                       kfuo, ijkfc_u, 'n', 'u' )
-
-             CALL pmci_interp_1sto_sn( v,  vc,  ico, jcv, kco, r1xo, r2xo,     &
-                                       r1yv, r2yv, r1zo, r2zo,                 &
-                                       logc_v_n, logc_ratio_v_n,               &
-                                       logc_kbounds_v_n, nzt_topo_nestbc_n,    &
-                                       kcto, iflo, ifuo, jflv, jfuv, kflo,     &
-                                       kfuo, ijkfc_v, 'n', 'v' )
-
-             CALL pmci_interp_1sto_sn( w,  wc,  ico, jco, kcw, r1xo, r2xo,     &
-                                       r1yo, r2yo, r1zw, r2zw,                 &
-                                       logc_w_n, logc_ratio_w_n,               &
-                                       logc_kbounds_w_n, nzt_topo_nestbc_n,    &
-                                       kctw, iflo, ifuo, jflo, jfuo, kflw,     &
-                                       kfuw, ijkfc_w, 'n', 'w' )
-
-             IF ( (        rans_mode_parent  .AND.         rans_mode )  .OR.   & 
-                  (  .NOT. rans_mode_parent  .AND.  .NOT.  rans_mode  .AND.    &
+             CALL pmci_interp_1sto_sn( v, vc, kcto, iflo, ifuo, kflo, kfuo, 'n', 'v' )
+             CALL pmci_interp_1sto_sn( w, wc, kctw, iflo, ifuo, kflw, kfuw, 'n', 'w' )
+             CALL pmci_interp_1sto_sn( u, uc, kcto, iflu, ifuu, kflo, kfuo, 'n', 'u' )
+
+             IF ( (        rans_mode_parent  .AND.         rans_mode )  .OR.                        & 
+                  (  .NOT. rans_mode_parent  .AND.  .NOT.  rans_mode  .AND.                         &
                      .NOT. constant_diffusion ) )  THEN
-!                CALL pmci_interp_1sto_sn( e,  ec,  ico, jco, kco, r1xo, r2xo,  &
-!                                          r1yo, r2yo, r1zo, r2zo,              &
-!                                          logc_w_n, logc_ratio_w_n,            &
-!                                          logc_kbounds_w_n, nzt_topo_nestbc_n, &
-!                                          kcto, iflo, ifuo, jflo, jfuo, kflo,  &
-!                                          kfuo, ijkfc_s, 'n', 'e' )
+!                CALL pmci_interp_1sto_sn( e, ec, kcto, iflo, ifuo, kflo, kfuo, 'n', 'e' )
 !
 !--             Interpolation of e is replaced by the Neumann condition. 
@@ -5483,68 +3239,22 @@
 
              IF ( rans_mode_parent  .AND.  rans_mode  .AND.  rans_tke_e )  THEN
-                CALL pmci_interp_1sto_sn( diss, dissc,  ico, jco, kco, r1xo,   &
-                                          r2xo, r1yo, r2yo, r1zo, r2zo,        &
-                                          logc_w_n, logc_ratio_w_n,            &
-                                          logc_kbounds_w_n, nzt_topo_nestbc_n, &
-                                          kcto, iflo, ifuo, jflo, jfuo, kflo,  &
-                                          kfuo, ijkfc_s, 'n', 's' )
-
+                CALL pmci_interp_1sto_sn( diss, dissc, kcto, iflo, ifuo, kflo, kfuo, 'n', 's' )
              ENDIF
 
              IF ( .NOT. neutral )  THEN
-                CALL pmci_interp_1sto_sn( pt, ptc, ico, jco, kco, r1xo, r2xo,  &
-                                          r1yo, r2yo, r1zo, r2zo,              &
-                                          logc_w_n, logc_ratio_w_n,            &
-                                          logc_kbounds_w_n, nzt_topo_nestbc_n, &
-                                          kcto, iflo, ifuo, jflo, jfuo, kflo,  &
-                                          kfuo, ijkfc_s, 'n', 's' )
+                CALL pmci_interp_1sto_sn( pt, ptc, kcto, iflo, ifuo, kflo, kfuo, 'n', 's' )
              ENDIF
 
              IF ( humidity )  THEN
-                CALL pmci_interp_1sto_sn( q, q_c, ico, jco, kco, r1xo, r2xo,   &
-                                          r1yo, r2yo, r1zo, r2zo,              &
-                                          logc_w_n, logc_ratio_w_n,            &
-                                          logc_kbounds_w_n, nzt_topo_nestbc_n, &
-                                          kcto, iflo, ifuo, jflo, jfuo, kflo,  &
-                                          kfuo, ijkfc_s, 'n', 's' )
+                CALL pmci_interp_1sto_sn( q, q_c, kcto, iflo, ifuo, kflo, kfuo, 'n', 's' )
 
                 IF ( bulk_cloud_model  .AND.  microphysics_morrison )  THEN
-
-                   CALL pmci_interp_1sto_sn( qc, qcc, ico, jco, kco, r1xo,     &
-                                             r2xo, r1yo, r2yo, r1zo, r2zo,     &
-                                             logc_w_n, logc_ratio_w_n,         &
-                                             logc_kbounds_w_n,                 &
-                                             nzt_topo_nestbc_n,                &
-                                             kcto, iflo, ifuo, jflo, jfuo,     &
-                                             kflo, kfuo, ijkfc_s, 'n', 's' )
-
-                   CALL pmci_interp_1sto_sn( nc, ncc, ico, jco, kco, r1xo,     &
-                                             r2xo, r1yo, r2yo, r1zo, r2zo,     &
-                                             logc_u_n, logc_ratio_u_n,         &
-                                             logc_kbounds_w_n,                 &
-                                             nzt_topo_nestbc_n,                &
-                                             kcto, iflo, ifuo, jflo, jfuo,     &
-                                             kflo, kfuo, ijkfc_s, 'n', 's' )
-
+                   CALL pmci_interp_1sto_sn( qc, qcc, kcto, iflo, ifuo, kflo, kfuo, 'n', 's' )
+                   CALL pmci_interp_1sto_sn( nc, ncc, kcto, iflo, ifuo, kflo, kfuo, 'n', 's' )
                 ENDIF
 
                 IF ( bulk_cloud_model  .AND.  microphysics_seifert )  THEN
-
-                   CALL pmci_interp_1sto_sn( qr, qrc, ico, jco, kco, r1xo,     &
-                                             r2xo, r1yo, r2yo, r1zo, r2zo,     &
-                                             logc_w_n, logc_ratio_w_n,         &
-                                             logc_kbounds_w_n,                 &
-                                             nzt_topo_nestbc_n,                &
-                                             kcto, iflo, ifuo, jflo, jfuo,     &
-                                             kflo, kfuo, ijkfc_s, 'n', 's' )
-
-                   CALL pmci_interp_1sto_sn( nr, nrc, ico, jco, kco, r1xo,     &
-                                             r2xo, r1yo, r2yo, r1zo, r2zo,     &
-                                             logc_w_n, logc_ratio_w_n,         &
-                                             logc_kbounds_w_n,                 &
-                                             nzt_topo_nestbc_n,                &
-                                             kcto, iflo, ifuo, jflo, jfuo,     &
-                                             kflo, kfuo, ijkfc_s, 'n', 's' )
-
+                   CALL pmci_interp_1sto_sn( qr, qrc, kcto, iflo, ifuo, kflo, kfuo, 'n', 's' )
+                   CALL pmci_interp_1sto_sn( nr, nrc, kcto, iflo, ifuo, kflo, kfuo, 'n', 's' )
                 ENDIF
 
@@ -5552,24 +3262,11 @@
 
              IF ( passive_scalar )  THEN
-                CALL pmci_interp_1sto_sn( s, sc, ico, jco, kco, r1xo, r2xo,    &
-                                          r1yo, r2yo, r1zo, r2zo,              &
-                                          logc_w_n, logc_ratio_w_n,            &
-                                          logc_kbounds_w_n,                    &
-                                          nzt_topo_nestbc_n,                   &
-                                          kcto, iflo, ifuo, jflo, jfuo,        &
-                                          kflo, kfuo, ijkfc_s, 'n', 's' )
+                CALL pmci_interp_1sto_sn( s, sc, kcto, iflo, ifuo, kflo, kfuo, 'n', 's' )
              ENDIF
 
              IF ( air_chemistry  .AND.  nest_chemistry )  THEN
                 DO  n = 1, nspec
-                   CALL pmci_interp_1sto_sn( chem_species(n)%conc,             &
-                                             chem_spec_c(:,:,:,n),             &
-                                             ico, jco, kco, r1xo, r2xo,        &
-                                             r1yo, r2yo, r1zo, r2zo,           &
-                                             logc_w_n, logc_ratio_w_n,         &
-                                             logc_kbounds_w_n,                 &
-                                             nzt_topo_nestbc_n,                &
-                                             kcto, iflo, ifuo, jflo, jfuo,     &
-                                             kflo, kfuo, ijkfc_s, 'n', 's' )
+                   CALL pmci_interp_1sto_sn( chem_species(n)%conc, chem_spec_c(:,:,:,n),            &
+                        kcto, iflo, ifuo, kflo, kfuo, 'n', 's' )
                 ENDDO
              ENDIF
@@ -5579,86 +3276,45 @@
 !
 !--    All PEs are top-border PEs
-       CALL pmci_interp_1sto_t( w,  wc,  ico, jco, kcw, r1xo, r2xo, r1yo,      &
-                                r2yo, r1zw, r2zw, kctw, iflo, ifuo,            &
-                                jflo, jfuo, kflw, kfuw, ijkfc_w, 'w' )
-       CALL pmci_interp_1sto_t( u,  uc,  icu, jco, kco, r1xu, r2xu, r1yo,      &
-                                r2yo, r1zo, r2zo, kcto, iflu, ifuu,            &
-                                jflo, jfuo, kflo, kfuo, ijkfc_u, 'u' )
-       CALL pmci_interp_1sto_t( v,  vc,  ico, jcv, kco, r1xo, r2xo, r1yv,      &
-                                r2yv, r1zo, r2zo, kcto, iflo, ifuo,            &
-                                jflv, jfuv, kflo, kfuo, ijkfc_v, 'v' )
-
+       CALL pmci_interp_1sto_t( w, wc, kctw, iflo, ifuo, jflo, jfuo, 'w' )
+       CALL pmci_interp_1sto_t( u, uc, kcto, iflu, ifuu, jflo, jfuo, 'u' )
+       CALL pmci_interp_1sto_t( v, vc, kcto, iflo, ifuo, jflv, jfuv, 'v' )
 
        IF ( (        rans_mode_parent  .AND.         rans_mode )  .OR.         &
             (  .NOT. rans_mode_parent  .AND.  .NOT.  rans_mode  .AND.          &
                .NOT. constant_diffusion ) )  THEN
-!          CALL pmci_interp_1sto_t( e,  ec,  ico, jco, kco, r1xo, r2xo, r1yo,   &
-!                                   r2yo, r1zo, r2zo, kcto, iflo, ifuo,         &
-!                                   jflo, jfuo, kflo, kfuo, ijkfc_s, 'e' )
+!          CALL pmci_interp_1sto_t( e, ec, kcto, iflo, ifuo, jflo, jfuo, 'e' )
 !
 !--       Interpolation of e is replaced by the Neumann condition. 
           e(nzt+1,nys:nyn,nxl:nxr) = e(nzt,nys:nyn,nxl:nxr)
-
        ENDIF
 
        IF ( rans_mode_parent  .AND.  rans_mode  .AND.  rans_tke_e )  THEN
-          CALL pmci_interp_1sto_t( diss, dissc, ico, jco, kco, r1xo, r2xo,     &
-                                   r1yo, r2yo, r1zo, r2zo, kcto, iflo, ifuo,   &
-                                   jflo, jfuo, kflo, kfuo, ijkfc_s, 's' )
+          CALL pmci_interp_1sto_t( diss, dissc, kcto, iflo, ifuo, jflo, jfuo, 's' )
        ENDIF
 
        IF ( .NOT. neutral )  THEN
-          CALL pmci_interp_1sto_t( pt, ptc, ico, jco, kco, r1xo, r2xo,         &
-                                   r1yo, r2yo, r1zo, r2zo, kcto, iflo, ifuo,   &
-                                   jflo, jfuo, kflo, kfuo, ijkfc_s, 's' )
+          CALL pmci_interp_1sto_t( pt, ptc, kcto, iflo, ifuo, jflo, jfuo, 's' )
        ENDIF
 
        IF ( humidity )  THEN
-
-          CALL pmci_interp_1sto_t( q, q_c, ico, jco, kco, r1xo, r2xo, r1yo,    &
-                                   r2yo, r1zo, r2zo, kcto, iflo, ifuo,         &
-                                   jflo, jfuo, kflo, kfuo, ijkfc_s, 's' )
-
+          CALL pmci_interp_1sto_t( q, q_c, kcto, iflo, ifuo, jflo, jfuo, 's' )
           IF ( bulk_cloud_model  .AND.  microphysics_morrison )  THEN
-
-             CALL pmci_interp_1sto_t( qc, qcc, ico, jco, kco, r1xo, r2xo, r1yo,&
-                                      r2yo, r1zo, r2zo, kcto, iflo, ifuo,      &
-                                      jflo, jfuo, kflo, kfuo, ijkfc_s, 's' )
-
-             CALL pmci_interp_1sto_t( nc, ncc, ico, jco, kco, r1xo, r2xo, r1yo,&
-                                      r2yo, r1zo, r2zo, kcto, iflo, ifuo,      &
-                                      jflo, jfuo, kflo, kfuo, ijkfc_s, 's' )
-
+             CALL pmci_interp_1sto_t( qc, qcc, kcto, iflo, ifuo, jflo, jfuo, 's' )
+             CALL pmci_interp_1sto_t( nc, ncc, kcto, iflo, ifuo, jflo, jfuo, 's' )
           ENDIF
-
           IF ( bulk_cloud_model  .AND.  microphysics_seifert )  THEN
-
-
-             CALL pmci_interp_1sto_t( qr, qrc, ico, jco, kco, r1xo, r2xo, r1yo,&
-                                      r2yo, r1zo, r2zo, kcto, iflo, ifuo,      &
-                                      jflo, jfuo, kflo, kfuo, ijkfc_s, 's' )
-
-             CALL pmci_interp_1sto_t( nr, nrc, ico, jco, kco, r1xo, r2xo, r1yo,&
-                                      r2yo, r1zo, r2zo, kcto, iflo, ifuo,      &
-                                      jflo, jfuo, kflo, kfuo, ijkfc_s, 's' )
-
+             CALL pmci_interp_1sto_t( qr, qrc, kcto, iflo, ifuo, jflo, jfuo, 's' )
+             CALL pmci_interp_1sto_t( nr, nrc, kcto, iflo, ifuo, jflo, jfuo, 's' )
           ENDIF
-
        ENDIF
 
        IF ( passive_scalar )  THEN
-          CALL pmci_interp_1sto_t( s, sc, ico, jco, kco, r1xo, r2xo, r1yo,     &
-                                   r2yo, r1zo, r2zo, kcto, iflo, ifuo,         &
-                                   jflo, jfuo, kflo, kfuo, ijkfc_s, 's' )
+          CALL pmci_interp_1sto_t( s, sc, kcto, iflo, ifuo, jflo, jfuo, 's' )
        ENDIF
 
        IF ( air_chemistry  .AND.  nest_chemistry )  THEN
           DO  n = 1, nspec
-             CALL pmci_interp_1sto_t( chem_species(n)%conc,                    &
-                                      chem_spec_c(:,:,:,n),                    &
-                                      ico, jco, kco, r1xo, r2xo,               &
-                                      r1yo, r2yo, r1zo, r2zo,                  &
-                                      kcto, iflo, ifuo, jflo, jfuo,            &
-                                      kflo, kfuo, ijkfc_s, 's' )
+             CALL pmci_interp_1sto_t( chem_species(n)%conc, chem_spec_c(:,:,:,n),                   &
+                                      kcto, iflo, ifuo, jflo, jfuo, 's' )
           ENDDO
        ENDIF
@@ -5674,19 +3330,15 @@
 !--   Note that TKE is not anterpolated.
       IMPLICIT NONE
-
       INTEGER(iwp) ::  n          !< running index for number of chemical species
 
-      CALL pmci_anterp_tophat( u,  uc,  kcto, iflu, ifuu, jflo, jfuo, kflo,    &
-                               kfuo, ijkfc_u, 'u' )
-      CALL pmci_anterp_tophat( v,  vc,  kcto, iflo, ifuo, jflv, jfuv, kflo,    &
-                               kfuo, ijkfc_v, 'v' )
-      CALL pmci_anterp_tophat( w,  wc,  kctw, iflo, ifuo, jflo, jfuo, kflw,    &
-                               kfuw, ijkfc_w, 'w' )
+      
+      CALL pmci_anterp_tophat( u,  uc,  kcto, iflu, ifuu, jflo, jfuo, kflo, kfuo, ijkfc_u, 'u' )
+      CALL pmci_anterp_tophat( v,  vc,  kcto, iflo, ifuo, jflv, jfuv, kflo, kfuo, ijkfc_v, 'v' )
+      CALL pmci_anterp_tophat( w,  wc,  kctw, iflo, ifuo, jflo, jfuo, kflw, kfuw, ijkfc_w, 'w' )
 !
 !--   Anterpolation of TKE and dissipation rate if parent and child are in 
 !--   RANS mode.
       IF ( rans_mode_parent  .AND.  rans_mode )  THEN
-         CALL pmci_anterp_tophat( e, ec, kcto, iflo, ifuo, jflo, jfuo, kflo,   &
-                                  kfuo, ijkfc_s, 'e' )
+         CALL pmci_anterp_tophat( e, ec, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, ijkfc_s, 'e' )
 !
 !--      Anterpolation of dissipation rate only if TKE-e closure is applied.
@@ -5699,19 +3351,17 @@
 
       IF ( .NOT. neutral )  THEN
-         CALL pmci_anterp_tophat( pt, ptc, kcto, iflo, ifuo, jflo, jfuo, kflo, &
-                                  kfuo, ijkfc_s, 'pt' )
+         CALL pmci_anterp_tophat( pt, ptc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, ijkfc_s, 'pt' )
       ENDIF
 
       IF ( humidity )  THEN
 
-         CALL pmci_anterp_tophat( q, q_c, kcto, iflo, ifuo, jflo, jfuo, kflo,  &
-                                  kfuo, ijkfc_s, 'q' )
+         CALL pmci_anterp_tophat( q, q_c, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, ijkfc_s, 'q' )
 
          IF ( bulk_cloud_model  .AND.  microphysics_morrison )  THEN
 
-            CALL pmci_anterp_tophat( qc, qcc, kcto, iflo, ifuo, jflo, jfuo,    &
+            CALL pmci_anterp_tophat( qc, qcc, kcto, iflo, ifuo, jflo, jfuo,                         &
                                      kflo, kfuo, ijkfc_s, 'qc' )
-
-            CALL pmci_anterp_tophat( nc, ncc, kcto, iflo, ifuo, jflo, jfuo,    &
+            
+            CALL pmci_anterp_tophat( nc, ncc, kcto, iflo, ifuo, jflo, jfuo,                         &
                                      kflo, kfuo, ijkfc_s, 'nc' )
 
@@ -5720,8 +3370,8 @@
          IF ( bulk_cloud_model  .AND.  microphysics_seifert )  THEN
 
-            CALL pmci_anterp_tophat( qr, qrc, kcto, iflo, ifuo, jflo, jfuo,    &
+            CALL pmci_anterp_tophat( qr, qrc, kcto, iflo, ifuo, jflo, jfuo,                         &
                                      kflo, kfuo, ijkfc_s, 'qr' )
 
-            CALL pmci_anterp_tophat( nr, nrc, kcto, iflo, ifuo, jflo, jfuo,    &
+            CALL pmci_anterp_tophat( nr, nrc, kcto, iflo, ifuo, jflo, jfuo,                         &
                                      kflo, kfuo, ijkfc_s, 'nr' )
 
@@ -5731,14 +3381,11 @@
 
       IF ( passive_scalar )  THEN
-         CALL pmci_anterp_tophat( s, sc, kcto, iflo, ifuo, jflo, jfuo, kflo,   &
-                                  kfuo, ijkfc_s, 's' )
+         CALL pmci_anterp_tophat( s, sc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, ijkfc_s, 's' )
       ENDIF
 
       IF ( air_chemistry  .AND.  nest_chemistry )  THEN
          DO  n = 1, nspec
-            CALL pmci_anterp_tophat( chem_species(n)%conc,                     &
-                                     chem_spec_c(:,:,:,n),                     &
-                                     kcto, iflo, ifuo, jflo, jfuo, kflo,       &
-                                     kfuo, ijkfc_s, 's' )
+            CALL pmci_anterp_tophat( chem_species(n)%conc, chem_spec_c(:,:,:,n),                    &
+                                     kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, ijkfc_s, 's' )
          ENDDO
       ENDIF
@@ -5748,9 +3395,5 @@
 
 
-   SUBROUTINE pmci_interp_1sto_lr( f, fc, ic, jc, kc, r1x, r2x, r1y, r2y, r1z, &
-                                   r2z, logc, logc_ratio, logc_kbounds,        &
-                                   nzt_topo_nestbc,                            &
-                                   kct, ifl, ifu, jfl, jfu, kfl, kfu, ijkfc,   &
-                                   edge, var )
+   SUBROUTINE pmci_interp_1sto_lr( f, fc, kct, jfl, jfu, kfl, kfu, edge, var )
 !
 !--   Interpolation of ghost-node values used as the child-domain boundary
@@ -5758,113 +3401,30 @@
       IMPLICIT NONE
 
-      INTEGER(iwp) ::  nzt_topo_nestbc   !<
-
-      REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                      &
-                                      INTENT(INOUT) ::  f       !<
-      REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr),                          &
-                                      INTENT(IN)    ::  fc      !<
-      REAL(wp), DIMENSION(1:2,0:ncorr-1,nzb:nzt_topo_nestbc,nys:nyn),          &
-                                      INTENT(IN)    ::  logc_ratio   !<
-!AH      REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN)    ::  r1x     !<
-!AH      REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN)    ::  r2x     !<
-!AH      REAL(wp), DIMENSION(nysg:nyng), INTENT(IN)    ::  r1y     !<
-!AH      REAL(wp), DIMENSION(nysg:nyng), INTENT(IN)    ::  r2y     !<
-      REAL(wp), DIMENSION(nxlfc:nxrfc), INTENT(IN)  ::  r1x     !<
-      REAL(wp), DIMENSION(nxlfc:nxrfc), INTENT(IN)  ::  r2x     !<
-      REAL(wp), DIMENSION(nysfc:nynfc), INTENT(IN)  ::  r1y     !<
-      REAL(wp), DIMENSION(nysfc:nynfc), INTENT(IN)  ::  r2y     !<
-
-!AH      REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN)    ::  r1z     !<
-!AH      REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN)    ::  r2z     !<
-      REAL(wp), DIMENSION(nzb:nzt+kgsr), INTENT(IN) ::  r1z     !<
-      REAL(wp), DIMENSION(nzb:nzt+kgsr), INTENT(IN) ::  r2z     !<
-      
-
-      INTEGER(iwp), DIMENSION(nxlfc:nxrfc), INTENT(IN)         ::  ic     !<
-      INTEGER(iwp), DIMENSION(nysfc:nynfc), INTENT(IN)         ::  jc     !<
-!AH      INTEGER(iwp), DIMENSION(nzb:nzt+1), INTENT(IN)           ::  kc     !<
-      INTEGER(iwp), DIMENSION(nzb:nzt+kgsr), INTENT(IN)        ::  kc     !<
-      INTEGER(iwp), DIMENSION(1:2,nzb:nzt_topo_nestbc,nys:nyn),                &
-                                          INTENT(IN)           :: logc   !<
-      INTEGER(iwp), DIMENSION(1:2,nys:nyn), INTENT(IN)         :: logc_kbounds !<
-
-      INTEGER(iwp) :: kct
-
-!AH
-!      INTEGER(iwp), DIMENSION(icl:icr), INTENT(IN) ::  ifl !< Indicates start index of child cells belonging to certain parent cell - x direction
-!      INTEGER(iwp), DIMENSION(icl:icr), INTENT(IN) ::  ifu !< Indicates end index of child cells belonging to certain parent cell - x direction
-!      INTEGER(iwp), DIMENSION(jcs:jcn), INTENT(IN) ::  jfl !< Indicates start index of child cells belonging to certain parent cell - y direction
-!      INTEGER(iwp), DIMENSION(jcs:jcn), INTENT(IN) ::  jfu !< Indicates start index of child cells belonging to certain parent cell - y direction
-      INTEGER(iwp), DIMENSION(icla:icra), INTENT(IN) ::  ifl !< Indicates start index of child cells belonging to certain parent cell - x direction
-      INTEGER(iwp), DIMENSION(icla:icra), INTENT(IN) ::  ifu !< Indicates end index of child cells belonging to certain parent cell - x direction
-      INTEGER(iwp), DIMENSION(jcsa:jcna), INTENT(IN) ::  jfl !< Indicates start index of child cells belonging to certain parent cell - y direction
-      INTEGER(iwp), DIMENSION(jcsa:jcna), INTENT(IN) ::  jfu !< Indicates start index of child cells belonging to certain parent cell - y direction
-!AH
-
-!AH      INTEGER(iwp), DIMENSION(0:kct), INTENT(IN)   ::  kfl !< Indicates start index of child cells belonging to certain parent cell - z direction
-!AH      INTEGER(iwp), DIMENSION(0:kct), INTENT(IN)   ::  kfu !< Indicates start index of child cells belonging to certain parent cell - z direction
-      INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN)   ::  kfl !< Indicates start index of child cells belonging to certain parent cell - z direction
-      INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN)   ::  kfu !< Indicates start index of child cells belonging to certain parent cell - z direction
-
-!AH      INTEGER(iwp), DIMENSION(0:kct,jcs:jcn,icl:icr), INTENT(IN) :: ijkfc !< number of child grid points contributing to a parent grid box
-!AH
-!      INTEGER(iwp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr), INTENT(IN) :: ijkfc !< number of child grid points contributing to a parent grid box
-      INTEGER(iwp), DIMENSION(0:cg%nz+1,jcsa:jcna,icla:icra), INTENT(IN) :: ijkfc !< number of child grid points contributing to a parent grid box
-!AH
-
-      CHARACTER(LEN=1), INTENT(IN) ::  edge   !< Edge symbol: 'l', 'r', 's' or 'n' 
-      CHARACTER(LEN=1), INTENT(IN) ::  var    !< Variable symbol: 'u', 'v', 'w' or 's'
-
-      INTEGER(iwp) ::  i        !< Lower bound of the running index ia
-      INTEGER(iwp) ::  ia       !< i-index running over the parent-grid cell on the boundary 
-      INTEGER(iwp) ::  iaw      !< Reduced ia-index for workarr_lr
-      INTEGER(iwp) ::  iawbc    !< iaw-index pointing to the boundary-value nodes (either 0 or igsr-1)      
+      REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(INOUT) ::  f   !< Child-grid array
+      REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr), INTENT(IN)        ::  fc  !< Parent-grid array
+      INTEGER(iwp) :: kct                                     !< The parent-grid index in z-direction just below the boundary value node
+      INTEGER(iwp), DIMENSION(jcsa:jcna), INTENT(IN) ::  jfl  !< Indicates start index of child cells belonging to certain parent cell - y direction
+      INTEGER(iwp), DIMENSION(jcsa:jcna), INTENT(IN) ::  jfu  !< Indicates end index of child cells belonging to certain parent cell - y direction
+      INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN) ::  kfl  !< Indicates start index of child cells belonging to certain parent cell - z direction
+      INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN) ::  kfu  !< Indicates end index of child cells belonging to certain parent cell - z direction
+      CHARACTER(LEN=1), INTENT(IN) ::  edge                   !< Edge symbol: 'l' or 'r'
+      CHARACTER(LEN=1), INTENT(IN) ::  var                    !< Variable symbol: 'u', 'v', 'w' or 's'
+!
+!--   Local variables:
       INTEGER(iwp) ::  ib       !< Fixed i-index pointing to the node just behind the boundary-value node
       INTEGER(iwp) ::  ibc      !< Fixed i-index pointing to the boundary-value nodes (either i or iend)
       INTEGER(iwp) ::  ibgp     !< Index running over the redundant boundary ghost points in i-direction
-!AH      INTEGER(iwp) ::  ibeg     !< i-index pointing to the starting point of workarr_lr in the i-direction 
-      INTEGER(iwp) ::  iend     !< Upper bound of the running index ia
       INTEGER(iwp) ::  ierr     !< MPI error code
-      INTEGER(iwp) ::  ijk      !< Running index for all child-grid cells within the anterpolation cell
-      INTEGER(iwp) ::  iw       !< i-index for wall_flags_0
       INTEGER(iwp) ::  j        !< Running index in the y-direction
-      INTEGER(iwp) ::  jco      !<
-      INTEGER(iwp) ::  jcorr    !<
-      INTEGER(iwp) ::  jinc     !<
-      INTEGER(iwp) ::  jw       !< j-index for wall_flags_0
-      INTEGER(iwp) ::  j1       !<
       INTEGER(iwp) ::  k        !< Running index in the z-direction
-      INTEGER(iwp) ::  k_wall   !< Vertical index of topography top
-      INTEGER(iwp) ::  kco      !<
-      INTEGER(iwp) ::  kcorr    !<
-      INTEGER(iwp) ::  kw       !< k-index for wall_flags_0
-      INTEGER(iwp) ::  k1       !<
-      INTEGER(iwp) ::  l        !< Parent-grid running index in the x-direction
       INTEGER(iwp) ::  lbeg     !< l-index pointing to the starting point of workarrc_lr in the l-direction 
-      INTEGER(iwp) ::  lp1      !< l+1
-      INTEGER(iwp) ::  loff     !< l-offset needed on the right boundary to correctly refer to boundary ghost points
-      INTEGER(iwp) ::  lw       !< Reduced l-index for workarrc_lr
+      INTEGER(iwp) ::  lw       !< Reduced l-index for workarrc_lr pointing to the boundary ghost node
+      INTEGER(iwp) ::  lwp      !< Reduced l-index for workarrc_lr pointing to the first prognostic node
       INTEGER(iwp) ::  m        !< Parent-grid running index in the y-direction
-      INTEGER(iwp) ::  mnorthv  !< Upshift by one for the upper bound of index m in case of var == 'v'
-      INTEGER(iwp) ::  mp1      !< m+1
       INTEGER(iwp) ::  n        !< Parent-grid running index in the z-direction
-      INTEGER(iwp) ::  np1      !< n+1
-      INTEGER(iwp) ::  ntopw    !< Upshift by one for the upper bound of index n in case of var == 'w'
-      INTEGER(iwp) ::  var_flag !< Variable flag for BTEST( wall_flags_0 )
-
-      REAL(wp) ::  cellsum      !< Sum of child-grid node values over the anterpolation cell 
-      REAL(wP) ::  cellsumd     !< Sum of differences over the anterpolation cell 
-      REAL(wp) ::  fkj          !< Intermediate result in trilinear interpolation
-      REAL(wp) ::  fkjp         !< Intermediate result in trilinear interpolation
-      REAL(wp) ::  fkpj         !< Intermediate result in trilinear interpolation
-      REAL(wp) ::  fkpjp        !< Intermediate result in trilinear interpolation
-      REAL(wp) ::  fk           !< Intermediate result in trilinear interpolation
-      REAL(wp) ::  fkp          !< Intermediate result in trilinear interpolation
-      REAL(wp) ::  rcorr        !< Average reversibility correction for the whole anterpolation cell
-      REAL(wp) ::  rcorr_ijk    !< Reversibility correction distributed to the individual child-grid nodes
-
-!      real(wp), parameter :: c1 =  2.0_wp / 6.0_wp
-!      real(wp), parameter :: c2 =  5.0_wp / 6.0_wp
-!      real(wp), parameter :: c3 = -1.0_wp / 6.0_wp
+      REAL(wp) ::  cb           !< Interpolation coefficient for the boundary ghost node  
+      REAL(wp) ::  cp           !< Interpolation coefficient for the first prognostic node
+      REAL(wp) ::  f_interp_1   !< Value interpolated in x direction from the parent-grid data
+      REAL(wp) ::  f_interp_2   !< Auxiliary value interpolated in x direction from the parent-grid data
 
 ! 
@@ -5874,69 +3434,41 @@
 !--      For u, nxl is a ghost node, but not for the other variables
          IF ( var == 'u' )  THEN
-            i     = nxl
-            iend  = nxl
             ibc   = nxl    
             ib    = ibc - 1
-            iawbc = 0
-            l     = icl + 2
             lw    = 2
+            lwp   = lw        ! This is redundant when var == 'u' 
             lbeg  = icl
-            loff  = 0            
          ELSE
-            i     = nxl - igsr
-            iend  = nxl - 1
             ibc   = nxl - 1
             ib    = ibc - 1
-            iawbc = igsr-1
-            l     = icl + 1
             lw    = 1
+            lwp   = 2
             lbeg  = icl
-            loff  = 0
          ENDIF        
       ELSEIF ( edge == 'r' )  THEN
          IF ( var == 'u' )  THEN
-            i     = nxr + 1            
-            iend  = nxr + 1
             ibc   = nxr + 1 
             ib    = ibc + 1
-            iawbc = 0
-            l     = icr - 1
             lw    = 1
+            lwp   = lw        ! This is redundant when var == 'u'            
             lbeg  = icr - 2
-            loff  = 0
          ELSE
-            i     = nxr + 1
-            iend  = nxr + igsr
             ibc   = nxr + 1
             ib    = ibc + 1
-            iawbc = 0
-            l     = icr - 1
             lw    = 1
+            lwp   = 0
             lbeg  = icr - 2
-            loff  = 1
          ENDIF         
       ENDIF
-
-      IF  ( var == 'w' )  THEN
-         ntopw = 1
+!
+!--   Interpolation coefficients
+      IF  ( interpolation_scheme_lrsn == 1 )  THEN
+         cb = 1.0_wp  ! 1st-order upwind 
+      ELSE IF  ( interpolation_scheme_lrsn == 2 )  THEN
+         cb = 0.5_wp  ! 2nd-order central
       ELSE
-         ntopw = 0
-      ENDIF
-
-      IF  ( var == 'v' )  THEN
-         mnorthv = 0
-      ELSE
-         mnorthv = 1
-      ENDIF
-
-      IF ( var == 'u' )  THEN 
-         var_flag = 1 
-      ELSEIF ( var == 'v' )  THEN
-         var_flag = 2 
-      ELSEIF ( var == 'w' )  THEN
-         var_flag = 3
-      ELSE
-         var_flag = 0
-      ENDIF
+         cb = 0.5_wp  ! 2nd-order central (default)
+      ENDIF         
+      cp    = 1.0_wp - cb
 !
 !--   Substitute the necessary parent-grid data to the work array workarrc_lr. 
@@ -5978,18 +3510,38 @@
       ENDIF
 
-      IF  ( var == 'v' )  THEN
+      IF  ( var == 'u' )  THEN
+
+         DO  m = jcsw, jcnw
+            DO n = 0, kct 
+               
+               DO  j = jfl(m), jfu(m)
+                  DO  k = kfl(n), kfu(n)
+                     f(k,j,ibc) = workarrc_lr(n,m,lw)
+                  ENDDO
+               ENDDO
+
+            ENDDO
+         ENDDO
+
+      ELSE IF  ( var == 'v' )  THEN
          
          DO  m = jcsw, jcnw-1
             DO n = 0, kct 
 !
+!--            First interpolate to the flux point
+               f_interp_1 = cb * workarrc_lr(n,m,lw)   + cp * workarrc_lr(n,m,lwp)
+               f_interp_2 = cb * workarrc_lr(n,m+1,lw) + cp * workarrc_lr(n,m+1,lwp)
+!
 !--            Use averages of the neighbouring matching grid-line values
                DO  j = jfl(m), jfl(m+1)
-                  f(kfl(n):kfu(n),j,ibc) = 0.5_wp * ( workarrc_lr(n,m,lw)       &
-                       +  workarrc_lr(n,m+1,lw) )
+!                  f(kfl(n):kfu(n),j,ibc) = 0.5_wp * ( workarrc_lr(n,m,lw)       &
+!                       +  workarrc_lr(n,m+1,lw) )
+                  f(kfl(n):kfu(n),j,ibc) = 0.5_wp * ( f_interp_1 + f_interp_2 )
                ENDDO
 !
 !--            Then set the values along the matching grid-lines  
                IF  ( MOD( jfl(m), jgsr ) == 0 )  THEN
-                  f(kfl(n):kfu(n),jfl(m),ibc) = workarrc_lr(n,m,lw)
+!                  f(kfl(n):kfu(n),jfl(m),ibc) = workarrc_lr(n,m,lw)
+                  f(kfl(n):kfu(n),jfl(m),ibc) = f_interp_1
                ENDIF
             ENDDO
@@ -5998,6 +3550,8 @@
 !--      Finally, set the values along the last matching grid-line  
          IF  ( MOD( jfl(jcnw), jgsr ) == 0 )  THEN
+            f_interp_1 = cb * workarrc_lr(n,jcnw,lw) + cp * workarrc_lr(n,jcnw,lwp)
             DO  n = 0, kct
-               f(kfl(n):kfu(n),jfl(jcnw),ibc) = workarrc_lr(n,jcnw,lw)
+!               f(kfl(n):kfu(n),jfl(jcnw),ibc) = workarrc_lr(n,jcnw,lw)
+               f(kfl(n):kfu(n),jfl(jcnw),ibc) = f_interp_1
             ENDDO
          ENDIF
@@ -6020,6 +3574,10 @@
             DO n = 0, kct + 1   ! It is important to go up to kct+1  
 !
+!--            Interpolate to the flux point
+               f_interp_1 = cb * workarrc_lr(n,m,lw) + cp * workarrc_lr(n,m,lwp)
+!
 !--            First substitute only the matching-node values
-               f(kfu(n),jfl(m):jfu(m),ibc) = workarrc_lr(n,m,lw)
+!               f(kfu(n),jfl(m):jfu(m),ibc) = workarrc_lr(n,m,lw)
+               f(kfu(n),jfl(m):jfu(m),ibc) = f_interp_1
                   
             ENDDO
@@ -6038,12 +3596,15 @@
          ENDDO
 
-      ELSE   ! u or scalars
+      ELSE   ! any scalar
          
          DO  m = jcsw, jcnw
             DO n = 0, kct 
-               
+!
+!--            Interpolate to the flux point
+               f_interp_1 = cb * workarrc_lr(n,m,lw) + cp * workarrc_lr(n,m,lwp)
                DO  j = jfl(m), jfu(m)
                   DO  k = kfl(n), kfu(n)
-                     f(k,j,ibc) = workarrc_lr(n,m,lw)
+!                     f(k,j,ibc) = workarrc_lr(n,m,lw)
+                     f(k,j,ibc) = f_interp_1
                   ENDDO
                ENDDO
@@ -6069,10 +3630,5 @@
 
 
-   SUBROUTINE pmci_interp_1sto_sn( f, fc, ic, jc, kc, r1x, r2x, r1y, r2y, r1z, &
-                                   r2z, logc, logc_ratio, logc_kbounds,        &
-                                   nzt_topo_nestbc,                            &
-                                   kct, ifl, ifu, jfl, jfu, kfl, kfu, ijkfc,   &
-                                   edge, var )
-
+   SUBROUTINE pmci_interp_1sto_sn( f, fc, kct, ifl, ifu, kfl, kfu, edge, var )
 !
 !--   Interpolation of ghost-node values used as the child-domain boundary
@@ -6080,106 +3636,30 @@
       IMPLICIT NONE
 
-      INTEGER(iwp) ::  nzt_topo_nestbc   !<
-
-      REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                      &
-                                      INTENT(INOUT) ::  f             !<
-      REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr),                          &
-                                      INTENT(IN)    ::  fc            !<
-      REAL(wp), DIMENSION(1:2,0:ncorr-1,nzb:nzt_topo_nestbc,nxl:nxr),          &
-                                      INTENT(IN)    ::  logc_ratio    !<
-      REAL(wp), DIMENSION(nxlfc:nxrfc), INTENT(IN)  ::  r1x           !<
-      REAL(wp), DIMENSION(nxlfc:nxrfc), INTENT(IN)  ::  r2x           !<
-      REAL(wp), DIMENSION(nysfc:nynfc), INTENT(IN)  ::  r1y           !<
-      REAL(wp), DIMENSION(nysfc:nynfc), INTENT(IN)  ::  r2y           !<
-!AH      REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN)    ::  r1z           !<
-!AH      REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN)    ::  r2z           !<
-      REAL(wp), DIMENSION(nzb:nzt+kgsr), INTENT(IN) ::  r1z           !<
-      REAL(wp), DIMENSION(nzb:nzt+kgsr), INTENT(IN) ::  r2z           !<
-
-      
-      INTEGER(iwp), DIMENSION(nxlfc:nxrfc), INTENT(IN)         ::  ic    !<
-      INTEGER(iwp), DIMENSION(nysfc:nynfc), INTENT(IN)         ::  jc    !<
-!AH      INTEGER(iwp), DIMENSION(nzb:nzt+1), INTENT(IN)           ::  kc    !<
-      INTEGER(iwp), DIMENSION(nzb:nzt+kgsr), INTENT(IN)        ::  kc    !<
-      INTEGER(iwp), DIMENSION(1:2,nzb:nzt_topo_nestbc,nxl:nxr),                &
-                                          INTENT(IN)           ::  logc  !<
-      INTEGER(iwp), DIMENSION(1:2,nxl:nxr), INTENT(IN)         ::  logc_kbounds  !< 
-
-      INTEGER(iwp) :: kct
-!AH
-!      INTEGER(iwp), DIMENSION(icl:icr), INTENT(IN) ::  ifl !< Indicates start index of child cells belonging to certain parent cell - x direction
-!      INTEGER(iwp), DIMENSION(icl:icr), INTENT(IN) ::  ifu !< Indicates end index of child cells belonging to certain parent cell - x direction
-!      INTEGER(iwp), DIMENSION(jcs:jcn), INTENT(IN) ::  jfl !< Indicates start index of child cells belonging to certain parent cell - y direction
-!      INTEGER(iwp), DIMENSION(jcs:jcn), INTENT(IN) ::  jfu !< Indicates start index of child cells belonging to certain parent cell - y direction
-      INTEGER(iwp), DIMENSION(icla:icra), INTENT(IN) ::  ifl !< Indicates start index of child cells belonging to certain parent cell - x direction
-      INTEGER(iwp), DIMENSION(icla:icra), INTENT(IN) ::  ifu !< Indicates end index of child cells belonging to certain parent cell - x direction
-      INTEGER(iwp), DIMENSION(jcsa:jcna), INTENT(IN) ::  jfl !< Indicates start index of child cells belonging to certain parent cell - y direction
-      INTEGER(iwp), DIMENSION(jcsa:jcna), INTENT(IN) ::  jfu !< Indicates start index of child cells belonging to certain parent cell - y direction
-!AH
-
-!AH      INTEGER(iwp), DIMENSION(0:kct), INTENT(IN)   ::  kfl !< Indicates start index of child cells belonging to certain parent cell - z direction
-!AH      INTEGER(iwp), DIMENSION(0:kct), INTENT(IN)   ::  kfu !< Indicates start index of child cells belonging to certain parent cell - z direction
-      INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN)   ::  kfl !< Indicates start index of child cells belonging to certain parent cell - z direction
-      INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN)   ::  kfu !< Indicates start index of child cells belonging to certain parent cell - z direction
-!AH      INTEGER(iwp), DIMENSION(0:kct,jcs:jcn,icl:icr), INTENT(IN) :: ijkfc !< number of child grid points contributing to a parent grid box
-!AH
-!      INTEGER(iwp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr), INTENT(IN) :: ijkfc !< number of child grid points contributing to a parent grid box
-      INTEGER(iwp), DIMENSION(0:cg%nz+1,jcsa:jcna,icla:icra), INTENT(IN) :: ijkfc !< number of child grid points contributing to a parent grid box
-!AH
-
-      CHARACTER(LEN=1), INTENT(IN) ::  edge   !< Edge symbol: 'l', 'r', 's' or 'n' 
+      REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(INOUT) ::  f   !< Child-grid array
+      REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr), INTENT(IN)        ::  fc  !< Parent-grid array
+      INTEGER(iwp) :: kct                                     !< The parent-grid index in z-direction just below the boundary value node
+      INTEGER(iwp), DIMENSION(icla:icra), INTENT(IN) ::  ifl  !< Indicates start index of child cells belonging to certain parent cell - x direction
+      INTEGER(iwp), DIMENSION(icla:icra), INTENT(IN) ::  ifu  !< Indicates end index of child cells belonging to certain parent cell - x direction
+      INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN) ::  kfl  !< Indicates start index of child cells belonging to certain parent cell - z direction
+      INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN) ::  kfu  !< Indicates end index of child cells belonging to certain parent cell - z direction
+      CHARACTER(LEN=1), INTENT(IN) ::  edge   !< Edge symbol: 's' or 'n' 
       CHARACTER(LEN=1), INTENT(IN) ::  var    !< Variable symbol: 'u', 'v', 'w' or 's'
-      
+!
+!--   Local variables:      
       INTEGER(iwp) ::  i        !< Running index in the x-direction
-      INTEGER(iwp) ::  iinc     !<
-      INTEGER(iwp) ::  icorr    !<
-      INTEGER(iwp) ::  ico      !<
       INTEGER(iwp) ::  ierr     !< MPI error code
-      INTEGER(iwp) ::  ijk      !< Running index for all child-grid cells within the anterpolation cell
-      INTEGER(iwp) ::  iw       !< i-index for wall_flags_0
-      INTEGER(iwp) ::  i1       !<
-      INTEGER(iwp) ::  j        !< Lower bound of the running index ja
-      INTEGER(iwp) ::  ja       !< Index in y-direction running over the parent-grid cell on the boundary 
-      INTEGER(iwp) ::  jaw      !< Reduced ja-index for workarr_sn
-      INTEGER(iwp) ::  jawbc    !< jaw-index pointing to the boundary-value nodes (either 0 or jgsr-1)
-!AH      INTEGER(iwp) ::  jbeg     !< j-index pointing to the starting point of workarr_sn in the j-direction
       INTEGER(iwp) ::  jb       !< Fixed j-index pointing to the node just behind the boundary-value node
       INTEGER(iwp) ::  jbc      !< Fixed j-index pointing to the boundary-value nodes (either j or jend)
       INTEGER(iwp) ::  jbgp     !< Index running over the redundant boundary ghost points in j-direction
-      INTEGER(iwp) ::  jend     !< Upper bound of the running index ja
-      INTEGER(iwp) ::  jw       !< j-index for wall_flags_0
       INTEGER(iwp) ::  k        !< Running index in the z-direction
-      INTEGER(iwp) ::  k_wall   !< Vertical index of topography top
-      INTEGER(iwp) ::  kcorr    !<
-      INTEGER(iwp) ::  kco      !<
-      INTEGER(iwp) ::  kw       !< k-index for wall_flags_0
-      INTEGER(iwp) ::  k1       !<
       INTEGER(iwp) ::  l        !< Parent-grid running index in the x-direction
-      INTEGER(iwp) ::  lp1      !< l+1
-      INTEGER(iwp) ::  lrightu  !< Upshift by one for the upper bound of index l in case of var == 'u'
-      INTEGER(iwp) ::  m        !< Parent-grid running index in the y-direction
       INTEGER(iwp) ::  mbeg     !< m-index pointing to the starting point of workarrc_sn in the m-direction 
-      INTEGER(iwp) ::  moff     !< m-offset needed on the north boundary to correctly refer to boundary ghost points
-      INTEGER(iwp) ::  mp1      !< m+1
-      INTEGER(iwp) ::  mw       !< Reduced m-index for workarrc_sn
+      INTEGER(iwp) ::  mw       !< Reduced m-index for workarrc_sn pointing to the boundary ghost node 
+      INTEGER(iwp) ::  mwp      !< Reduced m-index for workarrc_sn pointing to the first prognostic node
       INTEGER(iwp) ::  n        !< Parent-grid running index in the z-direction
-      INTEGER(iwp) ::  np1      !< n+1
-      INTEGER(iwp) ::  ntopw    !< Upshift by one for the upper bound of index n in case of var == 'w'
-      INTEGER(iwp) ::  var_flag !< Variable flag for BTEST( wall_flags_0 )
-
-      REAL(wp) ::  cellsum      !< Sum of child-grid node values over the anterpolation cell 
-      REAL(wp) ::  cellsumd     !< Sum of differences over the anterpolation cell 
-      REAL(wp) ::  fk           !< Intermediate result in trilinear interpolation
-      REAL(wp) ::  fkj          !< Intermediate result in trilinear interpolation
-      REAL(wp) ::  fkjp         !< Intermediate result in trilinear interpolation
-      REAL(wp) ::  fkpj         !< Intermediate result in trilinear interpolation
-      REAL(wp) ::  fkpjp        !< Intermediate result in trilinear interpolation
-      REAL(wp) ::  fkp          !< Intermediate result in trilinear interpolation
-      REAL(wp) ::  rcorr        !< Average reversibility correction for the whole anterpolation cell
-      REAL(wp) ::  rcorr_ijk    !< Reversibility correction distributed to the individual child-grid nodes
-
-!      real(wp), parameter :: c1 =  2.0_wp / 6.0_wp
-!      real(wp), parameter :: c2 =  5.0_wp / 6.0_wp
-!      real(wp), parameter :: c3 = -1.0_wp / 6.0_wp
+      REAL(wp) ::  cb           !< Interpolation coefficient for the boundary ghost node  
+      REAL(wp) ::  cp           !< Interpolation coefficient for the first prognostic node
+      REAL(wp) ::  f_interp_1   !< Value interpolated in y direction from the parent-grid data
+      REAL(wp) ::  f_interp_2   !< Auxiliary value interpolated in y direction from the parent-grid data
 
 !
@@ -6189,69 +3669,41 @@
 !--      For v, nys is a ghost node, but not for the other variables
          IF ( var == 'v' )  THEN
-            j     = nys
-            jend  = nys 
-            jawbc = 0
             jbc   = nys
             jb    = jbc - 1
-            m     = jcs + 2
             mw    = 2
+            mwp   = 2         ! This is redundant when var == 'v'
             mbeg  = jcs
-            moff  = 0
          ELSE
-            j     = nys - jgsr
-            jend  = nys - 1
-            jawbc = jgsr - 1
             jbc   = nys - 1
             jb    = jbc - 1
-            m     = jcs + 1
             mw    = 1
+            mwp   = 2
             mbeg  = jcs
-            moff  = 0
          ENDIF
       ELSEIF ( edge == 'n' )  THEN
          IF ( var == 'v' )  THEN
-            j     = nyn + 1
-            jend  = nyn + 1
-            jawbc = 0
             jbc   = nyn + 1
             jb    = jbc + 1
-            m     = jcn - 1
             mw    = 1
+            mwp   = 0         ! This is redundant when var == 'v'     
             mbeg  = jcn - 2
-            moff  = 0
          ELSE
-            j     = nyn + 1
-            jend  = nyn + jgsr
-            jawbc = 0
             jbc   = nyn + 1
             jb    = jbc + 1
-            m     = jcn - 1
             mw    = 1
+            mwp   = 0
             mbeg  = jcn - 2
-            moff  = 1
          ENDIF
       ENDIF
-
-      IF  ( var == 'w' )  THEN
-         ntopw = 1
+!
+!--   Interpolation coefficients
+      IF  ( interpolation_scheme_lrsn == 1 )  THEN
+         cb = 1.0_wp  ! 1st-order upwind 
+      ELSE IF  ( interpolation_scheme_lrsn == 2 )  THEN
+         cb = 0.5_wp  ! 2nd-order central
       ELSE
-         ntopw = 0
-      ENDIF
-
-      IF  ( var == 'u' )  THEN
-         lrightu = 0
-      ELSE
-         lrightu = 1
-      ENDIF
-
-      IF ( var == 'u' )  THEN 
-         var_flag = 1 
-      ELSEIF ( var == 'v' )  THEN
-         var_flag = 2 
-      ELSEIF ( var == 'w' )  THEN
-         var_flag = 3
-      ELSE
-         var_flag = 0
-      ENDIF
+         cb = 0.5_wp  ! 2nd-order central (default)
+      ENDIF         
+      cp    = 1.0_wp - cb
 !
 !--   Substitute the necessary parent-grid data to the work array workarrc_sn. 
@@ -6293,18 +3745,38 @@
       ENDIF
 
-      IF  ( var == 'u' )  THEN
+      IF  ( var == 'v' )  THEN
+
+         DO  l = iclw, icrw
+            DO n = 0, kct 
+               
+               DO  i = ifl(l), ifu(l)
+                  DO  k = kfl(n), kfu(n)
+                     f(k,jbc,i) = workarrc_sn(n,mw,l)
+                  ENDDO
+               ENDDO
+
+            ENDDO
+         ENDDO
+
+      ELSE IF  ( var == 'u' )  THEN
          
          DO  l = iclw, icrw-1
-            DO n = 0, kct 
+            DO n = 0, kct
+!
+!--            First interpolate to the flux point
+               f_interp_1 = cb * workarrc_sn(n,mw,l)   + cp * workarrc_sn(n,mwp,l)
+               f_interp_2 = cb * workarrc_sn(n,mw,l+1) + cp * workarrc_sn(n,mwp,l+1)
 !
 !--            Use averages of the neighbouring matching grid-line values
                DO  i = ifl(l), ifl(l+1)
-                  f(kfl(n):kfu(n),jbc,i) = 0.5_wp * ( workarrc_sn(n,mw,l)       &
-                       +  workarrc_sn(n,mw,l+1) )
+!                  f(kfl(n):kfu(n),jbc,i) = 0.5_wp * ( workarrc_sn(n,mw,l)       &
+!                       +  workarrc_sn(n,mw,l+1) )
+                  f(kfl(n):kfu(n),jbc,i) = 0.5_wp * ( f_interp_1 + f_interp_2 )
                ENDDO
 !
 !--            Then set the values along the matching grid-lines  
                IF  ( MOD( ifl(l), igsr ) == 0 )  THEN
-                  f(kfl(n):kfu(n),jbc,ifl(l)) = workarrc_sn(n,mw,l)
+!                  f(kfl(n):kfu(n),jbc,ifl(l)) = workarrc_sn(n,mw,l)
+                  f(kfl(n):kfu(n),jbc,ifl(l)) = f_interp_1
                ENDIF
 
@@ -6314,6 +3786,8 @@
 !--      Finally, set the values along the last matching grid-line  
          IF  ( MOD( ifl(icrw), igsr ) == 0 )  THEN
+            f_interp_1 = cb * workarrc_sn(n,mw,icrw) + cp * workarrc_sn(n,mwp,icrw)
             DO  n = 0, kct
-               f(kfl(n):kfu(n),jbc,ifl(icrw)) = workarrc_sn(n,mw,icrw)
+!               f(kfl(n):kfu(n),jbc,ifl(icrw)) = workarrc_sn(n,mw,icrw)
+               f(kfl(n):kfu(n),jbc,ifl(icrw)) = f_interp_1
             ENDDO
          ENDIF
@@ -6335,7 +3809,11 @@
          DO  l = iclw, icrw
             DO n = 0, kct + 1   ! It is important to go up to kct+1  
+!
+!--            Interpolate to the flux point
+               f_interp_1 = cb * workarrc_sn(n,mw,l) + cp * workarrc_sn(n,mwp,l)
 !                  
 !--            First substitute only the matching-node values                 
-               f(kfu(n),jbc,ifl(l):ifu(l)) = workarrc_sn(n,mw,l)
+!               f(kfu(n),jbc,ifl(l):ifu(l)) = workarrc_sn(n,mw,l)
+               f(kfu(n),jbc,ifl(l):ifu(l)) = f_interp_1
 
             ENDDO
@@ -6354,12 +3832,15 @@
          ENDDO
 
-      ELSE   ! v or scalars
+      ELSE   ! Any scalar
          
          DO  l = iclw, icrw
             DO n = 0, kct 
-               
+!
+!--            Interpolate to the flux point
+               f_interp_1 = cb * workarrc_sn(n,mw,l) + cp * workarrc_sn(n,mwp,l)
                DO  i = ifl(l), ifu(l)
                   DO  k = kfl(n), kfu(n)
-                     f(k,jbc,i) = workarrc_sn(n,mw,l)
+!                     f(k,jbc,i) = workarrc_sn(n,mw,l)
+                     f(k,jbc,i) = f_interp_1
                   ENDDO
                ENDDO
@@ -6385,8 +3866,5 @@
 
 
-   SUBROUTINE pmci_interp_1sto_t( f, fc, ic, jc, kc, r1x, r2x, r1y, r2y,       &
-                                  r1z, r2z, kct, ifl, ifu, jfl, jfu, kfl, kfu, &
-                                  ijkfc, var )
-
+   SUBROUTINE pmci_interp_1sto_t( f, fc, kct, ifl, ifu, jfl, jfu, var )
 !
 !--   Interpolation of ghost-node values used as the child-domain boundary
@@ -6394,111 +3872,53 @@
       IMPLICIT NONE
 
-      REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                      &
-                                      INTENT(INOUT) ::  f     !< Child-grid array
-      REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr),                          &
-                                      INTENT(IN)    ::  fc    !< Parent-grid array
-      REAL(wp), DIMENSION(nxlfc:nxrfc), INTENT(IN)  ::  r1x   !<
-      REAL(wp), DIMENSION(nxlfc:nxrfc), INTENT(IN)  ::  r2x   !<
-      REAL(wp), DIMENSION(nysfc:nynfc), INTENT(IN)  ::  r1y   !<
-      REAL(wp), DIMENSION(nysfc:nynfc), INTENT(IN)  ::  r2y   !<
-!AH      REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN)    ::  r1z   !<
-!AH      REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN)    ::  r2z   !<
-      REAL(wp), DIMENSION(nzb:nzt+kgsr), INTENT(IN) ::  r1z   !<
-      REAL(wp), DIMENSION(nzb:nzt+kgsr), INTENT(IN) ::  r2z   !<
-
-      
-      INTEGER(iwp), DIMENSION(nxlfc:nxrfc), INTENT(IN)  ::  ic    !<
-      INTEGER(iwp), DIMENSION(nysfc:nynfc), INTENT(IN)  ::  jc    !<
-!AH      INTEGER(iwp), DIMENSION(nzb:nzt+1), INTENT(IN)    ::  kc    !<
-      INTEGER(iwp), DIMENSION(nzb:nzt+kgsr), INTENT(IN) ::  kc    !<
-
-      INTEGER(iwp) :: kct
-!AH
-!      INTEGER(iwp), DIMENSION(icl:icr), INTENT(IN) ::  ifl !< Indicates start index of child cells belonging to certain parent cell - x direction
-!      INTEGER(iwp), DIMENSION(icl:icr), INTENT(IN) ::  ifu !< Indicates end index of child cells belonging to certain parent cell - x direction
-!      INTEGER(iwp), DIMENSION(jcs:jcn), INTENT(IN) ::  jfl !< Indicates start index of child cells belonging to certain parent cell - y direction
-!      INTEGER(iwp), DIMENSION(jcs:jcn), INTENT(IN) ::  jfu !< Indicates start index of child cells belonging to certain parent cell - y direction
-      INTEGER(iwp), DIMENSION(icla:icra), INTENT(IN) ::  ifl !< Indicates start index of child cells belonging to certain parent cell - x direction
-      INTEGER(iwp), DIMENSION(icla:icra), INTENT(IN) ::  ifu !< Indicates end index of child cells belonging to certain parent cell - x direction
-      INTEGER(iwp), DIMENSION(jcsa:jcna), INTENT(IN) ::  jfl !< Indicates start index of child cells belonging to certain parent cell - y direction
-      INTEGER(iwp), DIMENSION(jcsa:jcna), INTENT(IN) ::  jfu !< Indicates start index of child cells belonging to certain parent cell - y direction
-!AH      INTEGER(iwp), DIMENSION(0:kct), INTENT(IN)   ::  kfl !< Indicates start index of child cells belonging to certain parent cell - z direction
-!AH      INTEGER(iwp), DIMENSION(0:kct), INTENT(IN)   ::  kfu !< Indicates start index of child cells belonging to certain parent cell - z direction
-      INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN)   ::  kfl !< Indicates start index of child cells belonging to certain parent cell - z direction
-      INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN)   ::  kfu !< Indicates start index of child cells belonging to certain parent cell - z direction
-!AH      INTEGER(iwp), DIMENSION(0:kct,jcs:jcn,icl:icr), INTENT(IN) :: ijkfc !< number of child grid points contributing to a parent grid box
-!AH
-!      INTEGER(iwp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr), INTENT(IN) :: ijkfc !< number of child grid points contributing to a parent grid box
-      INTEGER(iwp), DIMENSION(0:cg%nz+1,jcsa:jcna,icla:icra), INTENT(IN) :: ijkfc !< number of child grid points contributing to a parent grid box
-!AH
-
-      CHARACTER(LEN=1), INTENT(IN) :: var   !<
-
-      INTEGER(iwp) ::  i    !<
-      INTEGER(iwp) ::  ib   !<
-      INTEGER(iwp) ::  iclc !< Lower i-index limit for copying fc-data to workarrc_t
-      INTEGER(iwp) ::  icrc !< Upper i-index limit for copying fc-data to workarrc_t
-      INTEGER(iwp) ::  ie   !<
-      INTEGER(iwp) ::  ierr !< MPI error code
-      INTEGER(iwp) ::  ijk  !<
-      INTEGER(iwp) ::  iw   !<
-      INTEGER(iwp) ::  j    !<
-      INTEGER(iwp) ::  jb   !<
-      INTEGER(iwp) ::  jcsc !< Lower j-index limit for copying fc-data to workarrc_t
-      INTEGER(iwp) ::  jcnc !< Upper j-index limit for copying fc-data to workarrc_t
-      INTEGER(iwp) ::  je   !< 
-      INTEGER(iwp) ::  jw   !<     
-      INTEGER(iwp) ::  k    !< Vertical child-grid index fixed to the boundary-value level 
-      INTEGER(iwp) ::  ka   !< Running vertical child-grid index
-      INTEGER(iwp) ::  kw   !< 
-      INTEGER(iwp) ::  l    !< Parent-grid index in x-direction
-      INTEGER(iwp) ::  lp1  !< l+1
-      INTEGER(iwp) ::  m    !< Parent-grid index in y-direction
-      INTEGER(iwp) ::  mp1  !< m+1
-      INTEGER(iwp) ::  n    !< Parent-grid work array index in z-direction
-      INTEGER(iwp) ::  np1  !< n+1
-      INTEGER(iwp) ::  noff !< n-offset needed on the top boundary to correctly refer to boundary ghost points  
-      INTEGER(iwp) ::  nw   !< n-index for workarrc_t
-      INTEGER(iwp) ::  var_flag  !<
-      
-      REAL(wp) ::  cellsum     !<
-      REAL(wp) ::  cellsumd    !<
-      REAL(wp) ::  fac
-      REAL(wp) ::  fk          !<
-      REAL(wp) ::  fkj         !<
-      REAL(wp) ::  fkjp        !<
-      REAL(wp) ::  fkpj        !<
-      REAL(wp) ::  fkpjp       !<
-      REAL(wp) ::  fkp         !<
-      REAL(wp) ::  f_interp    !<
-      REAL(wp) ::  rcorr       !<
-      REAL(wp) ::  rcorr_ijk   !<
-
-!      real(wp), parameter :: c1 =  2.0_wp / 6.0_wp
-!      real(wp), parameter :: c2 =  5.0_wp / 6.0_wp
-!      real(wp), parameter :: c3 = -1.0_wp / 6.0_wp
+      REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(INOUT) ::  f    !< Child-grid array
+      REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr), INTENT(IN)        ::  fc   !< Parent-grid array
+      INTEGER(iwp), DIMENSION(icla:icra), INTENT(IN)    ::  ifl  !< Indicates start index of child cells belonging to certain parent cell - x direction
+      INTEGER(iwp), DIMENSION(icla:icra), INTENT(IN)    ::  ifu  !< Indicates end index of child cells belonging to certain parent cell - x direction
+      INTEGER(iwp), DIMENSION(jcsa:jcna), INTENT(IN)    ::  jfl  !< Indicates start index of child cells belonging to certain parent cell - y direction
+      INTEGER(iwp), DIMENSION(jcsa:jcna), INTENT(IN)    ::  jfu  !< Indicates end index of child cells belonging to certain parent cell - y direction
+      INTEGER(iwp) :: kct                                        !< The parent-grid index in z-direction just below the boundary value node
+      CHARACTER(LEN=1), INTENT(IN) :: var                        !< Variable symbol: 'u', 'v', 'w' or 's'
+!
+!--   Local variables:
+      REAL(wp)     ::  c31         !< Interpolation coefficient for the 3rd-order WS scheme
+      REAL(wp)     ::  c32         !< Interpolation coefficient for the 3rd-order WS scheme
+      REAL(wp)     ::  c33         !< Interpolation coefficient for the 3rd-order WS scheme
+      REAL(wp)     ::  f_interp_1  !< Value interpolated in z direction from the parent-grid data
+      REAL(wp)     ::  f_interp_2  !< Auxiliary value interpolated in z direction from the parent-grid data
+      INTEGER(iwp) ::  i           !< Child-grid index in x-direction
+      INTEGER(iwp) ::  iclc        !< Lower i-index limit for copying fc-data to workarrc_t
+      INTEGER(iwp) ::  icrc        !< Upper i-index limit for copying fc-data to workarrc_t
+      INTEGER(iwp) ::  ierr        !< MPI error code
+      INTEGER(iwp) ::  j           !< Child-grid index in y-direction
+      INTEGER(iwp) ::  jcsc        !< Lower j-index limit for copying fc-data to workarrc_t
+      INTEGER(iwp) ::  jcnc        !< Upper j-index limit for copying fc-data to workarrc_t
+      INTEGER(iwp) ::  k           !< Vertical child-grid index fixed to the boundary-value level 
+      INTEGER(iwp) ::  l           !< Parent-grid index in x-direction
+      INTEGER(iwp) ::  m           !< Parent-grid index in y-direction
+      INTEGER(iwp) ::  nw          !< Reduced n-index for workarrc_t pointing to the boundary ghost node 
 
 
       IF ( var == 'w' )  THEN
          k    = nzt
-         noff = 0
       ELSE
          k    = nzt + 1
-         noff = 1
       ENDIF
-
-      IF ( var == 'u' )  THEN 
-         var_flag = 1 
-      ELSEIF ( var == 'v' )  THEN
-         var_flag = 2      
-      ELSEIF ( var == 'w' )  THEN
-         var_flag = 3
-      ELSE
-         var_flag = 0
-      ENDIF
-      n  = kc(k) + noff     ! Chance this to get rid of kc. 
-      nw = noff 
-!      write(9,"(a1,2x,5(i3,2x))") var, k, kc(k), noff, n, nw 
-!      flush(9)
+      nw = 1
+!
+!--   Interpolation coefficients
+      IF  ( interpolation_scheme_t == 1 )  THEN
+         c31 =  0.0_wp           ! 1st-order upwind
+         c32 =  1.0_wp
+         c33 =  0.0_wp
+      ELSE IF  ( interpolation_scheme_t == 2 )  THEN
+         c31 =  0.5_wp           ! 2nd-order central
+         c32 =  0.5_wp
+         c33 =  0.0_wp
+      ELSE            
+         c31 =  2.0_wp / 6.0_wp  ! 3rd-order WS upwind biased (default)
+         c32 =  5.0_wp / 6.0_wp
+         c33 = -1.0_wp / 6.0_wp         
+      ENDIF         
 !
 !--   Substitute the necessary parent-grid data to the work array. 
@@ -6523,5 +3943,5 @@
       ENDIF
       workarrc_t = 0.0_wp
-      workarrc_t(0:2,jcsc:jcnc,iclc:icrc) = fc(kc(k):kc(k)+2,jcsc:jcnc,iclc:icrc)
+      workarrc_t(-2:3,jcsc:jcnc,iclc:icrc) = fc(kct-2:kct+3,jcsc:jcnc,iclc:icrc)
 !
 !--   Left-right exchange if more than one PE subdomain in the x-direction.
@@ -6567,18 +3987,40 @@
 #endif      
 
-      IF  ( var == 'u' )  THEN
+      IF  ( var == 'w' )  THEN
+         DO  l = iclw, icrw
+            DO  m = jcsw, jcnw
+ 
+               DO  i = ifl(l), ifu(l)
+                  DO  j = jfl(m), jfu(m)
+                     f(k,j,i) = workarrc_t(nw,m,l)
+                  ENDDO
+               ENDDO
+
+            ENDDO
+         ENDDO
+
+      ELSE IF  ( var == 'u' )  THEN
 
          DO  l = iclw, icrw-1
             DO  m = jcsw, jcnw
 !
+!--            First interpolate to the flux point using the 3rd-order WS scheme
+               f_interp_1 = c31 * workarrc_t(nw-1,m,l)   + c32 * workarrc_t(nw,m,l)   + c33 * workarrc_t(nw+1,m,l)
+               f_interp_2 = c31 * workarrc_t(nw-1,m,l+1) + c32 * workarrc_t(nw,m,l+1) + c33 * workarrc_t(nw+1,m,l+1)
+!
 !--            Use averages of the neighbouring matching grid-line values
                DO  i = ifl(l), ifl(l+1)
-                  f(k,jfl(m):jfu(m),i) = 0.5_wp * ( workarrc_t(nw,m,l)   &
-                       + workarrc_t(nw,m,l+1) )
+!                  f(k,jfl(m):jfu(m),i) = 0.5_wp * ( workarrc_t(nw,m,l)   &
+!                       + workarrc_t(nw,m,l+1) )
+                  f(k,jfl(m):jfu(m),i) = 0.5_wp * ( f_interp_1 + f_interp_2 )
                ENDDO
 !
 !--            Then set the values along the matching grid-lines  
                IF  ( MOD( ifl(l), igsr ) == 0 )  THEN
-                  f(k,jfl(m):jfu(m),ifl(l)) = workarrc_t(nw,m,l)
+!
+!--            First interpolate to the flux point using the 3rd-order WS scheme
+                  f_interp_1 = c31 * workarrc_t(nw-1,m,l) + c32 * workarrc_t(nw,m,l) + c33 * workarrc_t(nw+1,m,l)                  
+!                  f(k,jfl(m):jfu(m),ifl(l)) = workarrc_t(nw,m,l)
+                  f(k,jfl(m):jfu(m),ifl(l)) = f_interp_1
                ENDIF
 
@@ -6589,5 +4031,9 @@
          IF  ( MOD( ifl(icrw), igsr ) == 0 )  THEN
             DO  m = jcsw, jcnw
-               f(k,jfl(m):jfu(m),ifl(icrw)) = workarrc_t(nw,m,icrw)
+!
+!--            First interpolate to the flux point using the 3rd-order WS scheme
+               f_interp_1 = c31 * workarrc_t(nw-1,m,icrw) + c32 * workarrc_t(nw,m,icrw) + c33 * workarrc_t(nw+1,m,icrw)
+!               f(k,jfl(m):jfu(m),ifl(icrw)) = workarrc_t(nw,m,icrw)
+               f(k,jfl(m):jfu(m),ifl(icrw)) = f_interp_1
             ENDDO
          ENDIF
@@ -6610,13 +4056,20 @@
             DO  m = jcsw, jcnw-1
 !
+!--            First interpolate to the flux point using the 3rd-order WS scheme
+               f_interp_1 = c31 * workarrc_t(nw-1,m,l)   + c32 * workarrc_t(nw,m,l)   + c33 * workarrc_t(nw+1,m,l)
+               f_interp_2 = c31 * workarrc_t(nw-1,m+1,l) + c32 * workarrc_t(nw,m+1,l) + c33 * workarrc_t(nw+1,m+1,l)
+!
 !--            Use averages of the neighbouring matching grid-line values
-               DO  j = jfl(m), jfl(m+1)                  
-                  f(k,j,ifl(l):ifu(l)) = 0.5_wp * ( workarrc_t(nw,m,l)   &
-                       + workarrc_t(nw,m+1,l) )
+               DO  j = jfl(m), jfl(m+1)          
+!                  f(k,j,ifl(l):ifu(l)) = 0.5_wp * ( workarrc_t(nw,m,l)   &
+!                       + workarrc_t(nw,m+1,l) )
+                  f(k,j,ifl(l):ifu(l)) = 0.5_wp * ( f_interp_1 + f_interp_2 )
                ENDDO
 !
 !--            Then set the values along the matching grid-lines  
                IF  ( MOD( jfl(m), jgsr ) == 0 )  THEN
-                  f(k,jfl(m),ifl(l):ifu(l)) = workarrc_t(nw,m,l)
+                  f_interp_1 = c31 * workarrc_t(nw-1,m,l) + c32 * workarrc_t(nw,m,l) + c33 * workarrc_t(nw+1,m,l)
+!                  f(k,jfl(m),ifl(l):ifu(l)) = workarrc_t(nw,m,l)
+                  f(k,jfl(m),ifl(l):ifu(l)) = f_interp_1
                ENDIF
                
@@ -6625,8 +4078,12 @@
          ENDDO
 !
-!--      Finally, set the values along the last matching grid-line  
+!--      Finally, set the values along the last matching grid-line
          IF  ( MOD( jfl(jcnw), jgsr ) == 0 )  THEN
             DO  l = iclw, icrw
-               f(k,jfl(jcnw),ifl(l):ifu(l)) = workarrc_t(nw,jcnw,l)
+!
+!--            First interpolate to the flux point using the 3rd-order WS scheme
+               f_interp_1 = c31 * workarrc_t(nw-1,jcnw,l) + c32 * workarrc_t(nw,jcnw,l) + c33 * workarrc_t(nw+1,jcnw,l)
+!               f(k,jfl(jcnw),ifl(l):ifu(l)) = workarrc_t(nw,jcnw,l)
+               f(k,jfl(jcnw),ifl(l):ifu(l)) = f_interp_1
             ENDDO
          ENDIF
@@ -6644,18 +4101,15 @@
          ENDIF
 
-      ELSE  ! w or any scalar
+      ELSE  ! any scalar variable
 
          DO  l = iclw, icrw
             DO  m = jcsw, jcnw
 !
-!--            3rd-order upwind biased interpolation. 
-!               IF  ( w(k,jfl(m),ifl(l)) < 0.0_wp )  THEN
-!                  f_interp = c1 * workarrc_t(0,m,l) + c2 * workarrc_t(1,m,l) + c3 * workarrc_t(2,m,l) 
-!               ELSE
-!                  f_interp = workarrc_t(nw,m,l)
-!               ENDIF              
+!--            First interpolate to the flux point using the 3rd-order WS scheme
+               f_interp_1 = c31 * workarrc_t(nw-1,m,l) + c32 * workarrc_t(nw,m,l) + c33 * workarrc_t(nw+1,m,l)
                DO  i = ifl(l), ifu(l)
                   DO  j = jfl(m), jfu(m)
-                     f(k,j,i) = workarrc_t(nw,m,l)
+!                     f(k,j,i) = workarrc_t(nw,m,l)
+                     f(k,j,i) = f_interp_1
                   ENDDO
                ENDDO
@@ -6675,171 +4129,72 @@
 
 
-   SUBROUTINE pmci_interp_tril_lr( f, fc, ic, jc, kc, r1x, r2x, r1y, r2y, r1z, &
-                                   r2z, logc, logc_ratio, logc_kbounds,        &
-                                   nzt_topo_nestbc,                            &
-                                   kct, ifl, ifu, jfl, jfu, kfl, kfu, ijkfc,   &
-                                   edge, var )
-!
-!--   Interpolation of ghost-node values used as the child-domain boundary
-!--   conditions. This subroutine handles the left and right boundaries. It is
-!--   based on trilinear interpolation.
+   SUBROUTINE pmci_anterp_tophat( f, fc, kct, ifl, ifu, jfl, jfu, kfl, kfu, ijkfc, var )
+!
+!--   Anterpolation of internal-node values to be used as the parent-domain
+!--   values. This subroutine is based on the first-order numerical
+!--   integration of the child-grid values contained within the anterpolation
+!--   cell.
 
       IMPLICIT NONE
 
-      INTEGER(iwp) ::  nzt_topo_nestbc   !<
-
-      REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                      &
-                                      INTENT(INOUT) ::  f       !<
-      REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr),                          &
-                                      INTENT(IN)    ::  fc      !<
-      REAL(wp), DIMENSION(1:2,0:ncorr-1,nzb:nzt_topo_nestbc,nys:nyn),          &
-                                      INTENT(IN)    ::  logc_ratio   !<
-!AH      REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN)    ::  r1x     !<
-!AH      REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN)    ::  r2x     !<
-!AH      REAL(wp), DIMENSION(nysg:nyng), INTENT(IN)    ::  r1y     !<
-!AH      REAL(wp), DIMENSION(nysg:nyng), INTENT(IN)    ::  r2y     !<
-      REAL(wp), DIMENSION(nxlfc:nxrfc), INTENT(IN)  ::  r1x     !<
-      REAL(wp), DIMENSION(nxlfc:nxrfc), INTENT(IN)  ::  r2x     !<
-      REAL(wp), DIMENSION(nysfc:nynfc), INTENT(IN)  ::  r1y     !<
-      REAL(wp), DIMENSION(nysfc:nynfc), INTENT(IN)  ::  r2y     !<
-
-!AH      REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN)    ::  r1z     !<
-!AH      REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN)    ::  r2z     !<
-      REAL(wp), DIMENSION(nzb:nzt+kgsr), INTENT(IN) ::  r1z     !<
-      REAL(wp), DIMENSION(nzb:nzt+kgsr), INTENT(IN) ::  r2z     !<
-      
-
-      INTEGER(iwp), DIMENSION(nxlfc:nxrfc), INTENT(IN)         ::  ic     !<
-      INTEGER(iwp), DIMENSION(nysfc:nynfc), INTENT(IN)         ::  jc     !<
-!AH      INTEGER(iwp), DIMENSION(nzb:nzt+1), INTENT(IN)           ::  kc     !<
-      INTEGER(iwp), DIMENSION(nzb:nzt+kgsr), INTENT(IN)        ::  kc     !<
-      INTEGER(iwp), DIMENSION(1:2,nzb:nzt_topo_nestbc,nys:nyn),                &
-                                          INTENT(IN)           :: logc   !<
-      INTEGER(iwp), DIMENSION(1:2,nys:nyn), INTENT(IN)         :: logc_kbounds !<
-
-      INTEGER(iwp) :: kct
-
-!AH
-!      INTEGER(iwp), DIMENSION(icl:icr), INTENT(IN) ::  ifl !< Indicates start index of child cells belonging to certain parent cell - x direction
-!      INTEGER(iwp), DIMENSION(icl:icr), INTENT(IN) ::  ifu !< Indicates end index of child cells belonging to certain parent cell - x direction
-!      INTEGER(iwp), DIMENSION(jcs:jcn), INTENT(IN) ::  jfl !< Indicates start index of child cells belonging to certain parent cell - y direction
-!      INTEGER(iwp), DIMENSION(jcs:jcn), INTENT(IN) ::  jfu !< Indicates start index of child cells belonging to certain parent cell - y direction
+      REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(IN) ::  f         !< Child-grid array
+      REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr), INTENT(INOUT)  ::  fc        !< Parent-grid array
+      INTEGER(iwp), DIMENSION(0:cg%nz+1,jcsa:jcna,icla:icra), INTENT(IN) :: ijkfc  !< number of child grid points contributing to a parent grid box
+      INTEGER(iwp), INTENT(IN) ::  kct                                             !< Top boundary index for anterpolation along z
       INTEGER(iwp), DIMENSION(icla:icra), INTENT(IN) ::  ifl !< Indicates start index of child cells belonging to certain parent cell - x direction
       INTEGER(iwp), DIMENSION(icla:icra), INTENT(IN) ::  ifu !< Indicates end index of child cells belonging to certain parent cell - x direction
       INTEGER(iwp), DIMENSION(jcsa:jcna), INTENT(IN) ::  jfl !< Indicates start index of child cells belonging to certain parent cell - y direction
-      INTEGER(iwp), DIMENSION(jcsa:jcna), INTENT(IN) ::  jfu !< Indicates start index of child cells belonging to certain parent cell - y direction
-!AH
-
-!AH      INTEGER(iwp), DIMENSION(0:kct), INTENT(IN)   ::  kfl !< Indicates start index of child cells belonging to certain parent cell - z direction
-!AH      INTEGER(iwp), DIMENSION(0:kct), INTENT(IN)   ::  kfu !< Indicates start index of child cells belonging to certain parent cell - z direction
-      INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN)   ::  kfl !< Indicates start index of child cells belonging to certain parent cell - z direction
-      INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN)   ::  kfu !< Indicates start index of child cells belonging to certain parent cell - z direction
-
-!AH      INTEGER(iwp), DIMENSION(0:kct,jcs:jcn,icl:icr), INTENT(IN) :: ijkfc !< number of child grid points contributing to a parent grid box
-!AH
-!      INTEGER(iwp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr), INTENT(IN) :: ijkfc !< number of child grid points contributing to a parent grid box
-      INTEGER(iwp), DIMENSION(0:cg%nz+1,jcsa:jcna,icla:icra), INTENT(IN) :: ijkfc !< number of child grid points contributing to a parent grid box
-!AH
-
-      CHARACTER(LEN=1), INTENT(IN) ::  edge   !< Edge symbol: 'l', 'r', 's' or 'n' 
-      CHARACTER(LEN=1), INTENT(IN) ::  var    !< Variable symbol: 'u', 'v', 'w' or 's'
-
-      INTEGER(iwp) ::  i        !< Lower bound of the running index ia
-      INTEGER(iwp) ::  ia       !< i-index running over the parent-grid cell on the boundary 
-      INTEGER(iwp) ::  iaw      !< Reduced ia-index for workarr_lr
-      INTEGER(iwp) ::  iawbc    !< iaw-index pointing to the boundary-value nodes (either 0 or igsr-1)      
-      INTEGER(iwp) ::  ibc      !< Fixed i-index pointing to the boundary-value nodes (either i or iend)
-!AH      INTEGER(iwp) ::  ibeg     !< i-index pointing to the starting point of workarr_lr in the i-direction 
-      INTEGER(iwp) ::  iend     !< Upper bound of the running index ia
-      INTEGER(iwp) ::  ierr     !< MPI error code
-      INTEGER(iwp) ::  ijk      !< Running index for all child-grid cells within the anterpolation cell
-      INTEGER(iwp) ::  iw       !< i-index for wall_flags_0
-      INTEGER(iwp) ::  j        !< Running index in the y-direction
-      INTEGER(iwp) ::  jco      !<
-      INTEGER(iwp) ::  jcorr    !<
-      INTEGER(iwp) ::  jinc     !<
-      INTEGER(iwp) ::  jw       !< j-index for wall_flags_0
-      INTEGER(iwp) ::  j1       !<
-      INTEGER(iwp) ::  k        !< Running index in the z-direction
-      INTEGER(iwp) ::  k_wall   !< Vertical index of topography top
-      INTEGER(iwp) ::  kco      !<
-      INTEGER(iwp) ::  kcorr    !<
-      INTEGER(iwp) ::  kw       !< k-index for wall_flags_0
-      INTEGER(iwp) ::  k1       !<
-      INTEGER(iwp) ::  l        !< Parent-grid running index in the x-direction
-      INTEGER(iwp) ::  lbeg     !< l-index pointing to the starting point of workarrc_lr in the l-direction 
-      INTEGER(iwp) ::  lp1      !< l+1
-      INTEGER(iwp) ::  loff     !< l-offset needed on the right boundary to correctly refer to boundary ghost points
-      INTEGER(iwp) ::  lw       !< Reduced l-index for workarrc_lr
-      INTEGER(iwp) ::  m        !< Parent-grid running index in the y-direction
-      INTEGER(iwp) ::  mnorthv  !< Upshift by one for the upper bound of index m in case of var == 'v'
-      INTEGER(iwp) ::  mp1      !< m+1
-      INTEGER(iwp) ::  n        !< Parent-grid running index in the z-direction
-      INTEGER(iwp) ::  np1      !< n+1
-      INTEGER(iwp) ::  ntopw    !< Upshift by one for the upper bound of index n in case of var == 'w'
-      INTEGER(iwp) ::  var_flag !< Variable flag for BTEST( wall_flags_0 )
-
-      REAL(wp) ::  cellsum      !< Sum of child-grid node values over the anterpolation cell 
-      REAL(wP) ::  cellsumd     !< Sum of differences over the anterpolation cell 
-      REAL(wp) ::  fkj          !< Intermediate result in trilinear interpolation
-      REAL(wp) ::  fkjp         !< Intermediate result in trilinear interpolation
-      REAL(wp) ::  fkpj         !< Intermediate result in trilinear interpolation
-      REAL(wp) ::  fkpjp        !< Intermediate result in trilinear interpolation
-      REAL(wp) ::  fk           !< Intermediate result in trilinear interpolation
-      REAL(wp) ::  fkp          !< Intermediate result in trilinear interpolation
-      REAL(wp) ::  rcorr        !< Average reversibility correction for the whole anterpolation cell
-      REAL(wp) ::  rcorr_ijk    !< Reversibility correction distributed to the individual child-grid nodes
- 
-! 
-!--   Check which edge is to be handled
-      IF ( edge == 'l' )  THEN
-!
-!--      For u, nxl is a ghost node, but not for the other variables
-         IF ( var == 'u' )  THEN
-            i     = nxl
-            iend  = nxl
-            ibc   = nxl
-            iawbc = 0
-            lbeg  = icl
-            loff  = 0
-         ELSE
-            i     = nxl - igsr
-            iend  = nxl - 1
-            ibc   = nxl - 1
-            iawbc = igsr-1
-            lbeg  = icl
-            loff  = 0
+      INTEGER(iwp), DIMENSION(jcsa:jcna), INTENT(IN) ::  jfu !< Indicates end index of child cells belonging to certain parent cell - y direction
+      INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN) ::  kfl !< Indicates start index of child cells belonging to certain parent cell - z direction
+      INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN) ::  kfu !< Indicates end index of child cells belonging to certain parent cell - z direction
+      CHARACTER(LEN=*), INTENT(IN) ::  var                   !< Variable symbol: 'u', 'v', 'w' or 's'
+!
+!--   Local variables:  
+      REAL(wp) ::  cellsum       !< sum of respective child cells belonging to parent cell 
+      INTEGER(iwp) ::  i         !< Running index x-direction - child grid
+      INTEGER(iwp) ::  iclant    !< Left boundary index for anterpolation along x
+      INTEGER(iwp) ::  icrant    !< Right boundary index for anterpolation along x
+      INTEGER(iwp) ::  j         !< Running index y-direction - child grid
+      INTEGER(iwp) ::  jcnant    !< North boundary index for anterpolation along y
+      INTEGER(iwp) ::  jcsant    !< South boundary index for anterpolation along y
+      INTEGER(iwp) ::  k         !< Running index z-direction - child grid     
+      INTEGER(iwp) ::  kcb = 0   !< Bottom boundary index for anterpolation along z
+      INTEGER(iwp) ::  kctant    !< Top boundary index for anterpolation along z
+      INTEGER(iwp) ::  l         !< Running index x-direction - parent grid
+      INTEGER(iwp) ::  m         !< Running index y-direction - parent grid
+      INTEGER(iwp) ::  n         !< Running index z-direction - parent grid
+      INTEGER(iwp) ::  var_flag  !< bit number used to flag topography on respective grid
+
+!
+!--   Define the index bounds iclant, icrant, jcsant and jcnant.
+!--   Note that kcb is simply zero and kct enters here as a parameter and it is
+!--   determined in pmci_init_anterp_tophat.
+!--   Please note, grid points used also for interpolation (from parent to
+!--   child) are excluded in anterpolation, e.g. anterpolation is only from 
+!--   nzb:kct-1, as kct is used for interpolation.
+      iclant = icl
+      icrant = icr
+      jcsant = jcs
+      jcnant = jcn
+      kctant = kct - 1
+      
+      kcb  = 0
+      IF ( nesting_mode /= 'vertical' )  THEN
+         IF ( bc_dirichlet_l )  THEN
+            iclant = icl + 3
          ENDIF
-      ELSEIF ( edge == 'r' )  THEN
-         IF ( var == 'u' )  THEN
-            i     = nxr + 1            
-            iend  = nxr + 1
-            ibc   = nxr + 1 
-            iawbc = 0
-            lbeg  = icr - 2
-            loff  = 0
-         ELSE
-            i     = nxr + 1
-            iend  = nxr + igsr
-            ibc   = nxr + 1
-            iawbc = 0
-            lbeg  = icr - 2
-            loff  = 1
+         IF ( bc_dirichlet_r )  THEN
+            icrant = icr - 3
          ENDIF
 
+         IF ( bc_dirichlet_s )  THEN
+            jcsant = jcs + 3
+         ENDIF
+         IF ( bc_dirichlet_n )  THEN
+            jcnant = jcn - 3
+         ENDIF
       ENDIF
-
-      IF  ( var == 'w' )  THEN
-         ntopw = 1
-      ELSE
-         ntopw = 0
-      ENDIF
-
-      IF  ( var == 'v' )  THEN
-         mnorthv = 0
-      ELSE
-         mnorthv = 1
-      ENDIF
-
+!
+!--   Set masking bit for topography flags 
       IF ( var == 'u' )  THEN 
          var_flag = 1 
@@ -6851,1358 +4206,38 @@
          var_flag = 0
       ENDIF
-
-!AH
-!
-!--   Substitute the necessary parent-grid data to the work array workarrc_lr. 
-      workarrc_lr = 0.0_wp     
-      IF  ( pdims(2) > 1 )  THEN
-#if defined( __parallel )
-         IF  ( nys == 0 )  THEN 
-            workarrc_lr(0:cg%nz+1,jcsw:jcnw-1,0:2)                              &
-                 = fc(0:cg%nz+1,jcsw:jcnw-1,lbeg:lbeg+2)
-         ELSE IF  ( nyn == ny )  THEN
-            workarrc_lr(0:cg%nz+1,jcsw+1:jcnw,0:2)                              &
-                 = fc(0:cg%nz+1,jcsw+1:jcnw,lbeg:lbeg+2)
-         ELSE
-            workarrc_lr(0:cg%nz+1,jcsw+1:jcnw-1,0:2)                            &
-                 = fc(0:cg%nz+1,jcsw+1:jcnw-1,lbeg:lbeg+2)
-         ENDIF
-!
-!--      South-north exchange if more than one PE subdomain in the y-direction.
-!--      Note that in case of 3-D nesting the south (psouth == MPI_PROC_NULL) 
-!--      and north (pnorth == MPI_PROC_NULL) boundaries are not exchanged 
-!--      because the nest domain is not cyclic.
-!--      From south to north
-         CALL MPI_SENDRECV( workarrc_lr(0,jcsw+1,0), 1,                         &
-              workarrc_lr_exchange_type, psouth,  0,                            &
-              workarrc_lr(0,jcnw,0), 1,                                         &
-              workarrc_lr_exchange_type, pnorth,  0,                            &
-              comm2d, status, ierr ) 
-!
-!--      From north to south        
-         CALL MPI_SENDRECV( workarrc_lr(0,jcnw-1,0), 1,                         &
-              workarrc_lr_exchange_type, pnorth,  1,                            &
-              workarrc_lr(0,jcsw,0), 1,                                         &
-              workarrc_lr_exchange_type, psouth,  1,                            &
-              comm2d, status, ierr )
-#endif
-      ELSE
-         workarrc_lr(0:cg%nz+1,jcsw:jcnw,0:2)                                   &
-              = fc(0:cg%nz+1,jcsw:jcnw,lbeg:lbeg+2)            
-      ENDIF
-!
-!AH
-      workarr_lr = 0.0_wp
-      
-      DO  ia = i, iend
-         iaw = ia - i
-         DO  j = nys-1, nyn+1
-!AH         DO  j = nys, nyn
-!
-!--         Determine vertical index of topography top at grid point (j,i)
-!AH         k_wall = get_topography_top_index_ji( j, i, TRIM( var ) )
-            DO  k = nzb, nzt+1 !k_wall, nzt+1
-!AH               l   = ic(ia) - ic(i)
-               l   = ic(ia) - lbeg
-               lp1 = MIN( l + 1, 2 )  ! If l+1 > 2 (l=ic(nxr+1)-lbeg), r1x = 1 and r2x = 0
-               m   = jc(j)
-               mp1 = MIN( m + 1, jcnw )  ! If m+1 > jcn (m=jc(nyn+1)), r1y = 1 and r2y = 0
-               n   = kc(k)
-               np1 = n + 1            
-
-!AH
-!               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)
-!AH
-               
-               fkj      = r1x(ia) * workarrc_lr(n,m,l)     + r2x(ia) * workarrc_lr(n,m,lp1)
-               fkjp     = r1x(ia) * workarrc_lr(n,mp1,l)   + r2x(ia) * workarrc_lr(n,mp1,lp1)
-               fkpj     = r1x(ia) * workarrc_lr(np1,m,l)   + r2x(ia) * workarrc_lr(np1,m,lp1)
-               fkpjp    = r1x(ia) * workarrc_lr(np1,mp1,l) + r2x(ia) * workarrc_lr(np1,mp1,lp1)
-               
-               fk       = r1y(j) * fkj  + r2y(j) * fkjp
-               fkp      = r1y(j) * fkpj + r2y(j) * fkpjp
-
-!AH
-!               f(k,j,i) = r1z(k) * fk + r2z(k) * fkp               
-               workarr_lr(k,j,iaw) = r1z(k) * fk + r2z(k) * fkp
-               
-!               if  ( ( edge == 'l' ) .and. ( ia  == ibc ) ) then
-!                  write(9,"('pmci_interp_tril_lr: ',a2,2x,11(i4,2x),7(e12.5,2x))") var, k, j, ia, ibc, iaw, n, m, l, np1, mp1, lp1, &
-!                       workarr_lr(k,j,iaw), r1x(ia), r2x(ia), workarrc_lr(n,m,l), workarrc_lr(n,mp1,l), workarrc_lr(np1,m,l), workarrc_lr(np1,mp1,l)
-!                  flush(9)
-!               endif
-
-!AH
-               
+!
+!--   Note that ii, jj, and kk are coarse-grid indices and i,j, and k 
+!--   are fine-grid indices.
+      DO  l = iclant, icrant
+         DO  m = jcsant, jcnant
+!
+!--         For simplicity anterpolate within buildings and under elevated
+!--         terrain too
+            DO  n = kcb, kctant
+               cellsum = 0.0_wp
+               DO  i = ifl(l), ifu(l)
+                  DO  j = jfl(m), jfu(m)
+                     DO  k = kfl(n), kfu(n)
+                        cellsum = cellsum + MERGE( f(k,j,i), 0.0_wp,          &
+                             BTEST( wall_flags_0(k,j,i), var_flag ) )
+                     ENDDO
+                  ENDDO
+               ENDDO
+!
+!--            In case all child grid points are inside topography, i.e. 
+!--            ijkfc and cellsum are zero, also parent solution would have 
+!--            zero values at that grid point, which may cause problems in 
+!--            particular for the temperature. Therefore, in case cellsum is 
+!--            zero, keep the parent solution at this point. 
+
+               IF ( ijkfc(n,m,l) /= 0 )  THEN
+                  fc(n,m,l) = cellsum / REAL( ijkfc(n,m,l), KIND=wp )
+               ENDIF
+
             ENDDO
          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 ( constant_flux_layer .AND. ( var == 'u' .OR. var == 'v' ) )  THEN
-         DO  j = nys, nyn
-!
-!--         Determine vertical index of topography top at grid point (j,i)
-            k_wall = get_topography_top_index_ji( j, i, TRIM ( var ) )
-
-            k = k_wall+1
-            IF ( ( logc(1,k,j) /= 0 )  .AND.  ( logc(2,k,j) == 0 ) )  THEN
-               k1 = logc(1,k,j)
-               DO  kcorr = 0, ncorr - 1
-                  kco = k + kcorr
-!AH                  f(kco,j,i) = logc_ratio(1,kcorr,k,j) * 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 ( constant_flux_layer .AND. ( var == 'u' .OR. var == 'w' ) )  THEN           
-!
-!--         Solid surface only on south/north side of the node                   
-            DO  j = nys, nyn
-               DO  k = logc_kbounds(1,j), logc_kbounds(2,j)   
-                  IF ( ( logc(2,k,j) /= 0 )  .AND.  ( logc(1,k,j) == 0 ) )  THEN
-!
-!--                  Direction of the wall-normal index is carried in as the
-!--                  sign of logc
-                     jinc = SIGN( 1, logc(2,k,j) )
-                     j1   = ABS( logc(2,k,j) )
-                     DO  jcorr = 0, ncorr-1
-                        jco = j + jinc * jcorr
-                        IF ( jco >= nys .AND. jco <= nyn )  THEN
-!AH                           f(k,jco,i) = logc_ratio(2,jcorr,k,j) * f(k,j1,i)
-                        ENDIF
-                     ENDDO
-                  ENDIF
-               ENDDO
-            ENDDO
-         ENDIF
-!
-!--      Solid surface on both below and on south/north side of the node           
-         IF ( constant_flux_layer .AND. var == 'u' )  THEN
-            DO  j = nys, nyn
-               k = logc_kbounds(1,j)
-               IF ( ( logc(2,k,j) /= 0 )  .AND.  ( logc(1,k,j) /= 0 ) )  THEN
-                  k1   = logc(1,k,j)                 
-                  jinc = SIGN( 1, logc(2,k,j) )
-                  j1   = ABS( logc(2,k,j) )                 
-                  DO  jcorr = 0, ncorr-1
-                     jco = j + jinc * jcorr
-                     IF ( jco >= nys .AND. jco <= nyn )  THEN
-                        DO  kcorr = 0, ncorr-1
-                           kco = k + kcorr
-!AH                           f(kco,jco,i) = 0.5_wp * ( logc_ratio(1,kcorr,k,j) * &
-!AH                                                     f(k1,j,i)                 &
-!AH                                                   + logc_ratio(2,jcorr,k,j) * &
-!AH                                                     f(k,j1,i) )
-                        ENDDO
-                     ENDIF
-                  ENDDO
-               ENDIF
-            ENDDO
-         ENDIF
-
-      ENDIF  ! ( topography /= 'flat' )
-!
-!--   Apply the reversibility correction. 
-
-!      if  ( var == 'u' )  then
-
-      l  = ic(ibc) + loff
-      lw = 1
-!      write(9,"('pmci_interp_tril_lr: edge, var, l, i, iend, ifl(l), ifu(l) = ',2(a2,2x),5(i4,2x))") &
-!           edge, var, l, i, iend, ifl(l), ifu(l)
-!      flush(9)
-!AH      DO  m = jcsw+1, jcnw-1       
-      DO  m = jcsw + 1, jcnw - mnorthv   ! mnorthv = 0 for v and 1 for all others
-         DO  n = 0, kct + ntopw            ! ntopw = 1 for w and 0 for all others
-            ijk = 1
-            cellsum   = 0.0_wp
-            cellsumd  = 0.0_wp
-!
-!--         Note that the index name i must not be used here as a loop 
-!--         index name since i is the constant boundary index, hence 
-!--         the name ia. 
-            DO  ia = ifl(l), ifu(l)
-               iaw = ia - i
-               iw  = MAX( MIN( ia, nx+1 ), -1 )
-               DO  j = jfl(m), jfu(m)
-                  jw = MAX( MIN( j, ny+1 ), -1 )
-                  DO  k = kfl(n), kfu(n)
-                     kw = MIN( k, nzt+1 )
-!AH
-!                     cellsum = cellsum + MERGE( f(k,j,ia), 0.0_wp,              &
-!                          BTEST( wall_flags_0(kw,jw,iw), var_flag ) )
-                     cellsum = cellsum + MERGE( workarr_lr(k,j,iaw), 0.0_wp,     &
-                          BTEST( wall_flags_0(kw,jw,iw), var_flag ) )
-!AH
-                     
-!AH                     celltmpd(ijk) = ABS( fc(n,m,l) - f(k,j,ia) )
-!AH                     celltmpd(ijk) = ABS( workarrc_lr(n,m,lw) - f(k,j,ia) )
-                     celltmpd(ijk) = ABS( workarrc_lr(n,m,lw) - workarr_lr(k,j,iaw) )
-                     cellsumd      = cellsumd  + MERGE( celltmpd(ijk),          &
-                          0.0_wp, BTEST( wall_flags_0(kw,jw,iw), var_flag ) )
-
-!                     write(9,"('lr1: ',a1,2x,8(i4,2x),5(e12.5,2x))") var, n, m, l, k, j, ia, iaw, ijk,  &
-!                          workarrc_lr(n,m,lw), workarr_lr(k,j,iaw), cellsum, celltmpd(ijk), cellsumd
-!                     flush(9)
-
-                     ijk = ijk + 1
-                  ENDDO
-               ENDDO
-            ENDDO
-
-            IF ( ijkfc(n,m,l) /= 0 )  THEN
-               cellsum   = cellsum / REAL( ijkfc(n,m,l), KIND=wp )
-!               rcorr     = fc(n,m,l) - cellsum
-               rcorr     = workarrc_lr(n,m,lw) - cellsum
-               cellsumd  = cellsumd / REAL( ijkfc(n,m,l), KIND=wp )
-            ELSE
-               cellsum   = 0.0_wp                  
-               rcorr     = 0.0_wp
-               cellsumd  = 1.0_wp
-               celltmpd  = 1.0_wp
-            ENDIF
-! 
-!--         Distribute the correction term to the child nodes according to 
-!--         their relative difference to the parent value such that the
-!--         node with the largest difference gets the largest share of the 
-!--         correction. The distribution is skipped if rcorr is negligibly 
-!--         small in order to avoid division by zero. 
-            IF ( ABS(rcorr) < 0.000001_wp )  THEN                  
-               cellsumd  = 1.0_wp
-               celltmpd  = 1.0_wp
-            ENDIF
-
-            ijk = 1
-            DO  ia = ifl(l), ifu(l)
-!AH               iaw = ia - ifl(l)
-               iaw = ia - i
-               DO  j = jfl(m), jfu(m)
-                  DO  k = kfl(n), kfu(n)
-                     rcorr_ijk = rcorr * celltmpd(ijk) / cellsumd 
-!AH                     f(k,j,ia) = f(k,j,ia) + rcorr_ijk
-                     workarr_lr(k,j,iaw) = workarr_lr(k,j,iaw) + rcorr_ijk
-
-!                     write(9,"('lr2: ',a1,2x,9(i4,2x),4(e12.5,2x))") var, n, m, l, k, j, ia, iaw, ijk, ijkfc(n,m,l), &
-!                          rcorr, rcorr_ijk, workarr_lr(k,j,iaw), workarrc_lr(n,m,lw)
-!                     flush(9)
-
-                     ijk = ijk + 1
-                  ENDDO
-               ENDDO
-            ENDDO
-!
-!--         Velocity components tangential to the boundary need special 
-!--         treatment because their anterpolation cells are flat in their 
-!--         direction and hence do not cover all the child-grid boundary nodes. 
-!--         These components are next linearly interpolated to those child-grid 
-!--         boundary nodes which are not covered by the anterpolation cells.
-            IF  ( ( var == 'w' ) .AND. ( n > 0 ) )  THEN
-               DO  k = kfu(n-1)+1, kfl(n)-1
-                  IF  ( k <= nzt )  THEN
-                     DO  j = jfl(m), jfu(m)
-                        IF  ( ( j >= nys ) .AND. ( j <= nyn+1 ) )  THEN
-!AH                              
-!                           f(k,j,ia) = r1z(k) * f(kfu(n-1),j,ia)                &
-!                                   + r2z(k) * f(kfl(n),j,ia)
-                           workarr_lr(k,j,iawbc) =                              &
-                                  r1z(k) * workarr_lr(kfu(n-1),j,iawbc)         &
-                                + r2z(k) * workarr_lr(kfl(n),j,iawbc)
-
-!                           write(9,"('lr3: ',a1,2x,7(i4,2x),3(e12.5,2x))") var, n, m, l, k, j, iawbc, ibc, &
-!                                workarr_lr(k-1,j,iawbc), workarr_lr(k,j,iawbc), workarr_lr(k+1,j,iawbc)
-!                           flush(9)
-
-!AH                              
-                        ENDIF
-                     ENDDO
-                  ENDIF
-               ENDDO
-            ENDIF
-
-            IF  ( ( var == 'v' ) .AND. ( m > jcsw ) )  THEN
-               DO  j = jfu(m-1)+1, jfl(m)-1
-                  IF  ( ( j >= nys ) .AND. ( j <= nyn+1 ) )  THEN
-                     DO  k = kfl(n), kfu(n)
-                        IF  ( k <= nzt+1 )  THEN                              
-!AH                              
-!                           f(k,j,ia) = r1y(j) * f(k,jfu(m-1),ia)                &
-!                                   + r2y(j) * f(k,jfl(m),ia)
-                           workarr_lr(k,j,iawbc) =                              &
-                                  r1y(j) * workarr_lr(k,jfu(m-1),iawbc)         &
-                                + r2y(j) * workarr_lr(k,jfl(m),iawbc)
-
-!                           write(9,"('lr4: ',a1,2x,7(i4,2x),3(e12.5,2x))") var, n, m, l, k, j, iawbc, ibc, &
-!                                workarr_lr(k,j-1,iawbc), workarr_lr(k,j,iawbc), workarr_lr(k,j+1,iawbc)
-!                           flush(9)
-
-!AH                              
-                        ENDIF
-                     ENDDO
-                  ENDIF
-               ENDDO
-            ENDIF
-               
-         ENDDO  ! n
-      ENDDO  ! m
-
-!      endif  ! var
-
-!
-!--   Finally substitute the boundary values.
-      f(nzb:nzt+1,nys:nyn,ibc) = workarr_lr(nzb:nzt+1,nys:nyn,iawbc)
-
-!      do  k = 0, 2
-!         do  j = nys, nyn 
-!            if  ( edge == 'l' )  then
-!               write(9,"('lr5: ',2(a2,2x),4(i4,2x),4(e12.5,2x))") edge, var, k, j, ibc, iawbc,  &
-!                    workarr_lr(k,j,iawbc), f(k,j,ibc), f(k,j,ibc+1), f(k,j,ibc+2)
-!            else if  ( edge == 'r' )  then
-!               write(9,"('lr5: ',2(a2,2x),4(i4,2x),4(e12.5,2x))") edge, var, k, j, ibc, iawbc,  &
-!                    f(k,j,ibc-2), f(k,j,ibc-1), f(k,j,ibc), workarr_lr(k,j,iawbc)
-!            endif
-!         enddo
-!      enddo
-!      flush(9)
-
-   END SUBROUTINE pmci_interp_tril_lr
-
-
-
-   SUBROUTINE pmci_interp_tril_sn( f, fc, ic, jc, kc, r1x, r2x, r1y, r2y, r1z, &
-                                   r2z, logc, logc_ratio, logc_kbounds,        &
-                                   nzt_topo_nestbc,                            &
-                                   kct, ifl, ifu, jfl, jfu, kfl, kfu, ijkfc,   &
-                                   edge, var )
-
-!
-!--   Interpolation of ghost-node values used as the child-domain boundary
-!--   conditions. This subroutine handles the south and north boundaries. 
-!--   This subroutine is based on trilinear interpolation.
-
-      IMPLICIT NONE
-
-      INTEGER(iwp) ::  nzt_topo_nestbc   !<
-
-      REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                      &
-                                      INTENT(INOUT) ::  f             !<
-      REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr),                          &
-                                      INTENT(IN)    ::  fc            !<
-      REAL(wp), DIMENSION(1:2,0:ncorr-1,nzb:nzt_topo_nestbc,nxl:nxr),          &
-                                      INTENT(IN)    ::  logc_ratio    !<
-      REAL(wp), DIMENSION(nxlfc:nxrfc), INTENT(IN)  ::  r1x           !<
-      REAL(wp), DIMENSION(nxlfc:nxrfc), INTENT(IN)  ::  r2x           !<
-      REAL(wp), DIMENSION(nysfc:nynfc), INTENT(IN)  ::  r1y           !<
-      REAL(wp), DIMENSION(nysfc:nynfc), INTENT(IN)  ::  r2y           !<
-!AH      REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN)    ::  r1z           !<
-!AH      REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN)    ::  r2z           !<
-      REAL(wp), DIMENSION(nzb:nzt+kgsr), INTENT(IN) ::  r1z           !<
-      REAL(wp), DIMENSION(nzb:nzt+kgsr), INTENT(IN) ::  r2z           !<
-
-      
-      INTEGER(iwp), DIMENSION(nxlfc:nxrfc), INTENT(IN)         ::  ic    !<
-      INTEGER(iwp), DIMENSION(nysfc:nynfc), INTENT(IN)         ::  jc    !<
-!AH      INTEGER(iwp), DIMENSION(nzb:nzt+1), INTENT(IN)           ::  kc    !<
-      INTEGER(iwp), DIMENSION(nzb:nzt+kgsr), INTENT(IN)        ::  kc    !<
-      INTEGER(iwp), DIMENSION(1:2,nzb:nzt_topo_nestbc,nxl:nxr),                &
-                                          INTENT(IN)           ::  logc  !<
-      INTEGER(iwp), DIMENSION(1:2,nxl:nxr), INTENT(IN)         ::  logc_kbounds  !< 
-
-      INTEGER(iwp) :: kct
-!AH
-!      INTEGER(iwp), DIMENSION(icl:icr), INTENT(IN) ::  ifl !< Indicates start index of child cells belonging to certain parent cell - x direction
-!      INTEGER(iwp), DIMENSION(icl:icr), INTENT(IN) ::  ifu !< Indicates end index of child cells belonging to certain parent cell - x direction
-!      INTEGER(iwp), DIMENSION(jcs:jcn), INTENT(IN) ::  jfl !< Indicates start index of child cells belonging to certain parent cell - y direction
-!      INTEGER(iwp), DIMENSION(jcs:jcn), INTENT(IN) ::  jfu !< Indicates start index of child cells belonging to certain parent cell - y direction
-      INTEGER(iwp), DIMENSION(icla:icra), INTENT(IN) ::  ifl !< Indicates start index of child cells belonging to certain parent cell - x direction
-      INTEGER(iwp), DIMENSION(icla:icra), INTENT(IN) ::  ifu !< Indicates end index of child cells belonging to certain parent cell - x direction
-      INTEGER(iwp), DIMENSION(jcsa:jcna), INTENT(IN) ::  jfl !< Indicates start index of child cells belonging to certain parent cell - y direction
-      INTEGER(iwp), DIMENSION(jcsa:jcna), INTENT(IN) ::  jfu !< Indicates start index of child cells belonging to certain parent cell - y direction
-!AH
-
-!AH      INTEGER(iwp), DIMENSION(0:kct), INTENT(IN)   ::  kfl !< Indicates start index of child cells belonging to certain parent cell - z direction
-!AH      INTEGER(iwp), DIMENSION(0:kct), INTENT(IN)   ::  kfu !< Indicates start index of child cells belonging to certain parent cell - z direction
-      INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN)   ::  kfl !< Indicates start index of child cells belonging to certain parent cell - z direction
-      INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN)   ::  kfu !< Indicates start index of child cells belonging to certain parent cell - z direction
-!AH      INTEGER(iwp), DIMENSION(0:kct,jcs:jcn,icl:icr), INTENT(IN) :: ijkfc !< number of child grid points contributing to a parent grid box
-!AH
-!      INTEGER(iwp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr), INTENT(IN) :: ijkfc !< number of child grid points contributing to a parent grid box
-      INTEGER(iwp), DIMENSION(0:cg%nz+1,jcsa:jcna,icla:icra), INTENT(IN) :: ijkfc !< number of child grid points contributing to a parent grid box
-!AH
-
-      CHARACTER(LEN=1), INTENT(IN) ::  edge   !< Edge symbol: 'l', 'r', 's' or 'n' 
-      CHARACTER(LEN=1), INTENT(IN) ::  var    !< Variable symbol: 'u', 'v', 'w' or 's'
-      
-      INTEGER(iwp) ::  i        !< Running index in the x-direction
-      INTEGER(iwp) ::  iinc     !<
-      INTEGER(iwp) ::  icorr    !<
-      INTEGER(iwp) ::  ico      !<
-      INTEGER(iwp) ::  ierr     !< MPI error code
-      INTEGER(iwp) ::  ijk      !< Running index for all child-grid cells within the anterpolation cell
-      INTEGER(iwp) ::  iw       !< i-index for wall_flags_0
-      INTEGER(iwp) ::  i1       !<
-      INTEGER(iwp) ::  j        !< Lower bound of the running index ja
-      INTEGER(iwp) ::  ja       !< Index in y-direction running over the parent-grid cell on the boundary 
-      INTEGER(iwp) ::  jaw      !< Reduced ja-index for workarr_sn
-      INTEGER(iwp) ::  jawbc    !< jaw-index pointing to the boundary-value nodes (either 0 or jgsr-1)
-!AH      INTEGER(iwp) ::  jbeg     !< j-index pointing to the starting point of workarr_sn in the j-direction
-      INTEGER(iwp) ::  jbc      !< Fixed j-index pointing to the boundary-value nodes (either j or jend)
-      INTEGER(iwp) ::  jend     !< Upper bound of the running index ja
-      INTEGER(iwp) ::  jw       !< j-index for wall_flags_0
-      INTEGER(iwp) ::  k        !< Running index in the z-direction
-      INTEGER(iwp) ::  k_wall   !< Vertical index of topography top
-      INTEGER(iwp) ::  kcorr    !<
-      INTEGER(iwp) ::  kco      !<
-      INTEGER(iwp) ::  kw       !< k-index for wall_flags_0
-      INTEGER(iwp) ::  k1       !<
-      INTEGER(iwp) ::  l        !< Parent-grid running index in the x-direction
-      INTEGER(iwp) ::  lp1      !< l+1
-      INTEGER(iwp) ::  lrightu  !< Upshift by one for the upper bound of index l in case of var == 'u'
-      INTEGER(iwp) ::  m        !< Parent-grid running index in the y-direction
-      INTEGER(iwp) ::  mbeg     !< m-index pointing to the starting point of workarrc_sn in the m-direction 
-      INTEGER(iwp) ::  moff     !< m-offset needed on the north boundary to correctly refer to boundary ghost points
-      INTEGER(iwp) ::  mp1      !< m+1
-      INTEGER(iwp) ::  mw       !< Reduced m-index for workarrc_sn
-      INTEGER(iwp) ::  n        !< Parent-grid running index in the z-direction
-      INTEGER(iwp) ::  np1      !< n+1
-      INTEGER(iwp) ::  ntopw    !< Upshift by one for the upper bound of index n in case of var == 'w'
-      INTEGER(iwp) ::  var_flag !< Variable flag for BTEST( wall_flags_0 )
-
-      REAL(wp) ::  cellsum      !< Sum of child-grid node values over the anterpolation cell 
-      REAL(wp) ::  cellsumd     !< Sum of differences over the anterpolation cell 
-      REAL(wp) ::  fk           !< Intermediate result in trilinear interpolation
-      REAL(wp) ::  fkj          !< Intermediate result in trilinear interpolation
-      REAL(wp) ::  fkjp         !< Intermediate result in trilinear interpolation
-      REAL(wp) ::  fkpj         !< Intermediate result in trilinear interpolation
-      REAL(wp) ::  fkpjp        !< Intermediate result in trilinear interpolation
-      REAL(wp) ::  fkp          !< Intermediate result in trilinear interpolation
-      REAL(wp) ::  rcorr        !< Average reversibility correction for the whole anterpolation cell
-      REAL(wp) ::  rcorr_ijk    !< Reversibility correction distributed to the individual child-grid nodes
-
-!
-!--   Check which edge is to be handled: south or north
-      IF ( edge == 's' )  THEN
-!
-!--      For v, nys is a ghost node, but not for the other variables
-         IF ( var == 'v' )  THEN
-            j     = nys
-            jend  = nys 
-            jawbc = 0
-            jbc   = nys       
-            mbeg  = jcs
-            moff  = 0
-         ELSE
-            j     = nys - jgsr
-            jend  = nys - 1
-            jawbc = jgsr - 1
-            jbc   = nys - 1
-            mbeg  = jcs
-            moff  = 0
-         ENDIF
-      ELSEIF ( edge == 'n' )  THEN
-         IF ( var == 'v' )  THEN
-            j     = nyn + 1
-            jend  = nyn + 1
-            jawbc = 0
-            jbc   = nyn + 1
-            mbeg  = jcn - 2
-            moff  = 0
-         ELSE
-            j     = nyn + 1
-            jend  = nyn + jgsr
-            jawbc = 0
-            jbc   = nyn + 1
-            mbeg  = jcn - 2
-            moff  = 1
-         ENDIF
-      ENDIF
-
-      IF  ( var == 'w' )  THEN
-         ntopw = 1
-      ELSE
-         ntopw = 0
-      ENDIF
-
-      IF  ( var == 'u' )  THEN
-         lrightu = 0
-      ELSE
-         lrightu = 1
-      ENDIF
-
-      IF ( var == 'u' )  THEN 
-         var_flag = 1 
-      ELSEIF ( var == 'v' )  THEN
-         var_flag = 2 
-      ELSEIF ( var == 'w' )  THEN
-         var_flag = 3
-      ELSE
-         var_flag = 0
-      ENDIF
-!AH
-!
-!--   Substitute the necessary parent-grid data to the work array workarrc_sn. 
-      workarrc_sn = 0.0_wp     
-      IF  ( pdims(1) > 1 )  THEN
-#if defined( __parallel )
-         IF  ( nxl == 0 )  THEN   ! if ( bc_dirichlet_l )
-            workarrc_sn(0:cg%nz+1,0:2,iclw:icrw-1)                              &
-                 = fc(0:cg%nz+1,mbeg:mbeg+2,iclw:icrw-1)
-         ELSE IF  ( nxr == nx )  THEN    ! if ( bc_dirichlet_r )
-            workarrc_sn(0:cg%nz+1,0:2,iclw+1:icrw)                              &
-                 = fc(0:cg%nz+1,mbeg:mbeg+2,iclw+1:icrw)
-         ELSE
-            workarrc_sn(0:cg%nz+1,0:2,iclw+1:icrw-1)                            &
-                 = fc(0:cg%nz+1,mbeg:mbeg+2,iclw+1:icrw-1)
-         ENDIF
-!
-!--      Left-right exchange if more than one PE subdomain in the x-direction.
-!--      Note that in case of 3-D nesting the left (pleft == MPI_PROC_NULL) and 
-!--      right (pright == MPI_PROC_NULL) boundaries are not exchanged because 
-!--      the nest domain is not cyclic.
-!--      From left to right
-         CALL MPI_SENDRECV( workarrc_sn(0,0,iclw+1), 1,                         &
-              workarrc_sn_exchange_type, pleft,   0,                            &
-              workarrc_sn(0,0,icrw), 1,                                         &
-              workarrc_sn_exchange_type, pright,  0,                            &
-              comm2d, status, ierr ) 
-!
-!--      From right to left        
-         CALL MPI_SENDRECV( workarrc_sn(0,0,icrw-1), 1,                         &
-              workarrc_sn_exchange_type, pright,  1,                            &
-              workarrc_sn(0,0,iclw), 1,                                         &
-              workarrc_sn_exchange_type, pleft,   1,                            &
-              comm2d, status, ierr )
-#endif      
-      ELSE
-         workarrc_sn(0:cg%nz+1,0:2,iclw+1:icrw-1)                               &
-                 = fc(0:cg%nz+1,mbeg:mbeg+2,iclw+1:icrw-1)
-      ENDIF
-!
-!AH
-
-      workarr_sn = 0.0_wp
-      
-      DO  i = nxl-1, nxr+1
-!AH      DO  i = nxl, nxr
-         DO  ja = j, jend
-            jaw = ja - j
-            DO  k = nzb, nzt+1
-               l   = ic(i)
-               lp1 = MIN( l + 1, icrw )  ! If l+1 > icr (l=ic(nxr+1)), r1x = 1 and r2x = 0
-!AH               m   = jc(ja) - jc(j)
-               m   = jc(ja) - mbeg
-               mp1 = MIN( m + 1, 2 )  ! If m+1 > 2 (m=jc(nyn+1)-mbeg), r1y = 1 and r2y = 0
-               n   = kc(k)
-               np1 = n + 1
-!AH
-!               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)
-!AH
-               fkj      = r1x(i) * workarrc_sn(n,m,l)     + r2x(i) * workarrc_sn(n,m,lp1)
-               fkjp     = r1x(i) * workarrc_sn(n,mp1,l)   + r2x(i) * workarrc_sn(n,mp1,lp1)
-               fkpj     = r1x(i) * workarrc_sn(np1,m,l)   + r2x(i) * workarrc_sn(np1,m,lp1)
-               fkpjp    = r1x(i) * workarrc_sn(np1,mp1,l) + r2x(i) * workarrc_sn(np1,mp1,lp1)
-
-               fk       = r1y(ja) * fkj  + r2y(ja) * fkjp
-               fkp      = r1y(ja) * fkpj + r2y(ja) * fkpjp
-!AH
-!               f(k,j,i) = r1z(k) * fk   + r2z(k) * fkp
-               workarr_sn(k,jaw,i) = r1z(k) * fk   + r2z(k) * fkp
-
-!               if  ( ( edge == 's' ) .and. ( ja  == jbc ) ) then
-!                  write(9,"('pmci_interp_tril_sn: ',a2,2x,11(i4,2x),1(e12.5,2x))") var, k, ja, i, jbc, jaw, n, m, l, np1, mp1, lp1, &
-!                       workarr_sn(k,jaw,i)
-!                  flush(9)
-!               endif
-
-!AH               
-            ENDDO
-         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 ( constant_flux_layer .AND. ( var == 'u'  .OR.  var == 'v' ) )  THEN           
-         DO  i = nxl, nxr
-!
-!--         Determine vertical index of topography top at grid point (j,i)
-            k_wall = get_topography_top_index_ji( j, i, TRIM( var ) )
-
-            k = k_wall + 1
-            IF ( ( logc(1,k,i) /= 0 )  .AND.  ( logc(2,k,i) == 0 ) )  THEN
-               k1 = logc(1,k,i)
-               DO  kcorr = 0, ncorr-1
-                  kco = k + kcorr
-!AH                  f(kco,j,i) = logc_ratio(1,kcorr,k,i) * 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 ( constant_flux_layer .AND. ( var == 'v' .OR. var == 'w' ) )  THEN
-            DO  i = nxl, nxr
-               DO  k = logc_kbounds(1,i), logc_kbounds(2,i)
-!
-!--               Solid surface only on left/right side of the node           
-                  IF ( ( logc(2,k,i) /= 0 )  .AND.  ( logc(1,k,i) == 0 ) )  THEN
-!
-!--                  Direction of the wall-normal index is carried in as the
-!--                  sign of logc
-                     iinc = SIGN( 1, logc(2,k,i) )
-                     i1  = ABS( logc(2,k,i) )
-                     DO  icorr = 0, ncorr-1
-                        ico = i + iinc * icorr
-                        IF ( ico >= nxl .AND. ico <= nxr )  THEN
-!AH                           f(k,j,ico) = logc_ratio(2,icorr,k,i) * f(k,j,i1)
-                        ENDIF
-                     ENDDO
-                  ENDIF
-               ENDDO
-            ENDDO
-         ENDIF
-!
-!--      Solid surface on both below and on left/right side of the node           
-         IF ( constant_flux_layer .AND. var == 'v' )  THEN
-            DO  i = nxl, nxr
-               k = logc_kbounds(1,i)
-               IF ( ( logc(2,k,i) /= 0 )  .AND.  ( logc(1,k,i) /= 0 ) )  THEN
-                  k1   = logc(1,k,i)         
-                  iinc = SIGN( 1, logc(2,k,i) )
-                  i1   = ABS( logc(2,k,i) )
-                  DO  icorr = 0, ncorr-1
-                     ico = i + iinc * icorr
-                     IF ( ico >= nxl .AND. ico <= nxr )  THEN
-                        DO  kcorr = 0, ncorr-1
-                           kco = k + kcorr
-!AH                           f(kco,j,ico) = 0.5_wp * ( logc_ratio(1,kcorr,k,i) * &
-!AH                                                     f(k1,j,i)                 &
-!AH                                                   + logc_ratio(2,icorr,k,i) * &
-!AH                                                     f(k,j,i1) )
-                        ENDDO
-                     ENDIF
-                  ENDDO
-               ENDIF
-            ENDDO
-         ENDIF
-         
-      ENDIF  ! ( topography /= 'flat' )
-!
-!--   Apply the reversibility correction. 
-      
-!      if  ( var == 'u' )  then
-
-      m  = jc(jbc) + moff
-      mw = 1
-!      write(9,"('pmci_interp_tril_sn: edge, var, m, j, jend, jfl(m), jfu(m) = ',2(a2,2x),5(i4,2x))") &
-!           edge, var, m, j, jend, jfl(m), jfu(m)
-!      flush(9)
-!AH      DO  l = iclw+1, icrw-1
-      DO  l = iclw + 1, icrw - lrightu   ! lrightu = 0 for u and 1 for all others
-         DO  n = 0, kct + ntopw            ! ntopw = 1 for w and 0 for all others
-            ijk = 1
-            cellsum   = 0.0_wp 
-            cellsumd  = 0.0_wp
-            DO  i = ifl(l), ifu(l)
-               iw = MAX( MIN( i, nx+1 ), -1 )
-               DO  ja = jfl(m), jfu(m)
-                  jaw = ja - j
-                  jw  = MAX( MIN( ja, ny+1 ), -1 )
-                  DO  k = kfl(n), kfu(n)
-                     kw = MIN( k, nzt+1 )
-!AH                     cellsum = cellsum + MERGE( f(k,ja,i), 0.0_wp,              &
-!AH                          BTEST( wall_flags_0(kw,jw,iw), var_flag ) )
-                     cellsum = cellsum + MERGE( workarr_sn(k,jaw,i), 0.0_wp,       &
-                          BTEST( wall_flags_0(kw,jw,iw), var_flag ) )                    
-!AH                     celltmpd(ijk) = ABS( fc(n,m,l) - f(k,ja,i) )
-!AH                     celltmpd(ijk) = ABS( workarrc_sn(n,mw,l) - f(k,ja,i) )
-                     celltmpd(ijk) = ABS( workarrc_sn(n,mw,l) - workarr_sn(k,jaw,i) )
-                     cellsumd      = cellsumd  + MERGE( celltmpd(ijk),          &
-                          0.0_wp, BTEST( wall_flags_0(kw,jw,iw), var_flag ) )
-
-!                     write(9,"('sn1: ',a1,2x,8(i4,2x),5(e12.5,2x))") var, n, m, l, k, ja, i, jaw, ijk,  &
-!                          workarrc_sn(n,mw,l), workarr_sn(k,jaw,i), cellsum, celltmpd(ijk), cellsumd
-!                     flush(9)
-
-                     ijk = ijk + 1
-                  ENDDO
-               ENDDO
-            ENDDO
-
-            IF ( ijkfc(n,m,l) /= 0 )  THEN
-               cellsum   = cellsum / REAL( ijkfc(n,m,l), KIND=wp )
-!AH               rcorr     = fc(n,m,l) - cellsum
-               rcorr     = workarrc_sn(n,mw,l) - cellsum
-               cellsumd  = cellsumd / REAL( ijkfc(n,m,l), KIND=wp )
-            ELSE
-               cellsum   = 0.0_wp                  
-               rcorr     = 0.0_wp
-               cellsumd  = 1.0_wp
-               celltmpd  = 1.0_wp
-            ENDIF
-! 
-!--         Distribute the correction term to the child nodes according to 
-!--         their relative difference to the parent value such that the
-!--         node with the largest difference gets the largest share of the 
-!--         correction. The distribution is skipped if rcorr is negligibly 
-!--         small in order to avoid division by zero. 
-            IF ( ABS(rcorr) < 0.000001_wp )  THEN                  
-               cellsumd  = 1.0_wp
-               celltmpd  = 1.0_wp
-            ENDIF
-            
-            ijk = 1           
-            DO  i = ifl(l), ifu(l)
-               DO  ja = jfl(m), jfu(m)
-!AH                  jaw = ja - jfl(m)
-                  jaw = ja - j
-                  DO  k = kfl(n), kfu(n)
-                     rcorr_ijk = rcorr * celltmpd(ijk) / cellsumd 
-!AH                     f(k,ja,i) = f(k,ja,i) + rcorr_ijk
-                     workarr_sn(k,jaw,i) = workarr_sn(k,jaw,i) + rcorr_ijk
-
-!                     write(9,"('sn2: ',a1,2x,9(i4,2x),4(e12.5,2x))") var, n, m, l, k, ja, i, jaw, ijk, ijkfc(n,m,l), &
-!                          rcorr, rcorr_ijk, workarr_sn(k,jaw,i), workarrc_sn(n,mw,l)
-!                     flush(9)
-
-                     ijk = ijk + 1
-                  ENDDO
-               ENDDO
-            ENDDO
-!
-!--         Velocity components tangential to the boundary need special 
-!--         treatment because their anterpolation cells are flat in their 
-!--         direction and hence do not cover all the child-grid boundary nodes. 
-!--         These components are next linearly interpolated to those child-grid 
-!--         boundary nodes which are not covered by the anterpolation cells.     
-            IF  ( ( var == 'w' ) .AND. ( n > 0 ) )  THEN
-               DO  k = kfu(n-1)+1, kfl(n)-1
-                  IF  ( k <= nzt )  THEN
-                     DO  i = ifl(l), ifu(l)
-                        IF  ( ( i >= nxl ) .AND. ( i <= nxr+1 ) )  THEN
-!AH                         f(k,ja,i) = r1z(k) * f(kfu(n-1),ja,i)                & 
-!AH                               + r2z(k) * f(kfl(n),ja,i)
-                           workarr_sn(k,jawbc,i) =                              &
-                                r1z(k) * workarr_sn(kfu(n-1),jawbc,i) +         & 
-                                r2z(k) * workarr_sn(kfl(n),jawbc,i)
-   
-!                           write(9,"('sn3: ',a1,2x,7(i4,2x),3(e12.5,2x))") var, n, m, l, k, jawbc, i, jbc,  &
-!                                workarr_sn(k-1,jawbc,i), workarr_sn(k,jawbc,i), workarr_sn(k+1,jawbc,i)
-!                           flush(9)
-
-                        ENDIF
-                     ENDDO
-                  ENDIF
-               ENDDO
-            ENDIF
-               
-            IF  ( ( var == 'u' ) .AND. ( l > iclw ) )  THEN
-               DO  i = ifu(l-1)+1, ifl(l)-1
-                  IF  ( ( i >= nxl ) .AND. ( i <= nxr+1 ) )  THEN
-                     DO  k = kfl(n), kfu(n)
-                        IF  ( k <= nzt+1 )  THEN
-!AH                         f(k,ja,i) = r1x(i) * f(k,ja,ifu(l-1))                &
-!AH                               + r2x(i) * f(k,ja,ifl(l))
-                           workarr_sn(k,jawbc,i) =                              &
-                                r1x(i) * workarr_sn(k,jawbc,ifu(l-1)) +         &
-                                r2x(i) * workarr_sn(k,jawbc,ifl(l))
-                           
-!                           write(9,"('sn4: ',a1,2x,7(i4,2x),3(e12.5,2x))") var, n, m, l, k, jawbc, i, jbc, &
-!                                workarr_sn(k,jawbc,i-1), workarr_sn(k,jawbc,i), workarr_sn(k,jawbc,i+1)
-!                           flush(9)
-
-                        ENDIF
-                     ENDDO
-                  ENDIF
-               ENDDO
-            ENDIF
-               
-         ENDDO  ! n
-      ENDDO  ! l 
-
-!      endif  ! var
-
-!
-!--   Finally substitute the boundary values.
-      f(nzb:nzt+1,jbc,nxl:nxr) = workarr_sn(nzb:nzt+1,jawbc,nxl:nxr)
-
-!      do  k = 0, 2
-!         do  i = nxl, nxr 
-!            if  ( edge == 's' )  then
-!               write(9,"('sn5: ',2(a2,2x),4(i4,2x),4(e12.5,2x))") edge, var, k, i, jbc, jawbc,  &
-!                    workarr_sn(k,jawbc,i), f(k,jbc,i), f(k,jbc+1,i), f(k,jbc+2,i)
-!            else if  ( edge == 'n' )  then
-!               write(9,"('sn5: ',2(a2,2x),4(i4,2x),4(e12.5,2x))") edge, var, k, i, jbc, jawbc,  &
-!                    f(k,jbc-2,i), f(k,jbc-1,i), f(k,jbc,i), workarr_sn(k,jawbc,i)
-!            endif
-!         enddo
-!      enddo
-!      flush(9)
-
-   END SUBROUTINE pmci_interp_tril_sn
-
- 
-
-   SUBROUTINE pmci_interp_tril_t( f, fc, ic, jc, kc, r1x, r2x, r1y, r2y,       &
-                                  r1z, r2z, kct, ifl, ifu, jfl, jfu, kfl, kfu, &
-                                  ijkfc, var )
-
-!
-!--   Interpolation of ghost-node values used as the child-domain boundary
-!--   conditions. This subroutine handles the top boundary. 
-!--   This subroutine is based on trilinear interpolation.
-
-      IMPLICIT NONE
-
-      REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                      &
-                                      INTENT(INOUT) ::  f     !< Child-grid array
-      REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr),                          &
-                                      INTENT(IN)    ::  fc    !< Parent-grid array
-      REAL(wp), DIMENSION(nxlfc:nxrfc), INTENT(IN)  ::  r1x   !<
-      REAL(wp), DIMENSION(nxlfc:nxrfc), INTENT(IN)  ::  r2x   !<
-      REAL(wp), DIMENSION(nysfc:nynfc), INTENT(IN)  ::  r1y   !<
-      REAL(wp), DIMENSION(nysfc:nynfc), INTENT(IN)  ::  r2y   !<
-!AH      REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN)    ::  r1z   !<
-!AH      REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN)    ::  r2z   !<
-      REAL(wp), DIMENSION(nzb:nzt+kgsr), INTENT(IN) ::  r1z   !<
-      REAL(wp), DIMENSION(nzb:nzt+kgsr), INTENT(IN) ::  r2z   !<
-
-      
-      INTEGER(iwp), DIMENSION(nxlfc:nxrfc), INTENT(IN)  ::  ic    !<
-      INTEGER(iwp), DIMENSION(nysfc:nynfc), INTENT(IN)  ::  jc    !<
-!AH      INTEGER(iwp), DIMENSION(nzb:nzt+1), INTENT(IN)    ::  kc    !<
-      INTEGER(iwp), DIMENSION(nzb:nzt+kgsr), INTENT(IN) ::  kc    !<
-
-      INTEGER(iwp) :: kct
-!AH
-!      INTEGER(iwp), DIMENSION(icl:icr), INTENT(IN) ::  ifl !< Indicates start index of child cells belonging to certain parent cell - x direction
-!      INTEGER(iwp), DIMENSION(icl:icr), INTENT(IN) ::  ifu !< Indicates end index of child cells belonging to certain parent cell - x direction
-!      INTEGER(iwp), DIMENSION(jcs:jcn), INTENT(IN) ::  jfl !< Indicates start index of child cells belonging to certain parent cell - y direction
-!      INTEGER(iwp), DIMENSION(jcs:jcn), INTENT(IN) ::  jfu !< Indicates start index of child cells belonging to certain parent cell - y direction
-      INTEGER(iwp), DIMENSION(icla:icra), INTENT(IN) ::  ifl !< Indicates start index of child cells belonging to certain parent cell - x direction
-      INTEGER(iwp), DIMENSION(icla:icra), INTENT(IN) ::  ifu !< Indicates end index of child cells belonging to certain parent cell - x direction
-      INTEGER(iwp), DIMENSION(jcsa:jcna), INTENT(IN) ::  jfl !< Indicates start index of child cells belonging to certain parent cell - y direction
-      INTEGER(iwp), DIMENSION(jcsa:jcna), INTENT(IN) ::  jfu !< Indicates start index of child cells belonging to certain parent cell - y direction
-!AH      INTEGER(iwp), DIMENSION(0:kct), INTENT(IN)   ::  kfl !< Indicates start index of child cells belonging to certain parent cell - z direction
-!AH      INTEGER(iwp), DIMENSION(0:kct), INTENT(IN)   ::  kfu !< Indicates start index of child cells belonging to certain parent cell - z direction
-      INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN)   ::  kfl !< Indicates start index of child cells belonging to certain parent cell - z direction
-      INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN)   ::  kfu !< Indicates start index of child cells belonging to certain parent cell - z direction
-!AH      INTEGER(iwp), DIMENSION(0:kct,jcs:jcn,icl:icr), INTENT(IN) :: ijkfc !< number of child grid points contributing to a parent grid box
-!AH
-!      INTEGER(iwp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr), INTENT(IN) :: ijkfc !< number of child grid points contributing to a parent grid box
-      INTEGER(iwp), DIMENSION(0:cg%nz+1,jcsa:jcna,icla:icra), INTENT(IN) :: ijkfc !< number of child grid points contributing to a parent grid box
-!AH
-
-      CHARACTER(LEN=1), INTENT(IN) :: var   !<
-
-      INTEGER(iwp) ::  i    !<
-      INTEGER(iwp) ::  ib   !<
-      INTEGER(iwp) ::  iclc !< Lower i-index limit for copying fc-data to workarrc_t
-      INTEGER(iwp) ::  icrc !< Upper i-index limit for copying fc-data to workarrc_t
-      INTEGER(iwp) ::  ie   !<
-      INTEGER(iwp) ::  ierr !< MPI error code
-      INTEGER(iwp) ::  ijk  !<
-      INTEGER(iwp) ::  iw   !<
-      INTEGER(iwp) ::  j    !<
-      INTEGER(iwp) ::  jb   !<
-      INTEGER(iwp) ::  jcsc !< Lower j-index limit for copying fc-data to workarrc_t
-      INTEGER(iwp) ::  jcnc !< Upper j-index limit for copying fc-data to workarrc_t
-      INTEGER(iwp) ::  je   !< 
-      INTEGER(iwp) ::  jw   !<     
-      INTEGER(iwp) ::  k    !< Vertical child-grid index fixed to the boundary-value level 
-      INTEGER(iwp) ::  ka   !< Running vertical child-grid index
-      INTEGER(iwp) ::  kw   !< 
-      INTEGER(iwp) ::  l    !< Parent-grid index in x-direction
-      INTEGER(iwp) ::  lp1  !< l+1
-      INTEGER(iwp) ::  m    !< Parent-grid index in y-direction
-      INTEGER(iwp) ::  mp1  !< m+1
-      INTEGER(iwp) ::  n    !< Parent-grid work array index in z-direction
-      INTEGER(iwp) ::  np1  !< n+1
-      INTEGER(iwp) ::  noff !< n-offset needed on the top boundary to correctly refer to boundary ghost points  
-      INTEGER(iwp) ::  nw   !< n-index for workarrc_t
-      INTEGER(iwp) ::  var_flag  !<
-      
-      REAL(wp) ::  cellsum     !<
-      REAL(wp) ::  cellsumd    !<
-      REAL(wp) ::  fk          !<
-      REAL(wp) ::  fkj         !<
-      REAL(wp) ::  fkjp        !<
-      REAL(wp) ::  fkpj        !<
-      REAL(wp) ::  fkpjp       !<
-      REAL(wp) ::  fkp         !<
-      REAL(wp) ::  rcorr       !<
-      REAL(wp) ::  rcorr_ijk   !<
-
-      integer(iwp) :: kend
-
-
-      IF ( var == 'w' )  THEN
-         k    = nzt
-         noff = 0
-         kend = nzt
-      ELSE
-         k    = nzt + 1
-         noff = 1
-         kend = nzt+kgsr
-      ENDIF
-!
-!--   These exceedings by one are needed only to avoid stripes
-!--   and spots in visualization. They have no effect on the 
-!--   actual solution.     
-!
-!AH   These loop bounds lead to overflows with the current reduced icl, icr, jcs, jcn
-!AH      ib = nxl-1
-!AH      ie = nxr+1
-!AH      jb = nys-1
-!AH      je = nyn+1
-      ib = nxl
-      ie = nxr
-      jb = nys
-      je = nyn
-
-      IF ( var == 'u' )  THEN 
-         var_flag = 1 
-         ie       = nxr + 1 ! Needed for finishing interpolation for u 
-      ELSEIF ( var == 'v' )  THEN
-         var_flag = 2      
-         je       = nyn + 1 ! Needed for finishing interpolation for v 
-      ELSEIF ( var == 'w' )  THEN
-         var_flag = 3
-      ELSE
-         var_flag = 0
-      ENDIF
-         
-!AH      DO  i = ib, ie
-!AH         DO  j = jb, je
-!AH            l = ic(i)
-!AH            m = jc(j)
-!AH            n = kc(k)            
-!AH            fkj      = r1x(i) * fc(n,m,l)     + r2x(i) * fc(n,m,l+1)
-!AH            fkjp     = r1x(i) * fc(n,m+1,l)   + r2x(i) * fc(n,m+1,l+1)
-!AH            fkpj     = r1x(i) * fc(n+1,m,l)   + r2x(i) * fc(n+1,m,l+1)
-!AH            fkpjp    = r1x(i) * fc(n+1,m+1,l) + r2x(i) * fc(n+1,m+1,l+1)
-!AH            fk       = r1y(j) * fkj  + r2y(j) * fkjp
-!AH            fkp      = r1y(j) * fkpj + r2y(j) * fkpjp
-!AH            f(k,j,i) = r1z(k) * fk   + r2z(k) * fkp
-!AH         ENDDO
-!AH      ENDDO
-
-!      write(9,"('workarrc_t kbounds: ',a2,2x,5(i3,2x))") var, k, kend, kc(k), kc(kend), cg%nz+1
-!      flush(9)
-!AH
-!
-!--   Substitute the necessary parent-grid data to the work array. 
-!--   Note that the dimension of workarrc_t is (0:2,jcsw:jcnw,iclw:icrw),
-!--   And the jc?w and ic?w-index bounds depend on the location of the PE-
-!--   subdomain relative to the side boundaries. 
-      iclc = iclw + 1
-      icrc = icrw - 1      
-      jcsc = jcsw + 1
-      jcnc = jcnw - 1
-      IF  ( bc_dirichlet_l )  THEN
-         iclc = iclw
-      ENDIF
-      IF  ( bc_dirichlet_r )  THEN
-         icrc = icrw
-      ENDIF
-      IF  ( bc_dirichlet_s )  THEN
-         jcsc = jcsw
-      ENDIF
-      IF  ( bc_dirichlet_n )  THEN
-         jcnc = jcnw
-      ENDIF
-      workarrc_t = 0.0_wp
-      workarrc_t(0:2,jcsc:jcnc,iclc:icrc)                                       &
-           = fc(kc(k):kc(k)+2,jcsc:jcnc,iclc:icrc)
-!
-!--   Left-right exchange if more than one PE subdomain in the x-direction.
-!--   Note that in case of 3-D nesting the left and right boundaries are 
-!--   not exchanged because the nest domain is not cyclic.
-#if defined( __parallel )
-      IF  ( pdims(1) > 1 )  THEN
-!
-!--      From left to right
-         CALL MPI_SENDRECV( workarrc_t(0,jcsw,iclw+1), 1,                       &
-              workarrc_t_exchange_type_y, pleft,  0,                            &
-              workarrc_t(0,jcsw,icrw), 1,                                       &
-              workarrc_t_exchange_type_y, pright, 0,                            &
-              comm2d, status, ierr ) 
-!
-!--      From right to left        
-         CALL MPI_SENDRECV( workarrc_t(0,jcsw,icrw-1), 1,                       &
-              workarrc_t_exchange_type_y, pright, 1,                            &
-              workarrc_t(0,jcsw,iclw), 1,                                       &
-              workarrc_t_exchange_type_y, pleft,  1,                            &
-              comm2d, status, ierr )
-      ENDIF
-!
-!--   South-north exchange if more than one PE subdomain in the y-direction.
-!--   Note that in case of 3-D nesting the south and north boundaries are 
-!--   not exchanged because the nest domain is not cyclic.
-      IF  ( pdims(2) > 1 )  THEN
-!
-!--      From south to north         
-         CALL MPI_SENDRECV( workarrc_t(0,jcsw+1,iclw), 1,                       &
-              workarrc_t_exchange_type_x, psouth, 2,                            &
-              workarrc_t(0,jcnw,iclw), 1,                                       &
-              workarrc_t_exchange_type_x, pnorth, 2,                            &
-              comm2d, status, ierr ) 
-!
-!--      From north to south        
-         CALL MPI_SENDRECV( workarrc_t(0,jcnw-1,iclw), 1,                       &
-              workarrc_t_exchange_type_x, pnorth, 3,                            &
-              workarrc_t(0,jcsw,iclw), 1,                                       &
-              workarrc_t_exchange_type_x, psouth, 3,                            &
-              comm2d, status, ierr )
-      ENDIF
-#endif      
-!
-!AH
-
-      workarr_t = 0.0_wp
-
-      DO  i = ib, ie
-         DO  j = jb, je
-            DO ka = k, kend
-               l    = ic(i)
-               lp1  = MIN( l + 1, icrw ) ! If l+1 > icr (l=ic(nxr+1)), r1x = 1 and r2x = 0
-               m    = jc(j)
-               mp1  = MIN( m + 1, jcnw ) ! If m+1 > jcn (m=jc(nyn+1)), r1y = 1 and r2y = 0
-!AH
-!               n    = kc(ka)            
-               n   = kc(ka) - kc(k)
-               np1 = n + 1
-!AH
-!               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)
-!AH
-               fkj       = r1x(i)  * workarrc_t(n,m,l)     + r2x(i) * workarrc_t(n,m,lp1)
-               fkjp      = r1x(i)  * workarrc_t(n,mp1,l)   + r2x(i) * workarrc_t(n,mp1,lp1)
-               fkpj      = r1x(i)  * workarrc_t(np1,m,l)   + r2x(i) * workarrc_t(np1,m,lp1)
-               fkpjp     = r1x(i)  * workarrc_t(np1,mp1,l) + r2x(i) * workarrc_t(np1,mp1,lp1)
-!AH
-               fk        = r1y(j)  * fkj  + r2y(j) * fkjp
-               fkp       = r1y(j)  * fkpj + r2y(j) * fkpjp
-               workarr_t(ka,j,i) = r1z(ka) * fk + r2z(ka) * fkp
-          
-            ENDDO
-         ENDDO
-      ENDDO
-
-!AH!
-!AH!--   Just fill up the redundant second ghost-node layer for w.
-!AH      IF ( var == 'w' )  THEN
-!AH         f(nzt+1,:,:) = f(nzt,:,:)
-!AH      ENDIF
-!
-!--      Apply the reversibility correction. 
-         n  = kc(k) + noff  
-         nw = 0
-!AH         DO  l = icl-1, icr+1
-         DO  l = iclw, icrw
-!AH            DO  m = jcs-1, jcn+1
-            DO  m = jcsw, jcnw
-               ijk = 1
-               cellsum   = 0.0_wp
-               cellsumd  = 0.0_wp
-               DO  i = ifl(l), ifu(l)
-                  iw = MAX( MIN( i, nx+1 ), -1 )
-                  IF  ( ( i >= nxl ) .AND. ( i <= nxr+1 ) )  THEN
-                     DO  j = jfl(m), jfu(m)
-                        jw = MAX( MIN( j, ny+1 ), -1 ) 
-                        IF  ( ( j >= nys ) .AND. ( j <= nyn+1 ) )  THEN
-                           DO  ka = kfl(n), kfu(n)
-                              kw = MIN( ka, nzt+1 )
-!AH                            cellsum = cellsum + MERGE( f(ka,j,i), 0.0_wp,           &
-                              cellsum = cellsum + MERGE( workarr_t(ka,j,i), 0.0_wp,   &
-                                   BTEST( wall_flags_0(kw,jw,iw), var_flag ) )
-!                              cellsum = cellsum + workarr_t(ka,j,i)
-!AH                            celltmpd(ijk) = ABS( fc(n,m,l) - f(ka,j,i) )
-!AH
-!                              celltmpd(ijk) = ABS( fc(n,m,l) - workarr_t(ka,j,i) )
-                              celltmpd(ijk) = ABS( workarrc_t(nw,m,l) - workarr_t(ka,j,i) )
-!AH
-                              cellsumd      = cellsumd  + MERGE( celltmpd(ijk),       &
-                                   0.0_wp, BTEST( wall_flags_0(kw,jw,iw), var_flag ) ) 
-                              ijk = ijk + 1
-                           ENDDO
-                        ENDIF
-                     ENDDO
-                  ENDIF
-               ENDDO
-
-               IF ( ijkfc(n,m,l) /= 0 )  THEN
-                  cellsum   = cellsum / REAL( ijkfc(n,m,l), KIND=wp )
-!AH
-!                  rcorr     = fc(n,m,l) - cellsum
-                  rcorr     = workarrc_t(nw,m,l) - cellsum
-!AH                  
-                  cellsumd  = cellsumd / REAL( ijkfc(n,m,l), KIND=wp )
-               ELSE
-                  cellsum   = 0.0_wp
-                  rcorr     = 0.0_wp
-                  cellsumd  = 1.0_wp
-                  celltmpd  = 1.0_wp
-               ENDIF
-! 
-!--            Distribute the correction term to the child nodes according to 
-!--            their relative difference to the parent value such that the
-!--            node with the largest difference gets the largest share of the 
-!--            correction. The distribution is skipped if rcorr is negligibly 
-!--            small in order to avoid division by zero. 
-               IF ( ABS(rcorr) < 0.000001_wp )  THEN                  
-                  cellsumd  = 1.0_wp
-                  celltmpd  = 1.0_wp
-               ENDIF
-            
-               ijk = 1
-               DO  i = ifl(l), ifu(l)
-                  IF  ( ( i >= nxl ) .AND. ( i <= nxr+1 ) )  THEN
-                     DO  j = jfl(m), jfu(m)
-                        IF  ( ( j >= nys ) .AND. ( j <= nyn+1 ) )  THEN
-                           DO  ka = kfl(n), kfu(n)
-                              rcorr_ijk = rcorr * celltmpd(ijk) / cellsumd 
-!AH                            f(ka,j,i) = f(ka,j,i) + rcorr_ijk
-                              workarr_t(ka,j,i) = workarr_t(ka,j,i) + rcorr_ijk
-
-!                                 if  ( i == 128 .and. var == 'u' )  then
-!                                    write(9,"('t2: ', 8(i4,2x),3(e12.5,2x))") nw, m, l, ka, j, i, ifl(l), ifu(l), &
-!                                         rcorr, rcorr_ijk, workarr_t(ka,j,i)
-!                                    flush(9)
-!                                 endif
-
-                              ijk = ijk + 1
-                           ENDDO
-                        ENDIF
-                     ENDDO
-                  ENDIF
-               ENDDO
-!
-!--            Velocity components tangential to the boundary need special 
-!--            "finishing" because their anterpolation cells are flat in their 
-!--            direction and hence do not cover all the child-grid boundary nodes. 
-!--            These components are next linearly interpolated to those child-grid 
-!--            boundary nodes which are not covered by the anterpolation cells. 
-               IF  ( ( var == 'v' ) .AND. ( m > jcs ) )  THEN
-                  DO  j = jfu(m-1)+1, jfl(m)-1
-                     IF  ( ( j >= nys ) .AND. ( j <= nyn+1 ) )  THEN
-                        DO  i = ifl(l), ifu(l)
-                           IF  ( ( i >= nxl ) .AND. ( i <= nxr+1 ) )  THEN
-                              DO  ka = kfl(n), kfu(n)        ! This loop should be removed and fixed k-value be used instead
-!AH                              f(ka,j,i) = r1y(j) * f(ka,jfu(m-1),i)             &
-!AH                                   + r2y(j) * f(ka,jfl(m),i)
-                                 workarr_t(ka,j,i) = r1y(j) * workarr_t(ka,jfu(m-1),i) &
-                                      + r2y(j) * workarr_t(ka,jfl(m),i)
-                              ENDDO
-                           ENDIF
-                        ENDDO
-                     ENDIF
-                  ENDDO
-               ENDIF
-               
-               IF  ( ( var == 'u' ) .AND. ( l > icl ) )  THEN
-                  DO  i = ifu(l-1)+1, ifl(l)-1
-                     IF  ( ( i >= nxl ) .AND. ( i <= nxr+1 ) )  THEN
-                        DO  j = jfl(m), jfu(m)
-                           IF  ( ( j >= nys ) .AND. ( j <= nyn+1 ) )  THEN
-                              DO  ka = kfl(n), kfu(n)        ! This loop should be removed and fixed k-value be used instead
-!AH                              f(ka,j,i) = r1x(i) * f(ka,j,ifu(l-1)) +           &
-!AH                                   r2x(i) * f(ka,j,ifl(l))
-                                 workarr_t(ka,j,i) = r1x(i) * workarr_t(ka,j,ifu(l-1)) &
-                                      + r2x(i) * workarr_t(ka,j,ifl(l))
-
-!                                 if  ( i == 127 )  then
-!                                    write(9,"('t4: ', 8(i4,2x),3(e12.5,2x))") nw, m, l, ka, j, ifu(l-1), i, ifl(l), &
-!                                         workarr_t(ka,j,ifu(l-1)), workarr_t(ka,j,i), workarr_t(ka,j,ifl(l))
-!                                    flush(9)
-!                                 endif
-
-                              ENDDO
-                           ENDIF
-                        ENDDO
-                     ENDIF
-                  ENDDO
-               ENDIF
-               
-            ENDDO  ! m
-         ENDDO  ! l
-!
-!--   Finally substitute the boundary values.
-      f(k,nys:nyn,nxl:nxr) = workarr_t(k,nys:nyn,nxl:nxr)
-      IF  ( var == 'w' )  THEN
-         f(k+1,nys:nyn,nxl:nxr) = f(k,nys:nyn,nxl:nxr)
-      ENDIF
-
-    END SUBROUTINE pmci_interp_tril_t
-
-
-
-    SUBROUTINE pmci_anterp_tophat( f, fc, kct, ifl, ifu, jfl, jfu, kfl, kfu,   &
-                                   ijkfc, var )
-!
-!--    Anterpolation of internal-node values to be used as the parent-domain
-!--    values. This subroutine is based on the first-order numerical
-!--    integration of the fine-grid values contained within the coarse-grid
-!--    cell.
-
-       IMPLICIT NONE
-
-       CHARACTER(LEN=*), INTENT(IN) ::  var   !< identifyer for treated variable
-
-!AH       INTEGER(iwp), DIMENSION(0:kct,jcs:jcn,icl:icr), INTENT(IN) :: ijkfc !< number of child grid points contributing to a parent grid box
-!AH
-!       INTEGER(iwp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr), INTENT(IN) :: ijkfc !< number of child grid points contributing to a parent grid box
-       INTEGER(iwp), DIMENSION(0:cg%nz+1,jcsa:jcna,icla:icra), INTENT(IN) :: ijkfc !< number of child grid points contributing to a parent grid box
-!AH
-
-       INTEGER(iwp) ::  i         !< Running index x-direction - fine-grid
-       INTEGER(iwp) ::  iclant    !< Left boundary index for anterpolation along x
-       INTEGER(iwp) ::  icrant    !< Right boundary index for anterpolation along x
-       INTEGER(iwp) ::  ii        !< Running index x-direction - coarse grid
-       INTEGER(iwp) ::  j         !< Running index y-direction - fine-grid
-       INTEGER(iwp) ::  jcnant    !< North boundary index for anterpolation along y
-       INTEGER(iwp) ::  jcsant    !< South boundary index for anterpolation along y
-       INTEGER(iwp) ::  jj        !< Running index y-direction - coarse grid
-       INTEGER(iwp) ::  k         !< Running index z-direction - fine-grid     
-       INTEGER(iwp) ::  kcb = 0   !< Bottom boundary index for anterpolation along z
-       INTEGER(iwp) ::  kctant    !< Top boundary index for anterpolation along z
-       INTEGER(iwp) ::  kk        !< Running index z-direction - coarse grid
-       INTEGER(iwp) ::  var_flag  !< bit number used to flag topography on respective grid
-
-       INTEGER(iwp), INTENT(IN) ::  kct   !< Top boundary index for anterpolation along z
-
-!AH
-!       INTEGER(iwp), DIMENSION(icl:icr), INTENT(IN) ::  ifl !< Indicates start index of child cells belonging to certain parent cell - x direction
-!       INTEGER(iwp), DIMENSION(icl:icr), INTENT(IN) ::  ifu !< Indicates end index of child cells belonging to certain parent cell - x direction
-!       INTEGER(iwp), DIMENSION(jcs:jcn), INTENT(IN) ::  jfl !< Indicates start index of child cells belonging to certain parent cell - y direction
-!       INTEGER(iwp), DIMENSION(jcs:jcn), INTENT(IN) ::  jfu !< Indicates start index of child cells belonging to certain parent cell - y direction
-       INTEGER(iwp), DIMENSION(icla:icra), INTENT(IN) ::  ifl !< Indicates start index of child cells belonging to certain parent cell - x direction
-       INTEGER(iwp), DIMENSION(icla:icra), INTENT(IN) ::  ifu !< Indicates end index of child cells belonging to certain parent cell - x direction
-       INTEGER(iwp), DIMENSION(jcsa:jcna), INTENT(IN) ::  jfl !< Indicates start index of child cells belonging to certain parent cell - y direction
-       INTEGER(iwp), DIMENSION(jcsa:jcna), INTENT(IN) ::  jfu !< Indicates start index of child cells belonging to certain parent cell - y direction
-!AH
-
-!AH       INTEGER(iwp), DIMENSION(0:kct), INTENT(IN)   ::  kfl !< Indicates start index of child cells belonging to certain parent cell - z direction
-!AH       INTEGER(iwp), DIMENSION(0:kct), INTENT(IN)   ::  kfu !< Indicates start index of child cells belonging to certain parent cell - z direction
-       INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN)   ::  kfl !< Indicates start index of child cells belonging to certain parent cell - z direction
-       INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN)   ::  kfu !< Indicates start index of child cells belonging to certain parent cell - z direction
-
-       REAL(wp) ::  cellsum   !< sum of respective child cells belonging to parent cell 
-       REAL(wp) ::  fra       !< relaxation faction
-
-       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(IN) ::  f   !< Treated variable - child domain
-       REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr), INTENT(INOUT)  ::  fc  !< Treated variable - parent domain
-  
-!
-!--    Define the index bounds iclant, icrant, jcsant and jcnant.
-!--    Note that kcb is simply zero and kct enters here as a parameter and it is
-!--    determined in pmci_init_anterp_tophat.
-!--    Please note, grid points used also for interpolation (from parent to
-!--    child) are excluded in anterpolation, e.g. anterpolation is only from 
-!--    nzb:kct-1, as kct is used for interpolation.
-       iclant = icl
-       icrant = icr
-       jcsant = jcs
-       jcnant = jcn
-       kctant = kct - 1
-
-       kcb  = 0
-       IF ( nesting_mode /= 'vertical' )  THEN
-          IF ( bc_dirichlet_l )  THEN
-             iclant = icl + 3
-          ENDIF
-          IF ( bc_dirichlet_r )  THEN
-             icrant = icr - 3
-          ENDIF
-
-          IF ( bc_dirichlet_s )  THEN
-             jcsant = jcs + 3
-          ENDIF
-          IF ( bc_dirichlet_n )  THEN
-             jcnant = jcn - 3
-          ENDIF
-       ENDIF
-!
-!--    Set masking bit for topography flags 
-       IF ( var == 'u' )  THEN 
-          var_flag = 1 
-       ELSEIF ( var == 'v' )  THEN
-          var_flag = 2 
-       ELSEIF ( var == 'w' )  THEN
-          var_flag = 3
-       ELSE
-          var_flag = 0
-       ENDIF  
-!
-!--    Note that ii, jj, and kk are coarse-grid indices and i,j, and k 
-!--    are fine-grid indices.
-       DO  ii = iclant, icrant
-          DO  jj = jcsant, jcnant
-!
-!--          For simplicity anterpolate within buildings and under elevated
-!--          terrain too
-             DO  kk = kcb, kctant !kct - 1
-                cellsum = 0.0_wp
-                DO  i = ifl(ii), ifu(ii)
-                   DO  j = jfl(jj), jfu(jj)
-                      DO  k = kfl(kk), kfu(kk)
-                         cellsum = cellsum + MERGE( f(k,j,i), 0.0_wp,          &
-                                        BTEST( wall_flags_0(k,j,i), var_flag ) )
-                      ENDDO
-                   ENDDO
-                ENDDO
-!
-!--             Spatial under-relaxation.
-!--             The relaxation buffer zones are no longer needed with
-!--             the new reversible interpolation algorithm. 23.10.2018.
-!                fra  = frax(ii) * fray(jj) * fraz(kk)                
-!
-!--             In case all child grid points are inside topography, i.e. 
-!--             ijkfc and cellsum are zero, also parent solution would have 
-!--             zero values at that grid point, which may cause problems in 
-!--             particular for the temperature. Therefore, in case cellsum is 
-!--             zero, keep the parent solution at this point. 
-
-                IF ( ijkfc(kk,jj,ii) /= 0 )  THEN
-!AH                   fc(kk,jj,ii) = ( 1.0_wp - fra ) * fc(kk,jj,ii) +         &
-!AH                        fra * cellsum  /                                    &
-!AH                        REAL( ijkfc(kk,jj,ii), KIND=wp )
-                   fc(kk,jj,ii) = cellsum / REAL( ijkfc(kk,jj,ii), KIND=wp )
-                ENDIF
-
-             ENDDO
-          ENDDO
-       ENDDO
-
-    END SUBROUTINE pmci_anterp_tophat
+
+   END SUBROUTINE pmci_anterp_tophat
 
 #endif
