Home


About us
PALM
PALM-4U
Installation
Release notes
Documentation
Getting Help
Gallery
Developers area

Changeset 3792


Ignore:
Timestamp:
Mar 14, 2019 4:50:07 PM (6 years ago)
Author:
hellstea
Message:

Interpolations improved. Large number of obsolete subroutines removed. All unused variables removed.

Location:
palm/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • palm/trunk/SCRIPTS/inifor_script

    r3791 r3792  
    2222# Current revisions:
    2323# ------------------
    24 # initial revision
     24#
    2525#
    2626# Former revisions:
    2727# -----------------
    2828# $Id$
     29# initial revision
     30#
     31#
    2932#
    3033#--------------------------------------------------------------------------------#

  • palm/trunk/SOURCE/pmc_interface_mod.f90

    r3741 r3792  
    2525! -----------------
    2626! $Id$
     27! Interpolations improved. Large number of obsolete subroutines removed.
     28! All unused variables removed.
     29!
     30! 3741 2019-02-13 16:24:49Z hellstea
    2731! Interpolations and child initialization adjusted to handle set ups with child
    2832! pe-subdomain dimension not integer divisible by the grid-spacing ratio in the
    … …  
    448452    INTEGER(iwp), PARAMETER ::  child_to_parent = 2   !<
    449453    INTEGER(iwp), PARAMETER ::  parent_to_child = 1   !<
     454    INTEGER(iwp), PARAMETER ::  interpolation_scheme_lrsn = 2  !< Interpolation scheme to be used on lateral boundaries (to be made user parameter)
     455    INTEGER(iwp), PARAMETER ::  interpolation_scheme_t    = 3  !< Interpolation scheme to be used on top boundary (to be made user parameter)
    450456!
    451457!-- Coupler setup
    … …  
    457463!
    458464!-- Control parameters
    459     CHARACTER(LEN=7), SAVE ::  nesting_datatransfer_mode = 'mixed'  !< steering
    460                                                          !< parameter for data-
    461                                                          !< transfer mode
    462     CHARACTER(LEN=8), SAVE ::  nesting_mode = 'two-way'  !< steering parameter
    463                                                          !< for 1- or 2-way nesting
     465    CHARACTER(LEN=7), SAVE ::  nesting_datatransfer_mode = 'mixed'  !< steering parameter for data-transfer mode
     466    CHARACTER(LEN=8), SAVE ::  nesting_mode = 'two-way'             !< steering parameter for 1- or 2-way nesting
    464467
    465468    LOGICAL, SAVE ::  nested_run = .FALSE.  !< general switch
    466469    LOGICAL       ::  rans_mode_parent = .FALSE. !< mode of parent model (.F. - LES mode, .T. - RANS mode)
    467 
    468     REAL(wp), SAVE ::  anterp_relax_length_l = -1.0_wp   !<
    469     REAL(wp), SAVE ::  anterp_relax_length_r = -1.0_wp   !<
    470     REAL(wp), SAVE ::  anterp_relax_length_s = -1.0_wp   !<
    471     REAL(wp), SAVE ::  anterp_relax_length_n = -1.0_wp   !<
    472     REAL(wp), SAVE ::  anterp_relax_length_t = -1.0_wp   !<
    473470!
    474471!-- Geometry
    … …  
    477474    REAL(wp), SAVE, PUBLIC                            ::  lower_left_coord_x !<
    478475    REAL(wp), SAVE, PUBLIC                            ::  lower_left_coord_y !<
    479 
    480476!
    481477!-- Children's parent-grid arrays
    … …  
    484480    INTEGER(iwp), SAVE, DIMENSION(4), PUBLIC    ::  coarse_bound_w      !< subdomain index bounds for children's parent-grid work arrays
    485481
    486     REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  dissc !< coarse grid array on child domain - dissipation rate
    487     REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ec   !<
    488     REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ptc  !<
    489     REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  uc   !<
    490     REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  vc   !<
    491     REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  wc   !<
    492     REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  q_c  !<
    493     REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  qcc  !<
    494     REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  qrc  !<
    495     REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  nrc  !<
    496     REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ncc  !<
    497     REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  sc   !<
     482    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  dissc !< Parent-grid array on child domain - dissipation rate
     483    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ec    !< Parent-grid array on child domain - SGS TKE
     484    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ptc   !< Parent-grid array on child domain - potential temperature
     485    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  uc    !< Parent-grid array on child domain - velocity component u
     486    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  vc    !< Parent-grid array on child domain - velocity component v
     487    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  wc    !< Parent-grid array on child domain - velocity component w
     488    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  q_c   !< Parent-grid array on child domain -
     489    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  qcc   !< Parent-grid array on child domain -
     490    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  qrc   !< Parent-grid array on child domain -
     491    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  nrc   !< Parent-grid array on child domain -
     492    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ncc   !< Parent-grid array on child domain -
     493    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  sc    !< Parent-grid array on child domain -
    498494    INTEGER(idp), SAVE, DIMENSION(:,:), ALLOCATABLE, TARGET, PUBLIC ::  nr_partc    !<
    499495    INTEGER(idp), SAVE, DIMENSION(:,:), ALLOCATABLE, TARGET, PUBLIC ::  part_adrc   !<
    500496
    501     REAL(wp), SAVE, DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  chem_spec_c !< coarse grid array on child domain - chemical species
    502 
    503 !
    504 !-- Child interpolation coefficients and child-array indices to be
    505 !-- precomputed and stored.
    506     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  ico    !<
    507     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  icu    !<
    508     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  jco    !<
    509     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  jcv    !<
    510     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  kco    !<
    511     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  kcw    !<
    512     REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  celltmpd !<
    513     REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r1xo   !<
    514     REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r2xo   !<
    515     REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r1xu   !<
    516     REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r2xu   !<
    517     REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r1yo   !<
    518     REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r2yo   !<
    519     REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r1yv   !<
    520     REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r2yv   !<
    521     REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r1zo   !<
    522     REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r2zo   !<
    523     REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r1zw   !<
    524     REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r2zw   !<
    525 
    526 !
    527 !-- Child index arrays and log-ratio arrays for the log-law near-wall
    528 !-- corrections. These are not truly 3-D arrays but multiple 2-D arrays.
    529     INTEGER(iwp), SAVE :: ncorr  !< 4th dimension of the log_ratio-arrays
    530     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_u_l   !<
    531     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_u_n   !<
    532     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_u_r   !<
    533     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_u_s   !<
    534     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_v_l   !<
    535     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_v_n   !<
    536     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_v_r   !<
    537     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_v_s   !<
    538     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_w_l   !<
    539     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_w_n   !<
    540     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_w_r   !<
    541     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_w_s   !<
    542     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:)   ::  logc_kbounds_u_l !<
    543     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:)   ::  logc_kbounds_u_n !<
    544     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:)   ::  logc_kbounds_u_r !<
    545     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:)   ::  logc_kbounds_u_s !<
    546     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:)   ::  logc_kbounds_v_l !<   
    547     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:)   ::  logc_kbounds_v_n !<
    548     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:)   ::  logc_kbounds_v_r !<   
    549     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:)   ::  logc_kbounds_v_s !<
    550     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:)   ::  logc_kbounds_w_l !<   
    551     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:)   ::  logc_kbounds_w_n !<
    552     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:)   ::  logc_kbounds_w_r !<   
    553     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:)   ::  logc_kbounds_w_s !<       
    554     REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_u_l   !<
    555     REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_u_n   !<
    556     REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_u_r   !<
    557     REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_u_s   !<
    558     REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_v_l   !<
    559     REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_v_n   !<
    560     REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_v_r   !<
    561     REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_v_s   !<
    562     REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_w_l   !<
    563     REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_w_n   !<
    564     REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_w_r   !<
    565     REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_w_s   !<
    566 !
     497    REAL(wp), SAVE, DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  chem_spec_c !< Parent-grid array on child domain - chemical species
     498!
     499!-- Grid-spacing ratios.
    567500    INTEGER(iwp), SAVE ::  igsr     !< Integer grid-spacing ratio in i-direction
    568501    INTEGER(iwp), SAVE ::  jgsr     !< Integer grid-spacing ratio in j-direction
    569502    INTEGER(iwp), SAVE ::  kgsr     !< Integer grid-spacing ratio in k-direction
     503!
     504!-- Highest prognostic parent-grid k-indices.
    570505    INTEGER(iwp), SAVE ::  kcto     !< Upper bound for k in anterpolation of variables other than w.
    571506    INTEGER(iwp), SAVE ::  kctw     !< Upper bound for k in anterpolation of w.
    572     INTEGER(iwp), SAVE ::  nxlfc    !< Lower index limit in x-direction for fine-to-coarse index mapping and interpolaton coefficient arrays
    573     INTEGER(iwp), SAVE ::  nxrfc    !< Upper index limit in x-direction for fine-to-coarse index mapping and interpolaton coefficient arrays
    574     INTEGER(iwp), SAVE ::  nynfc    !< Upper index limit in y-direction for fine-to-coarse index mapping and interpolaton coefficient arrays
    575     INTEGER(iwp), SAVE ::  nysfc    !< Lower index limit in y-direction for fine-to-coarse index mapping and interpolaton coefficient arrays
    576 !
    577 !-- Upper bound for k in log-law correction in interpolation.
    578     INTEGER(iwp), SAVE ::  nzt_topo_nestbc_l   !<
    579     INTEGER(iwp), SAVE ::  nzt_topo_nestbc_n   !<
    580     INTEGER(iwp), SAVE ::  nzt_topo_nestbc_r   !<
    581     INTEGER(iwp), SAVE ::  nzt_topo_nestbc_s   !<
    582 !
    583 !-- Spatial under-relaxation coefficients for anterpolation.
    584     REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) ::  frax   !<
    585     REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) ::  fray   !<
    586     REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) ::  fraz   !<
    587507!
    588508!-- Child-array indices to be precomputed and stored for anterpolation.
    … …  
    606526    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  ijkfc_w  !< number of child grid boxes contribution to a parent grid box, w-grid
    607527    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  ijkfc_s  !< number of child grid boxes contribution to a parent grid box, scalar-grid
    608    
     528!   
     529!-- Work arrays for interpolation and user-defined type definitions for horizontal work-array exchange   
     530    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: workarrc_lr
     531    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: workarrc_sn
     532    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: workarrc_t
     533    INTEGER(iwp) :: workarrc_lr_exchange_type
     534    INTEGER(iwp) :: workarrc_sn_exchange_type
     535    INTEGER(iwp) :: workarrc_t_exchange_type_x
     536    INTEGER(iwp) :: workarrc_t_exchange_type_y
     537 
    609538    INTEGER(iwp), DIMENSION(3)          ::  parent_grid_info_int    !<
    610539    REAL(wp), DIMENSION(7)              ::  parent_grid_info_real   !<
    … …  
    652581    INTEGER(idp),ALLOCATABLE,DIMENSION(:,:),PUBLIC,TARGET    :: part_adr !<
    653582
    654 !AH
    655     REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: workarr_lr
    656     REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: workarr_sn
    657     REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: workarr_t
    658     REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: workarrc_lr
    659     REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: workarrc_sn
    660     REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: workarrc_t
    661     INTEGER(iwp) :: workarrc_lr_exchange_type
    662     INTEGER(iwp) :: workarrc_sn_exchange_type
    663     INTEGER(iwp) :: workarrc_t_exchange_type_x
    664     INTEGER(iwp) :: workarrc_t_exchange_type_y
    665 !AH
    666    
     583   
    667584    INTERFACE pmci_boundary_conds
    668585       MODULE PROCEDURE pmci_boundary_conds
    … …  
    713630    END  INTERFACE get_child_gridspacing
    714631
    715 
    716632    INTERFACE pmci_set_swaplevel
    717633       MODULE PROCEDURE pmci_set_swaplevel
    718634    END INTERFACE pmci_set_swaplevel
    719635
    720     PUBLIC anterp_relax_length_l, anterp_relax_length_r,                       &
    721            anterp_relax_length_s, anterp_relax_length_n,                       &
    722            anterp_relax_length_t, child_to_parent, comm_world_nesting,         &
    723            cpl_id, nested_run, nesting_datatransfer_mode, nesting_mode,        &
    724            parent_to_child, rans_mode_parent
     636    PUBLIC child_to_parent, comm_world_nesting, cpl_id, nested_run,                                 &
     637           nesting_datatransfer_mode, nesting_mode, parent_to_child, rans_mode_parent
    725638
    726639    PUBLIC pmci_boundary_conds
    … …  
    733646    PUBLIC pmci_set_swaplevel
    734647    PUBLIC get_number_of_childs, get_childid, get_child_edges, get_child_gridspacing
    735 
    736648
    737649
    … …  
    903815    REAL(wp) ::  xez              !<
    904816    REAL(wp) ::  yez              !<
    905 
    906     REAL(wp), DIMENSION(5) ::  fval             !<
    907 
     817    REAL(wp), DIMENSION(5) ::  fval                      !<
    908818    REAL(wp), DIMENSION(:), ALLOCATABLE ::  cl_coord_x   !<
    909819    REAL(wp), DIMENSION(:), ALLOCATABLE ::  cl_coord_y   !<
    … …  
    912822!   Initialize the pmc parent
    913823    CALL pmc_parentinit
    914 
    915824!
    916825!-- Corners of all children of the present parent
    … …  
    924833       ALLOCATE( childgrid(1:SIZE( pmc_parent_for_child ) - 1) )
    925834    ENDIF
    926 
    927835!
    928836!-- Get coordinates from all children
    … …  
    948856!--       transfer
    949857          DO  k = 1, nz                 
    950              IF ( zw(k) > fval(1) )  THEN
     858!AH  Let's try to make the parent-grid arrays higher by one parent dz
     859!AH             IF ( zw(k) > fval(1) )  THEN
     860             IF ( zw(k) > fval(1)+dz(1) )  THEN
    951861                nz_cl = k
    952862                EXIT
    … …  
    954864          ENDDO
    955865
    956           zmax_coarse = fval(1:2)
    957           cl_height   = fval(1)
     866!AH  Let's make the parent-grid arrays higher by one parent dz
     867!AH          zmax_coarse = fval(1:2)
     868!AH          cl_height   = fval(1)
     869          zmax_coarse(1) = fval(1) + dz(1)
     870          zmax_coarse(2) = fval(2) + dz(1)
     871          cl_height   = fval(1) + dz(1)
     872!AH
    958873
    959874!   
    … …  
    1008923!--       that the top ghost layer of the child grid does not exceed
    1009924!--       the parent domain top boundary.
    1010 
    1011925          IF ( cl_height > zw(nz) ) THEN
    1012926             nomatch = 1
    … …  
    10921006!--    for coupling are stored once into the pmc context. While data transfer, the array do not
    10931007!--    have to be specified again
    1094 
    10951008       CALL pmc_s_clear_next_array_list
    10961009       DO  WHILE ( pmc_s_getnextarray( child_id, myname ) )
    … …  
    11181031
    11191032
    1120    SUBROUTINE pmci_create_index_list
     1033    SUBROUTINE pmci_create_index_list
    11211034
    11221035       IMPLICIT NONE
    … …  
    12201133     END SUBROUTINE pmci_create_index_list
    12211134
     1135
     1136
    12221137     SUBROUTINE set_child_edge_coords
    12231138        IMPLICIT  NONE
    … …  
    12541169 SUBROUTINE pmci_setup_child
    12551170
    1256 
    12571171#if defined( __parallel )
    12581172    IMPLICIT NONE
    12591173
    1260     CHARACTER(LEN=da_namelen) ::  myname     !<
    1261 
    1262     INTEGER(iwp) ::  i          !<
    1263     INTEGER(iwp) ::  ierr       !<
     1174    CHARACTER(LEN=da_namelen) ::  myname     !<
     1175    INTEGER(iwp) ::  ierr       !< MPI error code
    12641176    INTEGER(iwp) ::  icl        !< Left index limit for children's parent-grid arrays
    12651177    INTEGER(iwp) ::  icla       !< Left index limit for allocation of index-mapping and other auxiliary arrays
    … …  
    12681180    INTEGER(iwp) ::  icra       !< Right index limit for allocation of index-mapping and other auxiliary arrays
    12691181    INTEGER(iwp) ::  icrw       !< Right index limit for children's parent-grid work arrays
    1270     INTEGER(iwp) ::  j          !<
    12711182    INTEGER(iwp) ::  jcn        !< North index limit for children's parent-grid arrays
    12721183    INTEGER(iwp) ::  jcna       !< North index limit for allocation of index-mapping and other auxiliary arrays
    … …  
    12761187    INTEGER(iwp) ::  jcsw       !< South index limit for children's parent-grid work arrays
    12771188    INTEGER(iwp) ::  n          !< Running index for number of chemical species
    1278 
    12791189    INTEGER(iwp), DIMENSION(5) ::  val        !<
    1280    
    12811190    REAL(wp) ::  xcs        !<
    12821191    REAL(wp) ::  xce        !<
    … …  
    12891198!-- Child setup
    12901199!-- Root model does not have a parent and is not a child, therefore no child setup on root model
    1291 
    12921200    IF ( .NOT. pmc_is_rootmodel() )  THEN
    12931201
    12941202       CALL pmc_childinit
    12951203!
    1296 !--    Here AND ONLY HERE the arrays are defined, which actualy will be
    1297 !--    exchanged between child and parent.
     1204!--    The arrays, which actually will be exchanged between child and parent
     1205!--    are defined Here AND ONLY HERE.
    12981206!--    If a variable is removed, it only has to be removed from here.
    12991207!--    Please check, if the arrays are in the list of POSSIBLE exchange arrays
    … …  
    13821290          CALL pmc_recv_from_parent( rans_mode_parent, 1, 0, 19, ierr )
    13831291!
    1384 !
    13851292!--       Receive Coarse grid information.
    13861293          CALL pmc_recv_from_parent( parent_grid_info_real,                    &
    13871294                                     SIZE(parent_grid_info_real), 0, 21, ierr )
    13881295          CALL pmc_recv_from_parent( parent_grid_info_int,  3, 0, 22, ierr )
    1389 !
    1390 !--        Debug-printouts - keep them
    1391 !           WRITE(0,*) 'Coarse grid from parent '
    1392 !           WRITE(0,*) 'startx_tot    = ',parent_grid_info_real(1)
    1393 !           WRITE(0,*) 'starty_tot    = ',parent_grid_info_real(2)
    1394 !           WRITE(0,*) 'endx_tot      = ',parent_grid_info_real(5)
    1395 !           WRITE(0,*) 'endy_tot      = ',parent_grid_info_real(6)
    1396 !           WRITE(0,*) 'dx            = ',parent_grid_info_real(3)
    1397 !           WRITE(0,*) 'dy            = ',parent_grid_info_real(4)
    1398 !           WRITE(0,*) 'dz            = ',parent_grid_info_real(7)
    1399 !           WRITE(0,*) 'nx_coarse     = ',parent_grid_info_int(1)
    1400 !           WRITE(0,*) 'ny_coarse     = ',parent_grid_info_int(2)
    1401 !           WRITE(0,*) 'nz_coarse     = ',parent_grid_info_int(3)
     1296
    14021297       ENDIF
    14031298
    … …  
    14161311       ALLOCATE( cg%coord_x(-nbgp:cg%nx+nbgp) )
    14171312       ALLOCATE( cg%coord_y(-nbgp:cg%ny+nbgp) )
    1418      
    14191313       ALLOCATE( cg%dzu(1:cg%nz+1) )
    14201314       ALLOCATE( cg%dzw(1:cg%nz+1) )
    … …  
    14691363       CALL pmc_c_setind_and_allocmem
    14701364!
    1471 !--    Precompute interpolation coefficients and child-array indices
    1472        CALL pmci_init_interp_tril
    1473 !
    1474 !--    Precompute the log-law correction index- and ratio-arrays
    1475        IF ( constant_flux_layer )  THEN
    1476           CALL pmci_init_loglaw_correction
    1477        ENDIF
    1478 !
    1479 !--    Two-way coupling for general and vertical nesting.
    1480 !--    Precompute the index arrays and relaxation functions for the
    1481 !--    anterpolation
    1482 !
    1483 !--    Note that the anterpolation index bounds are needed also in case
    1484 !--    of one-way coupling because of the reversibility correction
    1485 !--    included in the interpolation algorithms.
    1486        CALL pmci_init_anterp_tophat
    1487 !
    1488 !--    Check that the child and parent grid lines match
     1365!--    Precompute the index-mapping arrays
     1366       CALL pmci_define_index_mapping
     1367!
     1368!--    Check that the child and parent grid lines do match
    14891369       CALL pmci_check_grid_matching
    14901370
    … …  
    15021382       INTEGER(iwp), DIMENSION(5,numprocs) ::  coarse_bound_all   !<
    15031383       INTEGER(iwp), DIMENSION(2)          ::  size_of_array      !<
    1504                                    
    15051384       INTEGER(iwp) :: i        !<
    15061385       INTEGER(iwp) :: iauxl    !<
    … …  
    15151394       REAL(wp) ::  yexn        !< Parent-grid array exceedance behind the north edge of the child PE subdomain
    15161395
    1517 !AH!
    1518 !AH!--    If the fine- and coarse grid nodes do not match:
    1519 !AH       loffset = MOD( coord_x(nxl), cg%dx )
    1520 !AH       xexl    = cg%dx + loffset
    1521 !AH       xcs  = coord_x(nxl) - xexl
    1522 !AH       DO  i = 0, cg%nx
    1523 !AH          IF ( cg%coord_x(i) > xcs )  THEN
    1524 !AH             icl = MAX( -1, i-1 )
    1525 !AH             EXIT
    1526 !AH          ENDIF
    1527 !AH       ENDDO
    1528 !AH!
    1529 !AH!--    If the fine- and coarse grid nodes do not match
    1530 !AH       roffset = MOD( coord_x(nxr+1), cg%dx )
    1531 !AH       xexr    = cg%dx + roffset
    1532 !AH       xce  = coord_x(nxr+1)
    1533 !AH       IF ( nxr == nx )  THEN
    1534 !AH          xce = xce + xexr
    1535 !AH       ENDIF
    1536 !AH       DO  i = cg%nx, 0 , -1
    1537 !AH          IF ( cg%coord_x(i) < xce )  THEN
    1538 !AH             icr = MIN( cg%nx+1, i+1 )
    1539 !AH             EXIT
    1540 !AH          ENDIF
    1541 !AH       ENDDO
    1542 !AH!
    1543 !AH!--    If the fine- and coarse grid nodes do not match
    1544 !AH       soffset = MOD( coord_y(nys), cg%dy )
    1545 !AH       yexs    = cg%dy + soffset
    1546 !AH       ycs  = coord_y(nys) - yexs
    1547 !AH       DO  j = 0, cg%ny
    1548 !AH          IF ( cg%coord_y(j) > ycs )  THEN
    1549 !AH             jcs = MAX( -nbgp, j-1 )
    1550 !AH             EXIT
    1551 !AH          ENDIF
    1552 !AH       ENDDO
    1553 !AH!
    1554 !AH!--    If the fine- and coarse grid nodes do not match
    1555 !AH       noffset = MOD( coord_y(nyn+1), cg%dy )
    1556 !AH       yexn    = cg%dy + noffset
    1557 !AH       yce  = coord_y(nyn+1)
    1558 !AH       IF ( nyn == ny )  THEN
    1559 !AH          yce = yce + yexn
    1560 !AH       ENDIF
    1561 !AH       DO  j = cg%ny, 0, -1
    1562 !AH          IF ( cg%coord_y(j) < yce )  THEN
    1563 !AH             jcn = MIN( cg%ny + nbgp, j+1 )
    1564 !AH             EXIT
    1565 !AH          ENDIF
    1566 !AH       ENDDO
    1567 !AH
    1568 !AH       coarse_bound(1) = icl
    1569 !AH       coarse_bound(2) = icr
    1570 !AH       coarse_bound(3) = jcs
    1571 !AH       coarse_bound(4) = jcn
    1572 !AH       coarse_bound(5) = myid
    15731396!
    15741397!--    Determine the anterpolation index limits. If at least half of the
    … …  
    15781401!--    anterpolation domain, or not included at all if we are at the outer
    15791402!--    edge of the child domain.
    1580 
    15811403!
    15821404!--    Left
    … …  
    16981520    END SUBROUTINE pmci_map_fine_to_coarse_grid
    16991521
    1700 
    1701 
    1702     SUBROUTINE pmci_init_interp_tril
    1703 !
    1704 !--    Precomputation of the interpolation coefficients and child-array indices
    1705 !--    to be used by the interpolation routines interp_tril_lr, interp_tril_ns
    1706 !--    and interp_tril_t.
     1522     
     1523     
     1524    SUBROUTINE pmci_define_index_mapping
     1525!
     1526!--    Precomputation of the mapping of the child- and parent-grid indices.
    17071527
    17081528       IMPLICIT NONE
    17091529
    1710        INTEGER(iwp) ::  acsize   !< Maximum dimension of anterpolation cell.
    1711        INTEGER(iwp) ::  i        !< Child-grid i-index
    1712        INTEGER(iwp) ::  ierr     !< MPI error code
    1713        INTEGER(iwp) ::  j        !< Child-grid j-index
    1714        INTEGER(iwp) ::  k        !< Child-grid k-index
    1715        INTEGER(iwp) ::  kc       !<
    1716        INTEGER(iwp) ::  kdzo     !<
    1717        INTEGER(iwp) ::  kdzw     !<
    1718        INTEGER(iwp) ::  moff     !< Parent-grid bound offset in j-direction
    1719        INTEGER(iwp) ::  loff     !< Parent-grid bound offset in i-direction
    1720 
    1721        REAL(wp) ::  dzmin        !<
    1722        REAL(wp) ::  parentdzmax  !<
    1723        REAL(wp) ::  xb           !<
    1724        REAL(wp) ::  xcsu         !<
    1725        REAL(wp) ::  xfso         !<
    1726        REAL(wp) ::  xcso         !<
    1727        REAL(wp) ::  xfsu         !<
    1728        REAL(wp) ::  yb           !<
    1729        REAL(wp) ::  ycso         !<
    1730        REAL(wp) ::  ycsv         !<
    1731        REAL(wp) ::  yfso         !<
    1732        REAL(wp) ::  yfsv         !<
    1733        REAL(wp) ::  zcso         !<
    1734        REAL(wp) ::  zcsw         !<
    1735        REAL(wp) ::  zfso         !<
    1736        REAL(wp) ::  zfsw         !<
    1737      
    1738        
    1739 !AH
     1530       INTEGER(iwp) ::  i         !< Child-grid index
     1531       INTEGER(iwp) ::  ii        !< Parent-grid index
     1532       INTEGER(iwp) ::  istart    !<
     1533       INTEGER(iwp) ::  ir        !<
     1534       INTEGER(iwp) ::  iw        !< Child-grid index limited to -1 <= iw <= nx+1
     1535       INTEGER(iwp) ::  j         !< Child-grid index
     1536       INTEGER(iwp) ::  jj        !< Parent-grid index
     1537       INTEGER(iwp) ::  jstart    !<
     1538       INTEGER(iwp) ::  jr        !<
     1539       INTEGER(iwp) ::  jw        !< Child-grid index limited to -1 <= jw <= ny+1
     1540       INTEGER(iwp) ::  k         !< Child-grid index
     1541       INTEGER(iwp) ::  kk        !< Parent-grid index
     1542       INTEGER(iwp) ::  kstart    !<
     1543       INTEGER(iwp) ::  kw        !< Child-grid index limited to kw <= nzt+1
     1544       REAL(wp)     ::  tolerance !<
     1545     
    17401546!
    17411547!--    Allocate child-grid work arrays for interpolation.
    1742        CALL pmci_allocate_finegrid_workarrays
     1548       igsr = NINT( cg%dx / dx, iwp )
     1549       jgsr = NINT( cg%dy / dy, iwp )
     1550       kgsr = NINT( cg%dzw(1) / dzw(1), iwp )
     1551       WRITE(9,"('igsr, jgsr, kgsr: ',3(i3,2x))") igsr, jgsr, kgsr
     1552       FLUSH(9)
    17431553!       
    17441554!--    Determine index bounds for the parent-grid work arrays for
    17451555!--    interpolation and allocate them.
    1746        CALL pmci_allocate_coarsegrid_workarrays
     1556       CALL pmci_allocate_workarrays
    17471557!       
    17481558!--    Define the MPI-datatypes for parent-grid work array
    17491559!--    exchange between the PE-subdomains.
    1750        CALL pmci_create_coarsegrid_workarray_exchange_datatypes
    1751 !
    1752 !--    Determine index bounds for the fine-to-coarse grid index mapping arrays
    1753 !--    and interpolation-coefficient arrays and allocate them.       
    1754        CALL pmci_allocate_fine_to_coarse_mapping_arrays
    1755 !AH       
    1756 !
    1757        xb   = nxl * dx
    1758        IF  ( bc_dirichlet_l )  THEN
    1759           loff = 2
    1760        ELSE
    1761           loff = 0
    1762        ENDIF
    1763 !AH       DO  i = nxlg, nxrg
    1764        DO  i = nxl-1, nxr+1
    1765           xfsu    = coord_x(i) - ( lower_left_coord_x + xb )
    1766           xfso    = coord_x(i) + 0.5_wp * dx - ( lower_left_coord_x + xb )
    1767 !
    1768 !--       icl points to 2 parent-grid cells left form the left nest boundary,
    1769 !--       thence icl + loff points to the left nest boundary.
    1770           icu(i)  = icl + loff + FLOOR( xfsu / cg%dx )
    1771           ico(i)  = icl + loff + FLOOR( ( xfso - 0.5_wp * cg%dx ) / cg%dx )
    1772           xcsu    = ( icu(i) - ( icl + loff ) ) * cg%dx
    1773           xcso    = ( ico(i) - ( icl + loff ) + 0.5_wp ) * cg%dx
    1774           r2xu(i) = ( xfsu - xcsu ) / cg%dx
    1775           r2xo(i) = ( xfso - xcso ) / cg%dx
    1776           r1xu(i) = 1.0_wp - r2xu(i)
    1777           r1xo(i) = 1.0_wp - r2xo(i)
    1778        ENDDO
    1779 !       
    1780 !--    Fill up the values behind nest boundaries by copying from inside
    1781 !--    the domain.
    1782        IF  ( bc_dirichlet_l )  THEN
    1783           icu(nxlfc:nxl-1)  = icu(nxlfc+igsr:nxl-1+igsr) - 1
    1784           r1xu(nxlfc:nxl-1) = r1xu(nxlfc+igsr:nxl-1+igsr)
    1785           r2xu(nxlfc:nxl-1) = r2xu(nxlfc+igsr:nxl-1+igsr)
    1786           ico(nxlfc:nxl-1)  = ico(nxlfc+igsr:nxl-1+igsr) - 1
    1787           r1xo(nxlfc:nxl-1) = r1xo(nxlfc+igsr:nxl-1+igsr)
    1788           r2xo(nxlfc:nxl-1) = r2xo(nxlfc+igsr:nxl-1+igsr)
    1789        ENDIF
    1790        
    1791        IF  ( bc_dirichlet_r )  THEN
    1792           icu(nxr+1:nxrfc)  = icu(nxr+1-igsr:nxrfc-igsr) + 1
    1793           r1xu(nxr+1:nxrfc) = r1xu(nxr+1-igsr:nxrfc-igsr)
    1794           r2xu(nxr+1:nxrfc) = r2xu(nxr+1-igsr:nxrfc-igsr)
    1795           ico(nxr+1:nxrfc)  = ico(nxr+1-igsr:nxrfc-igsr) + 1
    1796           r1xo(nxr+1:nxrfc) = r1xo(nxr+1-igsr:nxrfc-igsr)
    1797           r2xo(nxr+1:nxrfc) = r2xo(nxr+1-igsr:nxrfc-igsr)
    1798        ENDIF
    1799 !
    1800 !--    Print out the indices and coefficients for checking and debugging purposes
    1801        DO  i = nxlfc, nxrfc
    1802           WRITE(9,"('pmci_init_interp_tril: i, icu, r1xu r2xu ', 2(i4,2x),2(e12.5,2x))") &
    1803                i, icu(i), r1xu(i), r2xu(i)
    1804           FLUSH(9)
    1805        ENDDO
    1806        WRITE(9,*)
    1807        DO  i = nxlfc, nxrfc
    1808           WRITE(9,"('pmci_init_interp_tril: i, ico, r1xo r2xo ', 2(i4,2x),2(e12.5,2x))") &
    1809                i, ico(i), r1xo(i), r2xo(i)
    1810           FLUSH(9)
    1811        ENDDO
    1812        WRITE(9,*)
    1813 
    1814        yb   = nys * dy
    1815        IF  ( bc_dirichlet_s )  THEN
    1816           moff = 2
    1817        ELSE
    1818           moff = 0
    1819        ENDIF
    1820 !AH       DO  j = nysg, nyng
    1821        DO  j = nys-1, nyn+1
    1822           yfsv    = coord_y(j) - ( lower_left_coord_y + yb )
    1823           yfso    = coord_y(j) + 0.5_wp * dy - ( lower_left_coord_y + yb )
    1824 !
    1825 !--       jcs points to 2 parent-grid cells south form the south nest boundary,
    1826 !--       thence jcs + moff points to the south nest boundary.
    1827           jcv(j)  = jcs + moff + FLOOR( yfsv / cg%dy )
    1828           jco(j)  = jcs + moff + FLOOR( ( yfso - 0.5_wp * cg%dy ) / cg%dy )
    1829           ycsv    = ( jcv(j) - ( jcs + moff ) ) * cg%dy
    1830           ycso    = ( jco(j) - ( jcs + moff ) + 0.5_wp ) * cg%dy
    1831           r2yv(j) = ( yfsv - ycsv ) / cg%dy
    1832           r2yo(j) = ( yfso - ycso ) / cg%dy
    1833           r1yv(j) = 1.0_wp - r2yv(j)
    1834           r1yo(j) = 1.0_wp - r2yo(j)
    1835        ENDDO
    1836 !       
    1837 !--    Fill up the values behind nest boundaries by copying from inside
    1838 !--    the domain.
    1839        IF  ( bc_dirichlet_s )  THEN
    1840           jcv(nysfc:nys-1)  = jcv(nysfc+jgsr:nys-1+jgsr) - 1
    1841           r1yv(nysfc:nys-1) = r1yv(nysfc+jgsr:nys-1+jgsr)
    1842           r2yv(nysfc:nys-1) = r2yv(nysfc+jgsr:nys-1+jgsr)
    1843           jco(nysfc:nys-1)  = jco(nysfc+jgsr:nys-1+jgsr) - 1
    1844           r1yo(nysfc:nys-1) = r1yo(nysfc+jgsr:nys-1+jgsr)
    1845           r2yo(nysfc:nys-1) = r2yo(nysfc+jgsr:nys-1+jgsr)
    1846        ENDIF
    1847        
    1848        IF  ( bc_dirichlet_n )  THEN
    1849           jcv(nyn+1:nynfc)  = jcv(nyn+1-jgsr:nynfc-jgsr) + 1
    1850           r1yv(nyn+1:nynfc) = r1yv(nyn+1-jgsr:nynfc-jgsr)
    1851           r2yv(nyn+1:nynfc) = r2yv(nyn+1-jgsr:nynfc-jgsr)
    1852           jco(nyn+1:nynfc)  = jco(nyn+1-jgsr:nynfc-jgsr) + 1
    1853           r1yo(nyn+1:nynfc) = r1yo(nyn+1-jgsr:nynfc-jgsr)
    1854           r2yo(nyn+1:nynfc) = r2yo(nyn+1-jgsr:nynfc-jgsr)
    1855        ENDIF
    1856 !
    1857 !--    Print out the indices and coefficients for checking and debugging purposes
    1858        DO  j = nysfc, nynfc
    1859           WRITE(9,"('pmci_init_interp_tril: j, jcv, r1yv r2yv ', 2(i4,2x),2(e12.5,2x))") &
    1860                j, jcv(j), r1yv(j), r2yv(j)
    1861           FLUSH(9)
    1862        ENDDO
    1863        WRITE(9,*)
    1864        DO  j = nysfc, nynfc
    1865           WRITE(9,"('pmci_init_interp_tril: j, jco, r1yo r2yo ', 2(i4,2x),2(e12.5,2x))") &
    1866                j, jco(j), r1yo(j), r2yo(j)
    1867           FLUSH(9)
    1868        ENDDO
    1869        WRITE(9,*)
    1870 
    1871        DO  k = nzb, nzt + 1
    1872           zfsw = zw(k)
    1873           zfso = zu(k)
    1874 
    1875           DO kc = 0, cg%nz+1
    1876              IF ( cg%zw(kc) > zfsw )  EXIT
    1877           ENDDO
    1878           kcw(k) = kc - 1
    1879          
    1880           DO kc = 0, cg%nz+1
    1881              IF ( cg%zu(kc) > zfso )  EXIT
    1882           ENDDO
    1883           kco(k) = kc - 1
    1884 
    1885           zcsw    = cg%zw(kcw(k))
    1886           zcso    = cg%zu(kco(k))
    1887           kdzw    = MIN( kcw(k)+1, cg%nz+1 )
    1888           kdzo    = MIN( kco(k)+1, cg%nz+1 )
    1889           r2zw(k) = ( zfsw - zcsw ) / cg%dzw(kdzw)
    1890           r2zo(k) = ( zfso - zcso ) / cg%dzu(kdzo)
    1891           r1zw(k) = 1.0_wp - r2zw(k)
    1892           r1zo(k) = 1.0_wp - r2zo(k)
    1893        ENDDO
    1894 !
    1895 !--    Set the interpolation index- and coefficient-information to the
    1896 !--    child-grid cells within the uppermost parent-grid cell. This
    1897 !--    information is only needed for the reversibility correction.   
    1898        kco(nzt+2:nzt+kgsr)  = kco(nzt+1) + 1
    1899        r1zo(nzt+2:nzt+kgsr) = r1zo(nzt+2-kgsr:nzt)
    1900        r2zo(nzt+2:nzt+kgsr) = r2zo(nzt+2-kgsr:nzt)
    1901 !
    1902 !--    kcw, r1zw and r2zw are not needed when k > nzt+1
    1903        kcw(nzt+2:nzt+kgsr)  = 0
    1904        r1zw(nzt+2:nzt+kgsr) = 0.0_wp
    1905        r2zw(nzt+2:nzt+kgsr) = 0.0_wp
    1906 !
    1907 !--    Print out the indices and coefficients for checking and debugging purposes
    1908        DO  k = nzb, nzt+1
    1909           WRITE(9,"('pmci_init_interp_tril: k, kcw, r1zw r2zw ', 2(i4,2x),2(e12.5,2x))") &
    1910                k, kcw(k), r1zw(k), r2zw(k)
    1911           FLUSH(9)
    1912        ENDDO
    1913        WRITE(9,*)
    1914        DO  k = nzb, nzt + kgsr
    1915           WRITE(9,"('pmci_init_interp_tril: k, kco, r1zo r2zo ', 2(i4,2x),2(e12.5,2x))") &
    1916                k, kco(k), r1zo(k), r2zo(k)
    1917           FLUSH(9)
    1918        ENDDO
    1919        WRITE(9,*)
    1920 !
    1921 !--    Determine the maximum dimension of anterpolation cells and allocate the
    1922 !--    work array celltmpd needed in the reversibility correction in the
    1923 !--    interpolation
    1924        dzmin = 999999.9_wp
    1925        DO k = 1, nzt+1
    1926           dzmin = MIN( dzmin, dzu(k), dzw(k) )
    1927        ENDDO
    1928        parentdzmax = 0.0_wp
    1929        DO k = 1, cg%nz+1
    1930           parentdzmax = MAX(parentdzmax , cg%dzu(k), cg%dzw(k) )
    1931        ENDDO
    1932        acsize = CEILING( cg%dx / dx ) * CEILING( cg%dy / dy ) *                 &
    1933             CEILING( parentdzmax / dzmin )
    1934        ALLOCATE( celltmpd(1:acsize) )
    1935 
    1936     END SUBROUTINE pmci_init_interp_tril
    1937    
    1938 
    1939 
    1940     SUBROUTINE pmci_allocate_finegrid_workarrays
    1941 !
    1942 !--    Allocate child-grid work-arrays for interpolation
    1943        IMPLICIT NONE
    1944 
    1945 
    1946        igsr = NINT( cg%dx / dx, iwp )
    1947        jgsr = NINT( cg%dy / dy, iwp )
    1948        kgsr = NINT( cg%dzw(1) / dzw(1), iwp )
    1949        write(9,"('igsr, jgsr, kgsr: ',3(i3,2x))") igsr, jgsr, kgsr
    1950        flush(9)
    1951 !       
    1952 !--    Note that i-indexing for workarr_lr runs from 0 to igsr-1.
    1953 !--    For u, only 0-element is used and all elements 0:igsr-1
    1954 !--    are used for all other variables.
    1955        ALLOCATE( workarr_lr(nzb:nzt+1,nysg:nyng,0:igsr-1) )
    1956 !       
    1957 !--    Note that j-indexing for workarr_sn runs from 0 to jgsr-1.
    1958 !--    For v, only 0-element is used and all elements 0:jgsr-1
    1959 !--    are used for all other variables.
    1960        ALLOCATE( workarr_sn(nzb:nzt+1,0:jgsr-1,nxlg:nxrg) )
    1961 !
    1962 !--    Note that genuine k-indexing is used for workarr_t.
    1963 !--    Only nzt-element is used for w and elements nzt+1:nzt+kgsr
    1964 !--    are used for all other variables.
    1965        ALLOCATE( workarr_t(nzt:nzt+kgsr,nysg:nyng,nxlg:nxrg) )
    1966 
    1967     END SUBROUTINE pmci_allocate_finegrid_workarrays
    1968 
    1969 
    1970 
    1971     SUBROUTINE pmci_allocate_coarsegrid_workarrays
    1972 !
    1973 !--    Allocate parent-grid work-arrays for interpolation
    1974        IMPLICIT NONE
    1975 
    1976 !
    1977 !--    Determine and store the PE-subdomain dependent index bounds
    1978        IF  ( bc_dirichlet_l )  THEN
    1979           iclw = icl + 1
    1980        ELSE
    1981           iclw = icl - 1
    1982        ENDIF
    1983 
    1984        IF  ( bc_dirichlet_r )  THEN
    1985           icrw = icr - 1
    1986        ELSE
    1987           icrw = icr + 1
    1988        ENDIF
    1989 
    1990        IF  ( bc_dirichlet_s )  THEN
    1991           jcsw = jcs + 1
    1992        ELSE
    1993           jcsw = jcs - 1
    1994        ENDIF
    1995 
    1996        IF  ( bc_dirichlet_n )  THEN
    1997           jcnw = jcn - 1
    1998        ELSE
    1999           jcnw = jcn + 1
    2000        ENDIF
    2001    
    2002        coarse_bound_w(1) = iclw
    2003        coarse_bound_w(2) = icrw
    2004        coarse_bound_w(3) = jcsw
    2005        coarse_bound_w(4) = jcnw
    2006 !
    2007 !--    Left and right boundaries.
    2008        ALLOCATE( workarrc_lr(0:cg%nz+1,jcsw:jcnw,0:2) )
    2009 !
    2010 !--    South and north boundaries.
    2011        ALLOCATE( workarrc_sn(0:cg%nz+1,0:2,iclw:icrw) )
    2012 !
    2013 !--    Top boundary.
    2014        ALLOCATE( workarrc_t(0:2,jcsw:jcnw,iclw:icrw) )
    2015 
    2016     END SUBROUTINE pmci_allocate_coarsegrid_workarrays
    2017 
    2018 
    2019 
    2020     SUBROUTINE pmci_create_coarsegrid_workarray_exchange_datatypes
    2021 !
    2022 !--    Define specific MPI types for workarrc-exhchange.
    2023        IMPLICIT NONE
    2024 
    2025 #if defined( __parallel )       
    2026 !
    2027 !--    For the left and right boundaries
    2028        CALL MPI_TYPE_VECTOR( 3, cg%nz+2, (jcnw-jcsw+1)*(cg%nz+2), MPI_REAL,     &
    2029             workarrc_lr_exchange_type, ierr )
    2030        CALL MPI_TYPE_COMMIT( workarrc_lr_exchange_type, ierr )
    2031 !
    2032 !--    For the south and north boundaries
    2033        CALL MPI_TYPE_VECTOR( 1, 3*(cg%nz+2), 3*(cg%nz+2), MPI_REAL,             &
    2034             workarrc_sn_exchange_type, ierr )
    2035        CALL MPI_TYPE_COMMIT( workarrc_sn_exchange_type, ierr )
    2036 !
    2037 !--    For the top-boundary x-slices
    2038        CALL MPI_TYPE_VECTOR( icrw-iclw+1, 3, 3*(jcnw-jcsw+1), MPI_REAL,         &
    2039             workarrc_t_exchange_type_x, ierr )
    2040        CALL MPI_TYPE_COMMIT( workarrc_t_exchange_type_x, ierr )
    2041 !
    2042 !--    For the top-boundary y-slices
    2043        CALL MPI_TYPE_VECTOR( 1, 3*(jcnw-jcsw+1), 3*(jcnw-jcsw+1), MPI_REAL,         &
    2044             workarrc_t_exchange_type_y, ierr )
    2045        CALL MPI_TYPE_COMMIT( workarrc_t_exchange_type_y, ierr )
    2046 #endif
    2047        
    2048     END SUBROUTINE pmci_create_coarsegrid_workarray_exchange_datatypes
    2049 
    2050 
    2051 
    2052     SUBROUTINE pmci_allocate_fine_to_coarse_mapping_arrays
    2053 !
    2054 !--    Define index limits and allocate the fine-to-coarse grid index mapping
    2055 !--    arrays and interpolation coefficient arrays.     
    2056        IMPLICIT NONE
    2057 
    2058        
    2059        IF  ( bc_dirichlet_l )  THEN
    2060 !AH          nxlfc = MIN( nxl-igsr, nxlg )         
    2061           nxlfc = nxl - igsr
    2062        ELSE
    2063 !AH          nxlfc = nxlg
    2064           nxlfc = nxl - 1
    2065        ENDIF
    2066        IF  ( bc_dirichlet_r )  THEN
    2067 !AH          nxrfc = MAX( nxr+igsr, nxrg )
    2068           nxrfc = nxr + igsr
    2069        ELSE
    2070 !AH          nxrfc = nxrg
    2071           nxrfc = nxr + 1         
    2072        ENDIF
    2073 
    2074        IF  ( bc_dirichlet_s )  THEN
    2075 !AH          nysfc = MIN( nys-jgsr, nysg )
    2076           nysfc = nys - jgsr
    2077        ELSE
    2078 !AH          nysfc = nysg
    2079           nysfc = nys - 1
    2080        ENDIF
    2081        IF  ( bc_dirichlet_n )  THEN
    2082 !AH          nynfc = MAX( nyn+jgsr, nyng )
    2083           nynfc = nyn + jgsr
    2084        ELSE
    2085 !AH          nynfc = nyng         
    2086           nynfc = nyn + 1         
    2087        ENDIF
    2088 
    2089        ALLOCATE( icu(nxlfc:nxrfc) )       
    2090        ALLOCATE( ico(nxlfc:nxrfc) )
    2091        ALLOCATE( jcv(nysfc:nynfc) )
    2092        ALLOCATE( jco(nysfc:nynfc) )
    2093        ALLOCATE( kcw(nzb:nzt+kgsr) )
    2094        ALLOCATE( kco(nzb:nzt+kgsr) )
    2095 
    2096        ALLOCATE( r1xu(nxlfc:nxrfc) )
    2097        ALLOCATE( r2xu(nxlfc:nxrfc) )
    2098        ALLOCATE( r1xo(nxlfc:nxrfc) )
    2099        ALLOCATE( r2xo(nxlfc:nxrfc) )
    2100        ALLOCATE( r1yv(nysfc:nynfc) )
    2101        ALLOCATE( r2yv(nysfc:nynfc) )
    2102        ALLOCATE( r1yo(nysfc:nynfc) )
    2103        ALLOCATE( r2yo(nysfc:nynfc) )
    2104        ALLOCATE( r1zw(nzb:nzt+kgsr) )
    2105        ALLOCATE( r2zw(nzb:nzt+kgsr) )
    2106        ALLOCATE( r1zo(nzb:nzt+kgsr) )
    2107        ALLOCATE( r2zo(nzb:nzt+kgsr) )
    2108 
    2109     END SUBROUTINE pmci_allocate_fine_to_coarse_mapping_arrays
    2110 
    2111      
    2112        
    2113     SUBROUTINE pmci_init_loglaw_correction
    2114 !
    2115 !--    Precomputation of the index and log-ratio arrays for the log-law
    2116 !--    corrections for near-wall nodes after the nest-BC interpolation.
    2117 !--    These are used by the interpolation routines interp_tril_lr and
    2118 !--    interp_tril_ns.
    2119 
    2120        IMPLICIT NONE
    2121 
    2122        INTEGER(iwp) ::  direction      !< Wall normal index: 1=k, 2=j, 3=i.
    2123        INTEGER(iwp) ::  dum            !< dummy value for reduce operation
    2124        INTEGER(iwp) ::  i              !<
    2125        INTEGER(iwp) ::  ierr           !< MPI status
    2126        INTEGER(iwp) ::  inc            !< Wall outward-normal index increment -1
    2127                                        !< or 1, for direction=1, inc=1 always
    2128        INTEGER(iwp) ::  j              !<
    2129        INTEGER(iwp) ::  k              !<
    2130        INTEGER(iwp) ::  k_wall_u_ji    !< topography top index on u-grid
    2131        INTEGER(iwp) ::  k_wall_u_ji_p  !< topography top index on u-grid
    2132        INTEGER(iwp) ::  k_wall_u_ji_m  !< topography top index on u-grid
    2133        INTEGER(iwp) ::  k_wall_v_ji    !< topography top index on v-grid
    2134        INTEGER(iwp) ::  k_wall_v_ji_p  !< topography top index on v-grid
    2135        INTEGER(iwp) ::  k_wall_v_ji_m  !< topography top index on v-grid
    2136        INTEGER(iwp) ::  k_wall_w_ji    !< topography top index on w-grid
    2137        INTEGER(iwp) ::  k_wall_w_ji_p  !< topography top index on w-grid
    2138        INTEGER(iwp) ::  k_wall_w_ji_m  !< topography top index on w-grid
    2139        INTEGER(iwp) ::  kb             !<
    2140        INTEGER(iwp) ::  lc             !<
    2141        INTEGER(iwp) ::  ni             !<
    2142        INTEGER(iwp) ::  nj             !<
    2143        INTEGER(iwp) ::  nk             !<
    2144        INTEGER(iwp) ::  nzt_topo_max   !<
    2145        INTEGER(iwp) ::  wall_index     !<  Index of the wall-node coordinate
    2146 
    2147        REAL(wp)     ::  z0_topo      !<  roughness at vertical walls
    2148        REAL(wp), ALLOCATABLE, DIMENSION(:) ::  lcr   !<
    2149 
    2150 !
    2151 !--    First determine the maximum k-index needed for the near-wall corrections.
    2152 !--    This maximum is individual for each boundary to minimize the storage
    2153 !--    requirements and to minimize the corresponding loop k-range in the
    2154 !--    interpolation routines.
    2155        nzt_topo_nestbc_l = nzb
    2156        IF ( bc_dirichlet_l )  THEN
    2157           DO  i = nxl-1, nxl
    2158              DO  j = nys, nyn
    2159 !
    2160 !--             Concept need to be reconsidered for 3D-topography
    2161 !--             Determine largest topography index on scalar grid
    2162                 nzt_topo_nestbc_l = MAX( nzt_topo_nestbc_l,                    &
    2163                                     get_topography_top_index_ji( j, i, 's' ) )
    2164 !
    2165 !--             Determine largest topography index on u grid
    2166                 nzt_topo_nestbc_l = MAX( nzt_topo_nestbc_l,                    &
    2167                                     get_topography_top_index_ji( j, i, 'u' ) )
    2168 !
    2169 !--             Determine largest topography index on v grid
    2170                 nzt_topo_nestbc_l = MAX( nzt_topo_nestbc_l,                    &
    2171                                     get_topography_top_index_ji( j, i, 'v' ) )
    2172 !
    2173 !--             Determine largest topography index on w grid
    2174                 nzt_topo_nestbc_l = MAX( nzt_topo_nestbc_l,                    &
    2175                                     get_topography_top_index_ji( j, i, 'w' ) )
    2176              ENDDO
    2177           ENDDO
    2178           nzt_topo_nestbc_l = nzt_topo_nestbc_l + 1
    2179        ENDIF
    2180      
    2181        nzt_topo_nestbc_r = nzb
    2182        IF ( bc_dirichlet_r )  THEN
    2183           i = nxr + 1
    2184           DO  j = nys, nyn
    2185 !
    2186 !--             Concept need to be reconsidered for 3D-topography
    2187 !--             Determine largest topography index on scalar grid
    2188                 nzt_topo_nestbc_r = MAX( nzt_topo_nestbc_r,                    &
    2189                                     get_topography_top_index_ji( j, i, 's' ) )
    2190 !
    2191 !--             Determine largest topography index on u grid
    2192                 nzt_topo_nestbc_r = MAX( nzt_topo_nestbc_r,                    &
    2193                                     get_topography_top_index_ji( j, i, 'u' ) )
    2194 !
    2195 !--             Determine largest topography index on v grid
    2196                 nzt_topo_nestbc_r = MAX( nzt_topo_nestbc_r,                    &
    2197                                     get_topography_top_index_ji( j, i, 'v' ) )
    2198 !
    2199 !--             Determine largest topography index on w grid
    2200                 nzt_topo_nestbc_r = MAX( nzt_topo_nestbc_r,                    &
    2201                                     get_topography_top_index_ji( j, i, 'w' ) )
    2202           ENDDO
    2203           nzt_topo_nestbc_r = nzt_topo_nestbc_r + 1
    2204        ENDIF
    2205 
    2206        nzt_topo_nestbc_s = nzb
    2207        IF ( bc_dirichlet_s )  THEN
    2208           DO  j = nys-1, nys
    2209              DO  i = nxl, nxr
    2210 !
    2211 !--             Concept need to be reconsidered for 3D-topography
    2212 !--             Determine largest topography index on scalar grid
    2213                 nzt_topo_nestbc_s = MAX( nzt_topo_nestbc_s,                    &
    2214                                     get_topography_top_index_ji( j, i, 's' ) )
    2215 !
    2216 !--             Determine largest topography index on u grid
    2217                 nzt_topo_nestbc_s = MAX( nzt_topo_nestbc_s,                    &
    2218                                     get_topography_top_index_ji( j, i, 'u' ) )
    2219 !
    2220 !--             Determine largest topography index on v grid
    2221                 nzt_topo_nestbc_s = MAX( nzt_topo_nestbc_s,                    &
    2222                                     get_topography_top_index_ji( j, i, 'v' ) )
    2223 !
    2224 !--             Determine largest topography index on w grid
    2225                 nzt_topo_nestbc_s = MAX( nzt_topo_nestbc_s,                    &
    2226                                     get_topography_top_index_ji( j, i, 'w' ) )
    2227              ENDDO
    2228           ENDDO
    2229           nzt_topo_nestbc_s = nzt_topo_nestbc_s + 1
    2230        ENDIF
    2231 
    2232        nzt_topo_nestbc_n = nzb
    2233        IF ( bc_dirichlet_n )  THEN
    2234           j = nyn + 1
    2235           DO  i = nxl, nxr
    2236 !
    2237 !--             Concept need to be reconsidered for 3D-topography
    2238 !--             Determine largest topography index on scalar grid
    2239                 nzt_topo_nestbc_n = MAX( nzt_topo_nestbc_n,                    &
    2240                                     get_topography_top_index_ji( j, i, 's' ) )
    2241 !
    2242 !--             Determine largest topography index on u grid
    2243                 nzt_topo_nestbc_n = MAX( nzt_topo_nestbc_n,                    &
    2244                                     get_topography_top_index_ji( j, i, 'u' ) )
    2245 !
    2246 !--             Determine largest topography index on v grid
    2247                 nzt_topo_nestbc_n = MAX( nzt_topo_nestbc_n,                    &
    2248                                     get_topography_top_index_ji( j, i, 'v' ) )
    2249 !
    2250 !--             Determine largest topography index on w grid
    2251                 nzt_topo_nestbc_n = MAX( nzt_topo_nestbc_n,                    &
    2252                                     get_topography_top_index_ji( j, i, 'w' ) )
    2253           ENDDO
    2254           nzt_topo_nestbc_n = nzt_topo_nestbc_n + 1
    2255        ENDIF
    2256 
    2257 #if defined( __parallel )
    2258 !
    2259 !--       Determine global topography-top index along child boundary.
    2260           dum = nzb
    2261           CALL MPI_ALLREDUCE( nzt_topo_nestbc_l, dum, 1, MPI_INTEGER,          &
    2262                               MPI_MAX, comm1dy, ierr )
    2263           nzt_topo_nestbc_l = dum
    2264 
    2265           dum = nzb
    2266           CALL MPI_ALLREDUCE( nzt_topo_nestbc_r, dum, 1, MPI_INTEGER,          &
    2267                               MPI_MAX, comm1dy, ierr )
    2268           nzt_topo_nestbc_r = dum
    2269 
    2270           dum = nzb
    2271           CALL MPI_ALLREDUCE( nzt_topo_nestbc_n, dum, 1, MPI_INTEGER,          &
    2272                               MPI_MAX, comm1dx, ierr )
    2273           nzt_topo_nestbc_n = dum
    2274 
    2275           dum = nzb
    2276           CALL MPI_ALLREDUCE( nzt_topo_nestbc_s, dum, 1, MPI_INTEGER,          &
    2277                               MPI_MAX, comm1dx, ierr )
    2278           nzt_topo_nestbc_s = dum
    2279 #endif
    2280 !
    2281 !--    Then determine the maximum number of near-wall nodes per wall point based
    2282 !--    on the grid-spacing ratios.
    2283        nzt_topo_max = MAX( nzt_topo_nestbc_l, nzt_topo_nestbc_r,               &
    2284                            nzt_topo_nestbc_s, nzt_topo_nestbc_n )
    2285 !
    2286 !--    Note that the outer division must be integer division.
    2287        ni = CEILING( cg%dx / dx ) / 2
    2288        nj = CEILING( cg%dy / dy ) / 2
    2289        nk = 1
    2290        DO  k = 1, nzt_topo_max
    2291           nk = MAX( nk, CEILING( cg%dzu(kco(k)+1) / dzu(k) ) )
    2292        ENDDO
    2293        nk = nk / 2   !  Note that this must be integer division.
    2294        ncorr =  MAX( ni, nj, nk )
    2295 
    2296        ALLOCATE( lcr(0:ncorr-1) )
    2297        lcr = 1.0_wp
    2298 
    2299        z0_topo = roughness_length
    2300 !
    2301 !--    First horizontal walls. Note that also logc_w_? and logc_ratio_w_? and
    2302 !--    logc_kbounds_* need to be allocated and initialized here.
    2303 !--    Left boundary
    2304        IF ( bc_dirichlet_l )  THEN
    2305 
    2306           ALLOCATE( logc_u_l(1:2,nzb:nzt_topo_nestbc_l,nys:nyn) )
    2307           ALLOCATE( logc_v_l(1:2,nzb:nzt_topo_nestbc_l,nys:nyn) )
    2308           ALLOCATE( logc_w_l(1:2,nzb:nzt_topo_nestbc_l,nys:nyn) )
    2309           ALLOCATE( logc_kbounds_u_l(1:2,nys:nyn) )
    2310           ALLOCATE( logc_kbounds_v_l(1:2,nys:nyn) )
    2311           ALLOCATE( logc_kbounds_w_l(1:2,nys:nyn) )
    2312           ALLOCATE( logc_ratio_u_l(1:2,0:ncorr-1,nzb:nzt_topo_nestbc_l,nys:nyn) )
    2313           ALLOCATE( logc_ratio_v_l(1:2,0:ncorr-1,nzb:nzt_topo_nestbc_l,nys:nyn) )
    2314           ALLOCATE( logc_ratio_w_l(1:2,0:ncorr-1,nzb:nzt_topo_nestbc_l,nys:nyn) )
    2315           logc_u_l       = 0
    2316           logc_v_l       = 0
    2317           logc_w_l       = 0
    2318           logc_ratio_u_l = 1.0_wp
    2319           logc_ratio_v_l = 1.0_wp
    2320           logc_ratio_w_l = 1.0_wp
    2321           direction      = 1
    2322           inc            = 1
    2323 
    2324           DO  j = nys, nyn
    2325 !
    2326 !--          Left boundary for u
    2327              i   = 0
    2328 !
    2329 !--          For loglaw correction the roughness z0 is required. z0, however,
    2330 !--          is part of the surfacetypes now. Set default roughness instead.
    2331 !--          Determine topography top index on u-grid
    2332              kb  = get_topography_top_index_ji( j, i, 'u' )
    2333              k   = kb + 1
    2334              wall_index = kb
    2335 
    2336              CALL pmci_define_loglaw_correction_parameters( lc, lcr, k,        &
    2337                             j, inc, wall_index, z0_topo,                       &
    2338                             kb, direction, ncorr )
    2339 
    2340              logc_u_l(1,k,j) = lc
    2341              logc_ratio_u_l(1,0:ncorr-1,k,j) = lcr(0:ncorr-1)
    2342              lcr(0:ncorr-1) = 1.0_wp
    2343 !
    2344 !--          Left boundary for v
    2345              i   = -1
    2346 !
    2347 !--          Determine topography top index on v-grid
    2348              kb  = get_topography_top_index_ji( j, i, 'v' )
    2349              k   = kb + 1
    2350              wall_index = kb
    2351 
    2352              CALL pmci_define_loglaw_correction_parameters( lc, lcr, k,        &
    2353                             j, inc, wall_index, z0_topo,                       &
    2354                             kb, direction, ncorr )
    2355 
    2356              logc_v_l(1,k,j) = lc
    2357              logc_ratio_v_l(1,0:ncorr-1,k,j) = lcr(0:ncorr-1)
    2358              lcr(0:ncorr-1) = 1.0_wp
    2359 
    2360           ENDDO
    2361 
    2362        ENDIF
    2363 !
    2364 !--    Right boundary
    2365        IF ( bc_dirichlet_r )  THEN
    2366            
    2367           ALLOCATE( logc_u_r(1:2,nzb:nzt_topo_nestbc_r,nys:nyn) )
    2368           ALLOCATE( logc_v_r(1:2,nzb:nzt_topo_nestbc_r,nys:nyn) )
    2369           ALLOCATE( logc_w_r(1:2,nzb:nzt_topo_nestbc_r,nys:nyn) )         
    2370           ALLOCATE( logc_kbounds_u_r(1:2,nys:nyn) )
    2371           ALLOCATE( logc_kbounds_v_r(1:2,nys:nyn) )
    2372           ALLOCATE( logc_kbounds_w_r(1:2,nys:nyn) )
    2373           ALLOCATE( logc_ratio_u_r(1:2,0:ncorr-1,nzb:nzt_topo_nestbc_r,nys:nyn) )
    2374           ALLOCATE( logc_ratio_v_r(1:2,0:ncorr-1,nzb:nzt_topo_nestbc_r,nys:nyn) )
    2375           ALLOCATE( logc_ratio_w_r(1:2,0:ncorr-1,nzb:nzt_topo_nestbc_r,nys:nyn) )
    2376           logc_u_r       = 0
    2377           logc_v_r       = 0
    2378           logc_w_r       = 0
    2379           logc_ratio_u_r = 1.0_wp
    2380           logc_ratio_v_r = 1.0_wp
    2381           logc_ratio_w_r = 1.0_wp
    2382           direction      = 1
    2383           inc            = 1
    2384 
    2385           DO  j = nys, nyn
    2386 !
    2387 !--          Right boundary for u
    2388              i   = nxr + 1
    2389 !
    2390 !--          For loglaw correction the roughness z0 is required. z0, however,
    2391 !--          is part of the surfacetypes now, so call subroutine according
    2392 !--          to the present surface tpye.
    2393 !--          Determine topography top index on u-grid
    2394              kb  = get_topography_top_index_ji( j, i, 'u' )
    2395              k   = kb + 1
    2396              wall_index = kb
    2397 
    2398              CALL pmci_define_loglaw_correction_parameters( lc, lcr, k,        &
    2399                                                  j, inc, wall_index, z0_topo,  &
    2400                                                  kb, direction, ncorr )
    2401 
    2402              logc_u_r(1,k,j) = lc
    2403              logc_ratio_u_r(1,0:ncorr-1,k,j) = lcr(0:ncorr-1)
    2404              lcr(0:ncorr-1) = 1.0_wp
    2405 !
    2406 !--          Right boundary for v
    2407              i   = nxr + 1
    2408 !
    2409 !--          Determine topography top index on v-grid
    2410              kb  = get_topography_top_index_ji( j, i, 'v' )
    2411              k   = kb + 1
    2412              wall_index = kb
    2413 
    2414              CALL pmci_define_loglaw_correction_parameters( lc, lcr, k,        &
    2415                                                  j, inc, wall_index, z0_topo,  &
    2416                                                  kb, direction, ncorr )
    2417 
    2418              logc_v_r(1,k,j) = lc
    2419              logc_ratio_v_r(1,0:ncorr-1,k,j) = lcr(0:ncorr-1)
    2420              lcr(0:ncorr-1) = 1.0_wp
    2421 
    2422           ENDDO
    2423 
    2424        ENDIF
    2425 !
    2426 !--    South boundary
    2427        IF ( bc_dirichlet_s )  THEN
    2428 
    2429           ALLOCATE( logc_u_s(1:2,nzb:nzt_topo_nestbc_s,nxl:nxr) )
    2430           ALLOCATE( logc_v_s(1:2,nzb:nzt_topo_nestbc_s,nxl:nxr) )
    2431           ALLOCATE( logc_w_s(1:2,nzb:nzt_topo_nestbc_s,nxl:nxr) )
    2432           ALLOCATE( logc_kbounds_u_s(1:2,nxl:nxr) )
    2433           ALLOCATE( logc_kbounds_v_s(1:2,nxl:nxr) )
    2434           ALLOCATE( logc_kbounds_w_s(1:2,nxl:nxr) )
    2435           ALLOCATE( logc_ratio_u_s(1:2,0:ncorr-1,nzb:nzt_topo_nestbc_s,nxl:nxr) )
    2436           ALLOCATE( logc_ratio_v_s(1:2,0:ncorr-1,nzb:nzt_topo_nestbc_s,nxl:nxr) )
    2437           ALLOCATE( logc_ratio_w_s(1:2,0:ncorr-1,nzb:nzt_topo_nestbc_s,nxl:nxr) )
    2438           logc_u_s       = 0
    2439           logc_v_s       = 0
    2440           logc_w_s       = 0
    2441           logc_ratio_u_s = 1.0_wp
    2442           logc_ratio_v_s = 1.0_wp
    2443           logc_ratio_w_s = 1.0_wp
    2444           direction      = 1
    2445           inc            = 1
    2446 
    2447           DO  i = nxl, nxr
    2448 !
    2449 !--          South boundary for u
    2450              j   = -1
    2451 !
    2452 !--          Determine topography top index on u-grid
    2453              kb  = get_topography_top_index_ji( j, i, 'u' )
    2454              k   = kb + 1
    2455              wall_index = kb
    2456 
    2457              CALL pmci_define_loglaw_correction_parameters( lc, lcr, k,        &
    2458                                                  j, inc, wall_index, z0_topo,  &
    2459                                                  kb, direction, ncorr )
    2460 
    2461              logc_u_s(1,k,i) = lc
    2462              logc_ratio_u_s(1,0:ncorr-1,k,i) = lcr(0:ncorr-1)
    2463              lcr(0:ncorr-1) = 1.0_wp
    2464 !
    2465 !--          South boundary for v
    2466              j   = 0
    2467 !
    2468 !--          Determine topography top index on v-grid
    2469              kb  = get_topography_top_index_ji( j, i, 'v' )
    2470              k   = kb + 1
    2471              wall_index = kb
    2472 
    2473              CALL pmci_define_loglaw_correction_parameters( lc, lcr, k,        &
    2474                                                  j, inc, wall_index, z0_topo,  &
    2475                                                  kb, direction, ncorr )
    2476 
    2477              logc_v_s(1,k,i) = lc
    2478              logc_ratio_v_s(1,0:ncorr-1,k,i) = lcr(0:ncorr-1)
    2479              lcr(0:ncorr-1) = 1.0_wp
    2480 
    2481           ENDDO
    2482 
    2483        ENDIF
    2484 !
    2485 !--    North boundary
    2486        IF ( bc_dirichlet_n )  THEN
    2487 
    2488           ALLOCATE( logc_u_n(1:2,nzb:nzt_topo_nestbc_n,nxl:nxr) )
    2489           ALLOCATE( logc_v_n(1:2,nzb:nzt_topo_nestbc_n,nxl:nxr) )
    2490           ALLOCATE( logc_w_n(1:2,nzb:nzt_topo_nestbc_n,nxl:nxr) )
    2491           ALLOCATE( logc_kbounds_u_n(1:2,nxl:nxr) )
    2492           ALLOCATE( logc_kbounds_v_n(1:2,nxl:nxr) )
    2493           ALLOCATE( logc_kbounds_w_n(1:2,nxl:nxr) )
    2494           ALLOCATE( logc_ratio_u_n(1:2,0:ncorr-1,nzb:nzt_topo_nestbc_n,nxl:nxr) )
    2495           ALLOCATE( logc_ratio_v_n(1:2,0:ncorr-1,nzb:nzt_topo_nestbc_n,nxl:nxr) )
    2496           ALLOCATE( logc_ratio_w_n(1:2,0:ncorr-1,nzb:nzt_topo_nestbc_n,nxl:nxr) )
    2497           logc_u_n       = 0
    2498           logc_v_n       = 0
    2499           logc_w_n       = 0
    2500           logc_ratio_u_n = 1.0_wp
    2501           logc_ratio_v_n = 1.0_wp
    2502           logc_ratio_w_n = 1.0_wp
    2503           direction      = 1
    2504           inc            = 1
    2505 
    2506           DO  i = nxl, nxr
    2507 !
    2508 !--          North boundary for u
    2509              j   = nyn + 1
    2510 !
    2511 !--          Determine topography top index on u-grid
    2512              kb  = get_topography_top_index_ji( j, i, 'u' )
    2513              k   = kb + 1
    2514              wall_index = kb
    2515 
    2516              CALL pmci_define_loglaw_correction_parameters( lc, lcr, k,        &
    2517                                                  j, inc, wall_index, z0_topo,  &
    2518                                                  kb, direction, ncorr )
    2519 
    2520              logc_u_n(1,k,i) = lc
    2521              logc_ratio_u_n(1,0:ncorr-1,k,i) = lcr(0:ncorr-1)
    2522              lcr(0:ncorr-1) = 1.0_wp
    2523 !
    2524 !--          North boundary for v
    2525              j   = nyn + 1
    2526 !
    2527 !--          Determine topography top index on v-grid
    2528              kb  = get_topography_top_index_ji( j, i, 'v' )
    2529              k   = kb + 1
    2530              wall_index = kb
    2531 
    2532              CALL pmci_define_loglaw_correction_parameters( lc, lcr, k,        &
    2533                                                  j, inc, wall_index, z0_topo,  &
    2534                                                  kb, direction, ncorr )
    2535              logc_v_n(1,k,i) = lc
    2536              logc_ratio_v_n(1,0:ncorr-1,k,i) = lcr(0:ncorr-1)
    2537              lcr(0:ncorr-1) = 1.0_wp
    2538 
    2539           ENDDO
    2540 
    2541        ENDIF
    2542 !       
    2543 !--    Then vertical walls and corners if necessary
    2544        IF ( topography /= 'flat' )  THEN
    2545 !
    2546 !--       Workaround, set z0 at vertical surfaces simply to the given roughness
    2547 !--       lenth, which is required to determine the logarithmic correction
    2548 !--       factors at the child boundaries, which are at the ghost-points.
    2549 !--       The surface data type for vertical surfaces, however, is not defined
    2550 !--       at ghost-points, so that no z0 can be retrieved at this point.
    2551 !--       Maybe, revise this later and define vertical surface datattype also
    2552 !--       at ghost-points.
    2553           z0_topo = roughness_length
    2554 
    2555           kb = 0       ! kb is not used when direction > 1       
    2556 !       
    2557 !--       Left boundary
    2558           IF ( bc_dirichlet_l )  THEN
    2559              logc_kbounds_u_l(1:2,nys:nyn) = 0
    2560              logc_kbounds_v_l(1:2,nys:nyn) = 0             
    2561              logc_kbounds_w_l(1:2,nys:nyn) = 0
    2562              
    2563              direction  = 2
    2564 
    2565              DO  j = nys, nyn
    2566 !
    2567 !--             Determine the lowest k-indices for u at j,i, j+1,i and j-1,i.
    2568                 i             = 0
    2569                 k_wall_u_ji   = get_topography_top_index_ji( j,   i, 'u' )
    2570                 k_wall_u_ji_p = get_topography_top_index_ji( j+1, i, 'u' )
    2571                 k_wall_u_ji_m = get_topography_top_index_ji( j-1, i, 'u' )
    2572 !
    2573 !--             Wall for u on the south side.
    2574                 IF ( ( k_wall_u_ji <  k_wall_u_ji_m ) .AND.                    &
    2575                      ( k_wall_u_ji >= k_wall_u_ji_p ) )  THEN
    2576                    inc        =  1
    2577                    wall_index =  j
    2578 !
    2579 !--                Store the kbounds for use in pmci_interp_tril_lr.
    2580                    logc_kbounds_u_l(1,j) = k_wall_u_ji + 1
    2581                    logc_kbounds_u_l(2,j) = k_wall_u_ji_m
    2582                    DO  k = logc_kbounds_u_l(1,j), logc_kbounds_u_l(2,j)
    2583                       CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
    2584                            k, j, inc, wall_index, z0_topo, kb, direction,      &
    2585                            ncorr )
    2586                       IF ( lc == -99 )  THEN
    2587 !                         
    2588 !--                      The pivot point is out of subdomain, skip the correction.
    2589                          logc_u_l(2,k,j) = 0
    2590                          logc_ratio_u_l(2,0:ncorr-1,k,j) = 1.0_wp
    2591                       ELSE
    2592 !
    2593 !--                      The direction of the wall-normal index is stored as the
    2594 !--                      sign of the logc-element.
    2595                          logc_u_l(2,k,j) = inc * lc
    2596                          logc_ratio_u_l(2,0:ncorr-1,k,j) = lcr(0:ncorr-1)
    2597                       ENDIF
    2598                       lcr(0:ncorr-1) = 1.0_wp
    2599                    ENDDO
    2600                 ENDIF
    2601 !
    2602 !--             Wall for u on the north side.
    2603                 IF ( ( k_wall_u_ji <  k_wall_u_ji_p ) .AND.                    &
    2604                      ( k_wall_u_ji >= k_wall_u_ji_m ) )  THEN
    2605                    inc        = -1
    2606                    wall_index =  j + 1
    2607 !
    2608 !--                Store the kbounds for use in pmci_interp_tril_lr.                   
    2609                    logc_kbounds_u_l(1,j) = k_wall_u_ji + 1
    2610                    logc_kbounds_u_l(2,j) = k_wall_u_ji_p
    2611                    DO  k = logc_kbounds_u_l(1,j), logc_kbounds_u_l(2,j)
    2612                       CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
    2613                            k, j, inc, wall_index, z0_topo, kb, direction,      &
    2614                            ncorr )
    2615                       IF ( lc == -99 )  THEN
    2616 !                         
    2617 !--                      The pivot point is out of subdomain, skip the correction.
    2618                          logc_u_l(2,k,j) = 0
    2619                          logc_ratio_u_l(2,0:ncorr-1,k,j) = 1.0_wp
    2620                       ELSE
    2621 !
    2622 !--                      The direction of the wall-normal index is stored as the
    2623 !--                      sign of the logc-element.
    2624                          logc_u_l(2,k,j) = inc * lc
    2625                          logc_ratio_u_l(2,0:ncorr-1,k,j) = lcr(0:ncorr-1)
    2626                       ENDIF
    2627                       lcr(0:ncorr-1) = 1.0_wp
    2628                    ENDDO
    2629                 ENDIF
    2630 !
    2631 !--             Determine the lowest k-indices for w at j,i, j+1,i and j-1,i.
    2632                 i             = -1
    2633                 k_wall_w_ji   = get_topography_top_index_ji( j,   i, 'w' )
    2634                 k_wall_w_ji_p = get_topography_top_index_ji( j+1, i, 'w' )
    2635                 k_wall_w_ji_m = get_topography_top_index_ji( j-1, i, 'w' )
    2636 !
    2637 !--             Wall for w on the south side.               
    2638                 IF ( ( k_wall_w_ji <  k_wall_w_ji_m ) .AND.                    &
    2639                      ( k_wall_w_ji >= k_wall_w_ji_p ) )  THEN
    2640                    inc        =  1
    2641                    wall_index =  j
    2642 !
    2643 !--                Store the kbounds for use in pmci_interp_tril_lr.
    2644                    logc_kbounds_w_l(1,j) = k_wall_w_ji + 1
    2645                    logc_kbounds_w_l(2,j) = k_wall_w_ji_m
    2646                    DO  k = logc_kbounds_w_l(1,j), logc_kbounds_w_l(2,j)
    2647                       CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
    2648                            k, j, inc, wall_index, z0_topo, kb, direction,      &
    2649                            ncorr )
    2650                       IF ( lc == -99 )  THEN
    2651 !                         
    2652 !--                      The pivot point is out of subdomain, skip the correction.
    2653                          logc_w_l(2,k,j) = 0
    2654                          logc_ratio_w_l(2,0:ncorr-1,k,j) = 1.0_wp
    2655                       ELSE
    2656 !
    2657 !--                      The direction of the wall-normal index is stored as the
    2658 !--                      sign of the logc-element.
    2659                          logc_w_l(2,k,j) = inc * lc
    2660                          logc_ratio_w_l(2,0:ncorr-1,k,j) = lcr(0:ncorr-1)
    2661                       ENDIF
    2662                       lcr(0:ncorr-1) = 1.0_wp
    2663                    ENDDO
    2664                 ENDIF
    2665 !
    2666 !--             Wall for w on the north side.
    2667                 IF ( ( k_wall_w_ji <  k_wall_w_ji_p ) .AND.                    &
    2668                      ( k_wall_w_ji >= k_wall_w_ji_m ) )  THEN
    2669                    inc        = -1
    2670                    wall_index =  j+1
    2671 !
    2672 !--                Store the kbounds for use in pmci_interp_tril_lr.
    2673                    logc_kbounds_w_l(1,j) = k_wall_w_ji + 1
    2674                    logc_kbounds_w_l(2,j) = k_wall_w_ji_p
    2675                    DO  k = logc_kbounds_w_l(1,j), logc_kbounds_w_l(2,j)
    2676                       CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
    2677                            k, j, inc, wall_index, z0_topo, kb, direction,      &
    2678                            ncorr )
    2679                       IF ( lc == -99 )  THEN
    2680 !                         
    2681 !--                      The pivot point is out of subdomain, skip the correction.
    2682                          logc_w_l(2,k,j) = 0
    2683                          logc_ratio_w_l(2,0:ncorr-1,k,j) = 1.0_wp
    2684                       ELSE
    2685 !
    2686 !--                      The direction of the wall-normal index is stored as the
    2687 !--                      sign of the logc-element.
    2688                          logc_w_l(2,k,j) = inc * lc
    2689                          logc_ratio_w_l(2,0:ncorr-1,k,j) = lcr(0:ncorr-1)
    2690                       ENDIF
    2691                       lcr(0:ncorr-1) = 1.0_wp
    2692                    ENDDO
    2693                 ENDIF
    2694                    
    2695              ENDDO
    2696 
    2697           ENDIF   !  IF ( bc_dirichlet_l )
    2698 !       
    2699 !--       Right boundary
    2700           IF ( bc_dirichlet_r )  THEN
    2701              logc_kbounds_u_r(1:2,nys:nyn) = 0
    2702              logc_kbounds_v_r(1:2,nys:nyn) = 0             
    2703              logc_kbounds_w_r(1:2,nys:nyn) = 0
    2704 
    2705              direction  = 2
    2706              i  = nx + 1
    2707 
    2708              DO  j = nys, nyn
    2709 !
    2710 !--             Determine the lowest k-indices for u at j,i, j+1,i and j-1,i.
    2711                 k_wall_u_ji   = get_topography_top_index_ji( j,   i, 'u' )
    2712                 k_wall_u_ji_p = get_topography_top_index_ji( j+1, i, 'u' )
    2713                 k_wall_u_ji_m = get_topography_top_index_ji( j-1, i, 'u' )
    2714 !
    2715 !--             Wall for u on the south side.
    2716                 IF ( ( k_wall_u_ji <  k_wall_u_ji_m ) .AND.                    &
    2717                      ( k_wall_u_ji >= k_wall_u_ji_p ) )  THEN
    2718                    inc        =  1
    2719                    wall_index =  j
    2720 !
    2721 !--                Store the kbounds for use in pmci_interp_tril_lr.                 
    2722                    logc_kbounds_u_r(1,j) = k_wall_u_ji + 1
    2723                    logc_kbounds_u_r(2,j) = k_wall_u_ji_m
    2724                    DO  k = logc_kbounds_u_r(1,j), logc_kbounds_u_r(2,j)
    2725                       CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
    2726                            k, j, inc, wall_index, z0_topo, kb, direction, ncorr )
    2727                       IF ( lc == -99 )  THEN
    2728 !                         
    2729 !--                      The pivot point is out of subdomain, skip the correction.
    2730                          logc_u_r(2,k,j) = 0
    2731                          logc_ratio_u_r(2,0:ncorr-1,k,j) = 1.0_wp
    2732                       ELSE
    2733 !
    2734 !--                      The direction of the wall-normal index is stored as the
    2735 !--                      sign of the logc-element.
    2736                          logc_u_r(2,k,j) = inc * lc
    2737                          logc_ratio_u_r(2,0:ncorr-1,k,j) = lcr(0:ncorr-1)
    2738                       ENDIF
    2739                       lcr(0:ncorr-1) = 1.0_wp
    2740                    ENDDO
    2741                 ENDIF
    2742 !
    2743 !--             Wall for u on the south side.
    2744                 IF ( ( k_wall_u_ji <  k_wall_u_ji_p ) .AND.                    &
    2745                      ( k_wall_u_ji >= k_wall_u_ji_m ) )  THEN
    2746                    inc        = -1
    2747                    wall_index =  j + 1                 
    2748 !
    2749 !--                Store the kbounds for use in pmci_interp_tril_lr.                   
    2750                    logc_kbounds_u_r(1,j) = k_wall_u_ji + 1
    2751                    logc_kbounds_u_r(2,j) = k_wall_u_ji_p
    2752                    DO  k = logc_kbounds_u_r(1,j), logc_kbounds_u_r(2,j)
    2753                       CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
    2754                            k, j, inc, wall_index, z0_topo, kb, direction,      &
    2755                            ncorr )
    2756                       IF ( lc == -99 )  THEN
    2757 !                         
    2758 !--                      The pivot point is out of subdomain, skip the correction.
    2759                          logc_u_r(2,k,j) = 0
    2760                          logc_ratio_u_r(2,0:ncorr-1,k,j) = 1.0_wp
    2761                       ELSE
    2762 !
    2763 !--                      The direction of the wall-normal index is stored as the
    2764 !--                      sign of the logc-element.
    2765                          logc_u_r(2,k,j) = inc * lc
    2766                          logc_ratio_u_r(2,0:ncorr-1,k,j) = lcr(0:ncorr-1)
    2767                       ENDIF
    2768                       lcr(0:ncorr-1) = 1.0_wp
    2769                    ENDDO
    2770                 ENDIF
    2771 !
    2772 !--             Determine the lowest k-indices for w at j,i, j+1,i and j-1,i.
    2773                 k_wall_w_ji   = get_topography_top_index_ji( j,   i, 'w' )
    2774                 k_wall_w_ji_p = get_topography_top_index_ji( j+1, i, 'w' )
    2775                 k_wall_w_ji_m = get_topography_top_index_ji( j-1, i, 'w' )
    2776 !
    2777 !--             Wall for w on the south side.               
    2778                 IF ( ( k_wall_w_ji <  k_wall_w_ji_m ) .AND.                    &
    2779                      ( k_wall_w_ji >= k_wall_w_ji_p ) )  THEN
    2780                    inc        =  1
    2781                    wall_index =  j
    2782 !
    2783 !--                Store the kbounds for use in pmci_interp_tril_lr.                   
    2784                    logc_kbounds_w_r(1,j) = k_wall_w_ji + 1
    2785                    logc_kbounds_w_r(2,j) = k_wall_w_ji_m
    2786                    DO  k = logc_kbounds_w_r(1,j), logc_kbounds_w_r(2,j)
    2787                       CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
    2788                            k, j, inc, wall_index, z0_topo, kb, direction,      &
    2789                            ncorr )
    2790                       IF ( lc == -99 )  THEN
    2791 !                         
    2792 !--                      The pivot point is out of subdomain, skip the correction.
    2793                          logc_w_r(2,k,j) = 0
    2794                          logc_ratio_w_r(2,0:ncorr-1,k,j) = 1.0_wp
    2795                       ELSE
    2796 !
    2797 !--                      The direction of the wall-normal index is stored as the
    2798 !--                      sign of the logc-element.
    2799                          logc_w_r(2,k,j) = inc * lc
    2800                          logc_ratio_w_r(2,0:ncorr-1,k,j) = lcr(0:ncorr-1)
    2801                       ENDIF
    2802                       lcr(0:ncorr-1) = 1.0_wp
    2803                    ENDDO
    2804                 ENDIF
    2805 !
    2806 !--             Wall for w on the north side.
    2807                 IF ( ( k_wall_w_ji <  k_wall_w_ji_p ) .AND.                    &
    2808                      ( k_wall_w_ji >= k_wall_w_ji_m ) )  THEN
    2809                    inc        = -1
    2810                    wall_index =  j+1
    2811 !
    2812 !--                Store the kbounds for use in pmci_interp_tril_lr.                   
    2813                    logc_kbounds_w_r(1,j) = k_wall_w_ji + 1
    2814                    logc_kbounds_w_r(2,j) = k_wall_w_ji_p
    2815                    DO  k = logc_kbounds_w_r(1,j), logc_kbounds_w_r(2,j)
    2816                       CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
    2817                            k, j, inc, wall_index, z0_topo, kb, direction,      &
    2818                            ncorr )
    2819                       IF ( lc == -99 )  THEN
    2820 !                         
    2821 !--                      The pivot point is out of subdomain, skip the correction.
    2822                          logc_w_r(2,k,j) = 0
    2823                          logc_ratio_w_r(2,0:ncorr-1,k,j) = 1.0_wp
    2824                       ELSE
    2825 !
    2826 !--                      The direction of the wall-normal index is stored as the
    2827 !--                      sign of the logc-element.
    2828                          logc_w_r(2,k,j) = inc * lc
    2829                          logc_ratio_w_r(2,0:ncorr-1,k,j) = lcr(0:ncorr-1)
    2830                       ENDIF
    2831                       lcr(0:ncorr-1) = 1.0_wp
    2832                    ENDDO
    2833                 ENDIF
    2834                    
    2835              ENDDO
    2836              
    2837           ENDIF   !  IF ( bc_dirichlet_r )
    2838 !       
    2839 !--       South boundary
    2840           IF ( bc_dirichlet_s )  THEN
    2841              logc_kbounds_u_s(1:2,nxl:nxr) = 0
    2842              logc_kbounds_v_s(1:2,nxl:nxr) = 0
    2843              logc_kbounds_w_s(1:2,nxl:nxr) = 0
    2844 
    2845              direction  = 3
    2846 
    2847              DO  i = nxl, nxr
    2848 !
    2849 !--             Determine the lowest k-indices for v at j,i, j,i+1 and j,i-1.
    2850                 j             = 0               
    2851                 k_wall_v_ji   = get_topography_top_index_ji( j, i,   'v' )
    2852                 k_wall_v_ji_p = get_topography_top_index_ji( j, i+1, 'v' )
    2853                 k_wall_v_ji_m = get_topography_top_index_ji( j, i-1, 'v' )
    2854 !
    2855 !--             Wall for v on the left side.
    2856                 IF ( ( k_wall_v_ji <  k_wall_v_ji_m ) .AND.                    &
    2857                      ( k_wall_v_ji >= k_wall_v_ji_p ) )  THEN
    2858                    inc        =  1
    2859                    wall_index =  i
    2860 !
    2861 !--                Store the kbounds for use in pmci_interp_tril_sn.                   
    2862                    logc_kbounds_v_s(1,i) = k_wall_v_ji + 1
    2863                    logc_kbounds_v_s(2,i) = k_wall_v_ji_m
    2864                    DO  k = logc_kbounds_v_s(1,i), logc_kbounds_v_s(2,i)
    2865                       CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
    2866                            k, i, inc, wall_index, z0_topo, kb, direction,      &
    2867                            ncorr )
    2868                       IF ( lc == -99 )  THEN
    2869 !                         
    2870 !--                      The pivot point is out of subdomain, skip the correction.
    2871                          logc_v_s(2,k,i) = 0
    2872                          logc_ratio_v_s(2,0:ncorr-1,k,i) = 1.0_wp
    2873                       ELSE
    2874 !
    2875 !--                      The direction of the wall-normal index is stored as the
    2876 !--                      sign of the logc-element.
    2877                          logc_v_s(2,k,i) = inc * lc
    2878                          logc_ratio_v_s(2,0:ncorr-1,k,i) = lcr(0:ncorr-1)
    2879                       ENDIF
    2880                       lcr(0:ncorr-1) = 1.0_wp
    2881                    ENDDO
    2882                 ENDIF
    2883 !
    2884 !--             Wall for v on the right side.
    2885                 IF ( ( k_wall_v_ji <  k_wall_v_ji_p ) .AND.                    &
    2886                      ( k_wall_v_ji >= k_wall_v_ji_m ) )  THEN
    2887                    inc        = -1
    2888                    wall_index =  i+1
    2889 !
    2890 !--                Store the kbounds for use in pmci_interp_tril_sn.                   
    2891                    logc_kbounds_v_s(1,i) = k_wall_v_ji + 1
    2892                    logc_kbounds_v_s(2,i) = k_wall_v_ji_p
    2893                    DO  k = logc_kbounds_v_s(1,i), logc_kbounds_v_s(2,i)
    2894                       CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
    2895                            k, i, inc, wall_index, z0_topo, kb, direction,      &
    2896                            ncorr )
    2897                       IF ( lc == -99 )  THEN
    2898 !                         
    2899 !--                      The pivot point is out of subdomain, skip the correction.
    2900                          logc_v_s(2,k,i) = 0
    2901                          logc_ratio_v_s(2,0:ncorr-1,k,i) = 1.0_wp
    2902                       ELSE
    2903 !
    2904 !--                      The direction of the wall-normal index is stored as the
    2905 !--                      sign of the logc-element.
    2906                          logc_v_s(2,k,i) = inc * lc
    2907                          logc_ratio_v_s(2,0:ncorr-1,k,i) = lcr(0:ncorr-1)
    2908                       ENDIF
    2909                       lcr(0:ncorr-1) = 1.0_wp
    2910                    ENDDO
    2911                 ENDIF
    2912 !
    2913 !--             Determine the lowest k-indices for w at j,i, j,i+1 and j,i-1.
    2914                 j             = -1
    2915                 k_wall_w_ji   = get_topography_top_index_ji( j, i,   'w' )
    2916                 k_wall_w_ji_p = get_topography_top_index_ji( j, i+1, 'w' )
    2917                 k_wall_w_ji_m = get_topography_top_index_ji( j, i-1, 'w' )
    2918 !
    2919 !--             Wall for w on the left side.
    2920                 IF ( ( k_wall_w_ji <  k_wall_w_ji_m ) .AND.                    &
    2921                      ( k_wall_w_ji >= k_wall_w_ji_p ) )  THEN
    2922                    inc        =  1
    2923                    wall_index =  i
    2924 !
    2925 !--                Store the kbounds for use in pmci_interp_tril_sn.
    2926                    logc_kbounds_w_s(1,i) = k_wall_w_ji + 1
    2927                    logc_kbounds_w_s(2,i) = k_wall_w_ji_m
    2928                    DO  k = logc_kbounds_w_s(1,i), logc_kbounds_w_s(2,i)
    2929                       CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
    2930                            k, i, inc, wall_index, z0_topo, kb, direction,      &
    2931                            ncorr )
    2932                       IF ( lc == -99 )  THEN
    2933 !                         
    2934 !--                      The pivot point is out of subdomain, skip the correction.
    2935                          logc_w_s(2,k,i) = 0
    2936                          logc_ratio_w_s(2,0:ncorr-1,k,i) = 1.0_wp
    2937                       ELSE
    2938 !
    2939 !--                      The direction of the wall-normal index is stored as the
    2940 !--                      sign of the logc-element.
    2941                          logc_w_s(2,k,i) = inc * lc
    2942                          logc_ratio_w_s(2,0:ncorr-1,k,i) = lcr(0:ncorr-1)
    2943                       ENDIF
    2944                       lcr(0:ncorr-1) = 1.0_wp
    2945                    ENDDO
    2946                 ENDIF
    2947 !
    2948 !--             Wall for w on the right side.
    2949                 IF ( ( k_wall_w_ji <  k_wall_w_ji_p ) .AND.                    &
    2950                      ( k_wall_w_ji >= k_wall_w_ji_m ) )  THEN
    2951                    inc        = -1
    2952                    wall_index =  i+1
    2953 !
    2954 !--                Store the kbounds for use in pmci_interp_tril_sn.
    2955                    logc_kbounds_w_s(1,i) = k_wall_w_ji + 1
    2956                    logc_kbounds_w_s(2,i) = k_wall_w_ji_p
    2957                    DO  k = logc_kbounds_w_s(1,i), logc_kbounds_w_s(2,i)
    2958                       CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
    2959                            k, i, inc, wall_index, z0_topo, kb, direction,      &
    2960                            ncorr )
    2961                       IF ( lc == -99 )  THEN
    2962 !                         
    2963 !--                      The pivot point is out of subdomain, skip the correction.
    2964                          logc_w_s(2,k,i) = 0
    2965                          logc_ratio_w_s(2,0:ncorr-1,k,i) = 1.0_wp
    2966                       ELSE
    2967 !
    2968 !--                      The direction of the wall-normal index is stored as the
    2969 !--                      sign of the logc-element.
    2970                          logc_w_s(2,k,i) = inc * lc
    2971                          logc_ratio_w_s(2,0:ncorr-1,k,i) = lcr(0:ncorr-1)
    2972                       ENDIF
    2973                       lcr(0:ncorr-1) = 1.0_wp
    2974                    ENDDO
    2975                 ENDIF
    2976 
    2977              ENDDO
    2978 
    2979           ENDIF   !  IF (bc_dirichlet_s )
    2980 !       
    2981 !--       North boundary
    2982           IF ( bc_dirichlet_n )  THEN
    2983              logc_kbounds_u_n(1:2,nxl:nxr) = 0             
    2984              logc_kbounds_v_n(1:2,nxl:nxr) = 0
    2985              logc_kbounds_w_n(1:2,nxl:nxr) = 0
    2986 
    2987              direction  = 3
    2988              j  = ny + 1
    2989 
    2990              DO  i = nxl, nxr
    2991 !
    2992 !--             Determine the lowest k-indices for v at j,i, j,i+1 and j,i-1
    2993                 k_wall_v_ji   = get_topography_top_index_ji( j, i,   'v' )
    2994                 k_wall_v_ji_p = get_topography_top_index_ji( j, i+1, 'v' )
    2995                 k_wall_v_ji_m = get_topography_top_index_ji( j, i-1, 'v' )
    2996 !
    2997 !--             Wall for v on the left side.
    2998                 IF ( ( k_wall_v_ji <  k_wall_v_ji_m ) .AND.                    &
    2999                      ( k_wall_v_ji >= k_wall_v_ji_p ) )  THEN
    3000                    inc        = 1
    3001                    wall_index = i                   
    3002 !
    3003 !--                Store the kbounds for use in pmci_interp_tril_sn.
    3004                    logc_kbounds_v_n(1,i) = k_wall_v_ji + 1
    3005                    logc_kbounds_v_n(2,i) = k_wall_v_ji_m
    3006                    DO  k = logc_kbounds_v_n(1,i), logc_kbounds_v_n(2,i)
    3007                       CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
    3008                            k, i, inc, wall_index, z0_topo, kb, direction,      &
    3009                            ncorr )
    3010                       IF ( lc == -99 )  THEN
    3011 !                         
    3012 !--                      The pivot point is out of subdomain, skip the correction.
    3013                          logc_v_n(2,k,i) = 0
    3014                          logc_ratio_v_n(2,0:ncorr-1,k,i) = 1.0_wp
    3015                       ELSE
    3016 !
    3017 !--                      The direction of the wall-normal index is stored as the
    3018 !--                      sign of the logc-element.
    3019                          logc_v_n(2,k,i) = inc * lc
    3020                          logc_ratio_v_n(2,0:ncorr-1,k,i) = lcr(0:ncorr-1)
    3021                       ENDIF
    3022                       lcr(0:ncorr-1) = 1.0_wp
    3023                    ENDDO
    3024                 ENDIF
    3025 !
    3026 !--             Wall for v on the right side.
    3027                 IF ( ( k_wall_v_ji <  k_wall_v_ji_p ) .AND.                    &
    3028                      ( k_wall_v_ji >= k_wall_v_ji_m ) )  THEN
    3029                    inc        = -1
    3030                    wall_index =  i + 1
    3031 !
    3032 !--                Store the kbounds for use in pmci_interp_tril_sn.
    3033                    logc_kbounds_v_n(1,i) = k_wall_v_ji + 1
    3034                    logc_kbounds_v_n(2,i) = k_wall_v_ji_p
    3035                    DO  k = logc_kbounds_v_n(1,i), logc_kbounds_v_n(2,i)
    3036                       CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
    3037                            k, i, inc, wall_index, z0_topo, kb, direction,      &
    3038                            ncorr )
    3039                       IF ( lc == -99 )  THEN
    3040 !                         
    3041 !--                      The pivot point is out of subdomain, skip the correction.
    3042                          logc_v_n(2,k,i) = 0
    3043                          logc_ratio_v_n(2,0:ncorr-1,k,i) = 1.0_wp
    3044                       ELSE
    3045 !
    3046 !--                      The direction of the wall-normal index is stored as the
    3047 !--                      sign of the logc-element.
    3048                          logc_v_n(2,k,i) = inc * lc
    3049                          logc_ratio_v_n(2,0:ncorr-1,k,i) = lcr(0:ncorr-1)
    3050                       ENDIF
    3051                       lcr(0:ncorr-1) = 1.0_wp
    3052                    ENDDO
    3053                 ENDIF
    3054 !
    3055 !--             Determine the lowest k-indices for w at j,i, j,i+1 and j,i-1.
    3056                 k_wall_w_ji   = get_topography_top_index_ji( j, i,   'w' )
    3057                 k_wall_w_ji_p = get_topography_top_index_ji( j, i+1, 'w' )
    3058                 k_wall_w_ji_m = get_topography_top_index_ji( j, i-1, 'w' )                   
    3059 !
    3060 !--             Wall for w on the left side.
    3061                 IF ( ( k_wall_w_ji <  k_wall_w_ji_m ) .AND.                    &
    3062                      ( k_wall_w_ji >= k_wall_w_ji_p ) )  THEN
    3063                    inc        = 1
    3064                    wall_index = i
    3065 !
    3066 !--                Store the kbounds for use in pmci_interp_tril_sn.
    3067                    logc_kbounds_w_n(1,i) = k_wall_w_ji + 1
    3068                    logc_kbounds_w_n(2,i) = k_wall_w_ji_m
    3069                    DO  k = logc_kbounds_w_n(1,i), logc_kbounds_w_n(2,i)
    3070                       CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
    3071                            k, i, inc, wall_index, z0_topo, kb, direction,      &
    3072                            ncorr )
    3073                       IF ( lc == -99 )  THEN
    3074 !                         
    3075 !--                      The pivot point is out of subdomain, skip the correction.
    3076                          logc_w_n(2,k,i) = 0
    3077                          logc_ratio_w_n(2,0:ncorr-1,k,i) = 1.0_wp
    3078                       ELSE
    3079 !
    3080 !--                      The direction of the wall-normal index is stored as the
    3081 !--                      sign of the logc-element.
    3082                          logc_w_n(2,k,i) = inc * lc
    3083                          logc_ratio_w_n(2,0:ncorr-1,k,i) = lcr(0:ncorr-1)
    3084                       ENDIF
    3085                       lcr(0:ncorr-1) = 1.0_wp
    3086                    ENDDO
    3087                 ENDIF
    3088 !
    3089 !--             Wall for w on the right side, but not on the left side
    3090                 IF ( ( k_wall_w_ji <  k_wall_w_ji_p ) .AND.                    &
    3091                      ( k_wall_w_ji >= k_wall_w_ji_m ) )  THEN
    3092                    inc        = -1
    3093                    wall_index =  i+1
    3094 !
    3095 !--                Store the kbounds for use in pmci_interp_tril_sn.
    3096                    logc_kbounds_w_n(1,i) = k_wall_w_ji + 1
    3097                    logc_kbounds_w_n(2,i) = k_wall_w_ji_p
    3098                    DO  k = logc_kbounds_w_n(1,i), logc_kbounds_w_n(2,i)
    3099                       CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
    3100                            k, i, inc, wall_index, z0_topo, kb, direction,      &
    3101                            ncorr )
    3102                       IF ( lc == -99 )  THEN
    3103 !                         
    3104 !--                      The pivot point is out of subdomain, skip the correction.
    3105                          logc_w_n(2,k,i) = 0
    3106                          logc_ratio_w_n(2,0:ncorr-1,k,i) = 1.0_wp
    3107                       ELSE
    3108 !
    3109 !--                      The direction of the wall-normal index is stored as the
    3110 !--                      sign of the logc-element.
    3111                          logc_w_n(2,k,i) = inc * lc
    3112                          logc_ratio_w_n(2,0:ncorr-1,k,i) = lcr(0:ncorr-1)
    3113                       ENDIF
    3114                       lcr(0:ncorr-1) = 1.0_wp
    3115                    ENDDO
    3116                 ENDIF
    3117 
    3118              ENDDO
    3119 
    3120           ENDIF   !  IF ( bc_dirichlet_n )
    3121 
    3122        ENDIF   !  IF ( topography /= 'flat' )
    3123 
    3124     END SUBROUTINE pmci_init_loglaw_correction
    3125 
    3126 
    3127 
    3128     SUBROUTINE pmci_define_loglaw_correction_parameters( lc, lcr, k, ij, inc,  &
    3129          wall_index, z0_l, kb, direction, ncorr )
    3130 
    3131        IMPLICIT NONE
    3132 
    3133        INTEGER(iwp), INTENT(IN)  ::  direction                 !<
    3134        INTEGER(iwp), INTENT(IN)  ::  ij                        !<
    3135        INTEGER(iwp), INTENT(IN)  ::  inc                       !<
    3136        INTEGER(iwp), INTENT(IN)  ::  k                         !<
    3137        INTEGER(iwp), INTENT(IN)  ::  kb                        !<
    3138        INTEGER(iwp), INTENT(OUT) ::  lc                        !<
    3139        INTEGER(iwp), INTENT(IN)  ::  ncorr                     !<
    3140        INTEGER(iwp), INTENT(IN)  ::  wall_index                !<
    3141 
    3142        INTEGER(iwp) ::  alcorr                                 !<
    3143        INTEGER(iwp) ::  corr_index                             !<
    3144        INTEGER(iwp) ::  lcorr                                  !<
    3145 
    3146        LOGICAL      ::  more                                   !<             
    3147 
    3148        REAL(wp), DIMENSION(0:ncorr-1), INTENT(INOUT) ::  lcr   !<
    3149        REAL(wp), INTENT(IN)      ::  z0_l                      !<
    3150      
    3151        REAL(wp)     ::  logvelc1                               !<
    3152      
    3153 
    3154        SELECT CASE ( direction )
    3155 
    3156           CASE (1)   !  k
    3157              more = .TRUE.
    3158              lcorr = 0
    3159              DO  WHILE ( more .AND. lcorr <= ncorr-1 )
    3160                 corr_index = k + lcorr
    3161                 IF ( lcorr == 0 )  THEN
    3162                    CALL pmci_find_logc_pivot_k( lc, logvelc1, z0_l, kb )
    3163                 ENDIF
    3164                
    3165                 IF ( corr_index < lc )  THEN
    3166                    lcr(lcorr) = LOG( ( zu(k) - zw(kb) ) / z0_l ) / logvelc1
    3167                    more = .TRUE.
    3168                 ELSE
    3169                    lcr(lcorr) = 1.0_wp
    3170                    more = .FALSE.
    3171                 ENDIF
    3172                 lcorr = lcorr + 1
    3173              ENDDO
    3174 
    3175           CASE (2)   !  j
    3176              more = .TRUE.
    3177              lcorr  = 0
    3178              alcorr = 0
    3179              DO  WHILE ( more  .AND.  alcorr <= ncorr-1 )
    3180                 corr_index = ij + lcorr   ! In this case (direction = 2) ij is j
    3181                 IF ( lcorr == 0 )  THEN
    3182                    CALL pmci_find_logc_pivot_j( lc, logvelc1, ij, wall_index,  &
    3183                                                 z0_l, inc )
    3184                 ENDIF
    3185 !
    3186 !--             The role of inc here is to make the comparison operation "<"
    3187 !--             valid in both directions
    3188                 IF ( ( inc * corr_index < inc * lc ) .AND. ( lc /= -99 ) )  THEN
    3189                    lcr(alcorr) = LOG( ABS( coord_y(corr_index) + 0.5_wp * dy   &
    3190                                          - coord_y(wall_index) ) / z0_l )      &
    3191                                  / logvelc1
    3192                    more = .TRUE.
    3193                 ELSE
    3194                    lcr(alcorr) = 1.0_wp
    3195                    more = .FALSE.
    3196                 ENDIF
    3197                 lcorr  = lcorr + inc
    3198                 alcorr = ABS( lcorr )
    3199              ENDDO
    3200 
    3201           CASE (3)   !  i
    3202              more = .TRUE.
    3203              lcorr  = 0
    3204              alcorr = 0
    3205              DO  WHILE ( more  .AND.  alcorr <= ncorr-1 )
    3206                 corr_index = ij + lcorr   ! In this case (direction = 3) ij is i
    3207                 IF ( lcorr == 0 )  THEN
    3208                    CALL pmci_find_logc_pivot_i( lc, logvelc1, ij, wall_index,  &
    3209                                                 z0_l, inc )
    3210                 ENDIF
    3211 !
    3212 !--             The role of inc here is to make the comparison operation "<"
    3213 !--             valid in both directions
    3214                 IF ( ( inc * corr_index < inc * lc ) .AND. ( lc /= -99 ) )  THEN
    3215                    lcr(alcorr) = LOG( ABS( coord_x(corr_index) + 0.5_wp * dx   &
    3216                                          - coord_x(wall_index) ) / z0_l )      &
    3217                                  / logvelc1
    3218                    more = .TRUE.
    3219                 ELSE
    3220                    lcr(alcorr) = 1.0_wp
    3221                    more = .FALSE.
    3222                 ENDIF
    3223                 lcorr  = lcorr + inc
    3224                 alcorr = ABS( lcorr )
    3225              ENDDO
    3226 
    3227        END SELECT
    3228 
    3229     END SUBROUTINE pmci_define_loglaw_correction_parameters
    3230 
    3231 
    3232 
    3233     SUBROUTINE pmci_find_logc_pivot_k( lc, logzc1, z0_l, kb )
    3234 !
    3235 !--    Finds the pivot node and the log-law factor for near-wall nodes for
    3236 !--    which the wall-parallel velocity components will be log-law corrected
    3237 !--    after interpolation. This subroutine is only for horizontal walls.
    3238 
    3239        IMPLICIT NONE
    3240 
    3241        INTEGER(iwp), INTENT(IN)  ::  kb   !<
    3242        INTEGER(iwp), INTENT(OUT) ::  lc   !<
    3243 
    3244        INTEGER(iwp) ::  kbc               !<
    3245        INTEGER(iwp) ::  k1                !<
    3246 
    3247        REAL(wp), INTENT(OUT) ::  logzc1   !<
    3248        REAL(wp), INTENT(IN)  ::  z0_l     !<
    3249 
    3250        REAL(wp) ::  zuc1                  !<
    3251 
    3252 !
    3253 !--    kbc is the first coarse-grid point above the surface
    3254        kbc = nzb + 1
    3255        DO  WHILE ( cg%zu(kbc) < zu(kb) )
    3256           kbc = kbc + 1
    3257        ENDDO
    3258        zuc1  = cg%zu(kbc)
    3259        k1    = kb + 1
    3260        DO  WHILE ( zu(k1) < zuc1 )  !  Important: must be <, not <=
    3261           k1 = k1 + 1
    3262        ENDDO
    3263        logzc1 = LOG( (zu(k1) - zw(kb) ) / z0_l )
    3264        lc = k1
    3265 
    3266     END SUBROUTINE pmci_find_logc_pivot_k
    3267 
    3268 
    3269 
    3270     SUBROUTINE pmci_find_logc_pivot_j( lc, logyc1, j, jw, z0_l, inc )
    3271 !
    3272 !--    Finds the pivot node and the log-law factor for near-wall nodes for
    3273 !--    which the wall-parallel velocity components will be log-law corrected
    3274 !--    after interpolation. This subroutine is only for vertical walls on
    3275 !--    south/north sides of the node. If the pivot node is found to be outside
    3276 !--    the subdomain, a marker value of -99 is set to lc and this tells
    3277 !--    pmci_init_loglaw_correction to not do the correction in this case.
    3278      
    3279        IMPLICIT NONE
    3280 
    3281        INTEGER(iwp), INTENT(IN)  ::  inc    !<  increment must be 1 or -1.
    3282        INTEGER(iwp), INTENT(IN)  ::  j      !<
    3283        INTEGER(iwp), INTENT(IN)  ::  jw     !<
    3284        INTEGER(iwp), INTENT(OUT) ::  lc     !<
    3285 
    3286        INTEGER(iwp) ::  jwc                 !<
    3287        INTEGER(iwp) ::  j1                  !<
    3288 
    3289        REAL(wp), INTENT(IN)  ::  z0_l       !<
    3290        REAL(wp), INTENT(OUT) ::  logyc1     !<
    3291 
    3292        REAL(wp) ::  ycb                     !<       
    3293        REAL(wp) ::  yc1                     !<
    3294        
    3295 !
    3296 !--    yc1 is the y-coordinate of the first coarse-grid u- and w-nodes out from
    3297 !--    the wall. Here we assume that the wall index in the coarse grid is the
    3298 !--    closest one if they don't match.
    3299        jwc  = pmci_find_nearest_coarse_grid_index_j( jw )
    3300        yc1  = cg%coord_y(jwc) - lower_left_coord_y + 0.5_wp * inc * cg%dy
    3301 !       
    3302 !--    Check if yc1 is out of the subdomain y-range. In such case set the marker
    3303 !--    value -99 for lc in order to skip the loglaw-correction locally.
    3304        IF ( yc1 < ( REAL( nysg, KIND=wp ) + 0.5_wp ) * dy  )  THEN
    3305           lc = -99
    3306           logyc1 = 1.0_wp
    3307        ELSE IF ( yc1 > ( REAL( nyng, KIND=wp ) + 0.5_wp ) * dy )  THEN
    3308           lc = -99
    3309           logyc1 = 1.0_wp
    3310        ELSE
    3311 !
    3312 !--       j1 is the first fine-grid index further away from the wall than yc1
    3313           j1 = j
    3314 !
    3315 !--       Important: the binary relation must be <, not <=
    3316           ycb = 0.5_wp * dy - lower_left_coord_y
    3317           DO  WHILE ( inc * ( coord_y(j1) + ycb ) < inc * yc1 )
    3318              j1 = j1 + inc
    3319           ENDDO
    3320          
    3321           logyc1 = LOG( ABS( coord_y(j1) + 0.5_wp * dy - coord_y(jw) ) / z0_l )
    3322           lc = j1
    3323        ENDIF
    3324        
    3325     END SUBROUTINE pmci_find_logc_pivot_j
    3326 
    3327 
    3328 
    3329     SUBROUTINE pmci_find_logc_pivot_i( lc, logxc1, i, iw, z0_l, inc )
    3330 !
    3331 !--    Finds the pivot node and the log-law factor for near-wall nodes for
    3332 !--    which the wall-parallel velocity components will be log-law corrected
    3333 !--    after interpolation. This subroutine is only for vertical walls on
    3334 !--    left/right sides of the node. If the pivot node is found to be outside
    3335 !--    the subdomain, a marker value of -99 is set to lc and this tells
    3336 !--    pmci_init_loglaw_correction to not do the correction in this case.
    3337 
    3338        IMPLICIT NONE
    3339 
    3340        INTEGER(iwp), INTENT(IN)  ::  i      !<
    3341        INTEGER(iwp), INTENT(IN)  ::  inc    !< increment must be 1 or -1.
    3342        INTEGER(iwp), INTENT(IN)  ::  iw     !<
    3343        INTEGER(iwp), INTENT(OUT) ::  lc     !<
    3344 
    3345        INTEGER(iwp) ::  iwc                 !<
    3346        INTEGER(iwp) ::  i1                  !<
    3347 
    3348        REAL(wp), INTENT(IN)  ::  z0_l       !<
    3349        REAL(wp), INTENT(OUT) ::  logxc1     !<
    3350 
    3351        REAL(wp) ::  xcb                     !<
    3352        REAL(wp) ::  xc1                     !<
    3353 
    3354 !
    3355 !--    xc1 is the x-coordinate of the first coarse-grid v- and w-nodes out from
    3356 !--    the wall. Here we assume that the wall index in the coarse grid is the
    3357 !--    closest one if they don't match.
    3358        iwc  = pmci_find_nearest_coarse_grid_index_i( iw )
    3359        xc1  = cg%coord_x(iwc) - lower_left_coord_x + 0.5_wp * inc * cg%dx
    3360 !       
    3361 !--    Check if xc1 is out of the subdomain x-range. In such case set the marker
    3362 !--    value -99 for lc in order to skip the loglaw-correction locally.       
    3363        IF ( xc1 < ( REAL( nxlg, KIND=wp ) + 0.5_wp ) * dx  )  THEN
    3364           lc = -99
    3365           logxc1 = 1.0_wp
    3366        ELSE IF ( xc1 > ( REAL( nxrg, KIND=wp ) + 0.5_wp ) * dx )  THEN
    3367           lc = -99
    3368           logxc1 = 1.0_wp
    3369        ELSE   
    3370 !
    3371 !--       i1 is the first fine-grid index futher away from the wall than xc1.
    3372           i1 = i
    3373 !
    3374 !--       Important: the binary relation must be <, not <=
    3375           xcb = 0.5_wp * dx - lower_left_coord_x
    3376           DO  WHILE ( inc * ( coord_x(i1) + xcb ) < inc * xc1 )
    3377              i1 = i1 + inc
    3378           ENDDO
    3379      
    3380           logxc1 = LOG( ABS( coord_x(i1) + 0.5_wp*dx - coord_x(iw) ) / z0_l )
    3381           lc = i1
    3382        ENDIF
    3383        
    3384     END SUBROUTINE pmci_find_logc_pivot_i
    3385 
    3386 
    3387    
    3388     FUNCTION pmci_find_nearest_coarse_grid_index_j( jw )
    3389 
    3390       IMPLICIT NONE
    3391       INTEGER(iwp) :: jw         !< Fine-grid wall index
    3392 
    3393       INTEGER(iwp) :: jc
    3394       INTEGER(iwp) :: pmci_find_nearest_coarse_grid_index_j
    3395       REAL(wp) :: dist
    3396       REAL(wp) :: newdist
    3397 
    3398      
    3399       dist = coord_y(nyn) - coord_y(nys)
    3400       DO jc = jcs, jcn
    3401          newdist = ABS( cg%coord_y(jc) - coord_y(jw) )
    3402          IF ( newdist < dist )  THEN
    3403             pmci_find_nearest_coarse_grid_index_j = jc
    3404             dist = newdist
    3405          ENDIF
    3406       ENDDO
    3407      
    3408     END FUNCTION pmci_find_nearest_coarse_grid_index_j
    3409 
    3410 
    3411    
    3412     FUNCTION pmci_find_nearest_coarse_grid_index_i( iw )
    3413 
    3414       IMPLICIT NONE
    3415       INTEGER(iwp) :: iw         !< Fine-grid wall index
    3416 
    3417       INTEGER(iwp) :: ic
    3418       INTEGER(iwp) :: pmci_find_nearest_coarse_grid_index_i
    3419       REAL(wp) :: dist
    3420       REAL(wp) :: newdist
    3421 
    3422      
    3423       dist = coord_x(nxr) - coord_x(nxl)
    3424       DO ic = icl, icr
    3425          newdist = ABS( cg%coord_x(ic) - coord_x(iw) )
    3426          IF ( newdist < dist )  THEN
    3427             pmci_find_nearest_coarse_grid_index_i = ic
    3428             dist = newdist
    3429          ENDIF
    3430       ENDDO
    3431      
    3432     END FUNCTION pmci_find_nearest_coarse_grid_index_i
    3433 
    3434    
    3435      
    3436     SUBROUTINE pmci_init_anterp_tophat
    3437 !
    3438 !--    Precomputation of the child-array indices for
    3439 !--    corresponding coarse-grid array index and the
    3440 !--    Under-relaxation coefficients to be used by anterp_tophat.
    3441 
    3442        IMPLICIT NONE
    3443 
    3444        INTEGER(iwp) ::  i        !< Fine-grid index
    3445        INTEGER(iwp) ::  ii       !< Coarse-grid index
    3446        INTEGER(iwp) ::  istart   !<
    3447        INTEGER(iwp) ::  ir       !<
    3448        INTEGER(iwp) ::  iw       !< Fine-grid index limited to -1 <= iw <= nx+1
    3449        INTEGER(iwp) ::  j        !< Fine-grid index
    3450        INTEGER(iwp) ::  jj       !< Coarse-grid index
    3451        INTEGER(iwp) ::  jstart   !<
    3452        INTEGER(iwp) ::  jr       !<
    3453        INTEGER(iwp) ::  jw       !< Fine-grid index limited to -1 <= jw <= ny+1
    3454        INTEGER(iwp) ::  k        !< Fine-grid index
    3455        INTEGER(iwp) ::  kk       !< Coarse-grid index
    3456        INTEGER(iwp) ::  kstart   !<
    3457        INTEGER(iwp) ::  kw       !< Fine-grid index limited to kw <= nzt+1
    3458        REAL(wp)     ::  xi       !<
    3459        REAL(wp)     ::  eta      !<
    3460        REAL(wp)     ::  tolerance !<
    3461        REAL(wp)     ::  zeta     !<
    3462      
    3463 !
    3464 !--    Default values for under-relaxation lengths:
    3465        IF ( anterp_relax_length_l < 0.0_wp )  THEN
    3466           anterp_relax_length_l = 0.1_wp * ( nx + 1 ) * dx
    3467        ENDIF
    3468        IF ( anterp_relax_length_r < 0.0_wp )  THEN
    3469           anterp_relax_length_r = 0.1_wp * ( nx + 1 ) * dx
    3470        ENDIF
    3471        IF ( anterp_relax_length_s < 0.0_wp )  THEN
    3472           anterp_relax_length_s = 0.1_wp * ( ny + 1 ) * dy
    3473        ENDIF
    3474        IF ( anterp_relax_length_n < 0.0_wp )  THEN
    3475           anterp_relax_length_n = 0.1_wp * ( ny + 1 ) * dy
    3476        ENDIF
    3477        IF ( anterp_relax_length_t < 0.0_wp )  THEN
    3478           anterp_relax_length_t = 0.1_wp * zu(nzt)
    3479        ENDIF
     1560       CALL pmci_create_workarray_exchange_datatypes
    34801561!
    34811562!--    First determine kcto and kctw which refer to the uppermost
    … …  
    34921573       ENDDO
    34931574       kctw = kk - 1
    3494 !AH
    3495        write(9,"('kcto, kctw = ', 2(i3,2x))") kcto, kctw
    3496 
    3497 !AH
    3498 !       ALLOCATE( iflu(icl:icr) )
    3499 !       ALLOCATE( iflo(icl:icr) )
    3500 !       ALLOCATE( ifuu(icl:icr) )
    3501 !       ALLOCATE( ifuo(icl:icr) )
    3502 !       ALLOCATE( jflv(jcs:jcn) )
    3503 !       ALLOCATE( jflo(jcs:jcn) )
    3504 !       ALLOCATE( jfuv(jcs:jcn) )
    3505 !       ALLOCATE( jfuo(jcs:jcn) )
    3506 !       
    3507 !       ALLOCATE( iflu(icl-1:icr+1) )
    3508 !       ALLOCATE( iflo(icl-1:icr+1) )
    3509 !       ALLOCATE( ifuu(icl-1:icr+1) )
    3510 !       ALLOCATE( ifuo(icl-1:icr+1) )
    3511 !       ALLOCATE( jflv(jcs-1:jcn+1) )
    3512 !       ALLOCATE( jflo(jcs-1:jcn+1) )
    3513 !       ALLOCATE( jfuv(jcs-1:jcn+1) )
    3514 !       ALLOCATE( jfuo(jcs-1:jcn+1) )
    3515 !
     1575
     1576       WRITE(9,"('kcto, kctw = ', 2(i3,2x))") kcto, kctw
     1577       FLUSH(9)
     1578       
    35161579       icla = coarse_bound_aux(1)
    35171580       icra = coarse_bound_aux(2)
    … …  
    35261589       ALLOCATE( jfuv(jcsa:jcna) )
    35271590       ALLOCATE( jfuo(jcsa:jcna) )       
    3528 !AH
    35291591       ALLOCATE( kflw(0:cg%nz+1) )
    35301592       ALLOCATE( kflo(0:cg%nz+1) )
    35311593       ALLOCATE( kfuw(0:cg%nz+1) )
    35321594       ALLOCATE( kfuo(0:cg%nz+1) )
    3533 !AH
    3534 !       ALLOCATE( ijkfc_u(0:cg%nz+1,jcs:jcn,icl:icr) )
    3535 !       ALLOCATE( ijkfc_v(0:cg%nz+1,jcs:jcn,icl:icr) )
    3536 !       ALLOCATE( ijkfc_w(0:cg%nz+1,jcs:jcn,icl:icr) )
    3537 !       ALLOCATE( ijkfc_s(0:cg%nz+1,jcs:jcn,icl:icr) )
    3538 !
    3539 !       ALLOCATE( ijkfc_u(0:cg%nz+1,jcs-1:jcn+1,icl-1:icr+1) )
    3540 !       ALLOCATE( ijkfc_v(0:cg%nz+1,jcs-1:jcn+1,icl-1:icr+1) )
    3541 !       ALLOCATE( ijkfc_w(0:cg%nz+1,jcs-1:jcn+1,icl-1:icr+1) )
    3542 !       ALLOCATE( ijkfc_s(0:cg%nz+1,jcs-1:jcn+1,icl-1:icr+1) )
    3543 !
    35441595       ALLOCATE( ijkfc_u(0:cg%nz+1,jcsa:jcna,icla:icra) )
    35451596       ALLOCATE( ijkfc_v(0:cg%nz+1,jcsa:jcna,icla:icra) )
    35461597       ALLOCATE( ijkfc_w(0:cg%nz+1,jcsa:jcna,icla:icra) )
    35471598       ALLOCATE( ijkfc_s(0:cg%nz+1,jcsa:jcna,icla:icra) )
    3548 !AH
    35491599
    35501600       ijkfc_u = 0
    … …  
    35681618!
    35691619!--       Print out the index bounds for checking and debugging purposes
    3570           write(9,"('pmci_init_anterp_tophat, ii, iflu, ifuu: ', 3(i4,2x))")    &
     1620          WRITE(9,"('pmci_init_anterp_tophat, ii, iflu, ifuu: ', 3(i4,2x))")    &
    35711621               ii, iflu(ii), ifuu(ii)
    3572           flush(9)
    3573 
     1622          FLUSH(9)
    35741623       ENDDO
    3575        write(9,*)
     1624       WRITE(9,*)
    35761625!
    35771626!--    i-indices of others for each ii-index value
    … …  
    35941643!
    35951644!--       Print out the index bounds for checking and debugging purposes
    3596           write(9,"('pmci_init_anterp_tophat, ii, iflo, ifuo: ', 3(i4,2x))")    &
     1645          WRITE(9,"('pmci_init_anterp_tophat, ii, iflo, ifuo: ', 3(i4,2x))")    &
    35971646               ii, iflo(ii), ifuo(ii)
    3598           flush(9)
     1647          FLUSH(9)
    35991648       ENDDO
    3600        write(9,*)
     1649       WRITE(9,*)
    36011650!
    36021651!--    j-indices of v for each jj-index value
    … …  
    36151664!
    36161665!--       Print out the index bounds for checking and debugging purposes
    3617           write(9,"('pmci_init_anterp_tophat, jj, jflv, jfuv: ', 3(i4,2x))")    &
     1666          WRITE(9,"('pmci_init_anterp_tophat, jj, jflv, jfuv: ', 3(i4,2x))")    &
    36181667               jj, jflv(jj), jfuv(jj)
    3619           flush(9)
     1668          FLUSH(9)
    36201669       ENDDO
    3621        write(9,*)
     1670       WRITE(9,*)
    36221671!
    36231672!--    j-indices of others for each jj-index value
    … …  
    36401689!
    36411690!--       Print out the index bounds for checking and debugging purposes
    3642           write(9,"('pmci_init_anterp_tophat, jj, jflo, jfuo: ', 3(i4,2x))")    &
     1691          WRITE(9,"('pmci_init_anterp_tophat, jj, jflo, jfuo: ', 3(i4,2x))")    &
    36431692               jj, jflo(jj), jfuo(jj)
    3644           flush(9)
     1693          FLUSH(9)
    36451694       ENDDO
    3646        write(9,*)
     1695       WRITE(9,*)
    36471696!
    36481697!--    k-indices of w for each kk-index value
    … …  
    36651714!
    36661715!--       Print out the index bounds for checking and debugging purposes
    3667           write(9,"('pmci_init_anterp_tophat, kk, kflw, kfuw: ', 4(i4,2x), 2(e12.5,2x))") &
     1716          WRITE(9,"('pmci_init_anterp_tophat, kk, kflw, kfuw: ', 4(i4,2x), 2(e12.5,2x))") &
    36681717               kk, kflw(kk), kfuw(kk), nzt,  cg%zu(kk), cg%zw(kk)
    3669           flush(9)
     1718          FLUSH(9)
    36701719       ENDDO
    3671        write(9,*)
     1720       WRITE(9,*)
    36721721!
    36731722!--    k-indices of others for each kk-index value
    … …  
    36921741       ENDDO
    36931742!
    3694 !--    Set the k-index bounds separately for the parent-grid cells cg%nz and cg%nz+1.
    3695 !--    Index bounds for cg%nz are needed for the reversibility correction.
    3696        kflo(cg%nz)   = nzt+1    ! Needed for the reversibility correction
    3697        kfuo(cg%nz)   = nzt+kgsr ! Needed for the reversibility correction
    3698        kflo(cg%nz+1) = nzt+kgsr ! Obsolete
    3699        kfuo(cg%nz+1) = nzt+kgsr ! Obsolete
    3700 !
    3701 !--       Print out the index bounds for checking and debugging purposes
     1743!--    Set the k-index bounds separately for the parent-grid cells cg%nz and cg%nz+1     
     1744!--    although they are not actually needed.
     1745       kflo(cg%nz)   = nzt+1   
     1746       kfuo(cg%nz)   = nzt+kgsr
     1747       kflo(cg%nz+1) = nzt+kgsr
     1748       kfuo(cg%nz+1) = nzt+kgsr
     1749!
     1750!--    Print out the index bounds for checking and debugging purposes
    37021751       DO  kk = 1, cg%nz+1
    3703           write(9,"('pmci_init_anterp_tophat, kk, kflo, kfuo: ', 4(i4,2x), 2(e12.5,2x))") &
     1752          WRITE(9,"('pmci_init_anterp_tophat, kk, kflo, kfuo: ', 4(i4,2x), 2(e12.5,2x))") &
    37041753               kk, kflo(kk), kfuo(kk), nzt,  cg%zu(kk), cg%zw(kk)
    3705           flush(9)
     1754          FLUSH(9)
    37061755       ENDDO
    3707        write(9,*)
     1756       WRITE(9,*)
    37081757!
    37091758!--    Precomputation of number of fine-grid nodes inside parent-grid cells.
    37101759!--    Note that ii, jj, and kk are parent-grid indices.
    37111760!--    This information is needed in anterpolation and in reversibility
    3712 !--    correction in interpolation. For the reversibility correction, ijkfc-
    3713 !--    information is needed also beyond the indices for wall_flags_0-masking
    3714 !--    must be modified here in the boundary-normal direction (iw, jw, kw).
    3715 !AH       DO  ii = icl, icr
    3716 !AH          DO  jj = jcs, jcn
    3717 !AH       DO  ii = icl-1, icr+1
    3718 !AH          DO  jj = jcs-1, jcn+1
     1761!--    correction in interpolation.
    37191762       DO  ii = icla, icra
    37201763          DO  jj = jcsa, jcna
    … …  
    37761819          ENDDO  ! jj
    37771820       ENDDO  ! ii
    3778 !
    3779 !--    Spatial under-relaxation coefficients
    3780        ALLOCATE( frax(icl:icr) )
    3781        ALLOCATE( fray(jcs:jcn) )
     1821
     1822    END SUBROUTINE pmci_define_index_mapping
     1823   
     1824
     1825
     1826    SUBROUTINE pmci_allocate_workarrays
     1827!
     1828!--    Allocate parent-grid work-arrays for interpolation
     1829       IMPLICIT NONE
     1830
     1831!
     1832!--    Determine and store the PE-subdomain dependent index bounds
     1833       IF  ( bc_dirichlet_l )  THEN
     1834          iclw = icl + 1
     1835       ELSE
     1836          iclw = icl - 1
     1837       ENDIF
     1838
     1839       IF  ( bc_dirichlet_r )  THEN
     1840          icrw = icr - 1
     1841       ELSE
     1842          icrw = icr + 1
     1843       ENDIF
     1844
     1845       IF  ( bc_dirichlet_s )  THEN
     1846          jcsw = jcs + 1
     1847       ELSE
     1848          jcsw = jcs - 1
     1849       ENDIF
     1850
     1851       IF  ( bc_dirichlet_n )  THEN
     1852          jcnw = jcn - 1
     1853       ELSE
     1854          jcnw = jcn + 1
     1855       ENDIF
     1856   
     1857       coarse_bound_w(1) = iclw
     1858       coarse_bound_w(2) = icrw
     1859       coarse_bound_w(3) = jcsw
     1860       coarse_bound_w(4) = jcnw
     1861!
     1862!--    Left and right boundaries.
     1863       ALLOCATE( workarrc_lr(0:cg%nz+1,jcsw:jcnw,0:2) )
     1864!
     1865!--    South and north boundaries.
     1866       ALLOCATE( workarrc_sn(0:cg%nz+1,0:2,iclw:icrw) )
     1867!
     1868!--    Top boundary.
     1869!AH       ALLOCATE( workarrc_t(0:2,jcsw:jcnw,iclw:icrw) )
     1870       ALLOCATE( workarrc_t(-2:3,jcsw:jcnw,iclw:icrw) )
     1871
     1872    END SUBROUTINE pmci_allocate_workarrays
     1873
     1874
     1875
     1876    SUBROUTINE pmci_create_workarray_exchange_datatypes
     1877!
     1878!--    Define specific MPI types for workarrc-exhchange.
     1879       IMPLICIT NONE
     1880
     1881#if defined( __parallel )       
     1882!
     1883!--    For the left and right boundaries
     1884       CALL MPI_TYPE_VECTOR( 3, cg%nz+2, (jcnw-jcsw+1)*(cg%nz+2), MPI_REAL,     &
     1885            workarrc_lr_exchange_type, ierr )
     1886       CALL MPI_TYPE_COMMIT( workarrc_lr_exchange_type, ierr )
     1887!
     1888!--    For the south and north boundaries
     1889       CALL MPI_TYPE_VECTOR( 1, 3*(cg%nz+2), 3*(cg%nz+2), MPI_REAL,             &
     1890            workarrc_sn_exchange_type, ierr )
     1891       CALL MPI_TYPE_COMMIT( workarrc_sn_exchange_type, ierr )
     1892!
     1893!--    For the top-boundary x-slices
     1894!AH       CALL MPI_TYPE_VECTOR( icrw-iclw+1, 3, 3*(jcnw-jcsw+1), MPI_REAL,         &
     1895!AH            workarrc_t_exchange_type_x, ierr )
     1896       CALL MPI_TYPE_VECTOR( icrw-iclw+1, 6, 6*(jcnw-jcsw+1), MPI_REAL,         &
     1897            workarrc_t_exchange_type_x, ierr )
     1898       CALL MPI_TYPE_COMMIT( workarrc_t_exchange_type_x, ierr )
     1899!
     1900!--    For the top-boundary y-slices
     1901!AH       CALL MPI_TYPE_VECTOR( 1, 3*(jcnw-jcsw+1), 3*(jcnw-jcsw+1), MPI_REAL,     &
     1902!AH            workarrc_t_exchange_type_y, ierr )
     1903       CALL MPI_TYPE_VECTOR( 1, 6*(jcnw-jcsw+1), 6*(jcnw-jcsw+1), MPI_REAL,     &
     1904            workarrc_t_exchange_type_y, ierr )
     1905       CALL MPI_TYPE_COMMIT( workarrc_t_exchange_type_y, ierr )
     1906#endif
    37821907       
    3783        frax(icl:icr) = 1.0_wp
    3784        fray(jcs:jcn) = 1.0_wp
    3785 
    3786 !AH       IF ( nesting_mode /= 'vertical' )  THEN
    3787 !AH          DO  ii = icl, icr
    3788 !AH             IF ( ifuu(ii) < ( nx + 1 ) / 2 )  THEN   
    3789 !AH                xi = ( MAX( 0.0_wp, ( cg%coord_x(ii) -                         &
    3790 !AH                     lower_left_coord_x ) ) / anterp_relax_length_l )**4
    3791 !AH                frax(ii) = xi / ( 1.0_wp + xi )
    3792 !AH             ELSE
    3793 !AH                xi = ( MAX( 0.0_wp, ( lower_left_coord_x + ( nx + 1 ) * dx -   &
    3794 !AH                                      cg%coord_x(ii) ) ) /                     &
    3795 !AH                       anterp_relax_length_r )**4
    3796 !AH                frax(ii) = xi / ( 1.0_wp + xi )               
    3797 !AH             ENDIF
    3798 !AH          ENDDO
    3799 !AH
    3800 !AH          DO  jj = jcs, jcn
    3801 !AH             IF ( jfuv(jj) < ( ny + 1 ) / 2 )  THEN
    3802 !AH                eta = ( MAX( 0.0_wp, ( cg%coord_y(jj) -                        &
    3803 !AH                     lower_left_coord_y ) ) / anterp_relax_length_s )**4
    3804 !AH                fray(jj) = eta / ( 1.0_wp + eta )
    3805 !AH             ELSE
    3806 !AH                eta = ( MAX( 0.0_wp, ( lower_left_coord_y + ( ny + 1 ) * dy -  &
    3807 !AH                                       cg%coord_y(jj)) ) /                     &
    3808 !AH                        anterp_relax_length_n )**4
    3809 !AH                fray(jj) = eta / ( 1.0_wp + eta )
    3810 !AH             ENDIF
    3811 !AH          ENDDO
    3812 !AH       ENDIF
    3813      
    3814        ALLOCATE( fraz(0:kcto) )
    3815        fraz(0:kcto) = 1.0_wp
    3816 !AH       DO  kk = 0, kcto
    3817 !AH          zeta = ( ( zu(nzt) - cg%zu(kk) ) / anterp_relax_length_t )**4
    3818 !AH          fraz(kk) = zeta / ( 1.0_wp + zeta )
    3819 !AH       ENDDO
    3820 
    3821     END SUBROUTINE pmci_init_anterp_tophat
     1908    END SUBROUTINE pmci_create_workarray_exchange_datatypes
    38221909
    38231910
    … …  
    39212008     END SUBROUTINE pmci_check_grid_matching
    39222009
    3923 
    39242010#endif 
    39252011 END SUBROUTINE pmci_setup_child
    … …  
    40002086       pmc_max_array = pmc_max_array + nspec
    40012087#endif
     2088   
    40022089 END SUBROUTINE pmci_num_arrays
    40032090
    … …  
    40122099    INTEGER(iwp), INTENT(IN),OPTIONAL ::  n           !< index of chemical species
    40132100
    4014     CHARACTER(LEN=*), INTENT(IN) ::  name        !<
     2101    CHARACTER(LEN=*), INTENT(IN) ::  name             !<
    40152102
    40162103#if defined( __parallel )
    4017     INTEGER(iwp) ::  ierr        !<
     2104    INTEGER(iwp) ::  ierr                            !< MPI error code
    40182105
    40192106    REAL(wp), POINTER, DIMENSION(:,:)     ::  p_2d        !<
    … …  
    40272114    NULLIFY( p_2d )
    40282115    NULLIFY( i_2d )
    4029 
    40302116!
    40312117!-- List of array names, which can be coupled.
    … …  
    40462132    IF ( TRIM(name) == "part_adr"   )  i_2d => part_adr
    40472133    IF ( INDEX( TRIM(name), "chem_" ) /= 0 )  p_3d => chem_species(n)%conc
    4048 
    40492134!
    40502135!-- Next line is just an example for a 2D array (not active for coupling!)
    40512136!-- Please note, that z0 has to be declared as TARGET array in modules.f90
    40522137!    IF ( TRIM(name) == "z0" )    p_2d => z0
    4053 
    40542138    IF ( TRIM(name) == "u"    )  p_3d_sec => u_2
    40552139    IF ( TRIM(name) == "v"    )  p_3d_sec => v_2
    … …  
    40942178
    40952179
    4096 INTEGER FUNCTION get_number_of_childs ()
     2180INTEGER FUNCTION get_number_of_childs ()     ! Change the name to "get_number_of_children"
    40972181
    40982182   IMPLICIT NONE
    … …  
    41962280    NULLIFY( p_2d )
    41972281    NULLIFY( i_2d )
    4198 
    41992282!
    42002283!-- List of array names, which can be coupled
    … …  
    42862369    INTEGER(iwp) ::  child_id    !<
    42872370    INTEGER(iwp) ::  m           !<
    4288 
    42892371    REAL(wp) ::  waittime        !<
    42902372
    … …  
    43242406    INTEGER(iwp) ::  k          !<
    43252407    INTEGER(iwp) ::  n          !< running index for chemical species
    4326 
    43272408    REAL(wp) ::  waittime       !<
    43282409
    … …  
    43502431!
    43512432!--    The interpolation.
    4352        CALL pmci_interp_1sto_all ( u,  uc,  icu, jco, kco, r1xu, r2xu, r1yo,   &
    4353                                    r2yo, r1zo, r2zo, kcto, iflu, ifuu,         &
    4354                                    jflo, jfuo, kflo, kfuo, ijkfc_u, 'u' )
    4355        CALL pmci_interp_1sto_all ( v,  vc,  ico, jcv, kco, r1xo, r2xo, r1yv,   &
    4356                                    r2yv, r1zo, r2zo, kcto, iflo, ifuo,         &
    4357                                    jflv, jfuv, kflo, kfuo, ijkfc_v, 'v' )
    4358        CALL pmci_interp_1sto_all ( w,  wc,  ico, jco, kcw, r1xo, r2xo, r1yo,   &
    4359                                    r2yo, r1zw, r2zw, kctw, iflo, ifuo,         &
    4360                                    jflo, jfuo, kflw, kfuw, ijkfc_w, 'w' )
    4361 
    4362        IF ( (        rans_mode_parent  .AND.         rans_mode )  .OR.          &
    4363             (  .NOT. rans_mode_parent  .AND.  .NOT.  rans_mode  .AND.           &
     2433       CALL pmci_interp_1sto_all ( u, uc, kcto, iflu, ifuu, jflo, jfuo, kflo, kfuo, 'u' )
     2434       CALL pmci_interp_1sto_all ( v, vc, kcto, iflo, ifuo, jflv, jfuv, kflo, kfuo, 'v' )
     2435       CALL pmci_interp_1sto_all ( w, wc, kctw, iflo, ifuo, jflo, jfuo, kflw, kfuw, 'w' )
     2436
     2437       IF ( (        rans_mode_parent  .AND.         rans_mode )  .OR.                              &
     2438            (  .NOT. rans_mode_parent  .AND.  .NOT.  rans_mode  .AND.                               &
    43642439               .NOT. constant_diffusion ) )  THEN
    4365           CALL pmci_interp_1sto_all ( e,  ec,  ico, jco, kco, r1xo, r2xo, r1yo, &
    4366                                       r2yo, r1zo, r2zo, kcto, iflo, ifuo,       &
    4367                                       jflo, jfuo, kflo, kfuo, ijkfc_s, 'e' )
     2440          CALL pmci_interp_1sto_all ( e, ec, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 'e' )
    43682441       ENDIF
    43692442
    43702443       IF ( rans_mode_parent  .AND.  rans_mode  .AND.  rans_tke_e )  THEN
    4371           CALL pmci_interp_1sto_all ( diss,  dissc,  ico, jco, kco, r1xo, r2xo,&
    4372                                       r1yo, r2yo, r1zo, r2zo, kcto, iflo, ifuo,&
    4373                                       jflo, jfuo, kflo, kfuo, ijkfc_s, 's' )
     2444          CALL pmci_interp_1sto_all ( diss, dissc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 's' )
    43742445       ENDIF
    43752446
    43762447       IF ( .NOT. neutral )  THEN
    4377           CALL pmci_interp_1sto_all ( pt, ptc, ico, jco, kco, r1xo, r2xo,      &
    4378                                       r1yo, r2yo, r1zo, r2zo, kcto, iflo, ifuo,&
    4379                                       jflo, jfuo, kflo, kfuo, ijkfc_s, 's' )
     2448          CALL pmci_interp_1sto_all ( pt, ptc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 's' )
    43802449       ENDIF
    43812450
    43822451       IF ( humidity )  THEN
    43832452
    4384           CALL pmci_interp_1sto_all ( q, q_c, ico, jco, kco, r1xo, r2xo, r1yo, &
    4385                                       r2yo, r1zo, r2zo, kcto, iflo, ifuo,      &
    4386                                       jflo, jfuo, kflo, kfuo, ijkfc_s, 's' )
     2453          CALL pmci_interp_1sto_all ( q, q_c, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 's' )
    43872454
    43882455          IF ( bulk_cloud_model  .AND.  microphysics_morrison )  THEN
    4389              CALL pmci_interp_1sto_all ( qc, qcc, ico, jco, kco, r1xo, r2xo,   &
    4390                                          r1yo, r2yo, r1zo, r2zo, kcto,         &
    4391                                          iflo, ifuo, jflo, jfuo, kflo, kfuo,   &
    4392                                          ijkfc_s, 's' )
    4393              CALL pmci_interp_1sto_all ( nc, ncc, ico, jco, kco, r1xo, r2xo,   &
    4394                                          r1yo, r2yo, r1zo, r2zo, kcto,         &
    4395                                          iflo, ifuo, jflo, jfuo, kflo, kfuo,   &
    4396                                          ijkfc_s, 's' )   
     2456             CALL pmci_interp_1sto_all ( qc, qcc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 's' )
     2457             CALL pmci_interp_1sto_all ( nc, ncc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 's' )   
    43972458          ENDIF
    43982459
    43992460          IF ( bulk_cloud_model  .AND.  microphysics_seifert )  THEN
    4400              CALL pmci_interp_1sto_all ( qr, qrc, ico, jco, kco, r1xo, r2xo,   &
    4401                                          r1yo, r2yo, r1zo, r2zo, kcto,         &
    4402                                          iflo, ifuo, jflo, jfuo, kflo, kfuo,   &
    4403                                          ijkfc_s, 's' )
    4404              CALL pmci_interp_1sto_all ( nr, nrc, ico, jco, kco, r1xo, r2xo,   &
    4405                                          r1yo, r2yo, r1zo, r2zo, kcto,         &
    4406                                          iflo, ifuo, jflo, jfuo, kflo, kfuo,   &
    4407                                          ijkfc_s, 's' )
     2461             CALL pmci_interp_1sto_all ( qr, qrc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 's' )
     2462             CALL pmci_interp_1sto_all ( nr, nrc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 's' )
    44082463          ENDIF
    44092464
    … …  
    44112466
    44122467       IF ( passive_scalar )  THEN
    4413           CALL pmci_interp_1sto_all ( s, sc, ico, jco, kco, r1xo, r2xo, r1yo,  &
    4414                                       r2yo, r1zo, r2zo, kcto, iflo, ifuo,      &
    4415                                       jflo, jfuo, kflo, kfuo, ijkfc_s, 's' )
     2468          CALL pmci_interp_1sto_all ( s, sc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 's' )
    44162469       ENDIF
    44172470
    44182471       IF ( air_chemistry  .AND.  nest_chemistry )  THEN
    44192472          DO  n = 1, nspec
    4420              CALL pmci_interp_1sto_all ( chem_species(n)%conc,                 &
    4421                                          chem_spec_c(:,:,:,n),                 &
    4422                                          ico, jco, kco, r1xo, r2xo, r1yo,      &
    4423                                          r2yo, r1zo, r2zo, kcto, iflo, ifuo,   &
    4424                                          jflo, jfuo, kflo, kfuo, ijkfc_s, 's' )
     2473             CALL pmci_interp_1sto_all ( chem_species(n)%conc, chem_spec_c(:,:,:,n),                &
     2474                                         kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 's' )
    44252475          ENDDO
    44262476       ENDIF
    … …  
    44602510
    44612511
    4462     SUBROUTINE pmci_interp_1sto_all( f, fc, ic, jc, kc, r1x, r2x, r1y, r2y,    &
    4463                                      r1z, r2z, kct, ifl, ifu, jfl, jfu,        &
    4464                                      kfl, kfu, ijkfc, var )
     2512    SUBROUTINE pmci_interp_1sto_all( f, fc, kct, ifl, ifu, jfl, jfu, kfl, kfu, var )
    44652513!
    44662514!--    Interpolation of the internal values for the child-domain initialization
    44672515       IMPLICIT NONE
    44682516
    4469        CHARACTER(LEN=1), INTENT(IN) :: var  !<
    4470 
    4471        INTEGER(iwp), DIMENSION(nxlfc:nxrfc), INTENT(IN)         ::  ic    !<
    4472        INTEGER(iwp), DIMENSION(nysfc:nynfc), INTENT(IN)         ::  jc    !<
    4473 !AH       INTEGER(iwp), DIMENSION(nzb:nzt+1), INTENT(IN)           ::  kc    !<
    4474        INTEGER(iwp), DIMENSION(nzb:nzt+kgsr), INTENT(IN)        ::  kc    !<
    4475 
    4476        REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(INOUT) :: f !<
    4477        REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr), INTENT(IN) :: fc       !<
    4478        REAL(wp), DIMENSION(nxlfc:nxrfc), INTENT(IN)  :: r1x   !<
    4479        REAL(wp), DIMENSION(nxlfc:nxrfc), INTENT(IN)  :: r2x   !<
    4480        REAL(wp), DIMENSION(nysfc:nynfc), INTENT(IN)  :: r1y   !<
    4481        REAL(wp), DIMENSION(nysfc:nynfc), INTENT(IN)  :: r2y   !<
    4482        REAL(wp), DIMENSION(nzb:nzt+kgsr), INTENT(IN) :: r1z   !<
    4483        REAL(wp), DIMENSION(nzb:nzt+kgsr), INTENT(IN) :: r2z   !<
    4484 
    4485        INTEGER(iwp) :: kct
    4486 !AH       INTEGER(iwp), DIMENSION(icl:icr), INTENT(IN) ::  ifl !< Indicates start index of child cells belonging to certain parent cell - x direction
    4487 !AH       INTEGER(iwp), DIMENSION(icl:icr), INTENT(IN) ::  ifu !< Indicates end index of child cells belonging to certain parent cell - x direction
    4488 !AH       INTEGER(iwp), DIMENSION(jcs:jcn), INTENT(IN) ::  jfl !< Indicates start index of child cells belonging to certain parent cell - y direction
    4489 !AH       INTEGER(iwp), DIMENSION(jcs:jcn), INTENT(IN) ::  jfu !< Indicates start index of child cells belonging to certain parent cell - y direction
     2517       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(INOUT) :: f  !< Child-grid array
     2518       REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr), INTENT(IN) :: fc        !< Parent-grid array
     2519       INTEGER(iwp) :: kct                                    !< The parent-grid index in z-direction just below the boundary value node
    44902520       INTEGER(iwp), DIMENSION(icla:icra), INTENT(IN) ::  ifl !< Indicates start index of child cells belonging to certain parent cell - x direction
    44912521       INTEGER(iwp), DIMENSION(icla:icra), INTENT(IN) ::  ifu !< Indicates end index of child cells belonging to certain parent cell - x direction
    44922522       INTEGER(iwp), DIMENSION(jcsa:jcna), INTENT(IN) ::  jfl !< Indicates start index of child cells belonging to certain parent cell - y direction
    4493        INTEGER(iwp), DIMENSION(jcsa:jcna), INTENT(IN) ::  jfu !< Indicates start index of child cells belonging to certain parent cell - y direction
     2523       INTEGER(iwp), DIMENSION(jcsa:jcna), INTENT(IN) ::  jfu !< Indicates end index of child cells belonging to certain parent cell - y direction
    44942524       INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN) ::  kfl !< Indicates start index of child cells belonging to certain parent cell - z direction
    4495        INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN) ::  kfu !< Indicates start index of child cells belonging to certain parent cell - z direction
    4496 !AH
    4497 !       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
    4498        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
    4499 !AH
    4500 
     2525       INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN) ::  kfu !< Indicates end index of child cells belonging to certain parent cell - z direction
     2526       CHARACTER(LEN=1), INTENT(IN) :: var                    !< Variable symbol: 'u', 'v', 'w' or 's'
     2527!
     2528!--    Local variables:
    45012529       INTEGER(iwp) ::  i        !<
    45022530       INTEGER(iwp) ::  ib       !<
    … …  
    45172545       INTEGER(iwp) ::  me       !<
    45182546       INTEGER(iwp) ::  n        !<
    4519        INTEGER(iwp) ::  var_flag !<
    45202547
    45212548
    … …  
    45582585             jlast = nyn + 1
    45592586          ENDIF
    4560        ENDIF
    4561 !
    4562 !--    Is masking needed here, think about it.
    4563        IF ( var == 'u' )  THEN
    4564           var_flag = 1
    4565        ELSEIF ( var == 'v' )  THEN
    4566           var_flag = 2
    4567        ELSEIF ( var == 'w' )  THEN
    4568           var_flag = 3
    4569        ELSE
    4570           var_flag = 0
    4571        ENDIF       
     2587       ENDIF     
    45722588
    45732589       f(:,:,:) = 0.0_wp
    … …  
    50443060          IF ( bc_dirichlet_l )  THEN
    50453061
    5046              CALL pmci_interp_1sto_lr( u,  uc,  icu, jco, kco, r1xu, r2xu,      &
    5047                                        r1yo, r2yo, r1zo, r2zo,                  &
    5048                                        logc_u_l, logc_ratio_u_l,                &
    5049                                        logc_kbounds_u_l, nzt_topo_nestbc_l,     &
    5050                                        kcto, iflu, ifuu, jflo, jfuo, kflo,      &
    5051                                        kfuo, ijkfc_u, 'l', 'u' )
    5052 
    5053              CALL pmci_interp_1sto_lr( v,  vc,  ico, jcv, kco, r1xo, r2xo,      &
    5054                                        r1yv, r2yv, r1zo, r2zo,                  &
    5055                                        logc_v_l, logc_ratio_v_l,                &
    5056                                        logc_kbounds_v_l, nzt_topo_nestbc_l,     &
    5057                                        kcto, iflo, ifuo, jflv, jfuv, kflo,      &
    5058                                        kfuo, ijkfc_v, 'l', 'v' )
    5059 
    5060              CALL pmci_interp_1sto_lr( w,  wc,  ico, jco, kcw, r1xo, r2xo,      &
    5061                                        r1yo, r2yo, r1zw, r2zw,                  &
    5062                                        logc_w_l, logc_ratio_w_l,                &
    5063                                        logc_kbounds_w_l, nzt_topo_nestbc_l,     &
    5064                                        kctw, iflo, ifuo, jflo, jfuo, kflw,      &
    5065                                        kfuw, ijkfc_w, 'l', 'w' )
    5066 
    5067              IF ( (        rans_mode_parent  .AND.         rans_mode )  .OR.   &
    5068                   (  .NOT. rans_mode_parent  .AND.  .NOT.  rans_mode  .AND.    &
     3062             CALL pmci_interp_1sto_lr( u, uc, kcto, jflo, jfuo, kflo, kfuo, 'l', 'u' )
     3063             CALL pmci_interp_1sto_lr( v, vc, kcto, jflv, jfuv, kflo, kfuo, 'l', 'v' )
     3064             CALL pmci_interp_1sto_lr( w, wc, kctw, jflo, jfuo, kflw, kfuw, 'l', 'w' )
     3065
     3066             IF ( (        rans_mode_parent  .AND.         rans_mode )  .OR.                        &
     3067                  (  .NOT. rans_mode_parent  .AND.  .NOT.  rans_mode  .AND.                         &
    50693068                     .NOT. constant_diffusion ) )  THEN
    5070 !                CALL pmci_interp_1sto_lr( e,  ec,  ico, jco, kco, r1xo, r2xo,  &
    5071 !                                          r1yo, r2yo, r1zo, r2zo,              &
    5072 !                                          logc_w_l, logc_ratio_w_l,            &
    5073 !                                          logc_kbounds_w_l, nzt_topo_nestbc_l, &
    5074 !                                          kcto, iflo, ifuo, jflo, jfuo, kflo,  &
    5075 !                                          kfuo, ijkfc_s, 'l', 'e' )
     3069!                CALL pmci_interp_1sto_lr( e, ec, kcto, jflo, jfuo, kflo, kfuo, 'l', 'e' )
    50763070!
    50773071!--             Interpolation of e is replaced by the Neumann condition.
    … …  
    50833077
    50843078             IF ( rans_mode_parent  .AND.  rans_mode  .AND.  rans_tke_e )  THEN
    5085                 CALL pmci_interp_1sto_lr( diss,  dissc,  ico, jco, kco, r1xo,  &
    5086                                           r2xo, r1yo, r2yo, r1zo, r2zo,        &
    5087                                           logc_w_l, logc_ratio_w_l,            &
    5088                                           logc_kbounds_w_l, nzt_topo_nestbc_l, &
    5089                                           kcto, iflo, ifuo, jflo, jfuo, kflo,  &
    5090                                           kfuo, ijkfc_s, 'l', 's' )
     3079                CALL pmci_interp_1sto_lr( diss, dissc, kcto, jflo, jfuo, kflo, kfuo, 'l', 's' )
    50913080             ENDIF
    50923081
    50933082             IF ( .NOT. neutral )  THEN
    5094                 CALL pmci_interp_1sto_lr( pt, ptc, ico, jco, kco, r1xo, r2xo,  &
    5095                                           r1yo, r2yo, r1zo, r2zo,              &
    5096                                           logc_w_l, logc_ratio_w_l,            &
    5097                                           logc_kbounds_w_l, nzt_topo_nestbc_l, &
    5098                                           kcto, iflo, ifuo, jflo, jfuo, kflo,  &
    5099                                           kfuo, ijkfc_s, 'l', 's' )
     3083                CALL pmci_interp_1sto_lr( pt, ptc, kcto, jflo, jfuo, kflo, kfuo, 'l', 's' )
    51003084             ENDIF
    51013085
    51023086             IF ( humidity )  THEN
    51033087
    5104                 CALL pmci_interp_1sto_lr( q, q_c, ico, jco, kco, r1xo, r2xo,   &
    5105                                           r1yo, r2yo, r1zo, r2zo,              &
    5106                                           logc_w_l, logc_ratio_w_l,            &
    5107                                           logc_kbounds_w_l, nzt_topo_nestbc_l, &
    5108                                           kcto, iflo, ifuo, jflo, jfuo, kflo,  &
    5109                                           kfuo, ijkfc_s, 'l', 's' )
     3088                CALL pmci_interp_1sto_lr( q, q_c, kcto, jflo, jfuo, kflo, kfuo, 'l', 's' )
    51103089
    51113090                IF ( bulk_cloud_model  .AND.  microphysics_morrison )  THEN
    5112                    CALL pmci_interp_1sto_lr( qc, qcc, ico, jco, kco, r1xo,     &
    5113                                              r2xo, r1yo, r2yo, r1zo, r2zo,     &
    5114                                              logc_w_l, logc_ratio_w_l,         &
    5115                                              logc_kbounds_w_l,                 &
    5116                                              nzt_topo_nestbc_l,                &
    5117                                              kcto, iflo, ifuo, jflo, jfuo,     &
    5118                                              kflo, kfuo, ijkfc_s, 'l', 's' ) 
    5119 
    5120                    CALL pmci_interp_1sto_lr( nc, ncc, ico, jco, kco, r1xo,     &
    5121                                              r2xo, r1yo, r2yo, r1zo, r2zo,     &
    5122                                              logc_w_l, logc_ratio_w_l,         &
    5123                                              logc_kbounds_w_l,                 &
    5124                                              nzt_topo_nestbc_l,                &
    5125                                              kcto, iflo, ifuo, jflo, jfuo,     &
    5126                                              kflo, kfuo, ijkfc_s, 'l', 's' )         
     3091                   CALL pmci_interp_1sto_lr( qc, qcc, kcto, jflo, jfuo, kflo, kfuo, 'l', 's' ) 
     3092                   CALL pmci_interp_1sto_lr( nc, ncc, kcto, jflo, jfuo, kflo, kfuo, 'l', 's' )         
    51273093                ENDIF
    51283094
    51293095                IF ( bulk_cloud_model  .AND.  microphysics_seifert )  THEN
    5130                    CALL pmci_interp_1sto_lr( qr, qrc, ico, jco, kco, r1xo,     &
    5131                                              r2xo, r1yo, r2yo, r1zo, r2zo,     &
    5132                                              logc_w_l, logc_ratio_w_l,         &
    5133                                              logc_kbounds_w_l,                 &
    5134                                              nzt_topo_nestbc_l,                &
    5135                                              kcto, iflo, ifuo, jflo, jfuo,     &
    5136                                              kflo, kfuo, ijkfc_s, 'l', 's' )
    5137 
    5138                    CALL pmci_interp_1sto_lr( nr, nrc, ico, jco, kco, r1xo,     &
    5139                                              r2xo, r1yo, r2yo, r1zo, r2zo,     &
    5140                                              logc_w_l, logc_ratio_w_l,         &
    5141                                              logc_kbounds_w_l,                 &
    5142                                              nzt_topo_nestbc_l,                &
    5143                                              kcto, iflo, ifuo, jflo, jfuo,     &
    5144                                              kflo, kfuo, ijkfc_s, 'l', 's' )             
     3096                   CALL pmci_interp_1sto_lr( qr, qrc, kcto, jflo, jfuo, kflo, kfuo, 'l', 's' )
     3097                   CALL pmci_interp_1sto_lr( nr, nrc, kcto, jflo, jfuo, kflo, kfuo, 'l', 's' )             
    51453098                ENDIF
    51463099
    … …  
    51483101
    51493102             IF ( passive_scalar )  THEN
    5150                 CALL pmci_interp_1sto_lr( s, sc, ico, jco, kco, r1xo, r2xo,    &
    5151                                           r1yo, r2yo, r1zo, r2zo,              &
    5152                                           logc_w_l, logc_ratio_w_l,            &
    5153                                           logc_kbounds_w_l,                    &
    5154                                           nzt_topo_nestbc_l,                   &
    5155                                           kcto, iflo, ifuo, jflo, jfuo,        &
    5156                                           kflo, kfuo, ijkfc_s, 'l', 's' )
     3103                CALL pmci_interp_1sto_lr( s, sc, kcto, jflo, jfuo, kflo, kfuo, 'l', 's' )
    51573104             ENDIF
    51583105
    51593106             IF ( air_chemistry  .AND.  nest_chemistry )  THEN
    51603107                DO  n = 1, nspec
    5161                    CALL pmci_interp_1sto_lr( chem_species(n)%conc,             &
    5162                                              chem_spec_c(:,:,:,n),             &
    5163                                              ico, jco, kco, r1xo, r2xo,        &
    5164                                              r1yo, r2yo, r1zo, r2zo,           &
    5165                                              logc_w_l, logc_ratio_w_l,         &
    5166                                              logc_kbounds_w_l,                 &
    5167                                              nzt_topo_nestbc_l,                &
    5168                                              kcto, iflo, ifuo, jflo, jfuo,     &
    5169                                              kflo, kfuo, ijkfc_s, 'l', 's' )
     3108                   CALL pmci_interp_1sto_lr( chem_species(n)%conc, chem_spec_c(:,:,:,n),            &
     3109                        kcto, jflo, jfuo, kflo, kfuo, 'l', 's' )
    51703110                ENDDO
    51713111             ENDIF
    … …  
    51763116          IF ( bc_dirichlet_r )  THEN
    51773117             
    5178              CALL pmci_interp_1sto_lr( u,  uc,  icu, jco, kco, r1xu, r2xu,     &
    5179                                        r1yo, r2yo, r1zo, r2zo,                 &
    5180                                        logc_u_r, logc_ratio_u_r,               &
    5181                                        logc_kbounds_u_r, nzt_topo_nestbc_r,    &
    5182                                        kcto, iflu, ifuu, jflo, jfuo, kflo,     &
    5183                                        kfuo, ijkfc_u, 'r', 'u' )
    5184 
    5185              CALL pmci_interp_1sto_lr( v,  vc,  ico, jcv, kco, r1xo, r2xo,     &
    5186                                        r1yv, r2yv, r1zo, r2zo,                 &
    5187                                        logc_v_r, logc_ratio_v_r,               &
    5188                                        logc_kbounds_v_r, nzt_topo_nestbc_r,    &
    5189                                        kcto, iflo, ifuo, jflv, jfuv, kflo,     &
    5190                                        kfuo, ijkfc_v, 'r', 'v' )
    5191 
    5192              CALL pmci_interp_1sto_lr( w,  wc,  ico, jco, kcw, r1xo, r2xo,     &
    5193                                        r1yo, r2yo, r1zw, r2zw,                 &
    5194                                        logc_w_r, logc_ratio_w_r,               &
    5195                                        logc_kbounds_w_r, nzt_topo_nestbc_r,    &
    5196                                        kctw, iflo, ifuo, jflo, jfuo, kflw,     &
    5197                                        kfuw, ijkfc_w, 'r', 'w' )
    5198 
    5199              IF ( (        rans_mode_parent  .AND.         rans_mode )  .OR.   &
    5200                   (  .NOT. rans_mode_parent  .AND.  .NOT.  rans_mode  .AND.    &
     3118             CALL pmci_interp_1sto_lr( u, uc, kcto, jflo, jfuo, kflo, kfuo, 'r', 'u' )
     3119             CALL pmci_interp_1sto_lr( v, vc, kcto, jflv, jfuv, kflo, kfuo, 'r', 'v' )
     3120             CALL pmci_interp_1sto_lr( w, wc, kctw, jflo, jfuo, kflw, kfuw, 'r', 'w' )
     3121
     3122             IF ( (        rans_mode_parent  .AND.         rans_mode )  .OR.                        &
     3123                  (  .NOT. rans_mode_parent  .AND.  .NOT.  rans_mode  .AND.                         &
    52013124                     .NOT. constant_diffusion ) )  THEN
    5202 !                CALL pmci_interp_1sto_lr( e,  ec,  ico, jco, kco, r1xo, r2xo,  &
    5203 !                                          r1yo,r2yo, r1zo, r2zo,               &
    5204 !                                          logc_w_r, logc_ratio_w_r,            &
    5205 !                                          logc_kbounds_w_r, nzt_topo_nestbc_r, &
    5206 !                                          kcto, iflo, ifuo, jflo, jfuo, kflo,  &
    5207 !                                          kfuo, ijkfc_s, 'r', 'e' )
     3125!                CALL pmci_interp_1sto_lr( e, ec, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 'r', 'e' )
    52083126!
    52093127!--             Interpolation of e is replaced by the Neumann condition.
    … …  
    52143132
    52153133             IF ( rans_mode_parent  .AND.  rans_mode  .AND.  rans_tke_e )  THEN
    5216                 CALL pmci_interp_1sto_lr( diss,  dissc,  ico, jco, kco, r1xo,  &
    5217                                           r2xo, r1yo,r2yo, r1zo, r2zo,         &
    5218                                           logc_w_r, logc_ratio_w_r,            &
    5219                                           logc_kbounds_w_r, nzt_topo_nestbc_r, &
    5220                                           kcto, iflo, ifuo, jflo, jfuo, kflo,  &
    5221                                           kfuo, ijkfc_s, 'r', 's' )
     3134                CALL pmci_interp_1sto_lr( diss, dissc, kcto, jflo, jfuo, kflo, kfuo, 'r', 's' )
    52223135
    52233136             ENDIF
    52243137
    52253138             IF ( .NOT. neutral )  THEN
    5226                 CALL pmci_interp_1sto_lr( pt, ptc, ico, jco, kco, r1xo, r2xo,  &
    5227                                           r1yo, r2yo, r1zo, r2zo,              &
    5228                                           logc_w_r, logc_ratio_w_r,            &
    5229                                           logc_kbounds_w_r, nzt_topo_nestbc_r, &
    5230                                           kcto, iflo, ifuo, jflo, jfuo, kflo,  &
    5231                                           kfuo, ijkfc_s, 'r', 's' )
     3139                CALL pmci_interp_1sto_lr( pt, ptc, kcto, jflo, jfuo, kflo, kfuo, 'r', 's' )
    52323140             ENDIF
    52333141
    52343142             IF ( humidity )  THEN
    5235                 CALL pmci_interp_1sto_lr( q, q_c, ico, jco, kco, r1xo, r2xo,   &
    5236                                           r1yo, r2yo, r1zo, r2zo,              &
    5237                                           logc_w_r, logc_ratio_w_r,            &
    5238                                           logc_kbounds_w_r, nzt_topo_nestbc_r, &
    5239                                           kcto, iflo, ifuo, jflo, jfuo, kflo,  &
    5240                                           kfuo, ijkfc_s, 'r', 's' )
     3143                CALL pmci_interp_1sto_lr( q, q_c, kcto, jflo, jfuo, kflo, kfuo, 'r', 's' )
    52413144
    52423145                IF ( bulk_cloud_model  .AND.  microphysics_morrison )  THEN
    5243 
    5244                    CALL pmci_interp_1sto_lr( qc, qcc, ico, jco, kco, r1xo,     &
    5245                                              r2xo, r1yo, r2yo, r1zo, r2zo,     &
    5246                                              logc_w_r, logc_ratio_w_r,         &
    5247                                              logc_kbounds_w_r,                 &
    5248                                              nzt_topo_nestbc_r,                &
    5249                                              kcto, iflo, ifuo, jflo, jfuo,     &
    5250                                              kflo, kfuo, ijkfc_s, 'r', 's' )
    5251      
    5252                    CALL pmci_interp_1sto_lr( nc, ncc, ico, jco, kco, r1xo,     &
    5253                                              r2xo, r1yo, r2yo, r1zo, r2zo,     &
    5254                                              logc_w_r, logc_ratio_w_r,         &
    5255                                              logc_kbounds_w_r,                 &
    5256                                              nzt_topo_nestbc_r,                &
    5257                                              kcto, iflo, ifuo, jflo, jfuo,     &
    5258                                              kflo, kfuo, ijkfc_s, 'r', 's' )
    5259 
     3146                   CALL pmci_interp_1sto_lr( qc, qcc, kcto, jflo, jfuo, kflo, kfuo, 'r', 's' )
     3147                   CALL pmci_interp_1sto_lr( nc, ncc, kcto, jflo, jfuo, kflo, kfuo, 'r', 's' )
    52603148                ENDIF
    52613149
    52623150                IF ( bulk_cloud_model  .AND.  microphysics_seifert )  THEN
    5263 
    5264      
    5265                    CALL pmci_interp_1sto_lr( qr, qrc, ico, jco, kco, r1xo,     &
    5266                                              r2xo, r1yo, r2yo, r1zo, r2zo,     &
    5267                                              logc_w_r, logc_ratio_w_r,         &
    5268                                              logc_kbounds_w_r,                 &
    5269                                              nzt_topo_nestbc_r,                &
    5270                                              kcto, iflo, ifuo, jflo, jfuo,     &
    5271                                              kflo, kfuo, ijkfc_s,              &
    5272                                              'r', 's' )
    5273 
    5274                    CALL pmci_interp_1sto_lr( nr, nrc, ico, jco, kco, r1xo,     &
    5275                                              r2xo, r1yo, r2yo, r1zo, r2zo,     &
    5276                                              logc_w_r, logc_ratio_w_r,         &
    5277                                              logc_kbounds_w_r,                 &
    5278                                              nzt_topo_nestbc_r,                &
    5279                                              kcto, iflo, ifuo, jflo, jfuo,     &
    5280                                              kflo, kfuo, ijkfc_s, 'r', 's' )
    5281 
     3151                   CALL pmci_interp_1sto_lr( qr, qrc, kcto, jflo, jfuo, kflo, kfuo, 'r', 's' )
     3152                   CALL pmci_interp_1sto_lr( nr, nrc, kcto, jflo, jfuo, kflo, kfuo, 'r', 's' )
    52823153                ENDIF
    52833154
    … …  
    52853156
    52863157             IF ( passive_scalar )  THEN
    5287                 CALL pmci_interp_1sto_lr( s, sc, ico, jco, kco, r1xo, r2xo,    &
    5288                                           r1yo, r2yo, r1zo, r2zo,              &
    5289                                           logc_w_r, logc_ratio_w_r,            &
    5290                                           logc_kbounds_w_r,                    &
    5291                                           nzt_topo_nestbc_r,                   &
    5292                                           kcto, iflo, ifuo, jflo, jfuo,        &
    5293                                           kflo, kfuo, ijkfc_s, 'r', 's' )
     3158                CALL pmci_interp_1sto_lr( s, sc, kcto, jflo, jfuo, kflo, kfuo, 'r', 's' )
    52943159             ENDIF
    52953160
    52963161             IF ( air_chemistry  .AND.  nest_chemistry )  THEN
    52973162                DO  n = 1, nspec
    5298                    CALL pmci_interp_1sto_lr( chem_species(n)%conc,             &
    5299                                              chem_spec_c(:,:,:,n),             &
    5300                                              ico, jco, kco, r1xo, r2xo,        &
    5301                                              r1yo, r2yo, r1zo, r2zo,           &
    5302                                              logc_w_r, logc_ratio_w_r,         &
    5303                                              logc_kbounds_w_r,                 &
    5304                                              nzt_topo_nestbc_r,                &
    5305                                              kcto, iflo, ifuo, jflo, jfuo,     &
    5306                                              kflo, kfuo, ijkfc_s, 'r', 's' )
     3163                   CALL pmci_interp_1sto_lr( chem_species(n)%conc, chem_spec_c(:,:,:,n),            &
     3164                        kcto, jflo, jfuo, kflo, kfuo, 'r', 's' )
    53073165                ENDDO
    53083166             ENDIF
    … …  
    53123170          IF ( bc_dirichlet_s )  THEN
    53133171
    5314              CALL pmci_interp_1sto_sn( v,  vc,  ico, jcv, kco, r1xo, r2xo,     &
    5315                                        r1yv, r2yv, r1zo, r2zo,                 &
    5316                                        logc_v_s, logc_ratio_v_s,               &
    5317                                        logc_kbounds_v_s, nzt_topo_nestbc_s,    &
    5318                                        kcto, iflo, ifuo, jflv, jfuv, kflo,     &
    5319                                        kfuo, ijkfc_v, 's', 'v' )
    5320 
    5321              CALL pmci_interp_1sto_sn( w,  wc,  ico, jco, kcw, r1xo, r2xo,     &
    5322                                        r1yo, r2yo, r1zw, r2zw,                 &
    5323                                        logc_w_s, logc_ratio_w_s,               &
    5324                                        logc_kbounds_w_s, nzt_topo_nestbc_s,    &
    5325                                        kctw, iflo, ifuo, jflo, jfuo, kflw,     &
    5326                                        kfuw, ijkfc_w, 's','w' )
    5327 
    5328              CALL pmci_interp_1sto_sn( u,  uc,  icu, jco, kco, r1xu, r2xu,     &
    5329                                        r1yo, r2yo, r1zo, r2zo,                 &
    5330                                        logc_u_s, logc_ratio_u_s,               &
    5331                                        logc_kbounds_u_s, nzt_topo_nestbc_s,    &
    5332                                        kcto, iflu, ifuu, jflo, jfuo, kflo,     &
    5333                                        kfuo, ijkfc_u, 's', 'u' )
     3172             CALL pmci_interp_1sto_sn( v, vc, kcto, iflo, ifuo, kflo, kfuo, 's', 'v' )
     3173             CALL pmci_interp_1sto_sn( w, wc, kctw, iflo, ifuo, kflw, kfuw, 's', 'w' )
     3174             CALL pmci_interp_1sto_sn( u, uc, kcto, iflu, ifuu, kflo, kfuo, 's', 'u' )
    53343175
    53353176             IF ( (        rans_mode_parent  .AND.         rans_mode )  .OR.   &
    53363177                  (  .NOT. rans_mode_parent  .AND.  .NOT.  rans_mode  .AND.    &
    53373178                     .NOT. constant_diffusion ) )  THEN
    5338 !                CALL pmci_interp_1sto_sn( e,  ec,  ico, jco, kco, r1xo, r2xo,  &
    5339 !                                          r1yo, r2yo, r1zo, r2zo,              &
    5340 !                                          logc_w_s, logc_ratio_w_s,            &
    5341 !                                          logc_kbounds_w_s, nzt_topo_nestbc_s, &
    5342 !                                          kcto, iflo, ifuo, jflo, jfuo, kflo,  &
    5343 !                                          kfuo, ijkfc_s, 's', 'e' )
     3179!                CALL pmci_interp_1sto_sn( e, ec, kcto, iflo, ifuo, kflo, kfuo, 's', 'e' )
    53443180!
    53453181!--             Interpolation of e is replaced by the Neumann condition.
    … …  
    53503186
    53513187             IF ( rans_mode_parent  .AND.  rans_mode  .AND.  rans_tke_e )  THEN
    5352                 CALL pmci_interp_1sto_sn( diss, dissc,  ico, jco, kco, r1xo,   &
    5353                                           r2xo, r1yo, r2yo, r1zo, r2zo,        &
    5354                                           logc_w_s, logc_ratio_w_s,            &
    5355                                           logc_kbounds_w_s, nzt_topo_nestbc_s, &
    5356                                           kcto, iflo, ifuo, jflo, jfuo, kflo,  &
    5357                                           kfuo, ijkfc_s, 's', 's' )
     3188                CALL pmci_interp_1sto_sn( diss, dissc, kcto, iflo, ifuo, kflo, kfuo, 's', 's' )
    53583189             ENDIF
    53593190
    53603191             IF ( .NOT. neutral )  THEN
    5361                 CALL pmci_interp_1sto_sn( pt, ptc, ico, jco, kco, r1xo, r2xo,  &
    5362                                           r1yo, r2yo, r1zo, r2zo,              &
    5363                                           logc_w_s, logc_ratio_w_s,            &
    5364                                           logc_kbounds_w_s, nzt_topo_nestbc_s, &
    5365                                           kcto, iflo, ifuo, jflo, jfuo, kflo,  &
    5366                                           kfuo, ijkfc_s, 's', 's' )
     3192                CALL pmci_interp_1sto_sn( pt, ptc, kcto, iflo, ifuo, kflo, kfuo, 's', 's' )
    53673193             ENDIF
    53683194
    53693195             IF ( humidity )  THEN
    5370                 CALL pmci_interp_1sto_sn( q, q_c, ico, jco, kco, r1xo, r2xo,   &
    5371                                           r1yo,r2yo, r1zo, r2zo,               &
    5372                                           logc_w_s, logc_ratio_w_s,            &
    5373                                           logc_kbounds_w_s, nzt_topo_nestbc_s, &
    5374                                           kcto, iflo, ifuo, jflo, jfuo, kflo,  &
    5375                                           kfuo, ijkfc_s, 's', 's' )
     3196                CALL pmci_interp_1sto_sn( q, q_c, kcto, iflo, ifuo, kflo, kfuo, 's', 's' )
    53763197
    53773198                IF ( bulk_cloud_model  .AND.  microphysics_morrison )  THEN
    5378 
    5379                    CALL pmci_interp_1sto_sn( qc, qcc, ico, jco, kco, r1xo,     &
    5380                                              r2xo, r1yo,r2yo, r1zo, r2zo,      &
    5381                                              logc_w_s, logc_ratio_w_s,         &
    5382                                              logc_kbounds_w_s,                 &
    5383                                              nzt_topo_nestbc_s,                &
    5384                                              kcto, iflo, ifuo, jflo, jfuo,     &
    5385                                              kflo, kfuo, ijkfc_s, 's', 's' )
    5386 
    5387                    CALL pmci_interp_1sto_sn( nc, ncc, ico, jco, kco, r1xo,     &
    5388                                              r2xo, r1yo,r2yo, r1zo, r2zo,      &
    5389                                              logc_w_s, logc_ratio_w_s,         &
    5390                                              logc_kbounds_w_s,                 &
    5391                                              nzt_topo_nestbc_s,                &
    5392                                              kcto, iflo, ifuo, jflo, jfuo,     &
    5393                                              kflo, kfuo, ijkfc_s, 's', 's' )
    5394 
     3199                   CALL pmci_interp_1sto_sn( qc, qcc, kcto, iflo, ifuo, kflo, kfuo, 's', 's' )
     3200                   CALL pmci_interp_1sto_sn( nc, ncc, kcto, iflo, ifuo, kflo, kfuo, 's', 's' )
    53953201                ENDIF
    53963202
    53973203                IF ( bulk_cloud_model  .AND.  microphysics_seifert )  THEN
    5398 
    5399                    CALL pmci_interp_1sto_sn( qr, qrc, ico, jco, kco, r1xo,     &
    5400                                              r2xo, r1yo,r2yo, r1zo, r2zo,      &
    5401                                              logc_w_s, logc_ratio_w_s,         &
    5402                                              logc_kbounds_w_s,                 &
    5403                                              nzt_topo_nestbc_s,                &
    5404                                              kcto, iflo, ifuo, jflo, jfuo,     &
    5405                                              kflo, kfuo, ijkfc_s, 's', 's' )
    5406 
    5407                    CALL pmci_interp_1sto_sn( nr, nrc, ico, jco, kco, r1xo,     &
    5408                                              r2xo, r1yo,r2yo, r1zo, r2zo,      &
    5409                                              logc_w_s, logc_ratio_w_s,         &
    5410                                              logc_kbounds_w_s,                 &
    5411                                              nzt_topo_nestbc_s,                &
    5412                                              kcto, iflo, ifuo, jflo, jfuo,     &
    5413                                              kflo, kfuo, ijkfc_s, 's', 's' )
    5414 
     3204                   CALL pmci_interp_1sto_sn( qr, qrc, kcto, iflo, ifuo, kflo, kfuo, 's', 's' )
     3205                   CALL pmci_interp_1sto_sn( nr, nrc, kcto, iflo, ifuo, kflo, kfuo, 's', 's' )
    54153206                ENDIF
    54163207
    … …  
    54183209
    54193210             IF ( passive_scalar )  THEN
    5420                 CALL pmci_interp_1sto_sn( s, sc, ico, jco, kco, r1xo, r2xo,    &
    5421                                           r1yo,r2yo, r1zo, r2zo,               &
    5422                                           logc_w_s, logc_ratio_w_s,            &
    5423                                           logc_kbounds_w_s,                    &
    5424                                           nzt_topo_nestbc_s,                   &
    5425                                           kcto, iflo, ifuo, jflo, jfuo,        &
    5426                                           kflo, kfuo, ijkfc_s, 's', 's' )
     3211                CALL pmci_interp_1sto_sn( s, sc, kcto, iflo, ifuo, kflo, kfuo, 's', 's' )
    54273212             ENDIF
    54283213
    54293214             IF ( air_chemistry  .AND.  nest_chemistry )  THEN
    54303215                DO  n = 1, nspec
    5431                    CALL pmci_interp_1sto_sn( chem_species(n)%conc,             &
    5432                                              chem_spec_c(:,:,:,n),             &
    5433                                              ico, jco, kco, r1xo, r2xo,        &
    5434                                              r1yo, r2yo, r1zo, r2zo,           &
    5435                                              logc_w_s, logc_ratio_w_s,         &
    5436                                              logc_kbounds_w_s,                 &
    5437                                              nzt_topo_nestbc_s,                &
    5438                                              kcto, iflo, ifuo, jflo, jfuo,     &
    5439                                              kflo, kfuo, ijkfc_s, 's', 's' )
     3216                   CALL pmci_interp_1sto_sn( chem_species(n)%conc, chem_spec_c(:,:,:,n),            &
     3217                        kcto, iflo, ifuo, kflo, kfuo, 's', 's' )
    54403218                ENDDO
    54413219             ENDIF
    … …  
    54453223          IF ( bc_dirichlet_n )  THEN
    54463224             
    5447              CALL pmci_interp_1sto_sn( u,  uc,  icu, jco, kco, r1xu, r2xu,     &
    5448                                        r1yo, r2yo, r1zo, r2zo,                 &
    5449                                        logc_u_n, logc_ratio_u_n,               &
    5450                                        logc_kbounds_u_n, nzt_topo_nestbc_n,    &
    5451                                        kcto, iflu, ifuu, jflo, jfuo, kflo,     &
    5452                                        kfuo, ijkfc_u, 'n', 'u' )
    5453 
    5454              CALL pmci_interp_1sto_sn( v,  vc,  ico, jcv, kco, r1xo, r2xo,     &
    5455                                        r1yv, r2yv, r1zo, r2zo,                 &
    5456                                        logc_v_n, logc_ratio_v_n,               &
    5457                                        logc_kbounds_v_n, nzt_topo_nestbc_n,    &
    5458                                        kcto, iflo, ifuo, jflv, jfuv, kflo,     &
    5459                                        kfuo, ijkfc_v, 'n', 'v' )
    5460 
    5461              CALL pmci_interp_1sto_sn( w,  wc,  ico, jco, kcw, r1xo, r2xo,     &
    5462                                        r1yo, r2yo, r1zw, r2zw,                 &
    5463                                        logc_w_n, logc_ratio_w_n,               &
    5464                                        logc_kbounds_w_n, nzt_topo_nestbc_n,    &
    5465                                        kctw, iflo, ifuo, jflo, jfuo, kflw,     &
    5466                                        kfuw, ijkfc_w, 'n', 'w' )
    5467 
    5468              IF ( (        rans_mode_parent  .AND.         rans_mode )  .OR.   &
    5469                   (  .NOT. rans_mode_parent  .AND.  .NOT.  rans_mode  .AND.    &
     3225             CALL pmci_interp_1sto_sn( v, vc, kcto, iflo, ifuo, kflo, kfuo, 'n', 'v' )
     3226             CALL pmci_interp_1sto_sn( w, wc, kctw, iflo, ifuo, kflw, kfuw, 'n', 'w' )
     3227             CALL pmci_interp_1sto_sn( u, uc, kcto, iflu, ifuu, kflo, kfuo, 'n', 'u' )
     3228
     3229             IF ( (        rans_mode_parent  .AND.         rans_mode )  .OR.                        &
     3230                  (  .NOT. rans_mode_parent  .AND.  .NOT.  rans_mode  .AND.                         &
    54703231                     .NOT. constant_diffusion ) )  THEN
    5471 !                CALL pmci_interp_1sto_sn( e,  ec,  ico, jco, kco, r1xo, r2xo,  &
    5472 !                                          r1yo, r2yo, r1zo, r2zo,              &
    5473 !                                          logc_w_n, logc_ratio_w_n,            &
    5474 !                                          logc_kbounds_w_n, nzt_topo_nestbc_n, &
    5475 !                                          kcto, iflo, ifuo, jflo, jfuo, kflo,  &
    5476 !                                          kfuo, ijkfc_s, 'n', 'e' )
     3232!                CALL pmci_interp_1sto_sn( e, ec, kcto, iflo, ifuo, kflo, kfuo, 'n', 'e' )
    54773233!
    54783234!--             Interpolation of e is replaced by the Neumann condition.
    … …  
    54833239
    54843240             IF ( rans_mode_parent  .AND.  rans_mode  .AND.  rans_tke_e )  THEN
    5485                 CALL pmci_interp_1sto_sn( diss, dissc,  ico, jco, kco, r1xo,   &
    5486                                           r2xo, r1yo, r2yo, r1zo, r2zo,        &
    5487                                           logc_w_n, logc_ratio_w_n,            &
    5488                                           logc_kbounds_w_n, nzt_topo_nestbc_n, &
    5489                                           kcto, iflo, ifuo, jflo, jfuo, kflo,  &
    5490                                           kfuo, ijkfc_s, 'n', 's' )
    5491 
     3241                CALL pmci_interp_1sto_sn( diss, dissc, kcto, iflo, ifuo, kflo, kfuo, 'n', 's' )
    54923242             ENDIF
    54933243
    54943244             IF ( .NOT. neutral )  THEN
    5495                 CALL pmci_interp_1sto_sn( pt, ptc, ico, jco, kco, r1xo, r2xo,  &
    5496                                           r1yo, r2yo, r1zo, r2zo,              &
    5497                                           logc_w_n, logc_ratio_w_n,            &
    5498                                           logc_kbounds_w_n, nzt_topo_nestbc_n, &
    5499                                           kcto, iflo, ifuo, jflo, jfuo, kflo,  &
    5500                                           kfuo, ijkfc_s, 'n', 's' )
     3245                CALL pmci_interp_1sto_sn( pt, ptc, kcto, iflo, ifuo, kflo, kfuo, 'n', 's' )
    55013246             ENDIF
    55023247
    55033248             IF ( humidity )  THEN
    5504                 CALL pmci_interp_1sto_sn( q, q_c, ico, jco, kco, r1xo, r2xo,   &
    5505                                           r1yo, r2yo, r1zo, r2zo,              &
    5506                                           logc_w_n, logc_ratio_w_n,            &
    5507                                           logc_kbounds_w_n, nzt_topo_nestbc_n, &
    5508                                           kcto, iflo, ifuo, jflo, jfuo, kflo,  &
    5509                                           kfuo, ijkfc_s, 'n', 's' )
     3249                CALL pmci_interp_1sto_sn( q, q_c, kcto, iflo, ifuo, kflo, kfuo, 'n', 's' )
    55103250
    55113251                IF ( bulk_cloud_model  .AND.  microphysics_morrison )  THEN
    5512 
    5513                    CALL pmci_interp_1sto_sn( qc, qcc, ico, jco, kco, r1xo,     &
    5514                                              r2xo, r1yo, r2yo, r1zo, r2zo,     &
    5515                                              logc_w_n, logc_ratio_w_n,         &
    5516                                              logc_kbounds_w_n,                 &
    5517                                              nzt_topo_nestbc_n,                &
    5518                                              kcto, iflo, ifuo, jflo, jfuo,     &
    5519                                              kflo, kfuo, ijkfc_s, 'n', 's' )
    5520 
    5521                    CALL pmci_interp_1sto_sn( nc, ncc, ico, jco, kco, r1xo,     &
    5522                                              r2xo, r1yo, r2yo, r1zo, r2zo,     &
    5523                                              logc_u_n, logc_ratio_u_n,         &
    5524                                              logc_kbounds_w_n,                 &
    5525                                              nzt_topo_nestbc_n,                &
    5526                                              kcto, iflo, ifuo, jflo, jfuo,     &
    5527                                              kflo, kfuo, ijkfc_s, 'n', 's' )
    5528 
     3252                   CALL pmci_interp_1sto_sn( qc, qcc, kcto, iflo, ifuo, kflo, kfuo, 'n', 's' )
     3253                   CALL pmci_interp_1sto_sn( nc, ncc, kcto, iflo, ifuo, kflo, kfuo, 'n', 's' )
    55293254                ENDIF
    55303255
    55313256                IF ( bulk_cloud_model  .AND.  microphysics_seifert )  THEN
    5532 
    5533                    CALL pmci_interp_1sto_sn( qr, qrc, ico, jco, kco, r1xo,     &
    5534                                              r2xo, r1yo, r2yo, r1zo, r2zo,     &
    5535                                              logc_w_n, logc_ratio_w_n,         &
    5536                                              logc_kbounds_w_n,                 &
    5537                                              nzt_topo_nestbc_n,                &
    5538                                              kcto, iflo, ifuo, jflo, jfuo,     &
    5539                                              kflo, kfuo, ijkfc_s, 'n', 's' )
    5540 
    5541                    CALL pmci_interp_1sto_sn( nr, nrc, ico, jco, kco, r1xo,     &
    5542                                              r2xo, r1yo, r2yo, r1zo, r2zo,     &
    5543                                              logc_w_n, logc_ratio_w_n,         &
    5544                                              logc_kbounds_w_n,                 &
    5545                                              nzt_topo_nestbc_n,                &
    5546                                              kcto, iflo, ifuo, jflo, jfuo,     &
    5547                                              kflo, kfuo, ijkfc_s, 'n', 's' )
    5548 
     3257                   CALL pmci_interp_1sto_sn( qr, qrc, kcto, iflo, ifuo, kflo, kfuo, 'n', 's' )
     3258                   CALL pmci_interp_1sto_sn( nr, nrc, kcto, iflo, ifuo, kflo, kfuo, 'n', 's' )
    55493259                ENDIF
    55503260
    … …  
    55523262
    55533263             IF ( passive_scalar )  THEN
    5554                 CALL pmci_interp_1sto_sn( s, sc, ico, jco, kco, r1xo, r2xo,    &
    5555                                           r1yo, r2yo, r1zo, r2zo,              &
    5556                                           logc_w_n, logc_ratio_w_n,            &
    5557                                           logc_kbounds_w_n,                    &
    5558                                           nzt_topo_nestbc_n,                   &
    5559                                           kcto, iflo, ifuo, jflo, jfuo,        &
    5560                                           kflo, kfuo, ijkfc_s, 'n', 's' )
     3264                CALL pmci_interp_1sto_sn( s, sc, kcto, iflo, ifuo, kflo, kfuo, 'n', 's' )
    55613265             ENDIF
    55623266
    55633267             IF ( air_chemistry  .AND.  nest_chemistry )  THEN
    55643268                DO  n = 1, nspec
    5565                    CALL pmci_interp_1sto_sn( chem_species(n)%conc,             &
    5566                                              chem_spec_c(:,:,:,n),             &
    5567                                              ico, jco, kco, r1xo, r2xo,        &
    5568                                              r1yo, r2yo, r1zo, r2zo,           &
    5569                                              logc_w_n, logc_ratio_w_n,         &
    5570                                              logc_kbounds_w_n,                 &
    5571                                              nzt_topo_nestbc_n,                &
    5572                                              kcto, iflo, ifuo, jflo, jfuo,     &
    5573                                              kflo, kfuo, ijkfc_s, 'n', 's' )
     3269                   CALL pmci_interp_1sto_sn( chem_species(n)%conc, chem_spec_c(:,:,:,n),            &
     3270                        kcto, iflo, ifuo, kflo, kfuo, 'n', 's' )
    55743271                ENDDO
    55753272             ENDIF
    … …  
    55793276!
    55803277!--    All PEs are top-border PEs
    5581        CALL pmci_interp_1sto_t( w,  wc,  ico, jco, kcw, r1xo, r2xo, r1yo,      &
    5582                                 r2yo, r1zw, r2zw, kctw, iflo, ifuo,            &
    5583                                 jflo, jfuo, kflw, kfuw, ijkfc_w, 'w' )
    5584        CALL pmci_interp_1sto_t( u,  uc,  icu, jco, kco, r1xu, r2xu, r1yo,      &
    5585                                 r2yo, r1zo, r2zo, kcto, iflu, ifuu,            &
    5586                                 jflo, jfuo, kflo, kfuo, ijkfc_u, 'u' )
    5587        CALL pmci_interp_1sto_t( v,  vc,  ico, jcv, kco, r1xo, r2xo, r1yv,      &
    5588                                 r2yv, r1zo, r2zo, kcto, iflo, ifuo,            &
    5589                                 jflv, jfuv, kflo, kfuo, ijkfc_v, 'v' )
    5590 
     3278       CALL pmci_interp_1sto_t( w, wc, kctw, iflo, ifuo, jflo, jfuo, 'w' )
     3279       CALL pmci_interp_1sto_t( u, uc, kcto, iflu, ifuu, jflo, jfuo, 'u' )
     3280       CALL pmci_interp_1sto_t( v, vc, kcto, iflo, ifuo, jflv, jfuv, 'v' )
    55913281
    55923282       IF ( (        rans_mode_parent  .AND.         rans_mode )  .OR.         &
    55933283            (  .NOT. rans_mode_parent  .AND.  .NOT.  rans_mode  .AND.          &
    55943284               .NOT. constant_diffusion ) )  THEN
    5595 !          CALL pmci_interp_1sto_t( e,  ec,  ico, jco, kco, r1xo, r2xo, r1yo,   &
    5596 !                                   r2yo, r1zo, r2zo, kcto, iflo, ifuo,         &
    5597 !                                   jflo, jfuo, kflo, kfuo, ijkfc_s, 'e' )
     3285!          CALL pmci_interp_1sto_t( e, ec, kcto, iflo, ifuo, jflo, jfuo, 'e' )
    55983286!
    55993287!--       Interpolation of e is replaced by the Neumann condition.
    56003288          e(nzt+1,nys:nyn,nxl:nxr) = e(nzt,nys:nyn,nxl:nxr)
    5601 
    56023289       ENDIF
    56033290
    56043291       IF ( rans_mode_parent  .AND.  rans_mode  .AND.  rans_tke_e )  THEN
    5605           CALL pmci_interp_1sto_t( diss, dissc, ico, jco, kco, r1xo, r2xo,     &
    5606                                    r1yo, r2yo, r1zo, r2zo, kcto, iflo, ifuo,   &
    5607                                    jflo, jfuo, kflo, kfuo, ijkfc_s, 's' )
     3292          CALL pmci_interp_1sto_t( diss, dissc, kcto, iflo, ifuo, jflo, jfuo, 's' )
    56083293       ENDIF
    56093294
    56103295       IF ( .NOT. neutral )  THEN
    5611           CALL pmci_interp_1sto_t( pt, ptc, ico, jco, kco, r1xo, r2xo,         &
    5612                                    r1yo, r2yo, r1zo, r2zo, kcto, iflo, ifuo,   &
    5613                                    jflo, jfuo, kflo, kfuo, ijkfc_s, 's' )
     3296          CALL pmci_interp_1sto_t( pt, ptc, kcto, iflo, ifuo, jflo, jfuo, 's' )
    56143297       ENDIF
    56153298
    56163299       IF ( humidity )  THEN
    5617 
    5618           CALL pmci_interp_1sto_t( q, q_c, ico, jco, kco, r1xo, r2xo, r1yo,    &
    5619                                    r2yo, r1zo, r2zo, kcto, iflo, ifuo,         &
    5620                                    jflo, jfuo, kflo, kfuo, ijkfc_s, 's' )
    5621 
     3300          CALL pmci_interp_1sto_t( q, q_c, kcto, iflo, ifuo, jflo, jfuo, 's' )
    56223301          IF ( bulk_cloud_model  .AND.  microphysics_morrison )  THEN
    5623 
    5624              CALL pmci_interp_1sto_t( qc, qcc, ico, jco, kco, r1xo, r2xo, r1yo,&
    5625                                       r2yo, r1zo, r2zo, kcto, iflo, ifuo,      &
    5626                                       jflo, jfuo, kflo, kfuo, ijkfc_s, 's' )
    5627 
    5628              CALL pmci_interp_1sto_t( nc, ncc, ico, jco, kco, r1xo, r2xo, r1yo,&
    5629                                       r2yo, r1zo, r2zo, kcto, iflo, ifuo,      &
    5630                                       jflo, jfuo, kflo, kfuo, ijkfc_s, 's' )
    5631 
     3302             CALL pmci_interp_1sto_t( qc, qcc, kcto, iflo, ifuo, jflo, jfuo, 's' )
     3303             CALL pmci_interp_1sto_t( nc, ncc, kcto, iflo, ifuo, jflo, jfuo, 's' )
    56323304          ENDIF
    5633 
    56343305          IF ( bulk_cloud_model  .AND.  microphysics_seifert )  THEN
    5635 
    5636 
    5637              CALL pmci_interp_1sto_t( qr, qrc, ico, jco, kco, r1xo, r2xo, r1yo,&
    5638                                       r2yo, r1zo, r2zo, kcto, iflo, ifuo,      &
    5639                                       jflo, jfuo, kflo, kfuo, ijkfc_s, 's' )
    5640 
    5641              CALL pmci_interp_1sto_t( nr, nrc, ico, jco, kco, r1xo, r2xo, r1yo,&
    5642                                       r2yo, r1zo, r2zo, kcto, iflo, ifuo,      &
    5643                                       jflo, jfuo, kflo, kfuo, ijkfc_s, 's' )
    5644 
     3306             CALL pmci_interp_1sto_t( qr, qrc, kcto, iflo, ifuo, jflo, jfuo, 's' )
     3307             CALL pmci_interp_1sto_t( nr, nrc, kcto, iflo, ifuo, jflo, jfuo, 's' )
    56453308          ENDIF
    5646 
    56473309       ENDIF
    56483310
    56493311       IF ( passive_scalar )  THEN
    5650           CALL pmci_interp_1sto_t( s, sc, ico, jco, kco, r1xo, r2xo, r1yo,     &
    5651                                    r2yo, r1zo, r2zo, kcto, iflo, ifuo,         &
    5652                                    jflo, jfuo, kflo, kfuo, ijkfc_s, 's' )
     3312          CALL pmci_interp_1sto_t( s, sc, kcto, iflo, ifuo, jflo, jfuo, 's' )
    56533313       ENDIF
    56543314
    56553315       IF ( air_chemistry  .AND.  nest_chemistry )  THEN
    56563316          DO  n = 1, nspec
    5657              CALL pmci_interp_1sto_t( chem_species(n)%conc,                    &
    5658                                       chem_spec_c(:,:,:,n),                    &
    5659                                       ico, jco, kco, r1xo, r2xo,               &
    5660                                       r1yo, r2yo, r1zo, r2zo,                  &
    5661                                       kcto, iflo, ifuo, jflo, jfuo,            &
    5662                                       kflo, kfuo, ijkfc_s, 's' )
     3317             CALL pmci_interp_1sto_t( chem_species(n)%conc, chem_spec_c(:,:,:,n),                   &
     3318                                      kcto, iflo, ifuo, jflo, jfuo, 's' )
    56633319          ENDDO
    56643320       ENDIF
    … …  
    56743330!--   Note that TKE is not anterpolated.
    56753331      IMPLICIT NONE
    5676 
    56773332      INTEGER(iwp) ::  n          !< running index for number of chemical species
    56783333
    5679       CALL pmci_anterp_tophat( u,  uc,  kcto, iflu, ifuu, jflo, jfuo, kflo,    &
    5680                                kfuo, ijkfc_u, 'u' )
    5681       CALL pmci_anterp_tophat( v,  vc,  kcto, iflo, ifuo, jflv, jfuv, kflo,    &
    5682                                kfuo, ijkfc_v, 'v' )
    5683       CALL pmci_anterp_tophat( w,  wc,  kctw, iflo, ifuo, jflo, jfuo, kflw,    &
    5684                                kfuw, ijkfc_w, 'w' )
     3334     
     3335      CALL pmci_anterp_tophat( u,  uc,  kcto, iflu, ifuu, jflo, jfuo, kflo, kfuo, ijkfc_u, 'u' )
     3336      CALL pmci_anterp_tophat( v,  vc,  kcto, iflo, ifuo, jflv, jfuv, kflo, kfuo, ijkfc_v, 'v' )
     3337      CALL pmci_anterp_tophat( w,  wc,  kctw, iflo, ifuo, jflo, jfuo, kflw, kfuw, ijkfc_w, 'w' )
    56853338!
    56863339!--   Anterpolation of TKE and dissipation rate if parent and child are in
    56873340!--   RANS mode.
    56883341      IF ( rans_mode_parent  .AND.  rans_mode )  THEN
    5689          CALL pmci_anterp_tophat( e, ec, kcto, iflo, ifuo, jflo, jfuo, kflo,   &
    5690                                   kfuo, ijkfc_s, 'e' )
     3342         CALL pmci_anterp_tophat( e, ec, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, ijkfc_s, 'e' )
    56913343!
    56923344!--      Anterpolation of dissipation rate only if TKE-e closure is applied.
    … …  
    56993351
    57003352      IF ( .NOT. neutral )  THEN
    5701          CALL pmci_anterp_tophat( pt, ptc, kcto, iflo, ifuo, jflo, jfuo, kflo, &
    5702                                   kfuo, ijkfc_s, 'pt' )
     3353         CALL pmci_anterp_tophat( pt, ptc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, ijkfc_s, 'pt' )
    57033354      ENDIF
    57043355
    57053356      IF ( humidity )  THEN
    57063357
    5707          CALL pmci_anterp_tophat( q, q_c, kcto, iflo, ifuo, jflo, jfuo, kflo,  &
    5708                                   kfuo, ijkfc_s, 'q' )
     3358         CALL pmci_anterp_tophat( q, q_c, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, ijkfc_s, 'q' )
    57093359
    57103360         IF ( bulk_cloud_model  .AND.  microphysics_morrison )  THEN
    57113361
    5712             CALL pmci_anterp_tophat( qc, qcc, kcto, iflo, ifuo, jflo, jfuo,    &
     3362            CALL pmci_anterp_tophat( qc, qcc, kcto, iflo, ifuo, jflo, jfuo,                         &
    57133363                                     kflo, kfuo, ijkfc_s, 'qc' )
    5714 
    5715             CALL pmci_anterp_tophat( nc, ncc, kcto, iflo, ifuo, jflo, jfuo,    &
     3364           
     3365            CALL pmci_anterp_tophat( nc, ncc, kcto, iflo, ifuo, jflo, jfuo,                         &
    57163366                                     kflo, kfuo, ijkfc_s, 'nc' )
    57173367
    … …  
    57203370         IF ( bulk_cloud_model  .AND.  microphysics_seifert )  THEN
    57213371
    5722             CALL pmci_anterp_tophat( qr, qrc, kcto, iflo, ifuo, jflo, jfuo,    &
     3372            CALL pmci_anterp_tophat( qr, qrc, kcto, iflo, ifuo, jflo, jfuo,                         &
    57233373                                     kflo, kfuo, ijkfc_s, 'qr' )
    57243374
    5725             CALL pmci_anterp_tophat( nr, nrc, kcto, iflo, ifuo, jflo, jfuo,    &
     3375            CALL pmci_anterp_tophat( nr, nrc, kcto, iflo, ifuo, jflo, jfuo,                         &
    57263376                                     kflo, kfuo, ijkfc_s, 'nr' )
    57273377
    … …  
    57313381
    57323382      IF ( passive_scalar )  THEN
    5733          CALL pmci_anterp_tophat( s, sc, kcto, iflo, ifuo, jflo, jfuo, kflo,   &
    5734                                   kfuo, ijkfc_s, 's' )
     3383         CALL pmci_anterp_tophat( s, sc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, ijkfc_s, 's' )
    57353384      ENDIF
    57363385
    57373386      IF ( air_chemistry  .AND.  nest_chemistry )  THEN
    57383387         DO  n = 1, nspec
    5739             CALL pmci_anterp_tophat( chem_species(n)%conc,                     &
    5740                                      chem_spec_c(:,:,:,n),                     &
    5741                                      kcto, iflo, ifuo, jflo, jfuo, kflo,       &
    5742                                      kfuo, ijkfc_s, 's' )
     3388            CALL pmci_anterp_tophat( chem_species(n)%conc, chem_spec_c(:,:,:,n),                    &
     3389                                     kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, ijkfc_s, 's' )
    57433390         ENDDO
    57443391      ENDIF
    … …  
    57483395
    57493396
    5750    SUBROUTINE pmci_interp_1sto_lr( f, fc, ic, jc, kc, r1x, r2x, r1y, r2y, r1z, &
    5751                                    r2z, logc, logc_ratio, logc_kbounds,        &
    5752                                    nzt_topo_nestbc,                            &
    5753                                    kct, ifl, ifu, jfl, jfu, kfl, kfu, ijkfc,   &
    5754                                    edge, var )
     3397   SUBROUTINE pmci_interp_1sto_lr( f, fc, kct, jfl, jfu, kfl, kfu, edge, var )
    57553398!
    57563399!--   Interpolation of ghost-node values used as the child-domain boundary
    … …  
    57583401      IMPLICIT NONE
    57593402
    5760       INTEGER(iwp) ::  nzt_topo_nestbc   !<
    5761 
    5762       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                      &
    5763                                       INTENT(INOUT) ::  f       !<
    5764       REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr),                          &
    5765                                       INTENT(IN)    ::  fc      !<
    5766       REAL(wp), DIMENSION(1:2,0:ncorr-1,nzb:nzt_topo_nestbc,nys:nyn),          &
    5767                                       INTENT(IN)    ::  logc_ratio   !<
    5768 !AH      REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN)    ::  r1x     !<
    5769 !AH      REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN)    ::  r2x     !<
    5770 !AH      REAL(wp), DIMENSION(nysg:nyng), INTENT(IN)    ::  r1y     !<
    5771 !AH      REAL(wp), DIMENSION(nysg:nyng), INTENT(IN)    ::  r2y     !<
    5772       REAL(wp), DIMENSION(nxlfc:nxrfc), INTENT(IN)  ::  r1x     !<
    5773       REAL(wp), DIMENSION(nxlfc:nxrfc), INTENT(IN)  ::  r2x     !<
    5774       REAL(wp), DIMENSION(nysfc:nynfc), INTENT(IN)  ::  r1y     !<
    5775       REAL(wp), DIMENSION(nysfc:nynfc), INTENT(IN)  ::  r2y     !<
    5776 
    5777 !AH      REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN)    ::  r1z     !<
    5778 !AH      REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN)    ::  r2z     !<
    5779       REAL(wp), DIMENSION(nzb:nzt+kgsr), INTENT(IN) ::  r1z     !<
    5780       REAL(wp), DIMENSION(nzb:nzt+kgsr), INTENT(IN) ::  r2z     !<
    5781      
    5782 
    5783       INTEGER(iwp), DIMENSION(nxlfc:nxrfc), INTENT(IN)         ::  ic     !<
    5784       INTEGER(iwp), DIMENSION(nysfc:nynfc), INTENT(IN)         ::  jc     !<
    5785 !AH      INTEGER(iwp), DIMENSION(nzb:nzt+1), INTENT(IN)           ::  kc     !<
    5786       INTEGER(iwp), DIMENSION(nzb:nzt+kgsr), INTENT(IN)        ::  kc     !<
    5787       INTEGER(iwp), DIMENSION(1:2,nzb:nzt_topo_nestbc,nys:nyn),                &
    5788                                           INTENT(IN)           :: logc   !<
    5789       INTEGER(iwp), DIMENSION(1:2,nys:nyn), INTENT(IN)         :: logc_kbounds !<
    5790 
    5791       INTEGER(iwp) :: kct
    5792 
    5793 !AH
    5794 !      INTEGER(iwp), DIMENSION(icl:icr), INTENT(IN) ::  ifl !< Indicates start index of child cells belonging to certain parent cell - x direction
    5795 !      INTEGER(iwp), DIMENSION(icl:icr), INTENT(IN) ::  ifu !< Indicates end index of child cells belonging to certain parent cell - x direction
    5796 !      INTEGER(iwp), DIMENSION(jcs:jcn), INTENT(IN) ::  jfl !< Indicates start index of child cells belonging to certain parent cell - y direction
    5797 !      INTEGER(iwp), DIMENSION(jcs:jcn), INTENT(IN) ::  jfu !< Indicates start index of child cells belonging to certain parent cell - y direction
    5798       INTEGER(iwp), DIMENSION(icla:icra), INTENT(IN) ::  ifl !< Indicates start index of child cells belonging to certain parent cell - x direction
    5799       INTEGER(iwp), DIMENSION(icla:icra), INTENT(IN) ::  ifu !< Indicates end index of child cells belonging to certain parent cell - x direction
    5800       INTEGER(iwp), DIMENSION(jcsa:jcna), INTENT(IN) ::  jfl !< Indicates start index of child cells belonging to certain parent cell - y direction
    5801       INTEGER(iwp), DIMENSION(jcsa:jcna), INTENT(IN) ::  jfu !< Indicates start index of child cells belonging to certain parent cell - y direction
    5802 !AH
    5803 
    5804 !AH      INTEGER(iwp), DIMENSION(0:kct), INTENT(IN)   ::  kfl !< Indicates start index of child cells belonging to certain parent cell - z direction
    5805 !AH      INTEGER(iwp), DIMENSION(0:kct), INTENT(IN)   ::  kfu !< Indicates start index of child cells belonging to certain parent cell - z direction
    5806       INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN)   ::  kfl !< Indicates start index of child cells belonging to certain parent cell - z direction
    5807       INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN)   ::  kfu !< Indicates start index of child cells belonging to certain parent cell - z direction
    5808 
    5809 !AH      INTEGER(iwp), DIMENSION(0:kct,jcs:jcn,icl:icr), INTENT(IN) :: ijkfc !< number of child grid points contributing to a parent grid box
    5810 !AH
    5811 !      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
    5812       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
    5813 !AH
    5814 
    5815       CHARACTER(LEN=1), INTENT(IN) ::  edge   !< Edge symbol: 'l', 'r', 's' or 'n'
    5816       CHARACTER(LEN=1), INTENT(IN) ::  var    !< Variable symbol: 'u', 'v', 'w' or 's'
    5817 
    5818       INTEGER(iwp) ::  i        !< Lower bound of the running index ia
    5819       INTEGER(iwp) ::  ia       !< i-index running over the parent-grid cell on the boundary
    5820       INTEGER(iwp) ::  iaw      !< Reduced ia-index for workarr_lr
    5821       INTEGER(iwp) ::  iawbc    !< iaw-index pointing to the boundary-value nodes (either 0 or igsr-1)     
     3403      REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(INOUT) ::  f   !< Child-grid array
     3404      REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr), INTENT(IN)        ::  fc  !< Parent-grid array
     3405      INTEGER(iwp) :: kct                                     !< The parent-grid index in z-direction just below the boundary value node
     3406      INTEGER(iwp), DIMENSION(jcsa:jcna), INTENT(IN) ::  jfl  !< Indicates start index of child cells belonging to certain parent cell - y direction
     3407      INTEGER(iwp), DIMENSION(jcsa:jcna), INTENT(IN) ::  jfu  !< Indicates end index of child cells belonging to certain parent cell - y direction
     3408      INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN) ::  kfl  !< Indicates start index of child cells belonging to certain parent cell - z direction
     3409      INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN) ::  kfu  !< Indicates end index of child cells belonging to certain parent cell - z direction
     3410      CHARACTER(LEN=1), INTENT(IN) ::  edge                   !< Edge symbol: 'l' or 'r'
     3411      CHARACTER(LEN=1), INTENT(IN) ::  var                    !< Variable symbol: 'u', 'v', 'w' or 's'
     3412!
     3413!--   Local variables:
    58223414      INTEGER(iwp) ::  ib       !< Fixed i-index pointing to the node just behind the boundary-value node
    58233415      INTEGER(iwp) ::  ibc      !< Fixed i-index pointing to the boundary-value nodes (either i or iend)
    58243416      INTEGER(iwp) ::  ibgp     !< Index running over the redundant boundary ghost points in i-direction
    5825 !AH      INTEGER(iwp) ::  ibeg     !< i-index pointing to the starting point of workarr_lr in the i-direction
    5826       INTEGER(iwp) ::  iend     !< Upper bound of the running index ia
    58273417      INTEGER(iwp) ::  ierr     !< MPI error code
    5828       INTEGER(iwp) ::  ijk      !< Running index for all child-grid cells within the anterpolation cell
    5829       INTEGER(iwp) ::  iw       !< i-index for wall_flags_0
    58303418      INTEGER(iwp) ::  j        !< Running index in the y-direction
    5831       INTEGER(iwp) ::  jco      !<
    5832       INTEGER(iwp) ::  jcorr    !<
    5833       INTEGER(iwp) ::  jinc     !<
    5834       INTEGER(iwp) ::  jw       !< j-index for wall_flags_0
    5835       INTEGER(iwp) ::  j1       !<
    58363419      INTEGER(iwp) ::  k        !< Running index in the z-direction
    5837       INTEGER(iwp) ::  k_wall   !< Vertical index of topography top
    5838       INTEGER(iwp) ::  kco      !<
    5839       INTEGER(iwp) ::  kcorr    !<
    5840       INTEGER(iwp) ::  kw       !< k-index for wall_flags_0
    5841       INTEGER(iwp) ::  k1       !<
    5842       INTEGER(iwp) ::  l        !< Parent-grid running index in the x-direction
    58433420      INTEGER(iwp) ::  lbeg     !< l-index pointing to the starting point of workarrc_lr in the l-direction
    5844       INTEGER(iwp) ::  lp1      !< l+1
    5845       INTEGER(iwp) ::  loff     !< l-offset needed on the right boundary to correctly refer to boundary ghost points
    5846       INTEGER(iwp) ::  lw       !< Reduced l-index for workarrc_lr
     3421      INTEGER(iwp) ::  lw       !< Reduced l-index for workarrc_lr pointing to the boundary ghost node
     3422      INTEGER(iwp) ::  lwp      !< Reduced l-index for workarrc_lr pointing to the first prognostic node
    58473423      INTEGER(iwp) ::  m        !< Parent-grid running index in the y-direction
    5848       INTEGER(iwp) ::  mnorthv  !< Upshift by one for the upper bound of index m in case of var == 'v'
    5849       INTEGER(iwp) ::  mp1      !< m+1
    58503424      INTEGER(iwp) ::  n        !< Parent-grid running index in the z-direction
    5851       INTEGER(iwp) ::  np1      !< n+1
    5852       INTEGER(iwp) ::  ntopw    !< Upshift by one for the upper bound of index n in case of var == 'w'
    5853       INTEGER(iwp) ::  var_flag !< Variable flag for BTEST( wall_flags_0 )
    5854 
    5855       REAL(wp) ::  cellsum      !< Sum of child-grid node values over the anterpolation cell
    5856       REAL(wP) ::  cellsumd     !< Sum of differences over the anterpolation cell
    5857       REAL(wp) ::  fkj          !< Intermediate result in trilinear interpolation
    5858       REAL(wp) ::  fkjp         !< Intermediate result in trilinear interpolation
    5859       REAL(wp) ::  fkpj         !< Intermediate result in trilinear interpolation
    5860       REAL(wp) ::  fkpjp        !< Intermediate result in trilinear interpolation
    5861       REAL(wp) ::  fk           !< Intermediate result in trilinear interpolation
    5862       REAL(wp) ::  fkp          !< Intermediate result in trilinear interpolation
    5863       REAL(wp) ::  rcorr        !< Average reversibility correction for the whole anterpolation cell
    5864       REAL(wp) ::  rcorr_ijk    !< Reversibility correction distributed to the individual child-grid nodes
    5865 
    5866 !      real(wp), parameter :: c1 =  2.0_wp / 6.0_wp
    5867 !      real(wp), parameter :: c2 =  5.0_wp / 6.0_wp
    5868 !      real(wp), parameter :: c3 = -1.0_wp / 6.0_wp
     3425      REAL(wp) ::  cb           !< Interpolation coefficient for the boundary ghost node 
     3426      REAL(wp) ::  cp           !< Interpolation coefficient for the first prognostic node
     3427      REAL(wp) ::  f_interp_1   !< Value interpolated in x direction from the parent-grid data
     3428      REAL(wp) ::  f_interp_2   !< Auxiliary value interpolated in x direction from the parent-grid data
    58693429
    58703430!
    … …  
    58743434!--      For u, nxl is a ghost node, but not for the other variables
    58753435         IF ( var == 'u' )  THEN
    5876             i     = nxl
    5877             iend  = nxl
    58783436            ibc   = nxl   
    58793437            ib    = ibc - 1
    5880             iawbc = 0
    5881             l     = icl + 2
    58823438            lw    = 2
     3439            lwp   = lw        ! This is redundant when var == 'u'
    58833440            lbeg  = icl
    5884             loff  = 0           
    58853441         ELSE
    5886             i     = nxl - igsr
    5887             iend  = nxl - 1
    58883442            ibc   = nxl - 1
    58893443            ib    = ibc - 1
    5890             iawbc = igsr-1
    5891             l     = icl + 1
    58923444            lw    = 1
     3445            lwp   = 2
    58933446            lbeg  = icl
    5894             loff  = 0
    58953447         ENDIF       
    58963448      ELSEIF ( edge == 'r' )  THEN
    58973449         IF ( var == 'u' )  THEN
    5898             i     = nxr + 1           
    5899             iend  = nxr + 1
    59003450            ibc   = nxr + 1
    59013451            ib    = ibc + 1
    5902             iawbc = 0
    5903             l     = icr - 1
    59043452            lw    = 1
     3453            lwp   = lw        ! This is redundant when var == 'u'           
    59053454            lbeg  = icr - 2
    5906             loff  = 0
    59073455         ELSE
    5908             i     = nxr + 1
    5909             iend  = nxr + igsr
    59103456            ibc   = nxr + 1
    59113457            ib    = ibc + 1
    5912             iawbc = 0
    5913             l     = icr - 1
    59143458            lw    = 1
     3459            lwp   = 0
    59153460            lbeg  = icr - 2
    5916             loff  = 1
    59173461         ENDIF         
    59183462      ENDIF
    5919 
    5920       IF  ( var == 'w' )  THEN
    5921          ntopw = 1
     3463!
     3464!--   Interpolation coefficients
     3465      IF  ( interpolation_scheme_lrsn == 1 )  THEN
     3466         cb = 1.0_wp  ! 1st-order upwind
     3467      ELSE IF  ( interpolation_scheme_lrsn == 2 )  THEN
     3468         cb = 0.5_wp  ! 2nd-order central
    59223469      ELSE
    5923          ntopw = 0
    5924       ENDIF
    5925 
    5926       IF  ( var == 'v' )  THEN
    5927          mnorthv = 0
    5928       ELSE
    5929          mnorthv = 1
    5930       ENDIF
    5931 
    5932       IF ( var == 'u' )  THEN
    5933          var_flag = 1
    5934       ELSEIF ( var == 'v' )  THEN
    5935          var_flag = 2
    5936       ELSEIF ( var == 'w' )  THEN
    5937          var_flag = 3
    5938       ELSE
    5939          var_flag = 0
    5940       ENDIF
     3470         cb = 0.5_wp  ! 2nd-order central (default)
     3471      ENDIF         
     3472      cp    = 1.0_wp - cb
    59413473!
    59423474!--   Substitute the necessary parent-grid data to the work array workarrc_lr.
    … …  
    59783510      ENDIF
    59793511
    5980       IF  ( var == 'v' )  THEN
     3512      IF  ( var == 'u' )  THEN
     3513
     3514         DO  m = jcsw, jcnw
     3515            DO n = 0, kct
     3516               
     3517               DO  j = jfl(m), jfu(m)
     3518                  DO  k = kfl(n), kfu(n)
     3519                     f(k,j,ibc) = workarrc_lr(n,m,lw)
     3520                  ENDDO
     3521               ENDDO
     3522
     3523            ENDDO
     3524         ENDDO
     3525
     3526      ELSE IF  ( var == 'v' )  THEN
    59813527         
    59823528         DO  m = jcsw, jcnw-1
    59833529            DO n = 0, kct
    59843530!
     3531!--            First interpolate to the flux point
     3532               f_interp_1 = cb * workarrc_lr(n,m,lw)   + cp * workarrc_lr(n,m,lwp)
     3533               f_interp_2 = cb * workarrc_lr(n,m+1,lw) + cp * workarrc_lr(n,m+1,lwp)
     3534!
    59853535!--            Use averages of the neighbouring matching grid-line values
    59863536               DO  j = jfl(m), jfl(m+1)
    5987                   f(kfl(n):kfu(n),j,ibc) = 0.5_wp * ( workarrc_lr(n,m,lw)       &
    5988                        +  workarrc_lr(n,m+1,lw) )
     3537!                  f(kfl(n):kfu(n),j,ibc) = 0.5_wp * ( workarrc_lr(n,m,lw)       &
     3538!                       +  workarrc_lr(n,m+1,lw) )
     3539                  f(kfl(n):kfu(n),j,ibc) = 0.5_wp * ( f_interp_1 + f_interp_2 )
    59893540               ENDDO
    59903541!
    59913542!--            Then set the values along the matching grid-lines 
    59923543               IF  ( MOD( jfl(m), jgsr ) == 0 )  THEN
    5993                   f(kfl(n):kfu(n),jfl(m),ibc) = workarrc_lr(n,m,lw)
     3544!                  f(kfl(n):kfu(n),jfl(m),ibc) = workarrc_lr(n,m,lw)
     3545                  f(kfl(n):kfu(n),jfl(m),ibc) = f_interp_1
    59943546               ENDIF
    59953547            ENDDO
    … …  
    59983550!--      Finally, set the values along the last matching grid-line 
    59993551         IF  ( MOD( jfl(jcnw), jgsr ) == 0 )  THEN
     3552            f_interp_1 = cb * workarrc_lr(n,jcnw,lw) + cp * workarrc_lr(n,jcnw,lwp)
    60003553            DO  n = 0, kct
    6001                f(kfl(n):kfu(n),jfl(jcnw),ibc) = workarrc_lr(n,jcnw,lw)
     3554!               f(kfl(n):kfu(n),jfl(jcnw),ibc) = workarrc_lr(n,jcnw,lw)
     3555               f(kfl(n):kfu(n),jfl(jcnw),ibc) = f_interp_1
    60023556            ENDDO
    60033557         ENDIF
    … …  
    60203574            DO n = 0, kct + 1   ! It is important to go up to kct+1 
    60213575!
     3576!--            Interpolate to the flux point
     3577               f_interp_1 = cb * workarrc_lr(n,m,lw) + cp * workarrc_lr(n,m,lwp)
     3578!
    60223579!--            First substitute only the matching-node values
    6023                f(kfu(n),jfl(m):jfu(m),ibc) = workarrc_lr(n,m,lw)
     3580!               f(kfu(n),jfl(m):jfu(m),ibc) = workarrc_lr(n,m,lw)
     3581               f(kfu(n),jfl(m):jfu(m),ibc) = f_interp_1
    60243582                 
    60253583            ENDDO
    … …  
    60383596         ENDDO
    60393597
    6040       ELSE   ! u or scalars
     3598      ELSE   ! any scalar
    60413599         
    60423600         DO  m = jcsw, jcnw
    60433601            DO n = 0, kct
    6044                
     3602!
     3603!--            Interpolate to the flux point
     3604               f_interp_1 = cb * workarrc_lr(n,m,lw) + cp * workarrc_lr(n,m,lwp)
    60453605               DO  j = jfl(m), jfu(m)
    60463606                  DO  k = kfl(n), kfu(n)
    6047                      f(k,j,ibc) = workarrc_lr(n,m,lw)
     3607!                     f(k,j,ibc) = workarrc_lr(n,m,lw)
     3608                     f(k,j,ibc) = f_interp_1
    60483609                  ENDDO
    60493610               ENDDO
    … …  
    60693630
    60703631
    6071    SUBROUTINE pmci_interp_1sto_sn( f, fc, ic, jc, kc, r1x, r2x, r1y, r2y, r1z, &
    6072                                    r2z, logc, logc_ratio, logc_kbounds,        &
    6073                                    nzt_topo_nestbc,                            &
    6074                                    kct, ifl, ifu, jfl, jfu, kfl, kfu, ijkfc,   &
    6075                                    edge, var )
    6076 
     3632   SUBROUTINE pmci_interp_1sto_sn( f, fc, kct, ifl, ifu, kfl, kfu, edge, var )
    60773633!
    60783634!--   Interpolation of ghost-node values used as the child-domain boundary
    … …  
    60803636      IMPLICIT NONE
    60813637
    6082       INTEGER(iwp) ::  nzt_topo_nestbc   !<
    6083 
    6084       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                      &
    6085                                       INTENT(INOUT) ::  f             !<
    6086       REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr),                          &
    6087                                       INTENT(IN)    ::  fc            !<
    6088       REAL(wp), DIMENSION(1:2,0:ncorr-1,nzb:nzt_topo_nestbc,nxl:nxr),          &
    6089                                       INTENT(IN)    ::  logc_ratio    !<
    6090       REAL(wp), DIMENSION(nxlfc:nxrfc), INTENT(IN)  ::  r1x           !<
    6091       REAL(wp), DIMENSION(nxlfc:nxrfc), INTENT(IN)  ::  r2x           !<
    6092       REAL(wp), DIMENSION(nysfc:nynfc), INTENT(IN)  ::  r1y           !<
    6093       REAL(wp), DIMENSION(nysfc:nynfc), INTENT(IN)  ::  r2y           !<
    6094 !AH      REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN)    ::  r1z           !<
    6095 !AH      REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN)    ::  r2z           !<
    6096       REAL(wp), DIMENSION(nzb:nzt+kgsr), INTENT(IN) ::  r1z           !<
    6097       REAL(wp), DIMENSION(nzb:nzt+kgsr), INTENT(IN) ::  r2z           !<
    6098 
    6099      
    6100       INTEGER(iwp), DIMENSION(nxlfc:nxrfc), INTENT(IN)         ::  ic    !<
    6101       INTEGER(iwp), DIMENSION(nysfc:nynfc), INTENT(IN)         ::  jc    !<
    6102 !AH      INTEGER(iwp), DIMENSION(nzb:nzt+1), INTENT(IN)           ::  kc    !<
    6103       INTEGER(iwp), DIMENSION(nzb:nzt+kgsr), INTENT(IN)        ::  kc    !<
    6104       INTEGER(iwp), DIMENSION(1:2,nzb:nzt_topo_nestbc,nxl:nxr),                &
    6105                                           INTENT(IN)           ::  logc  !<
    6106       INTEGER(iwp), DIMENSION(1:2,nxl:nxr), INTENT(IN)         ::  logc_kbounds  !<
    6107 
    6108       INTEGER(iwp) :: kct
    6109 !AH
    6110 !      INTEGER(iwp), DIMENSION(icl:icr), INTENT(IN) ::  ifl !< Indicates start index of child cells belonging to certain parent cell - x direction
    6111 !      INTEGER(iwp), DIMENSION(icl:icr), INTENT(IN) ::  ifu !< Indicates end index of child cells belonging to certain parent cell - x direction
    6112 !      INTEGER(iwp), DIMENSION(jcs:jcn), INTENT(IN) ::  jfl !< Indicates start index of child cells belonging to certain parent cell - y direction
    6113 !      INTEGER(iwp), DIMENSION(jcs:jcn), INTENT(IN) ::  jfu !< Indicates start index of child cells belonging to certain parent cell - y direction
    6114       INTEGER(iwp), DIMENSION(icla:icra), INTENT(IN) ::  ifl !< Indicates start index of child cells belonging to certain parent cell - x direction
    6115       INTEGER(iwp), DIMENSION(icla:icra), INTENT(IN) ::  ifu !< Indicates end index of child cells belonging to certain parent cell - x direction
    6116       INTEGER(iwp), DIMENSION(jcsa:jcna), INTENT(IN) ::  jfl !< Indicates start index of child cells belonging to certain parent cell - y direction
    6117       INTEGER(iwp), DIMENSION(jcsa:jcna), INTENT(IN) ::  jfu !< Indicates start index of child cells belonging to certain parent cell - y direction
    6118 !AH
    6119 
    6120 !AH      INTEGER(iwp), DIMENSION(0:kct), INTENT(IN)   ::  kfl !< Indicates start index of child cells belonging to certain parent cell - z direction
    6121 !AH      INTEGER(iwp), DIMENSION(0:kct), INTENT(IN)   ::  kfu !< Indicates start index of child cells belonging to certain parent cell - z direction
    6122       INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN)   ::  kfl !< Indicates start index of child cells belonging to certain parent cell - z direction
    6123       INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN)   ::  kfu !< Indicates start index of child cells belonging to certain parent cell - z direction
    6124 !AH      INTEGER(iwp), DIMENSION(0:kct,jcs:jcn,icl:icr), INTENT(IN) :: ijkfc !< number of child grid points contributing to a parent grid box
    6125 !AH
    6126 !      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
    6127       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
    6128 !AH
    6129 
    6130       CHARACTER(LEN=1), INTENT(IN) ::  edge   !< Edge symbol: 'l', 'r', 's' or 'n'
     3638      REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(INOUT) ::  f   !< Child-grid array
     3639      REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr), INTENT(IN)        ::  fc  !< Parent-grid array
     3640      INTEGER(iwp) :: kct                                     !< The parent-grid index in z-direction just below the boundary value node
     3641      INTEGER(iwp), DIMENSION(icla:icra), INTENT(IN) ::  ifl  !< Indicates start index of child cells belonging to certain parent cell - x direction
     3642      INTEGER(iwp), DIMENSION(icla:icra), INTENT(IN) ::  ifu  !< Indicates end index of child cells belonging to certain parent cell - x direction
     3643      INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN) ::  kfl  !< Indicates start index of child cells belonging to certain parent cell - z direction
     3644      INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN) ::  kfu  !< Indicates end index of child cells belonging to certain parent cell - z direction
     3645      CHARACTER(LEN=1), INTENT(IN) ::  edge   !< Edge symbol: 's' or 'n'
    61313646      CHARACTER(LEN=1), INTENT(IN) ::  var    !< Variable symbol: 'u', 'v', 'w' or 's'
    6132      
     3647!
     3648!--   Local variables:     
    61333649      INTEGER(iwp) ::  i        !< Running index in the x-direction
    6134       INTEGER(iwp) ::  iinc     !<
    6135       INTEGER(iwp) ::  icorr    !<
    6136       INTEGER(iwp) ::  ico      !<
    61373650      INTEGER(iwp) ::  ierr     !< MPI error code
    6138       INTEGER(iwp) ::  ijk      !< Running index for all child-grid cells within the anterpolation cell
    6139       INTEGER(iwp) ::  iw       !< i-index for wall_flags_0
    6140       INTEGER(iwp) ::  i1       !<
    6141       INTEGER(iwp) ::  j        !< Lower bound of the running index ja
    6142       INTEGER(iwp) ::  ja       !< Index in y-direction running over the parent-grid cell on the boundary
    6143       INTEGER(iwp) ::  jaw      !< Reduced ja-index for workarr_sn
    6144       INTEGER(iwp) ::  jawbc    !< jaw-index pointing to the boundary-value nodes (either 0 or jgsr-1)
    6145 !AH      INTEGER(iwp) ::  jbeg     !< j-index pointing to the starting point of workarr_sn in the j-direction
    61463651      INTEGER(iwp) ::  jb       !< Fixed j-index pointing to the node just behind the boundary-value node
    61473652      INTEGER(iwp) ::  jbc      !< Fixed j-index pointing to the boundary-value nodes (either j or jend)
    61483653      INTEGER(iwp) ::  jbgp     !< Index running over the redundant boundary ghost points in j-direction
    6149       INTEGER(iwp) ::  jend     !< Upper bound of the running index ja
    6150       INTEGER(iwp) ::  jw       !< j-index for wall_flags_0
    61513654      INTEGER(iwp) ::  k        !< Running index in the z-direction
    6152       INTEGER(iwp) ::  k_wall   !< Vertical index of topography top
    6153       INTEGER(iwp) ::  kcorr    !<
    6154       INTEGER(iwp) ::  kco      !<
    6155       INTEGER(iwp) ::  kw       !< k-index for wall_flags_0
    6156       INTEGER(iwp) ::  k1       !<
    61573655      INTEGER(iwp) ::  l        !< Parent-grid running index in the x-direction
    6158       INTEGER(iwp) ::  lp1      !< l+1
    6159       INTEGER(iwp) ::  lrightu  !< Upshift by one for the upper bound of index l in case of var == 'u'
    6160       INTEGER(iwp) ::  m        !< Parent-grid running index in the y-direction
    61613656      INTEGER(iwp) ::  mbeg     !< m-index pointing to the starting point of workarrc_sn in the m-direction
    6162       INTEGER(iwp) ::  moff     !< m-offset needed on the north boundary to correctly refer to boundary ghost points
    6163       INTEGER(iwp) ::  mp1      !< m+1
    6164       INTEGER(iwp) ::  mw       !< Reduced m-index for workarrc_sn
     3657      INTEGER(iwp) ::  mw       !< Reduced m-index for workarrc_sn pointing to the boundary ghost node
     3658      INTEGER(iwp) ::  mwp      !< Reduced m-index for workarrc_sn pointing to the first prognostic node
    61653659      INTEGER(iwp) ::  n        !< Parent-grid running index in the z-direction
    6166       INTEGER(iwp) ::  np1      !< n+1
    6167       INTEGER(iwp) ::  ntopw    !< Upshift by one for the upper bound of index n in case of var == 'w'
    6168       INTEGER(iwp) ::  var_flag !< Variable flag for BTEST( wall_flags_0 )
    6169 
    6170       REAL(wp) ::  cellsum      !< Sum of child-grid node values over the anterpolation cell
    6171       REAL(wp) ::  cellsumd     !< Sum of differences over the anterpolation cell
    6172       REAL(wp) ::  fk           !< Intermediate result in trilinear interpolation
    6173       REAL(wp) ::  fkj          !< Intermediate result in trilinear interpolation
    6174       REAL(wp) ::  fkjp         !< Intermediate result in trilinear interpolation
    6175       REAL(wp) ::  fkpj         !< Intermediate result in trilinear interpolation
    6176       REAL(wp) ::  fkpjp        !< Intermediate result in trilinear interpolation
    6177       REAL(wp) ::  fkp          !< Intermediate result in trilinear interpolation
    6178       REAL(wp) ::  rcorr        !< Average reversibility correction for the whole anterpolation cell
    6179       REAL(wp) ::  rcorr_ijk    !< Reversibility correction distributed to the individual child-grid nodes
    6180 
    6181 !      real(wp), parameter :: c1 =  2.0_wp / 6.0_wp
    6182 !      real(wp), parameter :: c2 =  5.0_wp / 6.0_wp
    6183 !      real(wp), parameter :: c3 = -1.0_wp / 6.0_wp
     3660      REAL(wp) ::  cb           !< Interpolation coefficient for the boundary ghost node 
     3661      REAL(wp) ::  cp           !< Interpolation coefficient for the first prognostic node
     3662      REAL(wp) ::  f_interp_1   !< Value interpolated in y direction from the parent-grid data
     3663      REAL(wp) ::  f_interp_2   !< Auxiliary value interpolated in y direction from the parent-grid data
    61843664
    61853665!
    … …  
    61893669!--      For v, nys is a ghost node, but not for the other variables
    61903670         IF ( var == 'v' )  THEN
    6191             j     = nys
    6192             jend  = nys
    6193             jawbc = 0
    61943671            jbc   = nys
    61953672            jb    = jbc - 1
    6196             m     = jcs + 2
    61973673            mw    = 2
     3674            mwp   = 2         ! This is redundant when var == 'v'
    61983675            mbeg  = jcs
    6199             moff  = 0
    62003676         ELSE
    6201             j     = nys - jgsr
    6202             jend  = nys - 1
    6203             jawbc = jgsr - 1
    62043677            jbc   = nys - 1
    62053678            jb    = jbc - 1
    6206             m     = jcs + 1
    62073679            mw    = 1
     3680            mwp   = 2
    62083681            mbeg  = jcs
    6209             moff  = 0
    62103682         ENDIF
    62113683      ELSEIF ( edge == 'n' )  THEN
    62123684         IF ( var == 'v' )  THEN
    6213             j     = nyn + 1
    6214             jend  = nyn + 1
    6215             jawbc = 0
    62163685            jbc   = nyn + 1
    62173686            jb    = jbc + 1
    6218             m     = jcn - 1
    62193687            mw    = 1
     3688            mwp   = 0         ! This is redundant when var == 'v'     
    62203689            mbeg  = jcn - 2
    6221             moff  = 0
    62223690         ELSE
    6223             j     = nyn + 1
    6224             jend  = nyn + jgsr
    6225             jawbc = 0
    62263691            jbc   = nyn + 1
    62273692            jb    = jbc + 1
    6228             m     = jcn - 1
    62293693            mw    = 1
     3694            mwp   = 0
    62303695            mbeg  = jcn - 2
    6231             moff  = 1
    62323696         ENDIF
    62333697      ENDIF
    6234 
    6235       IF  ( var == 'w' )  THEN
    6236          ntopw = 1
     3698!
     3699!--   Interpolation coefficients
     3700      IF  ( interpolation_scheme_lrsn == 1 )  THEN
     3701         cb = 1.0_wp  ! 1st-order upwind
     3702      ELSE IF  ( interpolation_scheme_lrsn == 2 )  THEN
     3703         cb = 0.5_wp  ! 2nd-order central
    62373704      ELSE
    6238          ntopw = 0
    6239       ENDIF
    6240 
    6241       IF  ( var == 'u' )  THEN
    6242          lrightu = 0
    6243       ELSE
    6244          lrightu = 1
    6245       ENDIF
    6246 
    6247       IF ( var == 'u' )  THEN
    6248          var_flag = 1
    6249       ELSEIF ( var == 'v' )  THEN
    6250          var_flag = 2
    6251       ELSEIF ( var == 'w' )  THEN
    6252          var_flag = 3
    6253       ELSE
    6254          var_flag = 0
    6255       ENDIF
     3705         cb = 0.5_wp  ! 2nd-order central (default)
     3706      ENDIF         
     3707      cp    = 1.0_wp - cb
    62563708!
    62573709!--   Substitute the necessary parent-grid data to the work array workarrc_sn.
    … …  
    62933745      ENDIF
    62943746
    6295       IF  ( var == 'u' )  THEN
     3747      IF  ( var == 'v' )  THEN
     3748
     3749         DO  l = iclw, icrw
     3750            DO n = 0, kct
     3751               
     3752               DO  i = ifl(l), ifu(l)
     3753                  DO  k = kfl(n), kfu(n)
     3754                     f(k,jbc,i) = workarrc_sn(n,mw,l)
     3755                  ENDDO
     3756               ENDDO
     3757
     3758            ENDDO
     3759         ENDDO
     3760
     3761      ELSE IF  ( var == 'u' )  THEN
    62963762         
    62973763         DO  l = iclw, icrw-1
    6298             DO n = 0, kct
     3764            DO n = 0, kct
     3765!
     3766!--            First interpolate to the flux point
     3767               f_interp_1 = cb * workarrc_sn(n,mw,l)   + cp * workarrc_sn(n,mwp,l)
     3768               f_interp_2 = cb * workarrc_sn(n,mw,l+1) + cp * workarrc_sn(n,mwp,l+1)
    62993769!
    63003770!--            Use averages of the neighbouring matching grid-line values
    63013771               DO  i = ifl(l), ifl(l+1)
    6302                   f(kfl(n):kfu(n),jbc,i) = 0.5_wp * ( workarrc_sn(n,mw,l)       &
    6303                        +  workarrc_sn(n,mw,l+1) )
     3772!                  f(kfl(n):kfu(n),jbc,i) = 0.5_wp * ( workarrc_sn(n,mw,l)       &
     3773!                       +  workarrc_sn(n,mw,l+1) )
     3774                  f(kfl(n):kfu(n),jbc,i) = 0.5_wp * ( f_interp_1 + f_interp_2 )
    63043775               ENDDO
    63053776!
    63063777!--            Then set the values along the matching grid-lines 
    63073778               IF  ( MOD( ifl(l), igsr ) == 0 )  THEN
    6308                   f(kfl(n):kfu(n),jbc,ifl(l)) = workarrc_sn(n,mw,l)
     3779!                  f(kfl(n):kfu(n),jbc,ifl(l)) = workarrc_sn(n,mw,l)
     3780                  f(kfl(n):kfu(n),jbc,ifl(l)) = f_interp_1
    63093781               ENDIF
    63103782
    … …  
    63143786!--      Finally, set the values along the last matching grid-line 
    63153787         IF  ( MOD( ifl(icrw), igsr ) == 0 )  THEN
     3788            f_interp_1 = cb * workarrc_sn(n,mw,icrw) + cp * workarrc_sn(n,mwp,icrw)
    63163789            DO  n = 0, kct
    6317                f(kfl(n):kfu(n),jbc,ifl(icrw)) = workarrc_sn(n,mw,icrw)
     3790!               f(kfl(n):kfu(n),jbc,ifl(icrw)) = workarrc_sn(n,mw,icrw)
     3791               f(kfl(n):kfu(n),jbc,ifl(icrw)) = f_interp_1
    63183792            ENDDO
    63193793         ENDIF
    … …  
    63353809         DO  l = iclw, icrw
    63363810            DO n = 0, kct + 1   ! It is important to go up to kct+1 
     3811!
     3812!--            Interpolate to the flux point
     3813               f_interp_1 = cb * workarrc_sn(n,mw,l) + cp * workarrc_sn(n,mwp,l)
    63373814!                 
    63383815!--            First substitute only the matching-node values                 
    6339                f(kfu(n),jbc,ifl(l):ifu(l)) = workarrc_sn(n,mw,l)
     3816!               f(kfu(n),jbc,ifl(l):ifu(l)) = workarrc_sn(n,mw,l)
     3817               f(kfu(n),jbc,ifl(l):ifu(l)) = f_interp_1
    63403818
    63413819            ENDDO
    … …  
    63543832         ENDDO
    63553833
    6356       ELSE   ! v or scalars
     3834      ELSE   ! Any scalar
    63573835         
    63583836         DO  l = iclw, icrw
    63593837            DO n = 0, kct
    6360                
     3838!
     3839!--            Interpolate to the flux point
     3840               f_interp_1 = cb * workarrc_sn(n,mw,l) + cp * workarrc_sn(n,mwp,l)
    63613841               DO  i = ifl(l), ifu(l)
    63623842                  DO  k = kfl(n), kfu(n)
    6363                      f(k,jbc,i) = workarrc_sn(n,mw,l)
     3843!                     f(k,jbc,i) = workarrc_sn(n,mw,l)
     3844                     f(k,jbc,i) = f_interp_1
    63643845                  ENDDO
    63653846               ENDDO
    … …  
    63853866
    63863867
    6387    SUBROUTINE pmci_interp_1sto_t( f, fc, ic, jc, kc, r1x, r2x, r1y, r2y,       &
    6388                                   r1z, r2z, kct, ifl, ifu, jfl, jfu, kfl, kfu, &
    6389                                   ijkfc, var )
    6390 
     3868   SUBROUTINE pmci_interp_1sto_t( f, fc, kct, ifl, ifu, jfl, jfu, var )
    63913869!
    63923870!--   Interpolation of ghost-node values used as the child-domain boundary
    … …  
    63943872      IMPLICIT NONE
    63953873
    6396       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                      &
    6397                                       INTENT(INOUT) ::  f     !< Child-grid array
    6398       REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr),                          &
    6399                                       INTENT(IN)    ::  fc    !< Parent-grid array
    6400       REAL(wp), DIMENSION(nxlfc:nxrfc), INTENT(IN)  ::  r1x   !<
    6401       REAL(wp), DIMENSION(nxlfc:nxrfc), INTENT(IN)  ::  r2x   !<
    6402       REAL(wp), DIMENSION(nysfc:nynfc), INTENT(IN)  ::  r1y   !<
    6403       REAL(wp), DIMENSION(nysfc:nynfc), INTENT(IN)  ::  r2y   !<
    6404 !AH      REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN)    ::  r1z   !<
    6405 !AH      REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN)    ::  r2z   !<
    6406       REAL(wp), DIMENSION(nzb:nzt+kgsr), INTENT(IN) ::  r1z   !<
    6407       REAL(wp), DIMENSION(nzb:nzt+kgsr), INTENT(IN) ::  r2z   !<
    6408 
    6409      
    6410       INTEGER(iwp), DIMENSION(nxlfc:nxrfc), INTENT(IN)  ::  ic    !<
    6411       INTEGER(iwp), DIMENSION(nysfc:nynfc), INTENT(IN)  ::  jc    !<
    6412 !AH      INTEGER(iwp), DIMENSION(nzb:nzt+1), INTENT(IN)    ::  kc    !<
    6413       INTEGER(iwp), DIMENSION(nzb:nzt+kgsr), INTENT(IN) ::  kc    !<
    6414 
    6415       INTEGER(iwp) :: kct
    6416 !AH
    6417 !      INTEGER(iwp), DIMENSION(icl:icr), INTENT(IN) ::  ifl !< Indicates start index of child cells belonging to certain parent cell - x direction
    6418 !      INTEGER(iwp), DIMENSION(icl:icr), INTENT(IN) ::  ifu !< Indicates end index of child cells belonging to certain parent cell - x direction
    6419 !      INTEGER(iwp), DIMENSION(jcs:jcn), INTENT(IN) ::  jfl !< Indicates start index of child cells belonging to certain parent cell - y direction
    6420 !      INTEGER(iwp), DIMENSION(jcs:jcn), INTENT(IN) ::  jfu !< Indicates start index of child cells belonging to certain parent cell - y direction
    6421       INTEGER(iwp), DIMENSION(icla:icra), INTENT(IN) ::  ifl !< Indicates start index of child cells belonging to certain parent cell - x direction
    6422       INTEGER(iwp), DIMENSION(icla:icra), INTENT(IN) ::  ifu !< Indicates end index of child cells belonging to certain parent cell - x direction
    6423       INTEGER(iwp), DIMENSION(jcsa:jcna), INTENT(IN) ::  jfl !< Indicates start index of child cells belonging to certain parent cell - y direction
    6424       INTEGER(iwp), DIMENSION(jcsa:jcna), INTENT(IN) ::  jfu !< Indicates start index of child cells belonging to certain parent cell - y direction
    6425 !AH      INTEGER(iwp), DIMENSION(0:kct), INTENT(IN)   ::  kfl !< Indicates start index of child cells belonging to certain parent cell - z direction
    6426 !AH      INTEGER(iwp), DIMENSION(0:kct), INTENT(IN)   ::  kfu !< Indicates start index of child cells belonging to certain parent cell - z direction
    6427       INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN)   ::  kfl !< Indicates start index of child cells belonging to certain parent cell - z direction
    6428       INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN)   ::  kfu !< Indicates start index of child cells belonging to certain parent cell - z direction
    6429 !AH      INTEGER(iwp), DIMENSION(0:kct,jcs:jcn,icl:icr), INTENT(IN) :: ijkfc !< number of child grid points contributing to a parent grid box
    6430 !AH
    6431 !      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
    6432       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
    6433 !AH
    6434 
    6435       CHARACTER(LEN=1), INTENT(IN) :: var   !<
    6436 
    6437       INTEGER(iwp) ::  i    !<
    6438       INTEGER(iwp) ::  ib   !<
    6439       INTEGER(iwp) ::  iclc !< Lower i-index limit for copying fc-data to workarrc_t
    6440       INTEGER(iwp) ::  icrc !< Upper i-index limit for copying fc-data to workarrc_t
    6441       INTEGER(iwp) ::  ie   !<
    6442       INTEGER(iwp) ::  ierr !< MPI error code
    6443       INTEGER(iwp) ::  ijk  !<
    6444       INTEGER(iwp) ::  iw   !<
    6445       INTEGER(iwp) ::  j    !<
    6446       INTEGER(iwp) ::  jb   !<
    6447       INTEGER(iwp) ::  jcsc !< Lower j-index limit for copying fc-data to workarrc_t
    6448       INTEGER(iwp) ::  jcnc !< Upper j-index limit for copying fc-data to workarrc_t
    6449       INTEGER(iwp) ::  je   !<
    6450       INTEGER(iwp) ::  jw   !<     
    6451       INTEGER(iwp) ::  k    !< Vertical child-grid index fixed to the boundary-value level
    6452       INTEGER(iwp) ::  ka   !< Running vertical child-grid index
    6453       INTEGER(iwp) ::  kw   !<
    6454       INTEGER(iwp) ::  l    !< Parent-grid index in x-direction
    6455       INTEGER(iwp) ::  lp1  !< l+1
    6456       INTEGER(iwp) ::  m    !< Parent-grid index in y-direction
    6457       INTEGER(iwp) ::  mp1  !< m+1
    6458       INTEGER(iwp) ::  n    !< Parent-grid work array index in z-direction
    6459       INTEGER(iwp) ::  np1  !< n+1
    6460       INTEGER(iwp) ::  noff !< n-offset needed on the top boundary to correctly refer to boundary ghost points 
    6461       INTEGER(iwp) ::  nw   !< n-index for workarrc_t
    6462       INTEGER(iwp) ::  var_flag  !<
    6463      
    6464       REAL(wp) ::  cellsum     !<
    6465       REAL(wp) ::  cellsumd    !<
    6466       REAL(wp) ::  fac
    6467       REAL(wp) ::  fk          !<
    6468       REAL(wp) ::  fkj         !<
    6469       REAL(wp) ::  fkjp        !<
    6470       REAL(wp) ::  fkpj        !<
    6471       REAL(wp) ::  fkpjp       !<
    6472       REAL(wp) ::  fkp         !<
    6473       REAL(wp) ::  f_interp    !<
    6474       REAL(wp) ::  rcorr       !<
    6475       REAL(wp) ::  rcorr_ijk   !<
    6476 
    6477 !      real(wp), parameter :: c1 =  2.0_wp / 6.0_wp
    6478 !      real(wp), parameter :: c2 =  5.0_wp / 6.0_wp
    6479 !      real(wp), parameter :: c3 = -1.0_wp / 6.0_wp
     3874      REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(INOUT) ::  f    !< Child-grid array
     3875      REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr), INTENT(IN)        ::  fc   !< Parent-grid array
     3876      INTEGER(iwp), DIMENSION(icla:icra), INTENT(IN)    ::  ifl  !< Indicates start index of child cells belonging to certain parent cell - x direction
     3877      INTEGER(iwp), DIMENSION(icla:icra), INTENT(IN)    ::  ifu  !< Indicates end index of child cells belonging to certain parent cell - x direction
     3878      INTEGER(iwp), DIMENSION(jcsa:jcna), INTENT(IN)    ::  jfl  !< Indicates start index of child cells belonging to certain parent cell - y direction
     3879      INTEGER(iwp), DIMENSION(jcsa:jcna), INTENT(IN)    ::  jfu  !< Indicates end index of child cells belonging to certain parent cell - y direction
     3880      INTEGER(iwp) :: kct                                        !< The parent-grid index in z-direction just below the boundary value node
     3881      CHARACTER(LEN=1), INTENT(IN) :: var                        !< Variable symbol: 'u', 'v', 'w' or 's'
     3882!
     3883!--   Local variables:
     3884      REAL(wp)     ::  c31         !< Interpolation coefficient for the 3rd-order WS scheme
     3885      REAL(wp)     ::  c32         !< Interpolation coefficient for the 3rd-order WS scheme
     3886      REAL(wp)     ::  c33         !< Interpolation coefficient for the 3rd-order WS scheme
     3887      REAL(wp)     ::  f_interp_1  !< Value interpolated in z direction from the parent-grid data
     3888      REAL(wp)     ::  f_interp_2  !< Auxiliary value interpolated in z direction from the parent-grid data
     3889      INTEGER(iwp) ::  i           !< Child-grid index in x-direction
     3890      INTEGER(iwp) ::  iclc        !< Lower i-index limit for copying fc-data to workarrc_t
     3891      INTEGER(iwp) ::  icrc        !< Upper i-index limit for copying fc-data to workarrc_t
     3892      INTEGER(iwp) ::  ierr        !< MPI error code
     3893      INTEGER(iwp) ::  j           !< Child-grid index in y-direction
     3894      INTEGER(iwp) ::  jcsc        !< Lower j-index limit for copying fc-data to workarrc_t
     3895      INTEGER(iwp) ::  jcnc        !< Upper j-index limit for copying fc-data to workarrc_t
     3896      INTEGER(iwp) ::  k           !< Vertical child-grid index fixed to the boundary-value level
     3897      INTEGER(iwp) ::  l           !< Parent-grid index in x-direction
     3898      INTEGER(iwp) ::  m           !< Parent-grid index in y-direction
     3899      INTEGER(iwp) ::  nw          !< Reduced n-index for workarrc_t pointing to the boundary ghost node
    64803900
    64813901
    64823902      IF ( var == 'w' )  THEN
    64833903         k    = nzt
    6484          noff = 0
    64853904      ELSE
    64863905         k    = nzt + 1
    6487          noff = 1
    64883906      ENDIF
    6489 
    6490       IF ( var == 'u' )  THEN
    6491          var_flag = 1
    6492       ELSEIF ( var == 'v' )  THEN
    6493          var_flag = 2     
    6494       ELSEIF ( var == 'w' )  THEN
    6495          var_flag = 3
    6496       ELSE
    6497          var_flag = 0
    6498       ENDIF
    6499       n  = kc(k) + noff     ! Chance this to get rid of kc.
    6500       nw = noff
    6501 !      write(9,"(a1,2x,5(i3,2x))") var, k, kc(k), noff, n, nw
    6502 !      flush(9)
     3907      nw = 1
     3908!
     3909!--   Interpolation coefficients
     3910      IF  ( interpolation_scheme_t == 1 )  THEN
     3911         c31 =  0.0_wp           ! 1st-order upwind
     3912         c32 =  1.0_wp
     3913         c33 =  0.0_wp
     3914      ELSE IF  ( interpolation_scheme_t == 2 )  THEN
     3915         c31 =  0.5_wp           ! 2nd-order central
     3916         c32 =  0.5_wp
     3917         c33 =  0.0_wp
     3918      ELSE           
     3919         c31 =  2.0_wp / 6.0_wp  ! 3rd-order WS upwind biased (default)
     3920         c32 =  5.0_wp / 6.0_wp
     3921         c33 = -1.0_wp / 6.0_wp         
     3922      ENDIF         
    65033923!
    65043924!--   Substitute the necessary parent-grid data to the work array.
    … …  
    65233943      ENDIF
    65243944      workarrc_t = 0.0_wp
    6525       workarrc_t(0:2,jcsc:jcnc,iclc:icrc) = fc(kc(k):kc(k)+2,jcsc:jcnc,iclc:icrc)
     3945      workarrc_t(-2:3,jcsc:jcnc,iclc:icrc) = fc(kct-2:kct+3,jcsc:jcnc,iclc:icrc)
    65263946!
    65273947!--   Left-right exchange if more than one PE subdomain in the x-direction.
    … …  
    65673987#endif     
    65683988
    6569       IF  ( var == 'u' )  THEN
     3989      IF  ( var == 'w' )  THEN
     3990         DO  l = iclw, icrw
     3991            DO  m = jcsw, jcnw
     3992 
     3993               DO  i = ifl(l), ifu(l)
     3994                  DO  j = jfl(m), jfu(m)
     3995                     f(k,j,i) = workarrc_t(nw,m,l)
     3996                  ENDDO
     3997               ENDDO
     3998
     3999            ENDDO
     4000         ENDDO
     4001
     4002      ELSE IF  ( var == 'u' )  THEN
    65704003
    65714004         DO  l = iclw, icrw-1
    65724005            DO  m = jcsw, jcnw
    65734006!
     4007!--            First interpolate to the flux point using the 3rd-order WS scheme
     4008               f_interp_1 = c31 * workarrc_t(nw-1,m,l)   + c32 * workarrc_t(nw,m,l)   + c33 * workarrc_t(nw+1,m,l)
     4009               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)
     4010!
    65744011!--            Use averages of the neighbouring matching grid-line values
    65754012               DO  i = ifl(l), ifl(l+1)
    6576                   f(k,jfl(m):jfu(m),i) = 0.5_wp * ( workarrc_t(nw,m,l)   &
    6577                        + workarrc_t(nw,m,l+1) )
     4013!                  f(k,jfl(m):jfu(m),i) = 0.5_wp * ( workarrc_t(nw,m,l)   &
     4014!                       + workarrc_t(nw,m,l+1) )
     4015                  f(k,jfl(m):jfu(m),i) = 0.5_wp * ( f_interp_1 + f_interp_2 )
    65784016               ENDDO
    65794017!
    65804018!--            Then set the values along the matching grid-lines 
    65814019               IF  ( MOD( ifl(l), igsr ) == 0 )  THEN
    6582                   f(k,jfl(m):jfu(m),ifl(l)) = workarrc_t(nw,m,l)
     4020!
     4021!--            First interpolate to the flux point using the 3rd-order WS scheme
     4022                  f_interp_1 = c31 * workarrc_t(nw-1,m,l) + c32 * workarrc_t(nw,m,l) + c33 * workarrc_t(nw+1,m,l)                 
     4023!                  f(k,jfl(m):jfu(m),ifl(l)) = workarrc_t(nw,m,l)
     4024                  f(k,jfl(m):jfu(m),ifl(l)) = f_interp_1
    65834025               ENDIF
    65844026
    … …  
    65894031         IF  ( MOD( ifl(icrw), igsr ) == 0 )  THEN
    65904032            DO  m = jcsw, jcnw
    6591                f(k,jfl(m):jfu(m),ifl(icrw)) = workarrc_t(nw,m,icrw)
     4033!
     4034!--            First interpolate to the flux point using the 3rd-order WS scheme
     4035               f_interp_1 = c31 * workarrc_t(nw-1,m,icrw) + c32 * workarrc_t(nw,m,icrw) + c33 * workarrc_t(nw+1,m,icrw)
     4036!               f(k,jfl(m):jfu(m),ifl(icrw)) = workarrc_t(nw,m,icrw)
     4037               f(k,jfl(m):jfu(m),ifl(icrw)) = f_interp_1
    65924038            ENDDO
    65934039         ENDIF
    … …  
    66104056            DO  m = jcsw, jcnw-1
    66114057!
     4058!--            First interpolate to the flux point using the 3rd-order WS scheme
     4059               f_interp_1 = c31 * workarrc_t(nw-1,m,l)   + c32 * workarrc_t(nw,m,l)   + c33 * workarrc_t(nw+1,m,l)
     4060               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)
     4061!
    66124062!--            Use averages of the neighbouring matching grid-line values
    6613                DO  j = jfl(m), jfl(m+1)                 
    6614                   f(k,j,ifl(l):ifu(l)) = 0.5_wp * ( workarrc_t(nw,m,l)   &
    6615                        + workarrc_t(nw,m+1,l) )
     4063               DO  j = jfl(m), jfl(m+1)         
     4064!                  f(k,j,ifl(l):ifu(l)) = 0.5_wp * ( workarrc_t(nw,m,l)   &
     4065!                       + workarrc_t(nw,m+1,l) )
     4066                  f(k,j,ifl(l):ifu(l)) = 0.5_wp * ( f_interp_1 + f_interp_2 )
    66164067               ENDDO
    66174068!
    66184069!--            Then set the values along the matching grid-lines 
    66194070               IF  ( MOD( jfl(m), jgsr ) == 0 )  THEN
    6620                   f(k,jfl(m),ifl(l):ifu(l)) = workarrc_t(nw,m,l)
     4071                  f_interp_1 = c31 * workarrc_t(nw-1,m,l) + c32 * workarrc_t(nw,m,l) + c33 * workarrc_t(nw+1,m,l)
     4072!                  f(k,jfl(m),ifl(l):ifu(l)) = workarrc_t(nw,m,l)
     4073                  f(k,jfl(m),ifl(l):ifu(l)) = f_interp_1
    66214074               ENDIF
    66224075               
    … …  
    66254078         ENDDO
    66264079!
    6627 !--      Finally, set the values along the last matching grid-line 
     4080!--      Finally, set the values along the last matching grid-line
    66284081         IF  ( MOD( jfl(jcnw), jgsr ) == 0 )  THEN
    66294082            DO  l = iclw, icrw
    6630                f(k,jfl(jcnw),ifl(l):ifu(l)) = workarrc_t(nw,jcnw,l)
     4083!
     4084!--            First interpolate to the flux point using the 3rd-order WS scheme
     4085               f_interp_1 = c31 * workarrc_t(nw-1,jcnw,l) + c32 * workarrc_t(nw,jcnw,l) + c33 * workarrc_t(nw+1,jcnw,l)
     4086!               f(k,jfl(jcnw),ifl(l):ifu(l)) = workarrc_t(nw,jcnw,l)
     4087               f(k,jfl(jcnw),ifl(l):ifu(l)) = f_interp_1
    66314088            ENDDO
    66324089         ENDIF
    … …  
    66444101         ENDIF
    66454102
    6646       ELSE  ! w or any scalar
     4103      ELSE  ! any scalar variable
    66474104
    66484105         DO  l = iclw, icrw
    66494106            DO  m = jcsw, jcnw
    66504107!
    6651 !--            3rd-order upwind biased interpolation.
    6652 !               IF  ( w(k,jfl(m),ifl(l)) < 0.0_wp )  THEN
    6653 !                  f_interp = c1 * workarrc_t(0,m,l) + c2 * workarrc_t(1,m,l) + c3 * workarrc_t(2,m,l)
    6654 !               ELSE
    6655 !                  f_interp = workarrc_t(nw,m,l)
    6656 !               ENDIF             
     4108!--            First interpolate to the flux point using the 3rd-order WS scheme
     4109               f_interp_1 = c31 * workarrc_t(nw-1,m,l) + c32 * workarrc_t(nw,m,l) + c33 * workarrc_t(nw+1,m,l)
    66574110               DO  i = ifl(l), ifu(l)
    66584111                  DO  j = jfl(m), jfu(m)
    6659                      f(k,j,i) = workarrc_t(nw,m,l)
     4112!                     f(k,j,i) = workarrc_t(nw,m,l)
     4113                     f(k,j,i) = f_interp_1
    66604114                  ENDDO
    66614115               ENDDO
    … …  
    66754129
    66764130
    6677    SUBROUTINE pmci_interp_tril_lr( f, fc, ic, jc, kc, r1x, r2x, r1y, r2y, r1z, &
    6678                                    r2z, logc, logc_ratio, logc_kbounds,        &
    6679                                    nzt_topo_nestbc,                            &
    6680                                    kct, ifl, ifu, jfl, jfu, kfl, kfu, ijkfc,   &
    6681                                    edge, var )
    6682 !
    6683 !--   Interpolation of ghost-node values used as the child-domain boundary
    6684 !--   conditions. This subroutine handles the left and right boundaries. It is
    6685 !--   based on trilinear interpolation.
     4131   SUBROUTINE pmci_anterp_tophat( f, fc, kct, ifl, ifu, jfl, jfu, kfl, kfu, ijkfc, var )
     4132!
     4133!--   Anterpolation of internal-node values to be used as the parent-domain
     4134!--   values. This subroutine is based on the first-order numerical
     4135!--   integration of the child-grid values contained within the anterpolation
     4136!--   cell.
    66864137
    66874138      IMPLICIT NONE
    66884139
    6689       INTEGER(iwp) ::  nzt_topo_nestbc   !<
    6690 
    6691       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                      &
    6692                                       INTENT(INOUT) ::  f       !<
    6693       REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr),                          &
    6694                                       INTENT(IN)    ::  fc      !<
    6695       REAL(wp), DIMENSION(1:2,0:ncorr-1,nzb:nzt_topo_nestbc,nys:nyn),          &
    6696                                       INTENT(IN)    ::  logc_ratio   !<
    6697 !AH      REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN)    ::  r1x     !<
    6698 !AH      REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN)    ::  r2x     !<
    6699 !AH      REAL(wp), DIMENSION(nysg:nyng), INTENT(IN)    ::  r1y     !<
    6700 !AH      REAL(wp), DIMENSION(nysg:nyng), INTENT(IN)    ::  r2y     !<
    6701       REAL(wp), DIMENSION(nxlfc:nxrfc), INTENT(IN)  ::  r1x     !<
    6702       REAL(wp), DIMENSION(nxlfc:nxrfc), INTENT(IN)  ::  r2x     !<
    6703       REAL(wp), DIMENSION(nysfc:nynfc), INTENT(IN)  ::  r1y     !<
    6704       REAL(wp), DIMENSION(nysfc:nynfc), INTENT(IN)  ::  r2y     !<
    6705 
    6706 !AH      REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN)    ::  r1z     !<
    6707 !AH      REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN)    ::  r2z     !<
    6708       REAL(wp), DIMENSION(nzb:nzt+kgsr), INTENT(IN) ::  r1z     !<
    6709       REAL(wp), DIMENSION(nzb:nzt+kgsr), INTENT(IN) ::  r2z     !<
    6710      
    6711 
    6712       INTEGER(iwp), DIMENSION(nxlfc:nxrfc), INTENT(IN)         ::  ic     !<
    6713       INTEGER(iwp), DIMENSION(nysfc:nynfc), INTENT(IN)         ::  jc     !<
    6714 !AH      INTEGER(iwp), DIMENSION(nzb:nzt+1), INTENT(IN)           ::  kc     !<
    6715       INTEGER(iwp), DIMENSION(nzb:nzt+kgsr), INTENT(IN)        ::  kc     !<
    6716       INTEGER(iwp), DIMENSION(1:2,nzb:nzt_topo_nestbc,nys:nyn),                &
    6717                                           INTENT(IN)           :: logc   !<
    6718       INTEGER(iwp), DIMENSION(1:2,nys:nyn), INTENT(IN)         :: logc_kbounds !<
    6719 
    6720       INTEGER(iwp) :: kct
    6721 
    6722 !AH
    6723 !      INTEGER(iwp), DIMENSION(icl:icr), INTENT(IN) ::  ifl !< Indicates start index of child cells belonging to certain parent cell - x direction
    6724 !      INTEGER(iwp), DIMENSION(icl:icr), INTENT(IN) ::  ifu !< Indicates end index of child cells belonging to certain parent cell - x direction
    6725 !      INTEGER(iwp), DIMENSION(jcs:jcn), INTENT(IN) ::  jfl !< Indicates start index of child cells belonging to certain parent cell - y direction
    6726 !      INTEGER(iwp), DIMENSION(jcs:jcn), INTENT(IN) ::  jfu !< Indicates start index of child cells belonging to certain parent cell - y direction
     4140      REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(IN) ::  f         !< Child-grid array
     4141      REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr), INTENT(INOUT)  ::  fc        !< Parent-grid array
     4142      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
     4143      INTEGER(iwp), INTENT(IN) ::  kct                                             !< Top boundary index for anterpolation along z
    67274144      INTEGER(iwp), DIMENSION(icla:icra), INTENT(IN) ::  ifl !< Indicates start index of child cells belonging to certain parent cell - x direction
    67284145      INTEGER(iwp), DIMENSION(icla:icra), INTENT(IN) ::  ifu !< Indicates end index of child cells belonging to certain parent cell - x direction
    67294146      INTEGER(iwp), DIMENSION(jcsa:jcna), INTENT(IN) ::  jfl !< Indicates start index of child cells belonging to certain parent cell - y direction
    6730       INTEGER(iwp), DIMENSION(jcsa:jcna), INTENT(IN) ::  jfu !< Indicates start index of child cells belonging to certain parent cell - y direction
    6731 !AH
    6732 
    6733 !AH      INTEGER(iwp), DIMENSION(0:kct), INTENT(IN)   ::  kfl !< Indicates start index of child cells belonging to certain parent cell - z direction
    6734 !AH      INTEGER(iwp), DIMENSION(0:kct), INTENT(IN)   ::  kfu !< Indicates start index of child cells belonging to certain parent cell - z direction
    6735       INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN)   ::  kfl !< Indicates start index of child cells belonging to certain parent cell - z direction
    6736       INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN)   ::  kfu !< Indicates start index of child cells belonging to certain parent cell - z direction
    6737 
    6738 !AH      INTEGER(iwp), DIMENSION(0:kct,jcs:jcn,icl:icr), INTENT(IN) :: ijkfc !< number of child grid points contributing to a parent grid box
    6739 !AH
    6740 !      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
    6741       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
    6742 !AH
    6743 
    6744       CHARACTER(LEN=1), INTENT(IN) ::  edge   !< Edge symbol: 'l', 'r', 's' or 'n'
    6745       CHARACTER(LEN=1), INTENT(IN) ::  var    !< Variable symbol: 'u', 'v', 'w' or 's'
    6746 
    6747       INTEGER(iwp) ::  i        !< Lower bound of the running index ia
    6748       INTEGER(iwp) ::  ia       !< i-index running over the parent-grid cell on the boundary
    6749       INTEGER(iwp) ::  iaw      !< Reduced ia-index for workarr_lr
    6750       INTEGER(iwp) ::  iawbc    !< iaw-index pointing to the boundary-value nodes (either 0 or igsr-1)     
    6751       INTEGER(iwp) ::  ibc      !< Fixed i-index pointing to the boundary-value nodes (either i or iend)
    6752 !AH      INTEGER(iwp) ::  ibeg     !< i-index pointing to the starting point of workarr_lr in the i-direction
    6753       INTEGER(iwp) ::  iend     !< Upper bound of the running index ia
    6754       INTEGER(iwp) ::  ierr     !< MPI error code
    6755       INTEGER(iwp) ::  ijk      !< Running index for all child-grid cells within the anterpolation cell
    6756       INTEGER(iwp) ::  iw       !< i-index for wall_flags_0
    6757       INTEGER(iwp) ::  j        !< Running index in the y-direction
    6758       INTEGER(iwp) ::  jco      !<
    6759       INTEGER(iwp) ::  jcorr    !<
    6760       INTEGER(iwp) ::  jinc     !<
    6761       INTEGER(iwp) ::  jw       !< j-index for wall_flags_0
    6762       INTEGER(iwp) ::  j1       !<
    6763       INTEGER(iwp) ::  k        !< Running index in the z-direction
    6764       INTEGER(iwp) ::  k_wall   !< Vertical index of topography top
    6765       INTEGER(iwp) ::  kco      !<
    6766       INTEGER(iwp) ::  kcorr    !<
    6767       INTEGER(iwp) ::  kw       !< k-index for wall_flags_0
    6768       INTEGER(iwp) ::  k1       !<
    6769       INTEGER(iwp) ::  l        !< Parent-grid running index in the x-direction
    6770       INTEGER(iwp) ::  lbeg     !< l-index pointing to the starting point of workarrc_lr in the l-direction
    6771       INTEGER(iwp) ::  lp1      !< l+1
    6772       INTEGER(iwp) ::  loff     !< l-offset needed on the right boundary to correctly refer to boundary ghost points
    6773       INTEGER(iwp) ::  lw       !< Reduced l-index for workarrc_lr
    6774       INTEGER(iwp) ::  m        !< Parent-grid running index in the y-direction
    6775       INTEGER(iwp) ::  mnorthv  !< Upshift by one for the upper bound of index m in case of var == 'v'
    6776       INTEGER(iwp) ::  mp1      !< m+1
    6777       INTEGER(iwp) ::  n        !< Parent-grid running index in the z-direction
    6778       INTEGER(iwp) ::  np1      !< n+1
    6779       INTEGER(iwp) ::  ntopw    !< Upshift by one for the upper bound of index n in case of var == 'w'
    6780       INTEGER(iwp) ::  var_flag !< Variable flag for BTEST( wall_flags_0 )
    6781 
    6782       REAL(wp) ::  cellsum      !< Sum of child-grid node values over the anterpolation cell
    6783       REAL(wP) ::  cellsumd     !< Sum of differences over the anterpolation cell
    6784       REAL(wp) ::  fkj          !< Intermediate result in trilinear interpolation
    6785       REAL(wp) ::  fkjp         !< Intermediate result in trilinear interpolation
    6786       REAL(wp) ::  fkpj         !< Intermediate result in trilinear interpolation
    6787       REAL(wp) ::  fkpjp        !< Intermediate result in trilinear interpolation
    6788       REAL(wp) ::  fk           !< Intermediate result in trilinear interpolation
    6789       REAL(wp) ::  fkp          !< Intermediate result in trilinear interpolation
    6790       REAL(wp) ::  rcorr        !< Average reversibility correction for the whole anterpolation cell
    6791       REAL(wp) ::  rcorr_ijk    !< Reversibility correction distributed to the individual child-grid nodes
    6792  
    6793 !
    6794 !--   Check which edge is to be handled
    6795       IF ( edge == 'l' )  THEN
    6796 !
    6797 !--      For u, nxl is a ghost node, but not for the other variables
    6798          IF ( var == 'u' )  THEN
    6799             i     = nxl
    6800             iend  = nxl
    6801             ibc   = nxl
    6802             iawbc = 0
    6803             lbeg  = icl
    6804             loff  = 0
    6805          ELSE
    6806             i     = nxl - igsr
    6807             iend  = nxl - 1
    6808             ibc   = nxl - 1
    6809             iawbc = igsr-1
    6810             lbeg  = icl
    6811             loff  = 0
     4147      INTEGER(iwp), DIMENSION(jcsa:jcna), INTENT(IN) ::  jfu !< Indicates end index of child cells belonging to certain parent cell - y direction
     4148      INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN) ::  kfl !< Indicates start index of child cells belonging to certain parent cell - z direction
     4149      INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN) ::  kfu !< Indicates end index of child cells belonging to certain parent cell - z direction
     4150      CHARACTER(LEN=*), INTENT(IN) ::  var                   !< Variable symbol: 'u', 'v', 'w' or 's'
     4151!
     4152!--   Local variables: 
     4153      REAL(wp) ::  cellsum       !< sum of respective child cells belonging to parent cell
     4154      INTEGER(iwp) ::  i         !< Running index x-direction - child grid
     4155      INTEGER(iwp) ::  iclant    !< Left boundary index for anterpolation along x
     4156      INTEGER(iwp) ::  icrant    !< Right boundary index for anterpolation along x
     4157      INTEGER(iwp) ::  j         !< Running index y-direction - child grid
     4158      INTEGER(iwp) ::  jcnant    !< North boundary index for anterpolation along y
     4159      INTEGER(iwp) ::  jcsant    !< South boundary index for anterpolation along y
     4160      INTEGER(iwp) ::  k         !< Running index z-direction - child grid     
     4161      INTEGER(iwp) ::  kcb = 0   !< Bottom boundary index for anterpolation along z
     4162      INTEGER(iwp) ::  kctant    !< Top boundary index for anterpolation along z
     4163      INTEGER(iwp) ::  l         !< Running index x-direction - parent grid
     4164      INTEGER(iwp) ::  m         !< Running index y-direction - parent grid
     4165      INTEGER(iwp) ::  n         !< Running index z-direction - parent grid
     4166      INTEGER(iwp) ::  var_flag  !< bit number used to flag topography on respective grid
     4167
     4168!
     4169!--   Define the index bounds iclant, icrant, jcsant and jcnant.
     4170!--   Note that kcb is simply zero and kct enters here as a parameter and it is
     4171!--   determined in pmci_init_anterp_tophat.
     4172!--   Please note, grid points used also for interpolation (from parent to
     4173!--   child) are excluded in anterpolation, e.g. anterpolation is only from
     4174!--   nzb:kct-1, as kct is used for interpolation.
     4175      iclant = icl
     4176      icrant = icr
     4177      jcsant = jcs
     4178      jcnant = jcn
     4179      kctant = kct - 1
     4180     
     4181      kcb  = 0
     4182      IF ( nesting_mode /= 'vertical' )  THEN
     4183         IF ( bc_dirichlet_l )  THEN
     4184            iclant = icl + 3
    68124185         ENDIF
    6813       ELSEIF ( edge == 'r' )  THEN
    6814          IF ( var == 'u' )  THEN
    6815             i     = nxr + 1           
    6816             iend  = nxr + 1
    6817             ibc   = nxr + 1
    6818             iawbc = 0
    6819             lbeg  = icr - 2
    6820             loff  = 0
    6821          ELSE
    6822             i     = nxr + 1
    6823             iend  = nxr + igsr
    6824             ibc   = nxr + 1
    6825             iawbc = 0
    6826             lbeg  = icr - 2
    6827             loff  = 1
     4186         IF ( bc_dirichlet_r )  THEN
     4187            icrant = icr - 3
    68284188         ENDIF
    68294189
     4190         IF ( bc_dirichlet_s )  THEN
     4191            jcsant = jcs + 3
     4192         ENDIF
     4193         IF ( bc_dirichlet_n )  THEN
     4194            jcnant = jcn - 3
     4195         ENDIF
    68304196      ENDIF
    6831 
    6832       IF  ( var == 'w' )  THEN
    6833          ntopw = 1
    6834       ELSE
    6835          ntopw = 0
    6836       ENDIF
    6837 
    6838       IF  ( var == 'v' )  THEN
    6839          mnorthv = 0
    6840       ELSE
    6841          mnorthv = 1
    6842       ENDIF
    6843 
     4197!
     4198!--   Set masking bit for topography flags
    68444199      IF ( var == 'u' )  THEN
    68454200         var_flag = 1
    … …  
    68514206         var_flag = 0
    68524207      ENDIF
    6853 
    6854 !AH
    6855 !
    6856 !--   Substitute the necessary parent-grid data to the work array workarrc_lr.
    6857       workarrc_lr = 0.0_wp     
    6858       IF  ( pdims(2) > 1 )  THEN
    6859 #if defined( __parallel )
    6860          IF  ( nys == 0 )  THEN
    6861             workarrc_lr(0:cg%nz+1,jcsw:jcnw-1,0:2)                              &
    6862                  = fc(0:cg%nz+1,jcsw:jcnw-1,lbeg:lbeg+2)
    6863          ELSE IF  ( nyn == ny )  THEN
    6864             workarrc_lr(0:cg%nz+1,jcsw+1:jcnw,0:2)                              &
    6865                  = fc(0:cg%nz+1,jcsw+1:jcnw,lbeg:lbeg+2)
    6866          ELSE
    6867             workarrc_lr(0:cg%nz+1,jcsw+1:jcnw-1,0:2)                            &
    6868                  = fc(0:cg%nz+1,jcsw+1:jcnw-1,lbeg:lbeg+2)
    6869          ENDIF
    6870 !
    6871 !--      South-north exchange if more than one PE subdomain in the y-direction.
    6872 !--      Note that in case of 3-D nesting the south (psouth == MPI_PROC_NULL)
    6873 !--      and north (pnorth == MPI_PROC_NULL) boundaries are not exchanged
    6874 !--      because the nest domain is not cyclic.
    6875 !--      From south to north
    6876          CALL MPI_SENDRECV( workarrc_lr(0,jcsw+1,0), 1,                         &
    6877               workarrc_lr_exchange_type, psouth,  0,                            &
    6878               workarrc_lr(0,jcnw,0), 1,                                         &
    6879               workarrc_lr_exchange_type, pnorth,  0,                            &
    6880               comm2d, status, ierr )
    6881 !
    6882 !--      From north to south       
    6883          CALL MPI_SENDRECV( workarrc_lr(0,jcnw-1,0), 1,                         &
    6884               workarrc_lr_exchange_type, pnorth,  1,                            &
    6885               workarrc_lr(0,jcsw,0), 1,                                         &
    6886               workarrc_lr_exchange_type, psouth,  1,                            &
    6887               comm2d, status, ierr )
    6888 #endif
    6889       ELSE
    6890          workarrc_lr(0:cg%nz+1,jcsw:jcnw,0:2)                                   &
    6891               = fc(0:cg%nz+1,jcsw:jcnw,lbeg:lbeg+2)           
    6892       ENDIF
    6893 !
    6894 !AH
    6895       workarr_lr = 0.0_wp
    6896      
    6897       DO  ia = i, iend
    6898          iaw = ia - i
    6899          DO  j = nys-1, nyn+1
    6900 !AH         DO  j = nys, nyn
    6901 !
    6902 !--         Determine vertical index of topography top at grid point (j,i)
    6903 !AH         k_wall = get_topography_top_index_ji( j, i, TRIM( var ) )
    6904             DO  k = nzb, nzt+1 !k_wall, nzt+1
    6905 !AH               l   = ic(ia) - ic(i)
    6906                l   = ic(ia) - lbeg
    6907                lp1 = MIN( l + 1, 2 )  ! If l+1 > 2 (l=ic(nxr+1)-lbeg), r1x = 1 and r2x = 0
    6908                m   = jc(j)
    6909                mp1 = MIN( m + 1, jcnw )  ! If m+1 > jcn (m=jc(nyn+1)), r1y = 1 and r2y = 0
    6910                n   = kc(k)
    6911                np1 = n + 1           
    6912 
    6913 !AH
    6914 !               fkj      = r1x(i) * fc(n,m,l)     + r2x(i) * fc(n,m,l+1)
    6915 !               fkjp     = r1x(i) * fc(n,m+1,l)   + r2x(i) * fc(n,m+1,l+1)
    6916 !               fkpj     = r1x(i) * fc(n+1,m,l)   + r2x(i) * fc(n+1,m,l+1)
    6917 !               fkpjp    = r1x(i) * fc(n+1,m+1,l) + r2x(i) * fc(n+1,m+1,l+1)
    6918 !AH
    6919                
    6920                fkj      = r1x(ia) * workarrc_lr(n,m,l)     + r2x(ia) * workarrc_lr(n,m,lp1)
    6921                fkjp     = r1x(ia) * workarrc_lr(n,mp1,l)   + r2x(ia) * workarrc_lr(n,mp1,lp1)
    6922                fkpj     = r1x(ia) * workarrc_lr(np1,m,l)   + r2x(ia) * workarrc_lr(np1,m,lp1)
    6923                fkpjp    = r1x(ia) * workarrc_lr(np1,mp1,l) + r2x(ia) * workarrc_lr(np1,mp1,lp1)
    6924                
    6925                fk       = r1y(j) * fkj  + r2y(j) * fkjp
    6926                fkp      = r1y(j) * fkpj + r2y(j) * fkpjp
    6927 
    6928 !AH
    6929 !               f(k,j,i) = r1z(k) * fk + r2z(k) * fkp               
    6930                workarr_lr(k,j,iaw) = r1z(k) * fk + r2z(k) * fkp
    6931                
    6932 !               if  ( ( edge == 'l' ) .and. ( ia  == ibc ) ) then
    6933 !                  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, &
    6934 !                       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)
    6935 !                  flush(9)
    6936 !               endif
    6937 
    6938 !AH
    6939                
     4208!
     4209!--   Note that ii, jj, and kk are coarse-grid indices and i,j, and k
     4210!--   are fine-grid indices.
     4211      DO  l = iclant, icrant
     4212         DO  m = jcsant, jcnant
     4213!
     4214!--         For simplicity anterpolate within buildings and under elevated
     4215!--         terrain too
     4216            DO  n = kcb, kctant
     4217               cellsum = 0.0_wp
     4218               DO  i = ifl(l), ifu(l)
     4219                  DO  j = jfl(m), jfu(m)
     4220                     DO  k = kfl(n), kfu(n)
     4221                        cellsum = cellsum + MERGE( f(k,j,i), 0.0_wp,          &
     4222                             BTEST( wall_flags_0(k,j,i), var_flag ) )
     4223                     ENDDO
     4224                  ENDDO
     4225               ENDDO
     4226!
     4227!--            In case all child grid points are inside topography, i.e.
     4228!--            ijkfc and cellsum are zero, also parent solution would have
     4229!--            zero values at that grid point, which may cause problems in
     4230!--            particular for the temperature. Therefore, in case cellsum is
     4231!--            zero, keep the parent solution at this point.
     4232
     4233               IF ( ijkfc(n,m,l) /= 0 )  THEN
     4234                  fc(n,m,l) = cellsum / REAL( ijkfc(n,m,l), KIND=wp )
     4235               ENDIF
     4236
    69404237            ENDDO
    69414238         ENDDO
    69424239      ENDDO
    6943 !
    6944 !--   Generalized log-law-correction algorithm.
    6945 !--   Doubly two-dimensional index arrays logc(1:2,:,:) and log-ratio arrays
    6946 !--   logc_ratio(1:2,0:ncorr-1,:,:) have been precomputed in subroutine
    6947 !--   pmci_init_loglaw_correction.
    6948 !
    6949 !--   Solid surface below the node
    6950       IF ( constant_flux_layer .AND. ( var == 'u' .OR. var == 'v' ) )  THEN
    6951          DO  j = nys, nyn
    6952 !
    6953 !--         Determine vertical index of topography top at grid point (j,i)
    6954             k_wall = get_topography_top_index_ji( j, i, TRIM ( var ) )
    6955 
    6956             k = k_wall+1
    6957             IF ( ( logc(1,k,j) /= 0 )  .AND.  ( logc(2,k,j) == 0 ) )  THEN
    6958                k1 = logc(1,k,j)
    6959                DO  kcorr = 0, ncorr - 1
    6960                   kco = k + kcorr
    6961 !AH                  f(kco,j,i) = logc_ratio(1,kcorr,k,j) * f(k1,j,i)
    6962                ENDDO
    6963             ENDIF
    6964          ENDDO
    6965       ENDIF
    6966 !
    6967 !--   In case of non-flat topography, also vertical walls and corners need to be
    6968 !--   treated. Only single and double wall nodes are corrected. Triple and
    6969 !--   higher-multiple wall nodes are not corrected as the log law would not be
    6970 !--   valid anyway in such locations.
    6971       IF ( topography /= 'flat' )  THEN
    6972 
    6973          IF ( constant_flux_layer .AND. ( var == 'u' .OR. var == 'w' ) )  THEN           
    6974 !
    6975 !--         Solid surface only on south/north side of the node                   
    6976             DO  j = nys, nyn
    6977                DO  k = logc_kbounds(1,j), logc_kbounds(2,j)   
    6978                   IF ( ( logc(2,k,j) /= 0 )  .AND.  ( logc(1,k,j) == 0 ) )  THEN
    6979 !
    6980 !--                  Direction of the wall-normal index is carried in as the
    6981 !--                  sign of logc
    6982                      jinc = SIGN( 1, logc(2,k,j) )
    6983                      j1   = ABS( logc(2,k,j) )
    6984                      DO  jcorr = 0, ncorr-1
    6985                         jco = j + jinc * jcorr
    6986                         IF ( jco >= nys .AND. jco <= nyn )  THEN
    6987 !AH                           f(k,jco,i) = logc_ratio(2,jcorr,k,j) * f(k,j1,i)
    6988                         ENDIF
    6989                      ENDDO
    6990                   ENDIF
    6991                ENDDO
    6992             ENDDO
    6993          ENDIF
    6994 !
    6995 !--      Solid surface on both below and on south/north side of the node           
    6996          IF ( constant_flux_layer .AND. var == 'u' )  THEN
    6997             DO  j = nys, nyn
    6998                k = logc_kbounds(1,j)
    6999                IF ( ( logc(2,k,j) /= 0 )  .AND.  ( logc(1,k,j) /= 0 ) )  THEN
    7000                   k1   = logc(1,k,j)                 
    7001                   jinc = SIGN( 1, logc(2,k,j) )
    7002                   j1   = ABS( logc(2,k,j) )                 
    7003                   DO  jcorr = 0, ncorr-1
    7004                      jco = j + jinc * jcorr
    7005                      IF ( jco >= nys .AND. jco <= nyn )  THEN
    7006                         DO  kcorr = 0, ncorr-1
    7007                            kco = k + kcorr
    7008 !AH                           f(kco,jco,i) = 0.5_wp * ( logc_ratio(1,kcorr,k,j) * &
    7009 !AH                                                     f(k1,j,i)                 &
    7010 !AH                                                   + logc_ratio(2,jcorr,k,j) * &
    7011 !AH                                                     f(k,j1,i) )
    7012                         ENDDO
    7013                      ENDIF
    7014                   ENDDO
    7015                ENDIF
    7016             ENDDO
    7017          ENDIF
    7018 
    7019       ENDIF  ! ( topography /= 'flat' )
    7020 !
    7021 !--   Apply the reversibility correction.
    7022 
    7023 !      if  ( var == 'u' )  then
    7024 
    7025       l  = ic(ibc) + loff
    7026       lw = 1
    7027 !      write(9,"('pmci_interp_tril_lr: edge, var, l, i, iend, ifl(l), ifu(l) = ',2(a2,2x),5(i4,2x))") &
    7028 !           edge, var, l, i, iend, ifl(l), ifu(l)
    7029 !      flush(9)
    7030 !AH      DO  m = jcsw+1, jcnw-1       
    7031       DO  m = jcsw + 1, jcnw - mnorthv   ! mnorthv = 0 for v and 1 for all others
    7032          DO  n = 0, kct + ntopw            ! ntopw = 1 for w and 0 for all others
    7033             ijk = 1
    7034             cellsum   = 0.0_wp
    7035             cellsumd  = 0.0_wp
    7036 !
    7037 !--         Note that the index name i must not be used here as a loop
    7038 !--         index name since i is the constant boundary index, hence
    7039 !--         the name ia.
    7040             DO  ia = ifl(l), ifu(l)
    7041                iaw = ia - i
    7042                iw  = MAX( MIN( ia, nx+1 ), -1 )
    7043                DO  j = jfl(m), jfu(m)
    7044                   jw = MAX( MIN( j, ny+1 ), -1 )
    7045                   DO  k = kfl(n), kfu(n)
    7046                      kw = MIN( k, nzt+1 )
    7047 !AH
    7048 !                     cellsum = cellsum + MERGE( f(k,j,ia), 0.0_wp,              &
    7049 !                          BTEST( wall_flags_0(kw,jw,iw), var_flag ) )
    7050                      cellsum = cellsum + MERGE( workarr_lr(k,j,iaw), 0.0_wp,     &
    7051                           BTEST( wall_flags_0(kw,jw,iw), var_flag ) )
    7052 !AH
    7053                      
    7054 !AH                     celltmpd(ijk) = ABS( fc(n,m,l) - f(k,j,ia) )
    7055 !AH                     celltmpd(ijk) = ABS( workarrc_lr(n,m,lw) - f(k,j,ia) )
    7056                      celltmpd(ijk) = ABS( workarrc_lr(n,m,lw) - workarr_lr(k,j,iaw) )
    7057                      cellsumd      = cellsumd  + MERGE( celltmpd(ijk),          &
    7058                           0.0_wp, BTEST( wall_flags_0(kw,jw,iw), var_flag ) )
    7059 
    7060 !                     write(9,"('lr1: ',a1,2x,8(i4,2x),5(e12.5,2x))") var, n, m, l, k, j, ia, iaw, ijk,  &
    7061 !                          workarrc_lr(n,m,lw), workarr_lr(k,j,iaw), cellsum, celltmpd(ijk), cellsumd
    7062 !                     flush(9)
    7063 
    7064                      ijk = ijk + 1
    7065                   ENDDO
    7066                ENDDO
    7067             ENDDO
    7068 
    7069             IF ( ijkfc(n,m,l) /= 0 )  THEN
    7070                cellsum   = cellsum / REAL( ijkfc(n,m,l), KIND=wp )
    7071 !               rcorr     = fc(n,m,l) - cellsum
    7072                rcorr     = workarrc_lr(n,m,lw) - cellsum
    7073                cellsumd  = cellsumd / REAL( ijkfc(n,m,l), KIND=wp )
    7074             ELSE
    7075                cellsum   = 0.0_wp                 
    7076                rcorr     = 0.0_wp
    7077                cellsumd  = 1.0_wp
    7078                celltmpd  = 1.0_wp
    7079             ENDIF
    7080 !
    7081 !--         Distribute the correction term to the child nodes according to
    7082 !--         their relative difference to the parent value such that the
    7083 !--         node with the largest difference gets the largest share of the
    7084 !--         correction. The distribution is skipped if rcorr is negligibly
    7085 !--         small in order to avoid division by zero.
    7086             IF ( ABS(rcorr) < 0.000001_wp )  THEN                 
    7087                cellsumd  = 1.0_wp
    7088                celltmpd  = 1.0_wp
    7089             ENDIF
    7090 
    7091             ijk = 1
    7092             DO  ia = ifl(l), ifu(l)
    7093 !AH               iaw = ia - ifl(l)
    7094                iaw = ia - i
    7095                DO  j = jfl(m), jfu(m)
    7096                   DO  k = kfl(n), kfu(n)
    7097                      rcorr_ijk = rcorr * celltmpd(ijk) / cellsumd
    7098 !AH                     f(k,j,ia) = f(k,j,ia) + rcorr_ijk
    7099                      workarr_lr(k,j,iaw) = workarr_lr(k,j,iaw) + rcorr_ijk
    7100 
    7101 !                     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), &
    7102 !                          rcorr, rcorr_ijk, workarr_lr(k,j,iaw), workarrc_lr(n,m,lw)
    7103 !                     flush(9)
    7104 
    7105                      ijk = ijk + 1
    7106                   ENDDO
    7107                ENDDO
    7108             ENDDO
    7109 !
    7110 !--         Velocity components tangential to the boundary need special
    7111 !--         treatment because their anterpolation cells are flat in their
    7112 !--         direction and hence do not cover all the child-grid boundary nodes.
    7113 !--         These components are next linearly interpolated to those child-grid
    7114 !--         boundary nodes which are not covered by the anterpolation cells.
    7115             IF  ( ( var == 'w' ) .AND. ( n > 0 ) )  THEN
    7116                DO  k = kfu(n-1)+1, kfl(n)-1
    7117                   IF  ( k <= nzt )  THEN
    7118                      DO  j = jfl(m), jfu(m)
    7119                         IF  ( ( j >= nys ) .AND. ( j <= nyn+1 ) )  THEN
    7120 !AH                             
    7121 !                           f(k,j,ia) = r1z(k) * f(kfu(n-1),j,ia)                &
    7122 !                                   + r2z(k) * f(kfl(n),j,ia)
    7123                            workarr_lr(k,j,iawbc) =                              &
    7124                                   r1z(k) * workarr_lr(kfu(n-1),j,iawbc)         &
    7125                                 + r2z(k) * workarr_lr(kfl(n),j,iawbc)
    7126 
    7127 !                           write(9,"('lr3: ',a1,2x,7(i4,2x),3(e12.5,2x))") var, n, m, l, k, j, iawbc, ibc, &
    7128 !                                workarr_lr(k-1,j,iawbc), workarr_lr(k,j,iawbc), workarr_lr(k+1,j,iawbc)
    7129 !                           flush(9)
    7130 
    7131 !AH                             
    7132                         ENDIF
    7133                      ENDDO
    7134                   ENDIF
    7135                ENDDO
    7136             ENDIF
    7137 
    7138             IF  ( ( var == 'v' ) .AND. ( m > jcsw ) )  THEN
    7139                DO  j = jfu(m-1)+1, jfl(m)-1
    7140                   IF  ( ( j >= nys ) .AND. ( j <= nyn+1 ) )  THEN
    7141                      DO  k = kfl(n), kfu(n)
    7142                         IF  ( k <= nzt+1 )  THEN                             
    7143 !AH                             
    7144 !                           f(k,j,ia) = r1y(j) * f(k,jfu(m-1),ia)                &
    7145 !                                   + r2y(j) * f(k,jfl(m),ia)
    7146                            workarr_lr(k,j,iawbc) =                              &
    7147                                   r1y(j) * workarr_lr(k,jfu(m-1),iawbc)         &
    7148                                 + r2y(j) * workarr_lr(k,jfl(m),iawbc)
    7149 
    7150 !                           write(9,"('lr4: ',a1,2x,7(i4,2x),3(e12.5,2x))") var, n, m, l, k, j, iawbc, ibc, &
    7151 !                                workarr_lr(k,j-1,iawbc), workarr_lr(k,j,iawbc), workarr_lr(k,j+1,iawbc)
    7152 !                           flush(9)
    7153 
    7154 !AH                             
    7155                         ENDIF
    7156                      ENDDO
    7157                   ENDIF
    7158                ENDDO
    7159             ENDIF
    7160                
    7161          ENDDO  ! n
    7162       ENDDO  ! m
    7163 
    7164 !      endif  ! var
    7165 
    7166 !
    7167 !--   Finally substitute the boundary values.
    7168       f(nzb:nzt+1,nys:nyn,ibc) = workarr_lr(nzb:nzt+1,nys:nyn,iawbc)
    7169 
    7170 !      do  k = 0, 2
    7171 !         do  j = nys, nyn
    7172 !            if  ( edge == 'l' )  then
    7173 !               write(9,"('lr5: ',2(a2,2x),4(i4,2x),4(e12.5,2x))") edge, var, k, j, ibc, iawbc,  &
    7174 !                    workarr_lr(k,j,iawbc), f(k,j,ibc), f(k,j,ibc+1), f(k,j,ibc+2)
    7175 !            else if  ( edge == 'r' )  then
    7176 !               write(9,"('lr5: ',2(a2,2x),4(i4,2x),4(e12.5,2x))") edge, var, k, j, ibc, iawbc,  &
    7177 !                    f(k,j,ibc-2), f(k,j,ibc-1), f(k,j,ibc), workarr_lr(k,j,iawbc)
    7178 !            endif
    7179 !         enddo
    7180 !      enddo
    7181 !      flush(9)
    7182 
    7183    END SUBROUTINE pmci_interp_tril_lr
    7184 
    7185 
    7186 
    7187    SUBROUTINE pmci_interp_tril_sn( f, fc, ic, jc, kc, r1x, r2x, r1y, r2y, r1z, &
    7188                                    r2z, logc, logc_ratio, logc_kbounds,        &
    7189                                    nzt_topo_nestbc,                            &
    7190                                    kct, ifl, ifu, jfl, jfu, kfl, kfu, ijkfc,   &
    7191                                    edge, var )
    7192 
    7193 !
    7194 !--   Interpolation of ghost-node values used as the child-domain boundary
    7195 !--   conditions. This subroutine handles the south and north boundaries.
    7196 !--   This subroutine is based on trilinear interpolation.
    7197 
    7198       IMPLICIT NONE
    7199 
    7200       INTEGER(iwp) ::  nzt_topo_nestbc   !<
    7201 
    7202       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                      &
    7203                                       INTENT(INOUT) ::  f             !<
    7204       REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr),                          &
    7205                                       INTENT(IN)    ::  fc            !<
    7206       REAL(wp), DIMENSION(1:2,0:ncorr-1,nzb:nzt_topo_nestbc,nxl:nxr),          &
    7207                                       INTENT(IN)    ::  logc_ratio    !<
    7208       REAL(wp), DIMENSION(nxlfc:nxrfc), INTENT(IN)  ::  r1x           !<
    7209       REAL(wp), DIMENSION(nxlfc:nxrfc), INTENT(IN)  ::  r2x           !<
    7210       REAL(wp), DIMENSION(nysfc:nynfc), INTENT(IN)  ::  r1y           !<
    7211       REAL(wp), DIMENSION(nysfc:nynfc), INTENT(IN)  ::  r2y           !<
    7212 !AH      REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN)    ::  r1z           !<
    7213 !AH      REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN)    ::  r2z           !<
    7214       REAL(wp), DIMENSION(nzb:nzt+kgsr), INTENT(IN) ::  r1z           !<
    7215       REAL(wp), DIMENSION(nzb:nzt+kgsr), INTENT(IN) ::  r2z           !<
    7216 
    7217      
    7218       INTEGER(iwp), DIMENSION(nxlfc:nxrfc), INTENT(IN)         ::  ic    !<
    7219       INTEGER(iwp), DIMENSION(nysfc:nynfc), INTENT(IN)         ::  jc    !<
    7220 !AH      INTEGER(iwp), DIMENSION(nzb:nzt+1), INTENT(IN)           ::  kc    !<
    7221       INTEGER(iwp), DIMENSION(nzb:nzt+kgsr), INTENT(IN)        ::  kc    !<
    7222       INTEGER(iwp), DIMENSION(1:2,nzb:nzt_topo_nestbc,nxl:nxr),                &
    7223                                           INTENT(IN)           ::  logc  !<
    7224       INTEGER(iwp), DIMENSION(1:2,nxl:nxr), INTENT(IN)         ::  logc_kbounds  !<
    7225 
    7226       INTEGER(iwp) :: kct
    7227 !AH
    7228 !      INTEGER(iwp), DIMENSION(icl:icr), INTENT(IN) ::  ifl !< Indicates start index of child cells belonging to certain parent cell - x direction
    7229 !      INTEGER(iwp), DIMENSION(icl:icr), INTENT(IN) ::  ifu !< Indicates end index of child cells belonging to certain parent cell - x direction
    7230 !      INTEGER(iwp), DIMENSION(jcs:jcn), INTENT(IN) ::  jfl !< Indicates start index of child cells belonging to certain parent cell - y direction
    7231 !      INTEGER(iwp), DIMENSION(jcs:jcn), INTENT(IN) ::  jfu !< Indicates start index of child cells belonging to certain parent cell - y direction
    7232       INTEGER(iwp), DIMENSION(icla:icra), INTENT(IN) ::  ifl !< Indicates start index of child cells belonging to certain parent cell - x direction
    7233       INTEGER(iwp), DIMENSION(icla:icra), INTENT(IN) ::  ifu !< Indicates end index of child cells belonging to certain parent cell - x direction
    7234       INTEGER(iwp), DIMENSION(jcsa:jcna), INTENT(IN) ::  jfl !< Indicates start index of child cells belonging to certain parent cell - y direction
    7235       INTEGER(iwp), DIMENSION(jcsa:jcna), INTENT(IN) ::  jfu !< Indicates start index of child cells belonging to certain parent cell - y direction
    7236 !AH
    7237 
    7238 !AH      INTEGER(iwp), DIMENSION(0:kct), INTENT(IN)   ::  kfl !< Indicates start index of child cells belonging to certain parent cell - z direction
    7239 !AH      INTEGER(iwp), DIMENSION(0:kct), INTENT(IN)   ::  kfu !< Indicates start index of child cells belonging to certain parent cell - z direction
    7240       INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN)   ::  kfl !< Indicates start index of child cells belonging to certain parent cell - z direction
    7241       INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN)   ::  kfu !< Indicates start index of child cells belonging to certain parent cell - z direction
    7242 !AH      INTEGER(iwp), DIMENSION(0:kct,jcs:jcn,icl:icr), INTENT(IN) :: ijkfc !< number of child grid points contributing to a parent grid box
    7243 !AH
    7244 !      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
    7245       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
    7246 !AH
    7247 
    7248       CHARACTER(LEN=1), INTENT(IN) ::  edge   !< Edge symbol: 'l', 'r', 's' or 'n'
    7249       CHARACTER(LEN=1), INTENT(IN) ::  var    !< Variable symbol: 'u', 'v', 'w' or 's'
    7250      
    7251       INTEGER(iwp) ::  i        !< Running index in the x-direction
    7252       INTEGER(iwp) ::  iinc     !<
    7253       INTEGER(iwp) ::  icorr    !<
    7254       INTEGER(iwp) ::  ico      !<
    7255       INTEGER(iwp) ::  ierr     !< MPI error code
    7256       INTEGER(iwp) ::  ijk      !< Running index for all child-grid cells within the anterpolation cell
    7257       INTEGER(iwp) ::  iw       !< i-index for wall_flags_0
    7258       INTEGER(iwp) ::  i1       !<
    7259       INTEGER(iwp) ::  j        !< Lower bound of the running index ja
    7260       INTEGER(iwp) ::  ja       !< Index in y-direction running over the parent-grid cell on the boundary
    7261       INTEGER(iwp) ::  jaw      !< Reduced ja-index for workarr_sn
    7262       INTEGER(iwp) ::  jawbc    !< jaw-index pointing to the boundary-value nodes (either 0 or jgsr-1)
    7263 !AH      INTEGER(iwp) ::  jbeg     !< j-index pointing to the starting point of workarr_sn in the j-direction
    7264       INTEGER(iwp) ::  jbc      !< Fixed j-index pointing to the boundary-value nodes (either j or jend)
    7265       INTEGER(iwp) ::  jend     !< Upper bound of the running index ja
    7266       INTEGER(iwp) ::  jw       !< j-index for wall_flags_0
    7267       INTEGER(iwp) ::  k        !< Running index in the z-direction
    7268       INTEGER(iwp) ::  k_wall   !< Vertical index of topography top
    7269       INTEGER(iwp) ::  kcorr    !<
    7270       INTEGER(iwp) ::  kco      !<
    7271       INTEGER(iwp) ::  kw       !< k-index for wall_flags_0
    7272       INTEGER(iwp) ::  k1       !<
    7273       INTEGER(iwp) ::  l        !< Parent-grid running index in the x-direction
    7274       INTEGER(iwp) ::  lp1      !< l+1
    7275       INTEGER(iwp) ::  lrightu  !< Upshift by one for the upper bound of index l in case of var == 'u'
    7276       INTEGER(iwp) ::  m        !< Parent-grid running index in the y-direction
    7277       INTEGER(iwp) ::  mbeg     !< m-index pointing to the starting point of workarrc_sn in the m-direction
    7278       INTEGER(iwp) ::  moff     !< m-offset needed on the north boundary to correctly refer to boundary ghost points
    7279       INTEGER(iwp) ::  mp1      !< m+1
    7280       INTEGER(iwp) ::  mw       !< Reduced m-index for workarrc_sn
    7281       INTEGER(iwp) ::  n        !< Parent-grid running index in the z-direction
    7282       INTEGER(iwp) ::  np1      !< n+1
    7283       INTEGER(iwp) ::  ntopw    !< Upshift by one for the upper bound of index n in case of var == 'w'
    7284       INTEGER(iwp) ::  var_flag !< Variable flag for BTEST( wall_flags_0 )
    7285 
    7286       REAL(wp) ::  cellsum      !< Sum of child-grid node values over the anterpolation cell
    7287       REAL(wp) ::  cellsumd     !< Sum of differences over the anterpolation cell
    7288       REAL(wp) ::  fk           !< Intermediate result in trilinear interpolation
    7289       REAL(wp) ::  fkj          !< Intermediate result in trilinear interpolation
    7290       REAL(wp) ::  fkjp         !< Intermediate result in trilinear interpolation
    7291       REAL(wp) ::  fkpj         !< Intermediate result in trilinear interpolation
    7292       REAL(wp) ::  fkpjp        !< Intermediate result in trilinear interpolation
    7293       REAL(wp) ::  fkp          !< Intermediate result in trilinear interpolation
    7294       REAL(wp) ::  rcorr        !< Average reversibility correction for the whole anterpolation cell
    7295       REAL(wp) ::  rcorr_ijk    !< Reversibility correction distributed to the individual child-grid nodes
    7296 
    7297 !
    7298 !--   Check which edge is to be handled: south or north
    7299       IF ( edge == 's' )  THEN
    7300 !
    7301 !--      For v, nys is a ghost node, but not for the other variables
    7302          IF ( var == 'v' )  THEN
    7303             j     = nys
    7304             jend  = nys
    7305             jawbc = 0
    7306             jbc   = nys       
    7307             mbeg  = jcs
    7308             moff  = 0
    7309          ELSE
    7310             j     = nys - jgsr
    7311             jend  = nys - 1
    7312             jawbc = jgsr - 1
    7313             jbc   = nys - 1
    7314             mbeg  = jcs
    7315             moff  = 0
    7316          ENDIF
    7317       ELSEIF ( edge == 'n' )  THEN
    7318          IF ( var == 'v' )  THEN
    7319             j     = nyn + 1
    7320             jend  = nyn + 1
    7321             jawbc = 0
    7322             jbc   = nyn + 1
    7323             mbeg  = jcn - 2
    7324             moff  = 0
    7325          ELSE
    7326             j     = nyn + 1
    7327             jend  = nyn + jgsr
    7328             jawbc = 0
    7329             jbc   = nyn + 1
    7330             mbeg  = jcn - 2
    7331             moff  = 1
    7332          ENDIF
    7333       ENDIF
    7334 
    7335       IF  ( var == 'w' )  THEN
    7336          ntopw = 1
    7337       ELSE
    7338          ntopw = 0
    7339       ENDIF
    7340 
    7341       IF  ( var == 'u' )  THEN
    7342          lrightu = 0
    7343       ELSE
    7344          lrightu = 1
    7345       ENDIF
    7346 
    7347       IF ( var == 'u' )  THEN
    7348          var_flag = 1
    7349       ELSEIF ( var == 'v' )  THEN
    7350          var_flag = 2
    7351       ELSEIF ( var == 'w' )  THEN
    7352          var_flag = 3
    7353       ELSE
    7354          var_flag = 0
    7355       ENDIF
    7356 !AH
    7357 !
    7358 !--   Substitute the necessary parent-grid data to the work array workarrc_sn.
    7359       workarrc_sn = 0.0_wp     
    7360       IF  ( pdims(1) > 1 )  THEN
    7361 #if defined( __parallel )
    7362          IF  ( nxl == 0 )  THEN   ! if ( bc_dirichlet_l )
    7363             workarrc_sn(0:cg%nz+1,0:2,iclw:icrw-1)                              &
    7364                  = fc(0:cg%nz+1,mbeg:mbeg+2,iclw:icrw-1)
    7365          ELSE IF  ( nxr == nx )  THEN    ! if ( bc_dirichlet_r )
    7366             workarrc_sn(0:cg%nz+1,0:2,iclw+1:icrw)                              &
    7367                  = fc(0:cg%nz+1,mbeg:mbeg+2,iclw+1:icrw)
    7368          ELSE
    7369             workarrc_sn(0:cg%nz+1,0:2,iclw+1:icrw-1)                            &
    7370                  = fc(0:cg%nz+1,mbeg:mbeg+2,iclw+1:icrw-1)
    7371          ENDIF
    7372 !
    7373 !--      Left-right exchange if more than one PE subdomain in the x-direction.
    7374 !--      Note that in case of 3-D nesting the left (pleft == MPI_PROC_NULL) and
    7375 !--      right (pright == MPI_PROC_NULL) boundaries are not exchanged because
    7376 !--      the nest domain is not cyclic.
    7377 !--      From left to right
    7378          CALL MPI_SENDRECV( workarrc_sn(0,0,iclw+1), 1,                         &
    7379               workarrc_sn_exchange_type, pleft,   0,                            &
    7380               workarrc_sn(0,0,icrw), 1,                                         &
    7381               workarrc_sn_exchange_type, pright,  0,                            &
    7382               comm2d, status, ierr )
    7383 !
    7384 !--      From right to left       
    7385          CALL MPI_SENDRECV( workarrc_sn(0,0,icrw-1), 1,                         &
    7386               workarrc_sn_exchange_type, pright,  1,                            &
    7387               workarrc_sn(0,0,iclw), 1,                                         &
    7388               workarrc_sn_exchange_type, pleft,   1,                            &
    7389               comm2d, status, ierr )
    7390 #endif     
    7391       ELSE
    7392          workarrc_sn(0:cg%nz+1,0:2,iclw+1:icrw-1)                               &
    7393                  = fc(0:cg%nz+1,mbeg:mbeg+2,iclw+1:icrw-1)
    7394       ENDIF
    7395 !
    7396 !AH
    7397 
    7398       workarr_sn = 0.0_wp
    7399      
    7400       DO  i = nxl-1, nxr+1
    7401 !AH      DO  i = nxl, nxr
    7402          DO  ja = j, jend
    7403             jaw = ja - j
    7404             DO  k = nzb, nzt+1
    7405                l   = ic(i)
    7406                lp1 = MIN( l + 1, icrw )  ! If l+1 > icr (l=ic(nxr+1)), r1x = 1 and r2x = 0
    7407 !AH               m   = jc(ja) - jc(j)
    7408                m   = jc(ja) - mbeg
    7409                mp1 = MIN( m + 1, 2 )  ! If m+1 > 2 (m=jc(nyn+1)-mbeg), r1y = 1 and r2y = 0
    7410                n   = kc(k)
    7411                np1 = n + 1
    7412 !AH
    7413 !               fkj      = r1x(i) * fc(n,m,l)     + r2x(i) * fc(n,m,l+1)
    7414 !               fkjp     = r1x(i) * fc(n,m+1,l)   + r2x(i) * fc(n,m+1,l+1)
    7415 !               fkpj     = r1x(i) * fc(n+1,m,l)   + r2x(i) * fc(n+1,m,l+1)
    7416 !               fkpjp    = r1x(i) * fc(n+1,m+1,l) + r2x(i) * fc(n+1,m+1,l+1)
    7417 !AH
    7418                fkj      = r1x(i) * workarrc_sn(n,m,l)     + r2x(i) * workarrc_sn(n,m,lp1)
    7419                fkjp     = r1x(i) * workarrc_sn(n,mp1,l)   + r2x(i) * workarrc_sn(n,mp1,lp1)
    7420                fkpj     = r1x(i) * workarrc_sn(np1,m,l)   + r2x(i) * workarrc_sn(np1,m,lp1)
    7421                fkpjp    = r1x(i) * workarrc_sn(np1,mp1,l) + r2x(i) * workarrc_sn(np1,mp1,lp1)
    7422 
    7423                fk       = r1y(ja) * fkj  + r2y(ja) * fkjp
    7424                fkp      = r1y(ja) * fkpj + r2y(ja) * fkpjp
    7425 !AH
    7426 !               f(k,j,i) = r1z(k) * fk   + r2z(k) * fkp
    7427                workarr_sn(k,jaw,i) = r1z(k) * fk   + r2z(k) * fkp
    7428 
    7429 !               if  ( ( edge == 's' ) .and. ( ja  == jbc ) ) then
    7430 !                  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, &
    7431 !                       workarr_sn(k,jaw,i)
    7432 !                  flush(9)
    7433 !               endif
    7434 
    7435 !AH               
    7436             ENDDO
    7437          ENDDO
    7438       ENDDO     
    7439 !
    7440 !--   Generalized log-law-correction algorithm.
    7441 !--   Multiply two-dimensional index arrays logc(1:2,:,:) and log-ratio arrays
    7442 !--   logc_ratio(1:2,0:ncorr-1,:,:) have been precomputed in subroutine
    7443 !--   pmci_init_loglaw_correction.
    7444 !
    7445 !--   Solid surface below the node
    7446       IF ( constant_flux_layer .AND. ( var == 'u'  .OR.  var == 'v' ) )  THEN           
    7447          DO  i = nxl, nxr
    7448 !
    7449 !--         Determine vertical index of topography top at grid point (j,i)
    7450             k_wall = get_topography_top_index_ji( j, i, TRIM( var ) )
    7451 
    7452             k = k_wall + 1
    7453             IF ( ( logc(1,k,i) /= 0 )  .AND.  ( logc(2,k,i) == 0 ) )  THEN
    7454                k1 = logc(1,k,i)
    7455                DO  kcorr = 0, ncorr-1
    7456                   kco = k + kcorr
    7457 !AH                  f(kco,j,i) = logc_ratio(1,kcorr,k,i) * f(k1,j,i)
    7458                ENDDO
    7459             ENDIF
    7460          ENDDO
    7461       ENDIF
    7462 !
    7463 !--   In case of non-flat topography, also vertical walls and corners need to be
    7464 !--   treated. Only single and double wall nodes are corrected.
    7465 !--   Triple and higher-multiple wall nodes are not corrected as it would be
    7466 !--   extremely complicated and the log law would not be valid anyway in such
    7467 !--   locations.
    7468       IF ( topography /= 'flat' )  THEN
    7469 
    7470          IF ( constant_flux_layer .AND. ( var == 'v' .OR. var == 'w' ) )  THEN
    7471             DO  i = nxl, nxr
    7472                DO  k = logc_kbounds(1,i), logc_kbounds(2,i)
    7473 !
    7474 !--               Solid surface only on left/right side of the node           
    7475                   IF ( ( logc(2,k,i) /= 0 )  .AND.  ( logc(1,k,i) == 0 ) )  THEN
    7476 !
    7477 !--                  Direction of the wall-normal index is carried in as the
    7478 !--                  sign of logc
    7479                      iinc = SIGN( 1, logc(2,k,i) )
    7480                      i1  = ABS( logc(2,k,i) )
    7481                      DO  icorr = 0, ncorr-1
    7482                         ico = i + iinc * icorr
    7483                         IF ( ico >= nxl .AND. ico <= nxr )  THEN
    7484 !AH                           f(k,j,ico) = logc_ratio(2,icorr,k,i) * f(k,j,i1)
    7485                         ENDIF
    7486                      ENDDO
    7487                   ENDIF
    7488                ENDDO
    7489             ENDDO
    7490          ENDIF
    7491 !
    7492 !--      Solid surface on both below and on left/right side of the node           
    7493          IF ( constant_flux_layer .AND. var == 'v' )  THEN
    7494             DO  i = nxl, nxr
    7495                k = logc_kbounds(1,i)
    7496                IF ( ( logc(2,k,i) /= 0 )  .AND.  ( logc(1,k,i) /= 0 ) )  THEN
    7497                   k1   = logc(1,k,i)         
    7498                   iinc = SIGN( 1, logc(2,k,i) )
    7499                   i1   = ABS( logc(2,k,i) )
    7500                   DO  icorr = 0, ncorr-1
    7501                      ico = i + iinc * icorr
    7502                      IF ( ico >= nxl .AND. ico <= nxr )  THEN
    7503                         DO  kcorr = 0, ncorr-1
    7504                            kco = k + kcorr
    7505 !AH                           f(kco,j,ico) = 0.5_wp * ( logc_ratio(1,kcorr,k,i) * &
    7506 !AH                                                     f(k1,j,i)                 &
    7507 !AH                                                   + logc_ratio(2,icorr,k,i) * &
    7508 !AH                                                     f(k,j,i1) )
    7509                         ENDDO
    7510                      ENDIF
    7511                   ENDDO
    7512                ENDIF
    7513             ENDDO
    7514          ENDIF
    7515          
    7516       ENDIF  ! ( topography /= 'flat' )
    7517 !
    7518 !--   Apply the reversibility correction.
    7519      
    7520 !      if  ( var == 'u' )  then
    7521 
    7522       m  = jc(jbc) + moff
    7523       mw = 1
    7524 !      write(9,"('pmci_interp_tril_sn: edge, var, m, j, jend, jfl(m), jfu(m) = ',2(a2,2x),5(i4,2x))") &
    7525 !           edge, var, m, j, jend, jfl(m), jfu(m)
    7526 !      flush(9)
    7527 !AH      DO  l = iclw+1, icrw-1
    7528       DO  l = iclw + 1, icrw - lrightu   ! lrightu = 0 for u and 1 for all others
    7529          DO  n = 0, kct + ntopw            ! ntopw = 1 for w and 0 for all others
    7530             ijk = 1
    7531             cellsum   = 0.0_wp
    7532             cellsumd  = 0.0_wp
    7533             DO  i = ifl(l), ifu(l)
    7534                iw = MAX( MIN( i, nx+1 ), -1 )
    7535                DO  ja = jfl(m), jfu(m)
    7536                   jaw = ja - j
    7537                   jw  = MAX( MIN( ja, ny+1 ), -1 )
    7538                   DO  k = kfl(n), kfu(n)
    7539                      kw = MIN( k, nzt+1 )
    7540 !AH                     cellsum = cellsum + MERGE( f(k,ja,i), 0.0_wp,              &
    7541 !AH                          BTEST( wall_flags_0(kw,jw,iw), var_flag ) )
    7542                      cellsum = cellsum + MERGE( workarr_sn(k,jaw,i), 0.0_wp,       &
    7543                           BTEST( wall_flags_0(kw,jw,iw), var_flag ) )                   
    7544 !AH                     celltmpd(ijk) = ABS( fc(n,m,l) - f(k,ja,i) )
    7545 !AH                     celltmpd(ijk) = ABS( workarrc_sn(n,mw,l) - f(k,ja,i) )
    7546                      celltmpd(ijk) = ABS( workarrc_sn(n,mw,l) - workarr_sn(k,jaw,i) )
    7547                      cellsumd      = cellsumd  + MERGE( celltmpd(ijk),          &
    7548                           0.0_wp, BTEST( wall_flags_0(kw,jw,iw), var_flag ) )
    7549 
    7550 !                     write(9,"('sn1: ',a1,2x,8(i4,2x),5(e12.5,2x))") var, n, m, l, k, ja, i, jaw, ijk,  &
    7551 !                          workarrc_sn(n,mw,l), workarr_sn(k,jaw,i), cellsum, celltmpd(ijk), cellsumd
    7552 !                     flush(9)
    7553 
    7554                      ijk = ijk + 1
    7555                   ENDDO
    7556                ENDDO
    7557             ENDDO
    7558 
    7559             IF ( ijkfc(n,m,l) /= 0 )  THEN
    7560                cellsum   = cellsum / REAL( ijkfc(n,m,l), KIND=wp )
    7561 !AH               rcorr     = fc(n,m,l) - cellsum
    7562                rcorr     = workarrc_sn(n,mw,l) - cellsum
    7563                cellsumd  = cellsumd / REAL( ijkfc(n,m,l), KIND=wp )
    7564             ELSE
    7565                cellsum   = 0.0_wp                 
    7566                rcorr     = 0.0_wp
    7567                cellsumd  = 1.0_wp
    7568                celltmpd  = 1.0_wp
    7569             ENDIF
    7570 !
    7571 !--         Distribute the correction term to the child nodes according to
    7572 !--         their relative difference to the parent value such that the
    7573 !--         node with the largest difference gets the largest share of the
    7574 !--         correction. The distribution is skipped if rcorr is negligibly
    7575 !--         small in order to avoid division by zero.
    7576             IF ( ABS(rcorr) < 0.000001_wp )  THEN                 
    7577                cellsumd  = 1.0_wp
    7578                celltmpd  = 1.0_wp
    7579             ENDIF
    7580            
    7581             ijk = 1           
    7582             DO  i = ifl(l), ifu(l)
    7583                DO  ja = jfl(m), jfu(m)
    7584 !AH                  jaw = ja - jfl(m)
    7585                   jaw = ja - j
    7586                   DO  k = kfl(n), kfu(n)
    7587                      rcorr_ijk = rcorr * celltmpd(ijk) / cellsumd
    7588 !AH                     f(k,ja,i) = f(k,ja,i) + rcorr_ijk
    7589                      workarr_sn(k,jaw,i) = workarr_sn(k,jaw,i) + rcorr_ijk
    7590 
    7591 !                     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), &
    7592 !                          rcorr, rcorr_ijk, workarr_sn(k,jaw,i), workarrc_sn(n,mw,l)
    7593 !                     flush(9)
    7594 
    7595                      ijk = ijk + 1
    7596                   ENDDO
    7597                ENDDO
    7598             ENDDO
    7599 !
    7600 !--         Velocity components tangential to the boundary need special
    7601 !--         treatment because their anterpolation cells are flat in their
    7602 !--         direction and hence do not cover all the child-grid boundary nodes.
    7603 !--         These components are next linearly interpolated to those child-grid
    7604 !--         boundary nodes which are not covered by the anterpolation cells.     
    7605             IF  ( ( var == 'w' ) .AND. ( n > 0 ) )  THEN
    7606                DO  k = kfu(n-1)+1, kfl(n)-1
    7607                   IF  ( k <= nzt )  THEN
    7608                      DO  i = ifl(l), ifu(l)
    7609                         IF  ( ( i >= nxl ) .AND. ( i <= nxr+1 ) )  THEN
    7610 !AH                         f(k,ja,i) = r1z(k) * f(kfu(n-1),ja,i)                &
    7611 !AH                               + r2z(k) * f(kfl(n),ja,i)
    7612                            workarr_sn(k,jawbc,i) =                              &
    7613                                 r1z(k) * workarr_sn(kfu(n-1),jawbc,i) +         &
    7614                                 r2z(k) * workarr_sn(kfl(n),jawbc,i)
    7615    
    7616 !                           write(9,"('sn3: ',a1,2x,7(i4,2x),3(e12.5,2x))") var, n, m, l, k, jawbc, i, jbc,  &
    7617 !                                workarr_sn(k-1,jawbc,i), workarr_sn(k,jawbc,i), workarr_sn(k+1,jawbc,i)
    7618 !                           flush(9)
    7619 
    7620                         ENDIF
    7621                      ENDDO
    7622                   ENDIF
    7623                ENDDO
    7624             ENDIF
    7625                
    7626             IF  ( ( var == 'u' ) .AND. ( l > iclw ) )  THEN
    7627                DO  i = ifu(l-1)+1, ifl(l)-1
    7628                   IF  ( ( i >= nxl ) .AND. ( i <= nxr+1 ) )  THEN
    7629                      DO  k = kfl(n), kfu(n)
    7630                         IF  ( k <= nzt+1 )  THEN
    7631 !AH                         f(k,ja,i) = r1x(i) * f(k,ja,ifu(l-1))                &
    7632 !AH                               + r2x(i) * f(k,ja,ifl(l))
    7633                            workarr_sn(k,jawbc,i) =                              &
    7634                                 r1x(i) * workarr_sn(k,jawbc,ifu(l-1)) +         &
    7635                                 r2x(i) * workarr_sn(k,jawbc,ifl(l))
    7636                            
    7637 !                           write(9,"('sn4: ',a1,2x,7(i4,2x),3(e12.5,2x))") var, n, m, l, k, jawbc, i, jbc, &
    7638 !                                workarr_sn(k,jawbc,i-1), workarr_sn(k,jawbc,i), workarr_sn(k,jawbc,i+1)
    7639 !                           flush(9)
    7640 
    7641                         ENDIF
    7642                      ENDDO
    7643                   ENDIF
    7644                ENDDO
    7645             ENDIF
    7646                
    7647          ENDDO  ! n
    7648       ENDDO  ! l
    7649 
    7650 !      endif  ! var
    7651 
    7652 !
    7653 !--   Finally substitute the boundary values.
    7654       f(nzb:nzt+1,jbc,nxl:nxr) = workarr_sn(nzb:nzt+1,jawbc,nxl:nxr)
    7655 
    7656 !      do  k = 0, 2
    7657 !         do  i = nxl, nxr
    7658 !            if  ( edge == 's' )  then
    7659 !               write(9,"('sn5: ',2(a2,2x),4(i4,2x),4(e12.5,2x))") edge, var, k, i, jbc, jawbc,  &
    7660 !                    workarr_sn(k,jawbc,i), f(k,jbc,i), f(k,jbc+1,i), f(k,jbc+2,i)
    7661 !            else if  ( edge == 'n' )  then
    7662 !               write(9,"('sn5: ',2(a2,2x),4(i4,2x),4(e12.5,2x))") edge, var, k, i, jbc, jawbc,  &
    7663 !                    f(k,jbc-2,i), f(k,jbc-1,i), f(k,jbc,i), workarr_sn(k,jawbc,i)
    7664 !            endif
    7665 !         enddo
    7666 !      enddo
    7667 !      flush(9)
    7668 
    7669    END SUBROUTINE pmci_interp_tril_sn
    7670 
    7671  
    7672 
    7673    SUBROUTINE pmci_interp_tril_t( f, fc, ic, jc, kc, r1x, r2x, r1y, r2y,       &
    7674                                   r1z, r2z, kct, ifl, ifu, jfl, jfu, kfl, kfu, &
    7675                                   ijkfc, var )
    7676 
    7677 !
    7678 !--   Interpolation of ghost-node values used as the child-domain boundary
    7679 !--   conditions. This subroutine handles the top boundary.
    7680 !--   This subroutine is based on trilinear interpolation.
    7681 
    7682       IMPLICIT NONE
    7683 
    7684       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                      &
    7685                                       INTENT(INOUT) ::  f     !< Child-grid array
    7686       REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr),                          &
    7687                                       INTENT(IN)    ::  fc    !< Parent-grid array
    7688       REAL(wp), DIMENSION(nxlfc:nxrfc), INTENT(IN)  ::  r1x   !<
    7689       REAL(wp), DIMENSION(nxlfc:nxrfc), INTENT(IN)  ::  r2x   !<
    7690       REAL(wp), DIMENSION(nysfc:nynfc), INTENT(IN)  ::  r1y   !<
    7691       REAL(wp), DIMENSION(nysfc:nynfc), INTENT(IN)  ::  r2y   !<
    7692 !AH      REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN)    ::  r1z   !<
    7693 !AH      REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN)    ::  r2z   !<
    7694       REAL(wp), DIMENSION(nzb:nzt+kgsr), INTENT(IN) ::  r1z   !<
    7695       REAL(wp), DIMENSION(nzb:nzt+kgsr), INTENT(IN) ::  r2z   !<
    7696 
    7697      
    7698       INTEGER(iwp), DIMENSION(nxlfc:nxrfc), INTENT(IN)  ::  ic    !<
    7699       INTEGER(iwp), DIMENSION(nysfc:nynfc), INTENT(IN)  ::  jc    !<
    7700 !AH      INTEGER(iwp), DIMENSION(nzb:nzt+1), INTENT(IN)    ::  kc    !<
    7701       INTEGER(iwp), DIMENSION(nzb:nzt+kgsr), INTENT(IN) ::  kc    !<
    7702 
    7703       INTEGER(iwp) :: kct
    7704 !AH
    7705 !      INTEGER(iwp), DIMENSION(icl:icr), INTENT(IN) ::  ifl !< Indicates start index of child cells belonging to certain parent cell - x direction
    7706 !      INTEGER(iwp), DIMENSION(icl:icr), INTENT(IN) ::  ifu !< Indicates end index of child cells belonging to certain parent cell - x direction
    7707 !      INTEGER(iwp), DIMENSION(jcs:jcn), INTENT(IN) ::  jfl !< Indicates start index of child cells belonging to certain parent cell - y direction
    7708 !      INTEGER(iwp), DIMENSION(jcs:jcn), INTENT(IN) ::  jfu !< Indicates start index of child cells belonging to certain parent cell - y direction
    7709       INTEGER(iwp), DIMENSION(icla:icra), INTENT(IN) ::  ifl !< Indicates start index of child cells belonging to certain parent cell - x direction
    7710       INTEGER(iwp), DIMENSION(icla:icra), INTENT(IN) ::  ifu !< Indicates end index of child cells belonging to certain parent cell - x direction
    7711       INTEGER(iwp), DIMENSION(jcsa:jcna), INTENT(IN) ::  jfl !< Indicates start index of child cells belonging to certain parent cell - y direction
    7712       INTEGER(iwp), DIMENSION(jcsa:jcna), INTENT(IN) ::  jfu !< Indicates start index of child cells belonging to certain parent cell - y direction
    7713 !AH      INTEGER(iwp), DIMENSION(0:kct), INTENT(IN)   ::  kfl !< Indicates start index of child cells belonging to certain parent cell - z direction
    7714 !AH      INTEGER(iwp), DIMENSION(0:kct), INTENT(IN)   ::  kfu !< Indicates start index of child cells belonging to certain parent cell - z direction
    7715       INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN)   ::  kfl !< Indicates start index of child cells belonging to certain parent cell - z direction
    7716       INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN)   ::  kfu !< Indicates start index of child cells belonging to certain parent cell - z direction
    7717 !AH      INTEGER(iwp), DIMENSION(0:kct,jcs:jcn,icl:icr), INTENT(IN) :: ijkfc !< number of child grid points contributing to a parent grid box
    7718 !AH
    7719 !      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
    7720       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
    7721 !AH
    7722 
    7723       CHARACTER(LEN=1), INTENT(IN) :: var   !<
    7724 
    7725       INTEGER(iwp) ::  i    !<
    7726       INTEGER(iwp) ::  ib   !<
    7727       INTEGER(iwp) ::  iclc !< Lower i-index limit for copying fc-data to workarrc_t
    7728       INTEGER(iwp) ::  icrc !< Upper i-index limit for copying fc-data to workarrc_t
    7729       INTEGER(iwp) ::  ie   !<
    7730       INTEGER(iwp) ::  ierr !< MPI error code
    7731       INTEGER(iwp) ::  ijk  !<
    7732       INTEGER(iwp) ::  iw   !<
    7733       INTEGER(iwp) ::  j    !<
    7734       INTEGER(iwp) ::  jb   !<
    7735       INTEGER(iwp) ::  jcsc !< Lower j-index limit for copying fc-data to workarrc_t
    7736       INTEGER(iwp) ::  jcnc !< Upper j-index limit for copying fc-data to workarrc_t
    7737       INTEGER(iwp) ::  je   !<
    7738       INTEGER(iwp) ::  jw   !<     
    7739       INTEGER(iwp) ::  k    !< Vertical child-grid index fixed to the boundary-value level
    7740       INTEGER(iwp) ::  ka   !< Running vertical child-grid index
    7741       INTEGER(iwp) ::  kw   !<
    7742       INTEGER(iwp) ::  l    !< Parent-grid index in x-direction
    7743       INTEGER(iwp) ::  lp1  !< l+1
    7744       INTEGER(iwp) ::  m    !< Parent-grid index in y-direction
    7745       INTEGER(iwp) ::  mp1  !< m+1
    7746       INTEGER(iwp) ::  n    !< Parent-grid work array index in z-direction
    7747       INTEGER(iwp) ::  np1  !< n+1
    7748       INTEGER(iwp) ::  noff !< n-offset needed on the top boundary to correctly refer to boundary ghost points 
    7749       INTEGER(iwp) ::  nw   !< n-index for workarrc_t
    7750       INTEGER(iwp) ::  var_flag  !<
    7751      
    7752       REAL(wp) ::  cellsum     !<
    7753       REAL(wp) ::  cellsumd    !<
    7754       REAL(wp) ::  fk          !<
    7755       REAL(wp) ::  fkj         !<
    7756       REAL(wp) ::  fkjp        !<
    7757       REAL(wp) ::  fkpj        !<
    7758       REAL(wp) ::  fkpjp       !<
    7759       REAL(wp) ::  fkp         !<
    7760       REAL(wp) ::  rcorr       !<
    7761       REAL(wp) ::  rcorr_ijk   !<
    7762 
    7763       integer(iwp) :: kend
    7764 
    7765 
    7766       IF ( var == 'w' )  THEN
    7767          k    = nzt
    7768          noff = 0
    7769          kend = nzt
    7770       ELSE
    7771          k    = nzt + 1
    7772          noff = 1
    7773          kend = nzt+kgsr
    7774       ENDIF
    7775 !
    7776 !--   These exceedings by one are needed only to avoid stripes
    7777 !--   and spots in visualization. They have no effect on the
    7778 !--   actual solution.     
    7779 !
    7780 !AH   These loop bounds lead to overflows with the current reduced icl, icr, jcs, jcn
    7781 !AH      ib = nxl-1
    7782 !AH      ie = nxr+1
    7783 !AH      jb = nys-1
    7784 !AH      je = nyn+1
    7785       ib = nxl
    7786       ie = nxr
    7787       jb = nys
    7788       je = nyn
    7789 
    7790       IF ( var == 'u' )  THEN
    7791          var_flag = 1
    7792          ie       = nxr + 1 ! Needed for finishing interpolation for u
    7793       ELSEIF ( var == 'v' )  THEN
    7794          var_flag = 2     
    7795          je       = nyn + 1 ! Needed for finishing interpolation for v
    7796       ELSEIF ( var == 'w' )  THEN
    7797          var_flag = 3
    7798       ELSE
    7799          var_flag = 0
    7800       ENDIF
    7801          
    7802 !AH      DO  i = ib, ie
    7803 !AH         DO  j = jb, je
    7804 !AH            l = ic(i)
    7805 !AH            m = jc(j)
    7806 !AH            n = kc(k)           
    7807 !AH            fkj      = r1x(i) * fc(n,m,l)     + r2x(i) * fc(n,m,l+1)
    7808 !AH            fkjp     = r1x(i) * fc(n,m+1,l)   + r2x(i) * fc(n,m+1,l+1)
    7809 !AH            fkpj     = r1x(i) * fc(n+1,m,l)   + r2x(i) * fc(n+1,m,l+1)
    7810 !AH            fkpjp    = r1x(i) * fc(n+1,m+1,l) + r2x(i) * fc(n+1,m+1,l+1)
    7811 !AH            fk       = r1y(j) * fkj  + r2y(j) * fkjp
    7812 !AH            fkp      = r1y(j) * fkpj + r2y(j) * fkpjp
    7813 !AH            f(k,j,i) = r1z(k) * fk   + r2z(k) * fkp
    7814 !AH         ENDDO
    7815 !AH      ENDDO
    7816 
    7817 !      write(9,"('workarrc_t kbounds: ',a2,2x,5(i3,2x))") var, k, kend, kc(k), kc(kend), cg%nz+1
    7818 !      flush(9)
    7819 !AH
    7820 !
    7821 !--   Substitute the necessary parent-grid data to the work array.
    7822 !--   Note that the dimension of workarrc_t is (0:2,jcsw:jcnw,iclw:icrw),
    7823 !--   And the jc?w and ic?w-index bounds depend on the location of the PE-
    7824 !--   subdomain relative to the side boundaries.
    7825       iclc = iclw + 1
    7826       icrc = icrw - 1     
    7827       jcsc = jcsw + 1
    7828       jcnc = jcnw - 1
    7829       IF  ( bc_dirichlet_l )  THEN
    7830          iclc = iclw
    7831       ENDIF
    7832       IF  ( bc_dirichlet_r )  THEN
    7833          icrc = icrw
    7834       ENDIF
    7835       IF  ( bc_dirichlet_s )  THEN
    7836          jcsc = jcsw
    7837       ENDIF
    7838       IF  ( bc_dirichlet_n )  THEN
    7839          jcnc = jcnw
    7840       ENDIF
    7841       workarrc_t = 0.0_wp
    7842       workarrc_t(0:2,jcsc:jcnc,iclc:icrc)                                       &
    7843            = fc(kc(k):kc(k)+2,jcsc:jcnc,iclc:icrc)
    7844 !
    7845 !--   Left-right exchange if more than one PE subdomain in the x-direction.
    7846 !--   Note that in case of 3-D nesting the left and right boundaries are
    7847 !--   not exchanged because the nest domain is not cyclic.
    7848 #if defined( __parallel )
    7849       IF  ( pdims(1) > 1 )  THEN
    7850 !
    7851 !--      From left to right
    7852          CALL MPI_SENDRECV( workarrc_t(0,jcsw,iclw+1), 1,                       &
    7853               workarrc_t_exchange_type_y, pleft,  0,                            &
    7854               workarrc_t(0,jcsw,icrw), 1,                                       &
    7855               workarrc_t_exchange_type_y, pright, 0,                            &
    7856               comm2d, status, ierr )
    7857 !
    7858 !--      From right to left       
    7859          CALL MPI_SENDRECV( workarrc_t(0,jcsw,icrw-1), 1,                       &
    7860               workarrc_t_exchange_type_y, pright, 1,                            &
    7861               workarrc_t(0,jcsw,iclw), 1,                                       &
    7862               workarrc_t_exchange_type_y, pleft,  1,                            &
    7863               comm2d, status, ierr )
    7864       ENDIF
    7865 !
    7866 !--   South-north exchange if more than one PE subdomain in the y-direction.
    7867 !--   Note that in case of 3-D nesting the south and north boundaries are
    7868 !--   not exchanged because the nest domain is not cyclic.
    7869       IF  ( pdims(2) > 1 )  THEN
    7870 !
    7871 !--      From south to north         
    7872          CALL MPI_SENDRECV( workarrc_t(0,jcsw+1,iclw), 1,                       &
    7873               workarrc_t_exchange_type_x, psouth, 2,                            &
    7874               workarrc_t(0,jcnw,iclw), 1,                                       &
    7875               workarrc_t_exchange_type_x, pnorth, 2,                            &
    7876               comm2d, status, ierr )
    7877 !
    7878 !--      From north to south       
    7879          CALL MPI_SENDRECV( workarrc_t(0,jcnw-1,iclw), 1,                       &
    7880               workarrc_t_exchange_type_x, pnorth, 3,                            &
    7881               workarrc_t(0,jcsw,iclw), 1,                                       &
    7882               workarrc_t_exchange_type_x, psouth, 3,                            &
    7883               comm2d, status, ierr )
    7884       ENDIF
    7885 #endif     
    7886 !
    7887 !AH
    7888 
    7889       workarr_t = 0.0_wp
    7890 
    7891       DO  i = ib, ie
    7892          DO  j = jb, je
    7893             DO ka = k, kend
    7894                l    = ic(i)
    7895                lp1  = MIN( l + 1, icrw ) ! If l+1 > icr (l=ic(nxr+1)), r1x = 1 and r2x = 0
    7896                m    = jc(j)
    7897                mp1  = MIN( m + 1, jcnw ) ! If m+1 > jcn (m=jc(nyn+1)), r1y = 1 and r2y = 0
    7898 !AH
    7899 !               n    = kc(ka)           
    7900                n   = kc(ka) - kc(k)
    7901                np1 = n + 1
    7902 !AH
    7903 !               fkj       = r1x(i)  * fc(n,m,l)     + r2x(i) * fc(n,m,l+1)
    7904 !               fkjp      = r1x(i)  * fc(n,m+1,l)   + r2x(i) * fc(n,m+1,l+1)
    7905 !               fkpj      = r1x(i)  * fc(n+1,m,l)   + r2x(i) * fc(n+1,m,l+1)
    7906 !               fkpjp     = r1x(i)  * fc(n+1,m+1,l) + r2x(i) * fc(n+1,m+1,l+1)
    7907 !AH
    7908                fkj       = r1x(i)  * workarrc_t(n,m,l)     + r2x(i) * workarrc_t(n,m,lp1)
    7909                fkjp      = r1x(i)  * workarrc_t(n,mp1,l)   + r2x(i) * workarrc_t(n,mp1,lp1)
    7910                fkpj      = r1x(i)  * workarrc_t(np1,m,l)   + r2x(i) * workarrc_t(np1,m,lp1)
    7911                fkpjp     = r1x(i)  * workarrc_t(np1,mp1,l) + r2x(i) * workarrc_t(np1,mp1,lp1)
    7912 !AH
    7913                fk        = r1y(j)  * fkj  + r2y(j) * fkjp
    7914                fkp       = r1y(j)  * fkpj + r2y(j) * fkpjp
    7915                workarr_t(ka,j,i) = r1z(ka) * fk + r2z(ka) * fkp
    7916          
    7917             ENDDO
    7918          ENDDO
    7919       ENDDO
    7920 
    7921 !AH!
    7922 !AH!--   Just fill up the redundant second ghost-node layer for w.
    7923 !AH      IF ( var == 'w' )  THEN
    7924 !AH         f(nzt+1,:,:) = f(nzt,:,:)
    7925 !AH      ENDIF
    7926 !
    7927 !--      Apply the reversibility correction.
    7928          n  = kc(k) + noff 
    7929          nw = 0
    7930 !AH         DO  l = icl-1, icr+1
    7931          DO  l = iclw, icrw
    7932 !AH            DO  m = jcs-1, jcn+1
    7933             DO  m = jcsw, jcnw
    7934                ijk = 1
    7935                cellsum   = 0.0_wp
    7936                cellsumd  = 0.0_wp
    7937                DO  i = ifl(l), ifu(l)
    7938                   iw = MAX( MIN( i, nx+1 ), -1 )
    7939                   IF  ( ( i >= nxl ) .AND. ( i <= nxr+1 ) )  THEN
    7940                      DO  j = jfl(m), jfu(m)
    7941                         jw = MAX( MIN( j, ny+1 ), -1 )
    7942                         IF  ( ( j >= nys ) .AND. ( j <= nyn+1 ) )  THEN
    7943                            DO  ka = kfl(n), kfu(n)
    7944                               kw = MIN( ka, nzt+1 )
    7945 !AH                            cellsum = cellsum + MERGE( f(ka,j,i), 0.0_wp,           &
    7946                               cellsum = cellsum + MERGE( workarr_t(ka,j,i), 0.0_wp,   &
    7947                                    BTEST( wall_flags_0(kw,jw,iw), var_flag ) )
    7948 !                              cellsum = cellsum + workarr_t(ka,j,i)
    7949 !AH                            celltmpd(ijk) = ABS( fc(n,m,l) - f(ka,j,i) )
    7950 !AH
    7951 !                              celltmpd(ijk) = ABS( fc(n,m,l) - workarr_t(ka,j,i) )
    7952                               celltmpd(ijk) = ABS( workarrc_t(nw,m,l) - workarr_t(ka,j,i) )
    7953 !AH
    7954                               cellsumd      = cellsumd  + MERGE( celltmpd(ijk),       &
    7955                                    0.0_wp, BTEST( wall_flags_0(kw,jw,iw), var_flag ) )
    7956                               ijk = ijk + 1
    7957                            ENDDO
    7958                         ENDIF
    7959                      ENDDO
    7960                   ENDIF
    7961                ENDDO
    7962 
    7963                IF ( ijkfc(n,m,l) /= 0 )  THEN
    7964                   cellsum   = cellsum / REAL( ijkfc(n,m,l), KIND=wp )
    7965 !AH
    7966 !                  rcorr     = fc(n,m,l) - cellsum
    7967                   rcorr     = workarrc_t(nw,m,l) - cellsum
    7968 !AH                 
    7969                   cellsumd  = cellsumd / REAL( ijkfc(n,m,l), KIND=wp )
    7970                ELSE
    7971                   cellsum   = 0.0_wp
    7972                   rcorr     = 0.0_wp
    7973                   cellsumd  = 1.0_wp
    7974                   celltmpd  = 1.0_wp
    7975                ENDIF
    7976 !
    7977 !--            Distribute the correction term to the child nodes according to
    7978 !--            their relative difference to the parent value such that the
    7979 !--            node with the largest difference gets the largest share of the
    7980 !--            correction. The distribution is skipped if rcorr is negligibly
    7981 !--            small in order to avoid division by zero.
    7982                IF ( ABS(rcorr) < 0.000001_wp )  THEN                 
    7983                   cellsumd  = 1.0_wp
    7984                   celltmpd  = 1.0_wp
    7985                ENDIF
    7986            
    7987                ijk = 1
    7988                DO  i = ifl(l), ifu(l)
    7989                   IF  ( ( i >= nxl ) .AND. ( i <= nxr+1 ) )  THEN
    7990                      DO  j = jfl(m), jfu(m)
    7991                         IF  ( ( j >= nys ) .AND. ( j <= nyn+1 ) )  THEN
    7992                            DO  ka = kfl(n), kfu(n)
    7993                               rcorr_ijk = rcorr * celltmpd(ijk) / cellsumd
    7994 !AH                            f(ka,j,i) = f(ka,j,i) + rcorr_ijk
    7995                               workarr_t(ka,j,i) = workarr_t(ka,j,i) + rcorr_ijk
    7996 
    7997 !                                 if  ( i == 128 .and. var == 'u' )  then
    7998 !                                    write(9,"('t2: ', 8(i4,2x),3(e12.5,2x))") nw, m, l, ka, j, i, ifl(l), ifu(l), &
    7999 !                                         rcorr, rcorr_ijk, workarr_t(ka,j,i)
    8000 !                                    flush(9)
    8001 !                                 endif
    8002 
    8003                               ijk = ijk + 1
    8004                            ENDDO
    8005                         ENDIF
    8006                      ENDDO
    8007                   ENDIF
    8008                ENDDO
    8009 !
    8010 !--            Velocity components tangential to the boundary need special
    8011 !--            "finishing" because their anterpolation cells are flat in their
    8012 !--            direction and hence do not cover all the child-grid boundary nodes.
    8013 !--            These components are next linearly interpolated to those child-grid
    8014 !--            boundary nodes which are not covered by the anterpolation cells.
    8015                IF  ( ( var == 'v' ) .AND. ( m > jcs ) )  THEN
    8016                   DO  j = jfu(m-1)+1, jfl(m)-1
    8017                      IF  ( ( j >= nys ) .AND. ( j <= nyn+1 ) )  THEN
    8018                         DO  i = ifl(l), ifu(l)
    8019                            IF  ( ( i >= nxl ) .AND. ( i <= nxr+1 ) )  THEN
    8020                               DO  ka = kfl(n), kfu(n)        ! This loop should be removed and fixed k-value be used instead
    8021 !AH                              f(ka,j,i) = r1y(j) * f(ka,jfu(m-1),i)             &
    8022 !AH                                   + r2y(j) * f(ka,jfl(m),i)
    8023                                  workarr_t(ka,j,i) = r1y(j) * workarr_t(ka,jfu(m-1),i) &
    8024                                       + r2y(j) * workarr_t(ka,jfl(m),i)
    8025                               ENDDO
    8026                            ENDIF
    8027                         ENDDO
    8028                      ENDIF
    8029                   ENDDO
    8030                ENDIF
    8031                
    8032                IF  ( ( var == 'u' ) .AND. ( l > icl ) )  THEN
    8033                   DO  i = ifu(l-1)+1, ifl(l)-1
    8034                      IF  ( ( i >= nxl ) .AND. ( i <= nxr+1 ) )  THEN
    8035                         DO  j = jfl(m), jfu(m)
    8036                            IF  ( ( j >= nys ) .AND. ( j <= nyn+1 ) )  THEN
    8037                               DO  ka = kfl(n), kfu(n)        ! This loop should be removed and fixed k-value be used instead
    8038 !AH                              f(ka,j,i) = r1x(i) * f(ka,j,ifu(l-1)) +           &
    8039 !AH                                   r2x(i) * f(ka,j,ifl(l))
    8040                                  workarr_t(ka,j,i) = r1x(i) * workarr_t(ka,j,ifu(l-1)) &
    8041                                       + r2x(i) * workarr_t(ka,j,ifl(l))
    8042 
    8043 !                                 if  ( i == 127 )  then
    8044 !                                    write(9,"('t4: ', 8(i4,2x),3(e12.5,2x))") nw, m, l, ka, j, ifu(l-1), i, ifl(l), &
    8045 !                                         workarr_t(ka,j,ifu(l-1)), workarr_t(ka,j,i), workarr_t(ka,j,ifl(l))
    8046 !                                    flush(9)
    8047 !                                 endif
    8048 
    8049                               ENDDO
    8050                            ENDIF
    8051                         ENDDO
    8052                      ENDIF
    8053                   ENDDO
    8054                ENDIF
    8055                
    8056             ENDDO  ! m
    8057          ENDDO  ! l
    8058 !
    8059 !--   Finally substitute the boundary values.
    8060       f(k,nys:nyn,nxl:nxr) = workarr_t(k,nys:nyn,nxl:nxr)
    8061       IF  ( var == 'w' )  THEN
    8062          f(k+1,nys:nyn,nxl:nxr) = f(k,nys:nyn,nxl:nxr)
    8063       ENDIF
    8064 
    8065     END SUBROUTINE pmci_interp_tril_t
    8066 
    8067 
    8068 
    8069     SUBROUTINE pmci_anterp_tophat( f, fc, kct, ifl, ifu, jfl, jfu, kfl, kfu,   &
    8070                                    ijkfc, var )
    8071 !
    8072 !--    Anterpolation of internal-node values to be used as the parent-domain
    8073 !--    values. This subroutine is based on the first-order numerical
    8074 !--    integration of the fine-grid values contained within the coarse-grid
    8075 !--    cell.
    8076 
    8077        IMPLICIT NONE
    8078 
    8079        CHARACTER(LEN=*), INTENT(IN) ::  var   !< identifyer for treated variable
    8080 
    8081 !AH       INTEGER(iwp), DIMENSION(0:kct,jcs:jcn,icl:icr), INTENT(IN) :: ijkfc !< number of child grid points contributing to a parent grid box
    8082 !AH
    8083 !       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
    8084        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
    8085 !AH
    8086 
    8087        INTEGER(iwp) ::  i         !< Running index x-direction - fine-grid
    8088        INTEGER(iwp) ::  iclant    !< Left boundary index for anterpolation along x
    8089        INTEGER(iwp) ::  icrant    !< Right boundary index for anterpolation along x
    8090        INTEGER(iwp) ::  ii        !< Running index x-direction - coarse grid
    8091        INTEGER(iwp) ::  j         !< Running index y-direction - fine-grid
    8092        INTEGER(iwp) ::  jcnant    !< North boundary index for anterpolation along y
    8093        INTEGER(iwp) ::  jcsant    !< South boundary index for anterpolation along y
    8094        INTEGER(iwp) ::  jj        !< Running index y-direction - coarse grid
    8095        INTEGER(iwp) ::  k         !< Running index z-direction - fine-grid     
    8096        INTEGER(iwp) ::  kcb = 0   !< Bottom boundary index for anterpolation along z
    8097        INTEGER(iwp) ::  kctant    !< Top boundary index for anterpolation along z
    8098        INTEGER(iwp) ::  kk        !< Running index z-direction - coarse grid
    8099        INTEGER(iwp) ::  var_flag  !< bit number used to flag topography on respective grid
    8100 
    8101        INTEGER(iwp), INTENT(IN) ::  kct   !< Top boundary index for anterpolation along z
    8102 
    8103 !AH
    8104 !       INTEGER(iwp), DIMENSION(icl:icr), INTENT(IN) ::  ifl !< Indicates start index of child cells belonging to certain parent cell - x direction
    8105 !       INTEGER(iwp), DIMENSION(icl:icr), INTENT(IN) ::  ifu !< Indicates end index of child cells belonging to certain parent cell - x direction
    8106 !       INTEGER(iwp), DIMENSION(jcs:jcn), INTENT(IN) ::  jfl !< Indicates start index of child cells belonging to certain parent cell - y direction
    8107 !       INTEGER(iwp), DIMENSION(jcs:jcn), INTENT(IN) ::  jfu !< Indicates start index of child cells belonging to certain parent cell - y direction
    8108        INTEGER(iwp), DIMENSION(icla:icra), INTENT(IN) ::  ifl !< Indicates start index of child cells belonging to certain parent cell - x direction
    8109        INTEGER(iwp), DIMENSION(icla:icra), INTENT(IN) ::  ifu !< Indicates end index of child cells belonging to certain parent cell - x direction
    8110        INTEGER(iwp), DIMENSION(jcsa:jcna), INTENT(IN) ::  jfl !< Indicates start index of child cells belonging to certain parent cell - y direction
    8111        INTEGER(iwp), DIMENSION(jcsa:jcna), INTENT(IN) ::  jfu !< Indicates start index of child cells belonging to certain parent cell - y direction
    8112 !AH
    8113 
    8114 !AH       INTEGER(iwp), DIMENSION(0:kct), INTENT(IN)   ::  kfl !< Indicates start index of child cells belonging to certain parent cell - z direction
    8115 !AH       INTEGER(iwp), DIMENSION(0:kct), INTENT(IN)   ::  kfu !< Indicates start index of child cells belonging to certain parent cell - z direction
    8116        INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN)   ::  kfl !< Indicates start index of child cells belonging to certain parent cell - z direction
    8117        INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN)   ::  kfu !< Indicates start index of child cells belonging to certain parent cell - z direction
    8118 
    8119        REAL(wp) ::  cellsum   !< sum of respective child cells belonging to parent cell
    8120        REAL(wp) ::  fra       !< relaxation faction
    8121 
    8122        REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(IN) ::  f   !< Treated variable - child domain
    8123        REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr), INTENT(INOUT)  ::  fc  !< Treated variable - parent domain
    8124  
    8125 !
    8126 !--    Define the index bounds iclant, icrant, jcsant and jcnant.
    8127 !--    Note that kcb is simply zero and kct enters here as a parameter and it is
    8128 !--    determined in pmci_init_anterp_tophat.
    8129 !--    Please note, grid points used also for interpolation (from parent to
    8130 !--    child) are excluded in anterpolation, e.g. anterpolation is only from
    8131 !--    nzb:kct-1, as kct is used for interpolation.
    8132        iclant = icl
    8133        icrant = icr
    8134        jcsant = jcs
    8135        jcnant = jcn
    8136        kctant = kct - 1
    8137 
    8138        kcb  = 0
    8139        IF ( nesting_mode /= 'vertical' )  THEN
    8140           IF ( bc_dirichlet_l )  THEN
    8141              iclant = icl + 3
    8142           ENDIF
    8143           IF ( bc_dirichlet_r )  THEN
    8144              icrant = icr - 3
    8145           ENDIF
    8146 
    8147           IF ( bc_dirichlet_s )  THEN
    8148              jcsant = jcs + 3
    8149           ENDIF
    8150           IF ( bc_dirichlet_n )  THEN
    8151              jcnant = jcn - 3
    8152           ENDIF
    8153        ENDIF
    8154 !
    8155 !--    Set masking bit for topography flags
    8156        IF ( var == 'u' )  THEN
    8157           var_flag = 1
    8158        ELSEIF ( var == 'v' )  THEN
    8159           var_flag = 2
    8160        ELSEIF ( var == 'w' )  THEN
    8161           var_flag = 3
    8162        ELSE
    8163           var_flag = 0
    8164        ENDIF 
    8165 !
    8166 !--    Note that ii, jj, and kk are coarse-grid indices and i,j, and k
    8167 !--    are fine-grid indices.
    8168        DO  ii = iclant, icrant
    8169           DO  jj = jcsant, jcnant
    8170 !
    8171 !--          For simplicity anterpolate within buildings and under elevated
    8172 !--          terrain too
    8173              DO  kk = kcb, kctant !kct - 1
    8174                 cellsum = 0.0_wp
    8175                 DO  i = ifl(ii), ifu(ii)
    8176                    DO  j = jfl(jj), jfu(jj)
    8177                       DO  k = kfl(kk), kfu(kk)
    8178                          cellsum = cellsum + MERGE( f(k,j,i), 0.0_wp,          &
    8179                                         BTEST( wall_flags_0(k,j,i), var_flag ) )
    8180                       ENDDO
    8181                    ENDDO
    8182                 ENDDO
    8183 !
    8184 !--             Spatial under-relaxation.
    8185 !--             The relaxation buffer zones are no longer needed with
    8186 !--             the new reversible interpolation algorithm. 23.10.2018.
    8187 !                fra  = frax(ii) * fray(jj) * fraz(kk)               
    8188 !
    8189 !--             In case all child grid points are inside topography, i.e.
    8190 !--             ijkfc and cellsum are zero, also parent solution would have
    8191 !--             zero values at that grid point, which may cause problems in
    8192 !--             particular for the temperature. Therefore, in case cellsum is
    8193 !--             zero, keep the parent solution at this point.
    8194 
    8195                 IF ( ijkfc(kk,jj,ii) /= 0 )  THEN
    8196 !AH                   fc(kk,jj,ii) = ( 1.0_wp - fra ) * fc(kk,jj,ii) +         &
    8197 !AH                        fra * cellsum  /                                    &
    8198 !AH                        REAL( ijkfc(kk,jj,ii), KIND=wp )
    8199                    fc(kk,jj,ii) = cellsum / REAL( ijkfc(kk,jj,ii), KIND=wp )
    8200                 ENDIF
    8201 
    8202              ENDDO
    8203           ENDDO
    8204        ENDDO
    8205 
    8206     END SUBROUTINE pmci_anterp_tophat
     4240
     4241   END SUBROUTINE pmci_anterp_tophat
    82074242
    82084243#endif
Note: See TracChangeset for help on using the changeset viewer.
                                                                                                                                                                                                                                                                                                                                                                               
  | Impressum | ©Leibniz Universität Hannover |