Changeset 3883 for palm


Ignore:
Timestamp:
Apr 10, 2019 12:51:50 PM (2 years ago)
Author:
hellstea
Message:

Checks and error messages improved and extended. Number of variables renamed etc

Location:
palm/trunk/SOURCE
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • palm/trunk/SOURCE/pmc_interface_mod.f90

    r3876 r3883  
    2525! -----------------
    2626! $Id$
     27! Checks and error messages improved and extended. All the child index bounds in the
     28! parent-grid index space are made module variables. Function get_number_of_childs
     29! renamed get_number_of_children. A number of variables renamed
     30! and qite a lot of other code reshaping made all around the module.
     31!
     32! 3876 2019-04-08 18:41:49Z knoop
    2733! Implemented nesting for salsa variables.
    2834!
     
    485491    INTEGER(iwp), PARAMETER ::  child_to_parent = 2   !<
    486492    INTEGER(iwp), PARAMETER ::  parent_to_child = 1   !<
    487     INTEGER(iwp), PARAMETER ::  interpolation_scheme_lrsn  = 2  !< Interpolation scheme to be used on lateral boundaries (maybe to be made user parameter)
    488     INTEGER(iwp), PARAMETER ::  interpolation_scheme_t     = 3  !< Interpolation scheme to be used on top boundary (maybe to be made user parameter)
     493    INTEGER(iwp), PARAMETER ::  interpolation_scheme_lrsn  = 2  !< Interpolation scheme to be used on lateral boundaries
     494    INTEGER(iwp), PARAMETER ::  interpolation_scheme_t     = 3  !< Interpolation scheme to be used on top boundary
    489495!
    490496!-- Coupler setup
    491497    INTEGER(iwp), SAVE      ::  comm_world_nesting    !<
    492498    INTEGER(iwp), SAVE      ::  cpl_id  = 1           !<
    493     CHARACTER(LEN=32), SAVE ::  cpl_name              !<
    494499    INTEGER(iwp), SAVE      ::  cpl_npe_total         !<
    495500    INTEGER(iwp), SAVE      ::  cpl_parent_id         !<
     501   
     502    CHARACTER(LEN=32), SAVE ::  cpl_name              !<
     503
    496504!
    497505!-- Control parameters
     506    INTEGER(iwp),     SAVE ::  anterpolation_buffer_width = 2       !< Boundary buffer width for anterpolation
    498507    CHARACTER(LEN=7), SAVE ::  nesting_datatransfer_mode = 'mixed'  !< steering parameter for data-transfer mode
    499508    CHARACTER(LEN=8), SAVE ::  nesting_mode = 'two-way'             !< steering parameter for 1- or 2-way nesting
    500     INTEGER(iwp),     SAVE ::  anterpolation_buffer_width = 2       !< Boundary buffer width for anterpolation
    501509   
    502510    LOGICAL, SAVE ::  nested_run = .FALSE.  !< general switch
     
    511519!-- Children's parent-grid arrays
    512520    INTEGER(iwp), SAVE, DIMENSION(5), PUBLIC    ::  coarse_bound        !< subdomain index bounds for children's parent-grid arrays
    513     INTEGER(iwp), SAVE, DIMENSION(4), PUBLIC    ::  coarse_bound_aux    !< subdomain index bounds for allocation of index-mapping and other auxiliary arrays
    514     INTEGER(iwp), SAVE, DIMENSION(4), PUBLIC    ::  coarse_bound_w      !< subdomain index bounds for children's parent-grid work arrays
    515521
    516522    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  dissc !< Parent-grid array on child domain - dissipation rate
     
    529535    INTEGER(idp), SAVE, DIMENSION(:,:), ALLOCATABLE, TARGET, PUBLIC ::  part_adrc   !<
    530536
    531     REAL(wp), SAVE, DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  chem_spec_c !< coarse grid array on child domain - chemical species
    532 
    533     REAL(wp), SAVE, DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  aerosol_mass_c   !< aerosol mass
    534     REAL(wp), SAVE, DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  aerosol_number_c !< aerosol number
    535     REAL(wp), SAVE, DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  salsa_gas_c      !<  salsa gases
     537    REAL(wp), SAVE, DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  chem_spec_c  !< Parent-grid array on child domain - chemical species
     538
     539    REAL(wp), SAVE, DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  aerosol_mass_c    !< Aerosol mass
     540    REAL(wp), SAVE, DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  aerosol_number_c  !< Aerosol number
     541    REAL(wp), SAVE, DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  salsa_gas_c       !< SALSA gases
    536542!
    537543!-- Grid-spacing ratios.
    538     INTEGER(iwp), SAVE ::  igsr     !< Integer grid-spacing ratio in i-direction
    539     INTEGER(iwp), SAVE ::  jgsr     !< Integer grid-spacing ratio in j-direction
    540     INTEGER(iwp), SAVE ::  kgsr     !< Integer grid-spacing ratio in k-direction
     544    INTEGER(iwp), SAVE ::  igsr    !< Integer grid-spacing ratio in i-direction
     545    INTEGER(iwp), SAVE ::  jgsr    !< Integer grid-spacing ratio in j-direction
     546    INTEGER(iwp), SAVE ::  kgsr    !< Integer grid-spacing ratio in k-direction
    541547!
    542548!-- Global parent-grid index bounds
    543     INTEGER(iwp), SAVE ::  iplg     !< Leftmost parent-grid array ip index of the whole child domain
    544     INTEGER(iwp), SAVE ::  iprg     !< Rightmost parent-grid array ip index of the whole child domain
    545     INTEGER(iwp), SAVE ::  jpsg     !< Southmost parent-grid array jp index of the whole child domain
    546     INTEGER(iwp), SAVE ::  jpng     !< Northmost parent-grid array jp index of the whole child domain
    547 !
    548 !-- Local parent-grid index bounds (to be moved here from pmci_setup_child)
    549 !-- EXPLAIN WHY SEVERAL SETS OF PARENT-GRID INDEX BOUNDS ARE NEEDED.
    550    
     549    INTEGER(iwp), SAVE ::  iplg    !< Leftmost parent-grid array ip index of the whole child domain
     550    INTEGER(iwp), SAVE ::  iprg    !< Rightmost parent-grid array ip index of the whole child domain
     551    INTEGER(iwp), SAVE ::  jpsg    !< Southmost parent-grid array jp index of the whole child domain
     552    INTEGER(iwp), SAVE ::  jpng    !< Northmost parent-grid array jp index of the whole child domain
     553!
     554!-- Local parent-grid index bounds. Different sets of index bounds are needed for parent-grid arrays (uc, etc),
     555!-- for index mapping arrays (iflu, etc) and for work arrays (workarr_lr, etc). This is because these arrays
     556!-- have different dimensions depending on the location of the subdomain relative to boundaries and corners.
     557    INTEGER(iwp), SAVE ::  ipl     !< Left index limit for children's parent-grid arrays
     558    INTEGER(iwp), SAVE ::  ipla    !< Left index limit for allocation of index-mapping and other auxiliary arrays
     559    INTEGER(iwp), SAVE ::  iplw    !< Left index limit for children's parent-grid work arrays
     560    INTEGER(iwp), SAVE ::  ipr     !< Right index limit for children's parent-grid arrays
     561    INTEGER(iwp), SAVE ::  ipra    !< Right index limit for allocation of index-mapping and other auxiliary arrays
     562    INTEGER(iwp), SAVE ::  iprw    !< Right index limit for children's parent-grid work arrays
     563    INTEGER(iwp), SAVE ::  jpn     !< North index limit for children's parent-grid arrays
     564    INTEGER(iwp), SAVE ::  jpna    !< North index limit for allocation of index-mapping and other auxiliary arrays
     565    INTEGER(iwp), SAVE ::  jpnw    !< North index limit for children's parent-grid work arrays
     566    INTEGER(iwp), SAVE ::  jps     !< South index limit for children's parent-grid arrays
     567    INTEGER(iwp), SAVE ::  jpsa    !< South index limit for allocation of index-mapping and other auxiliary arrays
     568    INTEGER(iwp), SAVE ::  jpsw    !< South index limit for children's parent-grid work arrays
    551569!
    552570!-- Highest prognostic parent-grid k-indices.
     
    568586    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  kfuo   !< child index indicating upper bound of parent grid box on scalar-grid
    569587!
    570 !-- Number of fine-grid nodes inside coarse-grid ij-faces
    571 !-- to be precomputed for anterpolation.
    572     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  ijkfc_u  !< number of child grid boxes contribution to a parent grid box, u-grid
    573     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  ijkfc_v  !< number of child grid boxes contribution to a parent grid box, v-grid
    574     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  ijkfc_w  !< number of child grid boxes contribution to a parent grid box, w-grid
    575     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  ijkfc_s  !< number of child grid boxes contribution to a parent grid box, scalar-grid
     588!-- Number of child-grid nodes within anterpolation cells to be precomputed for anterpolation.
     589    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  ijkfc_u  !< number of child grid points contributing to a parent grid
     590                                                                   !< node in anterpolation, u-grid
     591    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  ijkfc_v  !< number of child grid points contributing to a parent grid
     592                                                                   !< node in anterpolation, v-grid
     593    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  ijkfc_w  !< number of child grid points contributing to a parent grid
     594                                                                   !< node in anterpolation, w-grid
     595    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  ijkfc_s  !< number of child grid points contributing to a parent grid
     596                                                                   !< node in anterpolation, scalar-grid
    576597!   
    577598!-- Work arrays for interpolation and user-defined type definitions for horizontal work-array exchange   
    578     REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: workarrc_lr
    579     REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: workarrc_sn
    580     REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: workarrc_t
    581     INTEGER(iwp) :: workarrc_lr_exchange_type
    582     INTEGER(iwp) :: workarrc_sn_exchange_type
    583     INTEGER(iwp) :: workarrc_t_exchange_type_x
    584     INTEGER(iwp) :: workarrc_t_exchange_type_y
     599    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: workarr_lr
     600    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: workarr_sn
     601    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: workarr_t
     602
     603    INTEGER(iwp) :: workarr_lr_exchange_type
     604    INTEGER(iwp) :: workarr_sn_exchange_type
     605    INTEGER(iwp) :: workarr_t_exchange_type_x
     606    INTEGER(iwp) :: workarr_t_exchange_type_y
    585607 
    586608    INTEGER(iwp), DIMENSION(3)          ::  parent_grid_info_int    !<
     609
    587610    REAL(wp), DIMENSION(7)              ::  parent_grid_info_real   !<
    588611    REAL(wp), DIMENSION(2)              ::  zmax_coarse             !<
     
    607630    END TYPE parentgrid_def
    608631
    609     TYPE(parentgrid_def), SAVE, PUBLIC     ::  cg                 !< change to pg
     632    TYPE(parentgrid_def), SAVE, PUBLIC     ::  pg                 !< Parent-grid information package of type parentgrid_def
    610633!
    611634!-- Variables for particle coupling
     
    617640       REAL(wp)                            ::  dy                   !<
    618641       REAL(wp)                            ::  dz                   !<
    619        REAL(wp)                            ::  lx_coord, lx_coord_b !<
     642       REAL(wp)                            ::  lx_coord, lx_coord_b !<   ! split onto separate lines
    620643       REAL(wp)                            ::  rx_coord, rx_coord_b !<
    621644       REAL(wp)                            ::  sy_coord, sy_coord_b !<
     
    624647    END TYPE childgrid_def
    625648
    626     TYPE(childgrid_def), SAVE, ALLOCATABLE, DIMENSION(:), PUBLIC :: childgrid !<
    627 
    628     INTEGER(idp),ALLOCATABLE,DIMENSION(:,:),PUBLIC,TARGET    :: nr_part  !<
    629     INTEGER(idp),ALLOCATABLE,DIMENSION(:,:),PUBLIC,TARGET    :: part_adr !<
     649    TYPE(childgrid_def), SAVE, ALLOCATABLE, DIMENSION(:), PUBLIC ::  childgrid !<
     650
     651    INTEGER(idp), ALLOCATABLE,DIMENSION(:,:), PUBLIC,TARGET :: nr_part  !<
     652    INTEGER(idp), ALLOCATABLE,DIMENSION(:,:), PUBLIC,TARGET :: part_adr !<
    630653
    631654   
     
    662685    END INTERFACE
    663686
    664     INTERFACE get_number_of_childs
    665        MODULE PROCEDURE get_number_of_childs
    666     END  INTERFACE get_number_of_childs
     687    INTERFACE get_number_of_children
     688       MODULE PROCEDURE get_number_of_children
     689    END  INTERFACE get_number_of_children
    667690
    668691    INTERFACE get_childid
     
    693716    PUBLIC pmci_synchronize
    694717    PUBLIC pmci_set_swaplevel
    695     PUBLIC get_number_of_childs, get_childid, get_child_edges, get_child_gridspacing
     718    PUBLIC get_number_of_children, get_childid, get_child_edges, get_child_gridspacing
    696719
    697720
     
    792815    INTEGER(iwp) ::  ncpl   !<  number of nest domains
    793816
     817   
    794818#if defined( __parallel )
    795819    CALL location_message( 'setup the nested model configuration', .FALSE. )
     
    797821!
    798822!-- Compute absolute coordinates for all models
    799     CALL pmci_setup_coordinates
     823    CALL pmci_setup_coordinates         ! CONTAIN THIS
    800824!
    801825!-- Determine the number of coupled arrays
    802     CALL pmci_num_arrays
     826    CALL pmci_num_arrays                ! CONTAIN THIS
    803827!
    804828!-- Initialize the child (must be called before pmc_setup_parent)
    805     CALL pmci_setup_child
     829!  EXTEND THIS COMMENT EXPLAINEIN WHY IT MUST BE CALLED BEFORE   
     830    CALL pmci_setup_child               ! CONTAIN THIS
    806831!
    807832!-- Initialize PMC parent
    808     CALL pmci_setup_parent
     833    CALL pmci_setup_parent              ! CONTAIN THIS
    809834!
    810835!-- Check for mismatches between settings of master and child variables
    811836!-- (e.g., all children have to follow the end_time settings of the root master)
    812     CALL pmci_check_setting_mismatches
     837    CALL pmci_check_setting_mismatches  ! CONTAIN THIS
    813838!
    814839!-- Set flag file for combine_plot_fields for precessing the nest output data
     
    831856    IMPLICIT NONE
    832857
    833     CHARACTER(LEN=32) ::  myname
    834     INTEGER(iwp) ::  child_id         !<
    835     INTEGER(iwp) ::  ib = 1           !< running index for aerosol size bins
    836     INTEGER(iwp) ::  ic = 1           !< running index for aerosol mass bins
    837     INTEGER(iwp) ::  ig = 1           !< running index for salsa gases
    838     INTEGER(iwp) ::  ierr             !<
    839     INTEGER(iwp) ::  k                !<
    840     INTEGER(iwp) ::  m                !<
    841     INTEGER(iwp) ::  mid              !<
    842     INTEGER(iwp) ::  mm               !<
    843     INTEGER(iwp) ::  n = 1            !< running index for chemical species
    844     INTEGER(iwp) ::  nest_overlap     !<
    845     INTEGER(iwp) ::  nomatch          !<
    846     INTEGER(iwp) ::  nx_cl            !<
    847     INTEGER(iwp) ::  ny_cl            !<
    848     INTEGER(iwp) ::  nz_cl            !<
    849 
    850     INTEGER(iwp), DIMENSION(5) ::  val    !<
    851 
    852     REAL(wp), DIMENSION(:), ALLOCATABLE ::  ch_xl   !<
    853     REAL(wp), DIMENSION(:), ALLOCATABLE ::  ch_xr   !<   
    854     REAL(wp), DIMENSION(:), ALLOCATABLE ::  ch_ys   !<
    855     REAL(wp), DIMENSION(:), ALLOCATABLE ::  ch_yn   !<
    856     REAL(wp) ::  cl_height        !<
    857     REAL(wp) ::  dx_cl            !<
    858     REAL(wp) ::  dy_cl            !<
    859     REAL(wp) ::  dz_cl            !<
    860     REAL(wp) ::  left_limit       !<
    861     REAL(wp) ::  north_limit      !<
    862     REAL(wp) ::  right_limit      !<
    863     REAL(wp) ::  south_limit      !<
    864     REAL(wp) ::  xez              !<
    865     REAL(wp) ::  yez              !<
    866     REAL(wp), DIMENSION(5) ::  fval                      !< Array for receiving the child-grid spacings etc
    867     REAL(wp), DIMENSION(:), ALLOCATABLE ::  cl_coord_x   !<
    868     REAL(wp), DIMENSION(:), ALLOCATABLE ::  cl_coord_y   !<
    869 
    870 !
    871 !   Initialize the pmc parent
     858    INTEGER(iwp) ::  child_id           !< Child id-number for the child m
     859    INTEGER(iwp) ::  ierr               !< MPI-error code
     860    INTEGER(iwp) ::  kp                 !< Parent-grid index n the z-direction
     861    INTEGER(iwp) ::  lb = 1             !< Running index for aerosol size bins
     862    INTEGER(iwp) ::  lc = 1             !< Running index for aerosol mass bins
     863    INTEGER(iwp) ::  lg = 1             !< Running index for SALSA gases
     864    INTEGER(iwp) ::  m                  !< Loop index over all children of the current parent
     865    INTEGER(iwp) ::  msib               !< Loop index over all other children than m in case of siblings (parallel children)
     866    INTEGER(iwp) ::  n = 1              !< Running index for chemical species
     867    INTEGER(iwp) ::  nest_overlap = 0   !< Tag for parallel child-domains' overlap situation (>0 if overlap found)
     868    INTEGER(iwp) ::  nomatch = 0        !< Tag for child-domain mismatch situation (>0 if mismatch found)
     869    INTEGER(iwp) ::  nx_child           !< Number of child-grid points in the x-direction
     870    INTEGER(iwp) ::  ny_child           !< Number of child-grid points in the y-direction
     871    INTEGER(iwp) ::  nz_child           !< Number of child-grid points in the z-direction
     872   
     873    INTEGER(iwp), DIMENSION(3) ::  child_grid_dim  !< Array for receiving the child-grid dimensions from the children
     874   
     875    REAL(wp), DIMENSION(:), ALLOCATABLE ::  child_x_left   !< Minimum x-coordinate of the child domain including the ghost
     876                                                           !< point layers
     877    REAL(wp), DIMENSION(:), ALLOCATABLE ::  child_x_right  !< Maximum x-coordinate of the child domain including the ghost
     878                                                           !< point layers   
     879    REAL(wp), DIMENSION(:), ALLOCATABLE ::  child_y_south  !< Minimum y-coordinate of the child domain including the ghost
     880                                                           !< point layers
     881    REAL(wp), DIMENSION(:), ALLOCATABLE ::  child_y_north  !< Maximum y-coordinate of the child domain including the ghost
     882                                                           !< point layers
     883    REAL(wp), DIMENSION(:), ALLOCATABLE ::  child_coord_x  !< Child domain x-coordinate array
     884    REAL(wp), DIMENSION(:), ALLOCATABLE ::  child_coord_y  !< Child domain y-coordinate array
     885   
     886    REAL(wp), DIMENSION(5) ::  child_grid_info  !< Array for receiving the child-grid spacings etc from the children
     887   
     888    REAL(wp) ::  child_height         !< Height of the child domain defined on the child side as zw(nzt+1)
     889    REAL(wp) ::  dx_child             !< Child-grid spacing in the x-direction
     890    REAL(wp) ::  dy_child             !< Child-grid spacing in the y-direction
     891    REAL(wp) ::  dz_child             !< Child-grid spacing in the z-direction
     892    REAL(wp) ::  left_limit           !< Left limit for the absolute x-coordinate of the child left boundary
     893    REAL(wp) ::  north_limit          !< North limit for the absolute y-coordinate of the child north boundary
     894    REAL(wp) ::  right_limit          !< Right limit for the absolute x-coordinate of the child right boundary
     895    REAL(wp) ::  south_limit          !< South limit for the absolute y-coordinate of the child south boundary
     896    REAL(wp) ::  upper_right_coord_x  !< Absolute x-coordinate of the upper right corner of the child domain
     897    REAL(wp) ::  upper_right_coord_y  !< Absolute y-coordinate of the upper right corner of the child domain 
     898    REAL(wp) ::  xez                  !< Minimum separation in the x-direction required between the child and
     899                                      !< parent boundaries (left or right)
     900    REAL(wp) ::  yez                  !< Minimum separation in the y-direction required between the child and
     901                                      !< parent boundaries (south or north)
     902    CHARACTER(LEN=32) ::  myname      !< String for variable name such as 'u'
     903
     904    LOGICAL :: m_left_in_msib         !< Logical auxiliary parameter for the overlap test: true if the left border
     905                                      !< of the child m is within the x-range of the child msib
     906    LOGICAL :: m_right_in_msib        !< Logical auxiliary parameter for the overlap test: true if the right border
     907                                      !< of the child m is within the x-range of the child msib
     908    LOGICAL :: msib_left_in_m         !< Logical auxiliary parameter for the overlap test: true if the left border
     909                                      !< of the child msib is within the x-range of the child m
     910    LOGICAL :: msib_right_in_m        !< Logical auxiliary parameter for the overlap test: true if the right border
     911                                      !< of the child msib is within the x-range of the child m
     912    LOGICAL :: m_south_in_msib        !< Logical auxiliary parameter for the overlap test: true if the south border
     913                                      !< of the child m is within the y-range of the child msib
     914    LOGICAL :: m_north_in_msib        !< Logical auxiliary parameter for the overlap test: true if the north border
     915                                      !< of the child m is within the y-range of the child msib
     916    LOGICAL :: msib_south_in_m        !< Logical auxiliary parameter for the overlap test: true if the south border
     917                                      !< of the child msib is within the y-range of the child m
     918    LOGICAL :: msib_north_in_m        !< Logical auxiliary parameter for the overlap test: true if the north border
     919                                      !< of the child msib is within the y-range of the child m
     920!
     921!-- Initialize the current pmc parent
    872922    CALL pmc_parentinit
    873923!
    874 !-- Corners of all children of the present parent
    875     IF ( ( SIZE( pmc_parent_for_child ) - 1 > 0 ) .AND. myid == 0 )  THEN
    876        ALLOCATE( ch_xl(1:SIZE( pmc_parent_for_child ) - 1) )
    877        ALLOCATE( ch_xr(1:SIZE( pmc_parent_for_child ) - 1) )
    878        ALLOCATE( ch_ys(1:SIZE( pmc_parent_for_child ) - 1) )
    879        ALLOCATE( ch_yn(1:SIZE( pmc_parent_for_child ) - 1) )
     924!-- Corners of all children of the present parent. Note that
     925!-- SIZE( pmc_parent_for_child ) = 1 if we have no children.
     926    IF ( ( SIZE( pmc_parent_for_child ) - 1 > 0 )  .AND.  myid == 0 )  THEN
     927       ALLOCATE( child_x_left(1:SIZE( pmc_parent_for_child ) - 1) )
     928       ALLOCATE( child_x_right(1:SIZE( pmc_parent_for_child ) - 1) )
     929       ALLOCATE( child_y_south(1:SIZE( pmc_parent_for_child ) - 1) )
     930       ALLOCATE( child_y_north(1:SIZE( pmc_parent_for_child ) - 1) )
    880931    ENDIF
    881932    IF ( ( SIZE( pmc_parent_for_child ) - 1 > 0 ) )  THEN
     
    883934    ENDIF
    884935!
    885 !-- Get coordinates from all children
     936!-- Get coordinates from all children and check that the children match the parent
     937!-- domain and each others. Note that SIZE( pmc_parent_for_child ) = 1
     938!-- if we have no children, thence the loop is not executed at all.
    886939    DO  m = 1, SIZE( pmc_parent_for_child ) - 1
    887940
     
    890943       IF ( myid == 0 )  THEN
    891944
    892           CALL pmc_recv_from_child( child_id, val,  SIZE(val), 0, 123, ierr )
    893           CALL pmc_recv_from_child( child_id, fval, SIZE(fval), 0, 124, ierr )
     945          CALL pmc_recv_from_child( child_id, child_grid_dim,  SIZE(child_grid_dim), 0, 123, ierr )
     946          CALL pmc_recv_from_child( child_id, child_grid_info, SIZE(child_grid_info), 0, 124, ierr )
    894947         
    895           nx_cl     = val(1)
    896           ny_cl     = val(2)
    897           dx_cl     = fval(3)
    898           dy_cl     = fval(4)
    899           dz_cl     = fval(5)
    900           cl_height = fval(1)
    901 
    902           nz_cl = nz
    903 !
    904 !--       Find the highest nest level in the parent grid for the reduced z
     948          nx_child     = child_grid_dim(1)
     949          ny_child     = child_grid_dim(2)
     950          dx_child     = child_grid_info(3)
     951          dy_child     = child_grid_info(4)
     952          dz_child     = child_grid_info(5)
     953          child_height = child_grid_info(1)
     954!
     955!--       Find the highest child-domain level in the parent grid for the reduced z
    905956!--       transfer
    906           DO  k = 1, nz                 
    907              IF ( zw(k) > fval(1) )  THEN
    908                 nz_cl = k
     957          DO  kp = 1, nz                 
     958             IF ( zw(kp) > child_height )  THEN
     959                nz_child = kp
    909960                EXIT
    910961             ENDIF
    911962          ENDDO
    912           zmax_coarse = fval(1:2)
    913           cl_height   = fval(1)
     963          zmax_coarse  = child_grid_info(1:2)
    914964!   
    915965!--       Get absolute coordinates from the child
    916           ALLOCATE( cl_coord_x(-nbgp:nx_cl+nbgp) )
    917           ALLOCATE( cl_coord_y(-nbgp:ny_cl+nbgp) )
     966          ALLOCATE( child_coord_x(-nbgp:nx_child+nbgp) )
     967          ALLOCATE( child_coord_y(-nbgp:ny_child+nbgp) )
    918968         
    919           CALL pmc_recv_from_child( child_id, cl_coord_x, SIZE( cl_coord_x ),  &
    920                0, 11, ierr )
    921           CALL pmc_recv_from_child( child_id, cl_coord_y, SIZE( cl_coord_y ),  &
    922                0, 12, ierr )
     969          CALL pmc_recv_from_child( child_id, child_coord_x, SIZE( child_coord_x ), 0, 11, ierr )
     970          CALL pmc_recv_from_child( child_id, child_coord_y, SIZE( child_coord_y ), 0, 12, ierr )
    923971         
    924972          parent_grid_info_real(1) = lower_left_coord_x
     
    926974          parent_grid_info_real(3) = dx
    927975          parent_grid_info_real(4) = dy
    928           parent_grid_info_real(5) = lower_left_coord_x + ( nx + 1 ) * dx
    929           parent_grid_info_real(6) = lower_left_coord_y + ( ny + 1 ) * dy
     976
     977          upper_right_coord_x      = lower_left_coord_x + ( nx + 1 ) * dx
     978          upper_right_coord_y      = lower_left_coord_y + ( ny + 1 ) * dy
     979          parent_grid_info_real(5) = upper_right_coord_x
     980          parent_grid_info_real(6) = upper_right_coord_y
    930981          parent_grid_info_real(7) = dz(1)
    931982
    932983          parent_grid_info_int(1)  = nx
    933984          parent_grid_info_int(2)  = ny
    934           parent_grid_info_int(3)  = nz_cl
    935 !
    936 !--       Check that the child domain matches parent domain.
    937           nomatch = 0
     985          parent_grid_info_int(3)  = nz_child
     986!
     987!--       Check that the child domain matches its parent domain.
    938988          IF ( nesting_mode == 'vertical' )  THEN
    939              right_limit = parent_grid_info_real(5)
    940              north_limit = parent_grid_info_real(6)
    941              IF ( ( cl_coord_x(nx_cl+1) /= right_limit ) .OR.                  &
    942                   ( cl_coord_y(ny_cl+1) /= north_limit ) )  THEN
     989!
     990!--          In case of vertical nesting, the lateral boundaries must match exactly.
     991             right_limit = upper_right_coord_x
     992             north_limit = upper_right_coord_y
     993             IF ( ( child_coord_x(nx_child+1) /= right_limit ) .OR.                                 &
     994                  ( child_coord_y(ny_child+1) /= north_limit ) )  THEN
    943995                nomatch = 1
    944996             ENDIF
    945997          ELSE       
    946998!
    947 !--       Check that the child domain is completely inside the parent domain.
     999!--          In case of 3-D nesting, check that the child domain is completely
     1000!--          inside its parent domain.
    9481001             xez = ( nbgp + 1 ) * dx
    9491002             yez = ( nbgp + 1 ) * dy
    9501003             left_limit  = lower_left_coord_x + xez
    951              right_limit = parent_grid_info_real(5) - xez
     1004             right_limit = upper_right_coord_x - xez
    9521005             south_limit = lower_left_coord_y + yez
    953              north_limit = parent_grid_info_real(6) - yez
    954              IF ( ( cl_coord_x(0) < left_limit )        .OR.                   &
    955                   ( cl_coord_x(nx_cl+1) > right_limit ) .OR.                   &
    956                   ( cl_coord_y(0) < south_limit )       .OR.                   &
    957                   ( cl_coord_y(ny_cl+1) > north_limit ) )  THEN
     1006             north_limit = upper_right_coord_y - yez
     1007             IF ( ( child_coord_x(0) < left_limit )  .OR.                                           &
     1008                  ( child_coord_x(nx_child+1) > right_limit )  .OR.                                 &
     1009                  ( child_coord_y(0) < south_limit )  .OR.                                          &
     1010                  ( child_coord_y(ny_child+1) > north_limit ) )  THEN
    9581011                nomatch = 1
    9591012             ENDIF
     
    9631016!--       that the top ghost layer of the child grid does not exceed
    9641017!--       the parent domain top boundary.
    965           IF ( cl_height > zw(nz) ) THEN
     1018          IF ( child_height > zw(nz) ) THEN
    9661019             nomatch = 1
    9671020          ENDIF
    9681021!
    969 !--       Check that parallel nest domains, if any, do not overlap.
    970           nest_overlap = 0
    971           IF ( SIZE( pmc_parent_for_child ) - 1 > 0 )  THEN
    972              ch_xl(m) = cl_coord_x(-nbgp)
    973              ch_xr(m) = cl_coord_x(nx_cl+nbgp)
    974              ch_ys(m) = cl_coord_y(-nbgp)
    975              ch_yn(m) = cl_coord_y(ny_cl+nbgp)
    976 
    977              IF ( m > 1 )  THEN
    978                 DO mm = 1, m - 1
    979                    mid = pmc_parent_for_child(mm)
    980 !
    981 !--                Check only different nest levels
    982                    IF (m_couplers(child_id)%parent_id /= m_couplers(mid)%parent_id)  THEN
    983                       IF ( ( ch_xl(m) < ch_xr(mm) .OR.                         &
    984                              ch_xr(m) > ch_xl(mm) )  .AND.                     &
    985                            ( ch_ys(m) < ch_yn(mm) .OR.                         &
    986                              ch_yn(m) > ch_ys(mm) ) )  THEN
    987                          nest_overlap = 1
    988                       ENDIF
    989                    ENDIF
    990                 ENDDO
    991              ENDIF
    992           ENDIF
     1022!--       If parallel child domains (siblings) do exist ( m > 1 ),
     1023!--       check that they do not overlap.
     1024          child_x_left(m)  = child_coord_x(-nbgp)
     1025          child_x_right(m) = child_coord_x(nx_child+nbgp)
     1026          child_y_south(m) = child_coord_y(-nbgp)
     1027          child_y_north(m) = child_coord_y(ny_child+nbgp)
     1028
     1029          IF ( nesting_mode /= 'vertical' )  THEN
     1030!
     1031!--          Note that the msib-loop is executed only if ( m > 1 ). 
     1032!--          Also note that the tests have to be made both ways (m vs msib and msib vs m)
     1033!--          in order to detect all the possible overlap situations.
     1034             DO  msib = 1, m - 1
     1035!
     1036!--             Set some logical auxiliary parameters to simplify the IF-condition. 
     1037                m_left_in_msib  = ( child_x_left(m)  >= child_x_left(msib) )  .AND.                 &
     1038                                  ( child_x_left(m)  <= child_x_right(msib) )
     1039                m_right_in_msib = ( child_x_right(m) >= child_x_left(msib) )  .AND.                 &
     1040                                  ( child_x_right(m) <= child_x_right(msib) )
     1041                msib_left_in_m  = ( child_x_left(msib)  >= child_x_left(m) )  .AND.                 &
     1042                                  ( child_x_left(msib)  <= child_x_right(m) )
     1043                msib_right_in_m = ( child_x_right(msib) >= child_x_left(m) )  .AND.                 &
     1044                                  ( child_x_right(msib) <= child_x_right(m) )
     1045                m_south_in_msib = ( child_y_south(m) >= child_y_south(msib) )  .AND.                &
     1046                                  ( child_y_south(m) <= child_y_north(msib) )
     1047                m_north_in_msib = ( child_y_north(m) >= child_y_south(msib) )  .AND.                &
     1048                                  ( child_y_north(m) <= child_y_north(msib) )
     1049                msib_south_in_m = ( child_y_south(msib) >= child_y_south(m) )  .AND.                &
     1050                                  ( child_y_south(msib) <= child_y_north(m) )
     1051                msib_north_in_m = ( child_y_north(msib) >= child_y_south(m) )  .AND.                &
     1052                                  ( child_y_north(msib) <= child_y_north(m) )
     1053               
     1054                IF ( ( m_left_in_msib  .OR.  m_right_in_msib  .OR.                                  &
     1055                       msib_left_in_m  .OR.  msib_right_in_m )                                      &
     1056                     .AND.                                                                          &
     1057                     ( m_south_in_msib  .OR.  m_north_in_msib  .OR.                                 &
     1058                       msib_south_in_m  .OR.  msib_north_in_m ) )  THEN
     1059                     nest_overlap = 1
     1060                ENDIF
     1061
     1062             ENDDO
     1063          ENDIF         
    9931064
    9941065          CALL set_child_edge_coords
    9951066
    996           DEALLOCATE( cl_coord_x )
    997           DEALLOCATE( cl_coord_y )
     1067          DEALLOCATE( child_coord_x )
     1068          DEALLOCATE( child_coord_y )
    9981069!
    9991070!--       Send information about operating mode (LES or RANS) to child. This will be
     
    10021073!
    10031074!--       Send coarse grid information to child
    1004           CALL pmc_send_to_child( child_id, parent_grid_info_real,             &
    1005                                    SIZE( parent_grid_info_real ), 0, 21,       &
    1006                                    ierr )
    1007           CALL pmc_send_to_child( child_id, parent_grid_info_int,  3, 0,       &
    1008                                    22, ierr )
     1075          CALL pmc_send_to_child( child_id, parent_grid_info_real,                                  &
     1076                                  SIZE( parent_grid_info_real ), 0, 21,                             &
     1077                                  ierr )
     1078          CALL pmc_send_to_child( child_id, parent_grid_info_int,  3, 0,                            &
     1079                                  22, ierr )
    10091080!
    10101081!--       Send local grid to child
    1011           CALL pmc_send_to_child( child_id, coord_x, nx+1+2*nbgp, 0, 24,       &
    1012                                    ierr )
    1013           CALL pmc_send_to_child( child_id, coord_y, ny+1+2*nbgp, 0, 25,       &
    1014                                    ierr )
     1082          CALL pmc_send_to_child( child_id, coord_x, nx+1+2*nbgp, 0, 24,                            &
     1083                                  ierr )
     1084          CALL pmc_send_to_child( child_id, coord_y, ny+1+2*nbgp, 0, 25,                            &
     1085                                  ierr )
    10151086!
    10161087!--       Also send the dzu-, dzw-, zu- and zw-arrays here
    1017           CALL pmc_send_to_child( child_id, dzu, nz_cl+1, 0, 26, ierr )
    1018           CALL pmc_send_to_child( child_id, dzw, nz_cl+1, 0, 27, ierr )
    1019           CALL pmc_send_to_child( child_id, zu,  nz_cl+2, 0, 28, ierr )
    1020           CALL pmc_send_to_child( child_id, zw,  nz_cl+2, 0, 29, ierr )
    1021 
    1022        ENDIF
    1023 
    1024        CALL MPI_BCAST( nomatch, 1, MPI_INTEGER, 0, comm2d, ierr )
    1025        IF ( nomatch /= 0 )  THEN
    1026           WRITE ( message_string, * )  'nested child domain does ',            &
    1027                                        'not fit into its parent domain'
    1028           CALL message( 'pmci_setup_parent', 'PA0425', 3, 2, 0, 6, 0 )
    1029        ENDIF
     1088          CALL pmc_send_to_child( child_id, dzu, nz_child + 1, 0, 26, ierr )
     1089          CALL pmc_send_to_child( child_id, dzw, nz_child + 1, 0, 27, ierr )
     1090          CALL pmc_send_to_child( child_id, zu,  nz_child + 2, 0, 28, ierr )
     1091          CALL pmc_send_to_child( child_id, zw,  nz_child + 2, 0, 29, ierr )
     1092
     1093          IF ( nomatch /= 0 )  THEN
     1094             WRITE ( message_string, * ) 'nested child domain does not fit into its parent domain'
     1095             CALL message( 'pmci_setup_parent', 'PA0425', 3, 2, 0, 6, 0 )
     1096          ENDIF
    10301097 
    1031        CALL MPI_BCAST( nest_overlap, 1, MPI_INTEGER, 0, comm2d, ierr )
    1032        IF ( nest_overlap /= 0  .AND.  nesting_mode /= 'vertical' )  THEN
    1033           WRITE ( message_string, * )  'nested parallel child domains overlap'
    1034           CALL message( 'pmci_setup_parent', 'PA0426', 3, 2, 0, 6, 0 )
    1035        ENDIF
    1036      
    1037        CALL MPI_BCAST( nz_cl, 1, MPI_INTEGER, 0, comm2d, ierr )
     1098          IF ( nest_overlap /= 0  .AND.  nesting_mode /= 'vertical' )  THEN
     1099             WRITE ( message_string, * ) 'nested parallel child domains overlap'
     1100             CALL message( 'pmci_setup_parent', 'PA0426', 3, 2, 0, 6, 0 )
     1101          ENDIF
     1102         
     1103       ENDIF  ! ( myid == 0 )
     1104
     1105       CALL MPI_BCAST( nz_child, 1, MPI_INTEGER, 0, comm2d, ierr )
    10381106
    10391107       CALL MPI_BCAST( childgrid(m), STORAGE_SIZE(childgrid(1))/8, MPI_BYTE, 0, comm2d, ierr )
    10401108!
    10411109!--    TO_DO: Klaus: please give a comment what is done here
     1110!  DO IT YOURSELF       
    10421111       CALL pmci_create_index_list
    10431112!
     
    10471116!--    have to be specified again
    10481117       CALL pmc_s_clear_next_array_list
    1049        DO  WHILE ( pmc_s_getnextarray( child_id, myname ) )
     1118       DO WHILE ( pmc_s_getnextarray( child_id, myname ) )
    10501119          IF ( INDEX( TRIM( myname ), 'chem_' ) /= 0 )  THEN             
    10511120             CALL pmci_set_array_pointer( myname, child_id = child_id,         &
    1052                                           nz_cl = nz_cl, n = n )
     1121                                          nz_child = nz_child, n = n )
    10531122             n = n + 1 
    10541123          ELSEIF ( INDEX( TRIM( myname ), 'an_' ) /= 0 )  THEN
    10551124             CALL pmci_set_array_pointer( myname, child_id = child_id,         &
    1056                                           nz_cl = nz_cl, n = ib )
    1057              ib = ib + 1
     1125                                          nz_child = nz_child, n = lb )
     1126             lb = lb + 1
    10581127          ELSEIF ( INDEX( TRIM( myname ), 'am_' ) /= 0 )  THEN
    10591128             CALL pmci_set_array_pointer( myname, child_id = child_id,         &
    1060                                           nz_cl = nz_cl, n = ic )
    1061              ic = ic + 1
     1129                                          nz_child = nz_child, n = lc )
     1130             lc = lc + 1
    10621131          ELSEIF ( INDEX( TRIM( myname ), 'sg_' ) /= 0  .AND.                  &
    10631132             .NOT. salsa_gases_from_chem )                                     &
    10641133          THEN
    10651134             CALL pmci_set_array_pointer( myname, child_id = child_id,         &
    1066                                           nz_cl = nz_cl, n = ig )
    1067              ig = ig + 1
     1135                                          nz_child = nz_child, n = lg )
     1136             lg = lg + 1
    10681137          ELSE
    1069              CALL pmci_set_array_pointer( myname, child_id = child_id,         &
    1070                                           nz_cl = nz_cl )
     1138             CALL pmci_set_array_pointer( myname, child_id = child_id, nz_child = nz_child )
    10711139          ENDIF
    10721140       ENDDO
    10731141
    10741142       CALL pmc_s_setind_and_allocmem( child_id )
    1075     ENDDO
    1076 
    1077     IF ( ( SIZE( pmc_parent_for_child ) - 1 > 0 ) .AND. myid == 0 )  THEN
    1078        DEALLOCATE( ch_xl )
    1079        DEALLOCATE( ch_xr )
    1080        DEALLOCATE( ch_ys )
    1081        DEALLOCATE( ch_yn )
     1143       
     1144    ENDDO  ! m
     1145
     1146    IF ( ( SIZE( pmc_parent_for_child ) - 1 > 0 ) .AND. myid == 0 )  THEN
     1147       DEALLOCATE( child_x_left )
     1148       DEALLOCATE( child_x_right )
     1149       DEALLOCATE( child_y_south )
     1150       DEALLOCATE( child_y_north )
    10821151    ENDIF
    10831152
     1153   
    10841154 CONTAINS
    10851155
     
    11081178       INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE  ::  index_list         !<
    11091179
     1180       
    11101181       IF ( myid == 0 )  THEN
    11111182!         
     
    11381209!
    11391210!--          Area along y required by actual child PE
    1140              DO  j = coarse_bound_all(3,k), coarse_bound_all(4,k)  !: j = jcs, jcn of PE# k
     1211             DO  j = coarse_bound_all(3,k), coarse_bound_all(4,k)  !: j = jps, jpn of PE# k
    11411212!
    11421213!--             Area along x required by actual child PE
    1143                 DO  i = coarse_bound_all(1,k), coarse_bound_all(2,k)  !: i = icl, icr of PE# k
     1214                DO  i = coarse_bound_all(1,k), coarse_bound_all(2,k)  !: i = ipl, ipr of PE# k
    11441215
    11451216                   px = i / nrx
     
    11921263        IMPLICIT  NONE
    11931264
    1194         INTEGER(iwp) :: nbgp_lpm = 1
    1195 
    1196         nbgp_lpm = min(nbgp_lpm, nbgp)
    1197 
    1198         childgrid(m)%nx = nx_cl
    1199         childgrid(m)%ny = ny_cl
    1200         childgrid(m)%nz = nz_cl
    1201         childgrid(m)%dx = dx_cl
    1202         childgrid(m)%dy = dy_cl
    1203         childgrid(m)%dz = dz_cl
    1204 
    1205         childgrid(m)%lx_coord   = cl_coord_x(0)
    1206         childgrid(m)%lx_coord_b = cl_coord_x(-nbgp_lpm)
    1207         childgrid(m)%rx_coord   = cl_coord_x(nx_cl)+dx_cl
    1208         childgrid(m)%rx_coord_b = cl_coord_x(nx_cl+nbgp_lpm)+dx_cl
    1209         childgrid(m)%sy_coord   = cl_coord_y(0)
    1210         childgrid(m)%sy_coord_b = cl_coord_y(-nbgp_lpm)
    1211         childgrid(m)%ny_coord   = cl_coord_y(ny_cl)+dy_cl
    1212         childgrid(m)%ny_coord_b = cl_coord_y(ny_cl+nbgp_lpm)+dy_cl
     1265        INTEGER(iwp) ::  nbgp_lpm = 1  !<
     1266
     1267       
     1268        nbgp_lpm = MIN( nbgp_lpm, nbgp )
     1269
     1270        childgrid(m)%nx = nx_child
     1271        childgrid(m)%ny = ny_child
     1272        childgrid(m)%nz = nz_child
     1273        childgrid(m)%dx = dx_child
     1274        childgrid(m)%dy = dy_child
     1275        childgrid(m)%dz = dz_child
     1276
     1277        childgrid(m)%lx_coord   = child_coord_x(0)
     1278        childgrid(m)%lx_coord_b = child_coord_x(-nbgp_lpm)
     1279        childgrid(m)%rx_coord   = child_coord_x(nx_child) + dx_child
     1280        childgrid(m)%rx_coord_b = child_coord_x(nx_child+nbgp_lpm) + dx_child
     1281        childgrid(m)%sy_coord   = child_coord_y(0)
     1282        childgrid(m)%sy_coord_b = child_coord_y(-nbgp_lpm)
     1283        childgrid(m)%ny_coord   = child_coord_y(ny_child) + dy_child
     1284        childgrid(m)%ny_coord_b = child_coord_y(ny_child+nbgp_lpm) + dy_child
    12131285        childgrid(m)%uz_coord   = zmax_coarse(2)
    12141286        childgrid(m)%uz_coord_b = zmax_coarse(1)
     
    12261298    IMPLICIT NONE
    12271299
    1228 
    1229     CHARACTER(LEN=da_namelen) ::  myname     !<
    1230     CHARACTER(LEN=5) ::  salsa_char          !<
    1231     INTEGER(iwp) ::  ib         !< running index for aerosol size bins
    1232     INTEGER(iwp) ::  ic         !< running index for aerosol mass bins
    1233     INTEGER(iwp) ::  ierr       !<
    1234     INTEGER(iwp) ::  icl        !< Left index limit for children's parent-grid arrays
    1235     INTEGER(iwp) ::  icla       !< Left index limit for allocation of index-mapping and other auxiliary arrays
    1236     INTEGER(iwp) ::  iclw       !< Left index limit for children's parent-grid work arrays
    1237     INTEGER(iwp) ::  icr        !< Left index limit for children's parent-grid arrays
    1238     INTEGER(iwp) ::  icra       !< Right index limit for allocation of index-mapping and other auxiliary arrays
    1239     INTEGER(iwp) ::  icrw       !< Right index limit for children's parent-grid work arrays
    1240     INTEGER(iwp) ::  ig         !< running index for salsa gases
    1241     INTEGER(iwp) ::  jcn        !< North index limit for children's parent-grid arrays
    1242     INTEGER(iwp) ::  jcna       !< North index limit for allocation of index-mapping and other auxiliary arrays
    1243     INTEGER(iwp) ::  jcnw       !< North index limit for children's parent-grid work arrays
    1244     INTEGER(iwp) ::  jcs        !< South index limit for children's parent-grid arrays
    1245     INTEGER(iwp) ::  jcsa       !< South index limit for allocation of index-mapping and other auxiliary arrays
    1246     INTEGER(iwp) ::  jcsw       !< South index limit for children's parent-grid work arrays
    1247     INTEGER(iwp) ::  n          !< Running index for number of chemical species
    1248     INTEGER(iwp), DIMENSION(3) ::  val  !< Array for sending the child-grid dimensions to parent
    1249     REAL(wp) ::  xcs        !<
    1250     REAL(wp) ::  xce        !<
    1251     REAL(wp) ::  ycs        !<
    1252     REAL(wp) ::  yce        !<
    1253 
    1254     REAL(wp), DIMENSION(5) ::  fval     !< Array for sending the child-grid spacings etc to parent
    1255                                              
     1300    INTEGER(iwp) ::  ierr                          !< MPI error code
     1301    INTEGER(iwp) ::  lb                            !< Running index for aerosol size bins
     1302    INTEGER(iwp) ::  lc                            !< Running index for aerosol mass bins
     1303    INTEGER(iwp) ::  lg                            !< Running index for salsa gases
     1304    INTEGER(iwp) ::  n                             !< Running index for number of chemical species
     1305    INTEGER(iwp), DIMENSION(3) ::  child_grid_dim  !< Array for sending the child-grid dimensions to parent
     1306
     1307    REAL(wp), DIMENSION(5) ::  child_grid_info     !< Array for sending the child-grid spacings etc to parent
     1308         
     1309    CHARACTER( LEN=da_namelen ) ::  myname         !<
     1310    CHARACTER(LEN=5) ::  salsa_char                !<
     1311   
    12561312!
    12571313!-- Child setup
    12581314!-- Root model does not have a parent and is not a child, therefore no child setup on root model
    12591315    IF ( .NOT. pmc_is_rootmodel() )  THEN
    1260 
     1316!
     1317!--    ADD A DESCRIPTION HERE WHAT PMC_CHILDINIT DOES       
    12611318       CALL pmc_childinit
    12621319!
     
    12671324!--    in subroutines:
    12681325!--    pmci_set_array_pointer (for parent arrays)
    1269 !--    pmci_create_child_arrays (for child arrays)
     1326!--    pmci_create_childs_parent_grid_arrays (for child's parent-grid arrays)
    12701327       CALL pmc_set_dataarray_name( 'coarse', 'u'  ,'fine', 'u',  ierr )
    12711328       CALL pmc_set_dataarray_name( 'coarse', 'v'  ,'fine', 'v',  ierr )
     
    13071364       ENDIF
    13081365
    1309        IF( particle_advection )  THEN
     1366       IF ( particle_advection )  THEN
    13101367          CALL pmc_set_dataarray_name( 'coarse', 'nr_part'  ,'fine',           &
    13111368               'nr_part',  ierr )
     
    13151372       
    13161373       IF ( air_chemistry  .AND.  nest_chemistry )  THEN
    1317           DO  n = 1, nspec
     1374          DO n = 1, nspec
    13181375             CALL pmc_set_dataarray_name( 'coarse',                            &
    13191376                                          'chem_' //                           &
    13201377                                          TRIM( chem_species(n)%name ),        &
    1321                                           'fine',                              &
     1378                                         'fine',                               &
    13221379                                          'chem_' //                           &
    13231380                                          TRIM( chem_species(n)%name ),        &
     
    13271384
    13281385       IF ( salsa  .AND.  nest_salsa )  THEN
    1329           DO  ib = 1, nbins_aerosol
    1330              WRITE(salsa_char,'(i0)') ib
     1386          DO  lb = 1, nbins_aerosol
     1387             WRITE(salsa_char,'(i0)') lb
    13311388             CALL pmc_set_dataarray_name( 'coarse',                            &
    13321389                                          'an_' //                             &
     
    13371394                                          ierr )
    13381395          ENDDO
    1339           DO  ic = 1, nbins_aerosol * ncomponents_mass
    1340              WRITE(salsa_char,'(i0)') ic
     1396          DO  lc = 1, nbins_aerosol * ncomponents_mass
     1397             WRITE(salsa_char,'(i0)') lc
    13411398             CALL pmc_set_dataarray_name( 'coarse',                            &
    13421399                                          'am_' //                             &
     
    13481405          ENDDO
    13491406          IF ( .NOT. salsa_gases_from_chem )  THEN
    1350              DO  ig = 1, ngases_salsa
    1351                 WRITE(salsa_char,'(i0)') ig
     1407             DO  lg = 1, ngases_salsa
     1408                WRITE(salsa_char,'(i0)') lg
    13521409                CALL pmc_set_dataarray_name( 'coarse',                         &
    13531410                                             'sg_' //                          &
     
    13641421!
    13651422!--    Send grid to parent
    1366        val(1)  = nx
    1367        val(2)  = ny
    1368        val(3)  = nz
    1369        fval(1) = zw(nzt+1)
    1370        fval(2) = zw(nzt)
    1371        fval(3) = dx
    1372        fval(4) = dy
    1373        fval(5) = dz(1)
     1423       child_grid_dim(1)  = nx
     1424       child_grid_dim(2)  = ny
     1425       child_grid_dim(3)  = nz
     1426       child_grid_info(1) = zw(nzt+1)
     1427       child_grid_info(2) = zw(nzt)
     1428       child_grid_info(3) = dx
     1429       child_grid_info(4) = dy
     1430       child_grid_info(5) = dz(1)
    13741431
    13751432       IF ( myid == 0 )  THEN
    13761433
    1377           CALL pmc_send_to_parent( val, SIZE( val ), 0, 123, ierr )
    1378           CALL pmc_send_to_parent( fval, SIZE( fval ), 0, 124, ierr )
     1434          CALL pmc_send_to_parent( child_grid_dim, SIZE( child_grid_dim ), 0, 123, ierr )
     1435          CALL pmc_send_to_parent( child_grid_info, SIZE( child_grid_info ), 0, 124, ierr )
    13791436          CALL pmc_send_to_parent( coord_x, nx + 1 + 2 * nbgp, 0, 11, ierr )
    13801437          CALL pmc_send_to_parent( coord_y, ny + 1 + 2 * nbgp, 0, 12, ierr )
     
    13931450       CALL MPI_BCAST( parent_grid_info_int, 3, MPI_INTEGER, 0, comm2d, ierr )
    13941451
    1395        cg%dx = parent_grid_info_real(3)
    1396        cg%dy = parent_grid_info_real(4)
    1397        cg%dz = parent_grid_info_real(7)
    1398        cg%nx = parent_grid_info_int(1)
    1399        cg%ny = parent_grid_info_int(2)
    1400        cg%nz = parent_grid_info_int(3)
     1452       pg%dx = parent_grid_info_real(3)
     1453       pg%dy = parent_grid_info_real(4)
     1454       pg%dz = parent_grid_info_real(7)
     1455       pg%nx = parent_grid_info_int(1)
     1456       pg%ny = parent_grid_info_int(2)
     1457       pg%nz = parent_grid_info_int(3)
    14011458!
    14021459!--    Get parent coordinates on coarse grid
    1403        ALLOCATE( cg%coord_x(-nbgp:cg%nx+nbgp) )
    1404        ALLOCATE( cg%coord_y(-nbgp:cg%ny+nbgp) )
    1405        ALLOCATE( cg%dzu(1:cg%nz+1) )
    1406        ALLOCATE( cg%dzw(1:cg%nz+1) )
    1407        ALLOCATE( cg%zu(0:cg%nz+1) )
    1408        ALLOCATE( cg%zw(0:cg%nz+1) )
     1460       ALLOCATE( pg%coord_x(-nbgp:pg%nx+nbgp) )
     1461       ALLOCATE( pg%coord_y(-nbgp:pg%ny+nbgp) )
     1462       ALLOCATE( pg%dzu(1:pg%nz+1) )
     1463       ALLOCATE( pg%dzw(1:pg%nz+1) )
     1464       ALLOCATE( pg%zu(0:pg%nz+1) )
     1465       ALLOCATE( pg%zw(0:pg%nz+1) )
    14091466!
    14101467!--    Get coarse grid coordinates and values of the z-direction from the parent
    14111468       IF ( myid == 0)  THEN
    1412           CALL pmc_recv_from_parent( cg%coord_x, cg%nx+1+2*nbgp, 0, 24, ierr )
    1413           CALL pmc_recv_from_parent( cg%coord_y, cg%ny+1+2*nbgp, 0, 25, ierr )
    1414           CALL pmc_recv_from_parent( cg%dzu, cg%nz+1, 0, 26, ierr )
    1415           CALL pmc_recv_from_parent( cg%dzw, cg%nz+1, 0, 27, ierr )
    1416           CALL pmc_recv_from_parent( cg%zu, cg%nz+2, 0, 28, ierr )
    1417           CALL pmc_recv_from_parent( cg%zw, cg%nz+2, 0, 29, ierr )
     1469          CALL pmc_recv_from_parent( pg%coord_x, pg%nx+1+2*nbgp, 0, 24, ierr )
     1470          CALL pmc_recv_from_parent( pg%coord_y, pg%ny+1+2*nbgp, 0, 25, ierr )
     1471          CALL pmc_recv_from_parent( pg%dzu, pg%nz+1, 0, 26, ierr )
     1472          CALL pmc_recv_from_parent( pg%dzw, pg%nz+1, 0, 27, ierr )
     1473          CALL pmc_recv_from_parent( pg%zu, pg%nz+2, 0, 28, ierr )
     1474          CALL pmc_recv_from_parent( pg%zw, pg%nz+2, 0, 29, ierr )
    14181475       ENDIF
    14191476!
    14201477!--    Broadcast this information
    1421        CALL MPI_BCAST( cg%coord_x, cg%nx+1+2*nbgp, MPI_REAL, 0, comm2d, ierr )
    1422        CALL MPI_BCAST( cg%coord_y, cg%ny+1+2*nbgp, MPI_REAL, 0, comm2d, ierr )
    1423        CALL MPI_BCAST( cg%dzu, cg%nz+1, MPI_REAL, 0, comm2d, ierr )
    1424        CALL MPI_BCAST( cg%dzw, cg%nz+1, MPI_REAL, 0, comm2d, ierr )
    1425        CALL MPI_BCAST( cg%zu, cg%nz+2,  MPI_REAL, 0, comm2d, ierr )
    1426        CALL MPI_BCAST( cg%zw, cg%nz+2,  MPI_REAL, 0, comm2d, ierr )
     1478       CALL MPI_BCAST( pg%coord_x, pg%nx+1+2*nbgp, MPI_REAL, 0, comm2d, ierr )
     1479       CALL MPI_BCAST( pg%coord_y, pg%ny+1+2*nbgp, MPI_REAL, 0, comm2d, ierr )
     1480       CALL MPI_BCAST( pg%dzu, pg%nz+1, MPI_REAL, 0, comm2d, ierr )
     1481       CALL MPI_BCAST( pg%dzw, pg%nz+1, MPI_REAL, 0, comm2d, ierr )
     1482       CALL MPI_BCAST( pg%zu, pg%nz+2,  MPI_REAL, 0, comm2d, ierr )
     1483       CALL MPI_BCAST( pg%zw, pg%nz+2,  MPI_REAL, 0, comm2d, ierr )
    14271484       CALL MPI_BCAST( rans_mode_parent, 1, MPI_LOGICAL, 0, comm2d, ierr )
     1485
     1486!  CHECK IF pmci_check_grid_matching COULD BE MOVED HERE.
     1487       
    14281488!
    14291489!--    Find the index bounds for the nest domain in the coarse-grid index space
     
    14371497       CALL  pmc_c_clear_next_array_list
    14381498
    1439        ib = 1
    1440        ic = 1
    1441        ig = 1
    14421499       n  = 1
     1500       lb = 1
     1501       lc = 1
     1502       lg = 1
    14431503
    14441504       DO  WHILE ( pmc_c_getnextarray( myname ) )
     
    14511511!--       species and increment this subsequently.
    14521512          IF ( INDEX( TRIM( myname ), 'chem_' ) /= 0 )  THEN             
    1453              CALL pmci_create_child_arrays ( myname, icl, icr, jcs, jcn, cg%nz, n )
     1513             CALL pmci_create_childs_parent_grid_arrays ( myname, ipl, ipr, jps, jpn, pg%nz, n )
    14541514             n = n + 1   
    14551515          ELSEIF ( INDEX( TRIM( myname ), 'an_' ) /= 0 )  THEN
    1456              CALL pmci_create_child_arrays ( myname, icl, icr, jcs, jcn, cg%nz,&
    1457                                              ib )
    1458              ib = ib + 1
     1516             CALL pmci_create_childs_parent_grid_arrays ( myname, ipl, ipr, jps, jpn, pg%nz, lb )
     1517             lb = lb + 1
    14591518          ELSEIF ( INDEX( TRIM( myname ), 'am_' ) /= 0 )  THEN
    1460              CALL pmci_create_child_arrays ( myname, icl, icr, jcs, jcn, cg%nz,&
    1461                                              ic )
    1462              ic = ic + 1
    1463           ELSEIF ( INDEX( TRIM( myname ), 'sg_' ) /= 0  .AND.                  &
    1464              .NOT. salsa_gases_from_chem )                                     &
    1465           THEN
    1466              CALL pmci_create_child_arrays ( myname, icl, icr, jcs, jcn, cg%nz,&
    1467                                              ig )
    1468              ig = ig + 1
     1519             CALL pmci_create_childs_parent_grid_arrays ( myname, ipl, ipr, jps, jpn, pg%nz, lc )
     1520             lc = lc + 1
     1521          ELSEIF ( INDEX( TRIM( myname ), 'sg_' ) /= 0  .AND.  .NOT.  salsa_gases_from_chem )  THEN
     1522             CALL pmci_create_childs_parent_grid_arrays ( myname, ipl, ipr, jps, jpn, pg%nz, lg )
     1523             lg = lg + 1
    14691524          ELSE
    1470              CALL pmci_create_child_arrays ( myname, icl, icr, jcs, jcn, cg%nz )
     1525             CALL pmci_create_childs_parent_grid_arrays ( myname, ipl, ipr, jps, jpn, pg%nz )
    14711526          ENDIF
    14721527       ENDDO
     
    14911546
    14921547       INTEGER(iwp), DIMENSION(5,numprocs) ::  coarse_bound_all     !< Transfer array for parent-grid index bounds
     1548
    14931549       INTEGER(iwp), DIMENSION(4)          ::  parent_bound_global  !< Transfer array for global parent-grid index bounds
    14941550       INTEGER(iwp), DIMENSION(2)          ::  size_of_array        !<
    1495        INTEGER(iwp) :: i        !<
    1496        INTEGER(iwp) :: iauxl    !<
    1497        INTEGER(iwp) :: iauxr    !<
    1498        INTEGER(iwp) :: ijaux    !<
    1499        INTEGER(iwp) :: j        !<
    1500        INTEGER(iwp) :: jauxs    !<
    1501        INTEGER(iwp) :: jauxn    !<
     1551
     1552       INTEGER(iwp) ::  i       !<
     1553       INTEGER(iwp) ::  iauxl   !<
     1554       INTEGER(iwp) ::  iauxr   !<
     1555       INTEGER(iwp) ::  ijaux   !<
     1556       INTEGER(iwp) ::  j       !<
     1557       INTEGER(iwp) ::  jauxs   !<
     1558       INTEGER(iwp) ::  jauxn   !<
     1559
    15021560       REAL(wp) ::  xexl        !< Parent-grid array exceedance behind the left edge of the child PE subdomain
    15031561       REAL(wp) ::  xexr        !< Parent-grid array exceedance behind the right edge of the child PE subdomain
    15041562       REAL(wp) ::  yexs        !< Parent-grid array exceedance behind the south edge of the child PE subdomain
    15051563       REAL(wp) ::  yexn        !< Parent-grid array exceedance behind the north edge of the child PE subdomain
     1564       REAL(wp) ::  xcs         !< RENAME
     1565       REAL(wp) ::  xce         !< RENAME
     1566       REAL(wp) ::  ycs         !< RENAME
     1567       REAL(wp) ::  yce         !< RENAME
    15061568
    15071569!
     
    15111573!--    Else the parent-grid cell is included in the neighbouring subdomain's
    15121574!--    anterpolation domain, or not included at all if we are at the outer
    1513 !--    edge of the child domain.
     1575!--    edge of the child domain. This may occur especially when a large grid-spacing
     1576!--    ratio is used.       
    15141577!
    15151578!--    Left
    1516        IF  ( bc_dirichlet_l )  THEN
    1517           xexl  = 2 * cg%dx
     1579!--    EXPLAIN THE EXTENSION HERE AND IN THE OTHER OCCASIONS (r, s, n)       
     1580       IF ( bc_dirichlet_l )  THEN
     1581          xexl  = 2 * pg%dx
    15181582          iauxl = 0
    15191583       ELSE
     
    15221586       ENDIF
    15231587       xcs     = coord_x(nxl) - xexl
    1524        DO  i = 0, cg%nx
    1525           IF ( cg%coord_x(i) + 0.5_wp * cg%dx >= xcs )  THEN
    1526              icl = MAX( 0, i )
     1588       DO  i = 0, pg%nx
     1589          IF ( pg%coord_x(i) + 0.5_wp * pg%dx >= xcs )  THEN   ! Consider changing >= to ==
     1590             ipl = MAX( 0, i )
    15271591             EXIT
    15281592          ENDIF
     
    15301594!
    15311595!--    Right
    1532        IF  ( bc_dirichlet_r )  THEN
    1533           xexr  = 2 * cg%dx
     1596       IF ( bc_dirichlet_r )  THEN
     1597          xexr  = 2 * pg%dx
    15341598          iauxr = 0 
    15351599       ELSE
     
    15381602       ENDIF
    15391603       xce  = coord_x(nxr+1) + xexr
    1540        DO  i = cg%nx, 0 , -1
    1541           IF ( cg%coord_x(i) + 0.5_wp * cg%dx <= xce )  THEN
    1542              icr = MIN( cg%nx, MAX( icl, i ) )
     1604       DO  i = pg%nx, 0 , -1
     1605          IF ( pg%coord_x(i) + 0.5_wp * pg%dx <= xce )  THEN
     1606             ipr = MIN( pg%nx, MAX( ipl, i ) )
    15431607             EXIT
    15441608          ENDIF
     
    15461610!
    15471611!--    South
    1548        IF  ( bc_dirichlet_s )  THEN
    1549           yexs  = 2 * cg%dy
     1612       IF ( bc_dirichlet_s )  THEN
     1613          yexs  = 2 * pg%dy
    15501614          jauxs = 0 
    15511615       ELSE
     
    15541618       ENDIF
    15551619       ycs  = coord_y(nys) - yexs
    1556        DO  j = 0, cg%ny
    1557           IF ( cg%coord_y(j) + 0.5_wp * cg%dy >= ycs )  THEN
    1558              jcs = MAX( 0, j )
     1620       DO  j = 0, pg%ny
     1621          IF ( pg%coord_y(j) + 0.5_wp * pg%dy >= ycs )  THEN
     1622             jps = MAX( 0, j )
    15591623             EXIT
    15601624          ENDIF
     
    15631627!--    North
    15641628       IF  ( bc_dirichlet_n )  THEN
    1565           yexn  = 2 * cg%dy
     1629          yexn  = 2 * pg%dy
    15661630          jauxn = 0
    15671631       ELSE
     
    15701634       ENDIF
    15711635       yce  = coord_y(nyn+1) + yexn
    1572        DO  j = cg%ny, 0 , -1
    1573           IF ( cg%coord_y(j) + 0.5_wp * cg%dy <= yce )  THEN
    1574              jcn = MIN( cg%ny, MAX( jcs, j ) )
     1636       DO  j = pg%ny, 0 , -1
     1637          IF ( pg%coord_y(j) + 0.5_wp * pg%dy <= yce )  THEN
     1638             jpn = MIN( pg%ny, MAX( jps, j ) )
    15751639             EXIT
    15761640          ENDIF
    15771641       ENDDO
    15781642!
    1579 !--    Make sure that the indexing is contiguous (no gaps, no overlaps)
    1580 #if defined( __parallel )
     1643!--    Make sure that the indexing is contiguous (no gaps, no overlaps).
     1644!--    This is a safety measure mainly for cases with high grid-spacing
     1645!--    ratio and narrow child subdomains.
    15811646       IF ( nxl == 0 )  THEN
    1582           CALL MPI_SEND( icr, 1, MPI_INTEGER, pright, 717, comm2d, ierr )
     1647          CALL MPI_SEND( ipr, 1, MPI_INTEGER, pright, 717, comm2d, ierr )
    15831648       ELSE IF ( nxr == nx )  THEN
    15841649          CALL MPI_RECV( ijaux, 1, MPI_INTEGER, pleft, 717, comm2d, status, ierr )
    1585           icl = ijaux + 1
     1650          ipl = ijaux + 1
    15861651       ELSE
    1587           CALL MPI_SEND( icr, 1, MPI_INTEGER, pright, 717, comm2d, ierr )
     1652          CALL MPI_SEND( ipr, 1, MPI_INTEGER, pright, 717, comm2d, ierr )
    15881653          CALL MPI_RECV( ijaux, 1, MPI_INTEGER, pleft, 717, comm2d, status, ierr )
    1589           icl = ijaux + 1
     1654          ipl = ijaux + 1
    15901655       ENDIF
    15911656       IF ( nys == 0 )  THEN
    1592           CALL MPI_SEND( jcn, 1, MPI_INTEGER, pnorth, 719, comm2d, ierr )
     1657          CALL MPI_SEND( jpn, 1, MPI_INTEGER, pnorth, 719, comm2d, ierr )
    15931658       ELSE IF ( nyn == ny )  THEN
    15941659          CALL MPI_RECV( ijaux, 1, MPI_INTEGER, psouth, 719, comm2d, status, ierr )
    1595           jcs = ijaux + 1
     1660          jps = ijaux + 1
    15961661       ELSE
    1597           CALL MPI_SEND( jcn, 1, MPI_INTEGER, pnorth, 719, comm2d, ierr )
     1662          CALL MPI_SEND( jpn, 1, MPI_INTEGER, pnorth, 719, comm2d, ierr )
    15981663          CALL MPI_RECV( ijaux, 1, MPI_INTEGER, psouth, 719, comm2d, status, ierr )
    1599           jcs = ijaux + 1
    1600        ENDIF
    1601 #endif       
    1602 
    1603        WRITE(9,"('Pmci_map_fine_to_coarse_grid. Parent-grid array bounds: ',4(i4,2x))") icl, icr, jcs, jcn
     1664          jps = ijaux + 1
     1665       ENDIF
     1666
     1667       WRITE(9,"('Pmci_map_fine_to_coarse_grid. Parent-grid array bounds: ',4(i4,2x))")             &
     1668            ipl, ipr, jps, jpn
    16041669       FLUSH(9)
    16051670
    1606        coarse_bound(1) = icl
    1607        coarse_bound(2) = icr
    1608        coarse_bound(3) = jcs
    1609        coarse_bound(4) = jcn
     1671       coarse_bound(1) = ipl
     1672       coarse_bound(2) = ipr
     1673       coarse_bound(3) = jps
     1674       coarse_bound(4) = jpn
    16101675       coarse_bound(5) = myid
    16111676!
    16121677!--    The following index bounds are used for allocating index mapping and some other auxiliary arrays
    1613        coarse_bound_aux(1) = icl - iauxl
    1614        coarse_bound_aux(2) = icr + iauxr
    1615        coarse_bound_aux(3) = jcs - jauxs
    1616        coarse_bound_aux(4) = jcn + jauxn
     1678       ipla = ipl - iauxl
     1679       ipra = ipr + iauxr
     1680       jpsa = jps - jauxs
     1681       jpna = jpn + jauxn
    16171682!
    16181683!--    Note that MPI_Gather receives data from all processes in the rank order
    16191684!--    This fact is exploited in creating the index list in pmci_create_index_list
    1620        CALL MPI_GATHER( coarse_bound, 5, MPI_INTEGER, coarse_bound_all, 5,     &
     1685!    IMPROVE THIS COMMENT. EXPLAIN WHERE THIS INFORMATION IS NEEDED.
     1686       CALL MPI_GATHER( coarse_bound, 5, MPI_INTEGER, coarse_bound_all, 5,                          &
    16211687                        MPI_INTEGER, 0, comm2d, ierr )
    16221688
     
    16251691          size_of_array(2) = SIZE( coarse_bound_all, 2 )
    16261692          CALL pmc_send_to_parent( size_of_array, 2, 0, 40, ierr )
    1627           CALL pmc_send_to_parent( coarse_bound_all, SIZE( coarse_bound_all ), &
    1628                0, 41, ierr )
     1693          CALL pmc_send_to_parent( coarse_bound_all, SIZE( coarse_bound_all ), 0, 41, ierr )
    16291694!
    16301695!--       Determine the global parent-grid index bounds       
     
    16411706       jpsg = parent_bound_global(3)
    16421707       jpng = parent_bound_global(4)
    1643        WRITE(9,"('Pmci_map_fine_to_coarse_grid. Global parent-grid index bounds iplg, iprg, jpsg, jpng: ',4(i4,2x))") iplg, iprg, jpsg, jpng
    1644        FLUSH(9)
     1708       WRITE( 9, "('Pmci_map_fine_to_coarse_grid. Global parent-grid index bounds iplg, iprg, jpsg, jpng: ',4(i4,2x))" ) &
     1709            iplg, iprg, jpsg, jpng
     1710       FLUSH( 9 )
    16451711       
    16461712    END SUBROUTINE pmci_map_fine_to_coarse_grid
     
    16541720       IMPLICIT NONE
    16551721
    1656        INTEGER(iwp) ::  i         !< Child-grid index
    1657        INTEGER(iwp) ::  ii        !< Parent-grid index
     1722       INTEGER(iwp) ::  i         !< Child-grid index in the x-direction
     1723       INTEGER(iwp) ::  ii        !< Parent-grid index in the x-direction
    16581724       INTEGER(iwp) ::  istart    !<
    16591725       INTEGER(iwp) ::  ir        !<
    1660        INTEGER(iwp) ::  iw        !< Child-grid index limited to -1 <= iw <= nx+1
    1661        INTEGER(iwp) ::  j         !< Child-grid index
    1662        INTEGER(iwp) ::  jj        !< Parent-grid index
     1726       INTEGER(iwp) ::  iw        !< Child-grid index limited to -1 <= iw <= nx+1 for wall_flags_0
     1727       INTEGER(iwp) ::  j         !< Child-grid index in the y-direction
     1728       INTEGER(iwp) ::  jj        !< Parent-grid index in the y-direction
    16631729       INTEGER(iwp) ::  jstart    !<
    16641730       INTEGER(iwp) ::  jr        !<
    1665        INTEGER(iwp) ::  jw        !< Child-grid index limited to -1 <= jw <= ny+1
    1666        INTEGER(iwp) ::  k         !< Child-grid index
    1667        INTEGER(iwp) ::  kk        !< Parent-grid index
     1731       INTEGER(iwp) ::  jw        !< Child-grid index limited to -1 <= jw <= ny+1 for wall_flags_0
     1732       INTEGER(iwp) ::  k         !< Child-grid index in the z-direction
     1733       INTEGER(iwp) ::  kk        !< Parent-grid index in the z-direction
    16681734       INTEGER(iwp) ::  kstart    !<
    1669        INTEGER(iwp) ::  kw        !< Child-grid index limited to kw <= nzt+1
     1735       INTEGER(iwp) ::  kw        !< Child-grid index limited to kw <= nzt+1 for wall_flags_0
    16701736     
    16711737!
    16721738!--    Allocate child-grid work arrays for interpolation.
    1673        igsr = NINT( cg%dx / dx, iwp )
    1674        jgsr = NINT( cg%dy / dy, iwp )
    1675        kgsr = NINT( cg%dzw(1) / dzw(1), iwp )
     1739       igsr = NINT( pg%dx / dx, iwp )
     1740       jgsr = NINT( pg%dy / dy, iwp )
     1741       kgsr = NINT( pg%dzw(1) / dzw(1), iwp )
    16761742       WRITE(9,"('igsr, jgsr, kgsr: ',3(i3,2x))") igsr, jgsr, kgsr
    16771743       FLUSH(9)
     
    16881754!--    coarse-grid levels below the child top-boundary level.
    16891755       kk = 0
    1690        DO  WHILE ( cg%zu(kk) <= zu(nzt) )
     1756       DO WHILE ( pg%zu(kk) <= zu(nzt) )
    16911757          kk = kk + 1
    16921758       ENDDO
     
    16941760
    16951761       kk = 0
    1696        DO  WHILE ( cg%zw(kk) <= zw(nzt-1) )
     1762       DO WHILE ( pg%zw(kk) <= zw(nzt-1) )
    16971763          kk = kk + 1
    16981764       ENDDO
    16991765       kctw = kk - 1
    17001766
    1701        WRITE(9,"('kcto, kctw = ', 2(i3,2x))") kcto, kctw
    1702        FLUSH(9)
     1767       WRITE( 9, "('kcto, kctw = ', 2(i3,2x))" ) kcto, kctw
     1768       FLUSH( 9 )
    17031769       
    1704        icla = coarse_bound_aux(1)
    1705        icra = coarse_bound_aux(2)
    1706        jcsa = coarse_bound_aux(3)
    1707        jcna = coarse_bound_aux(4)
    1708        ALLOCATE( iflu(icla:icra) )
    1709        ALLOCATE( iflo(icla:icra) )
    1710        ALLOCATE( ifuu(icla:icra) )
    1711        ALLOCATE( ifuo(icla:icra) )
    1712        ALLOCATE( jflv(jcsa:jcna) )
    1713        ALLOCATE( jflo(jcsa:jcna) )
    1714        ALLOCATE( jfuv(jcsa:jcna) )
    1715        ALLOCATE( jfuo(jcsa:jcna) )       
    1716        ALLOCATE( kflw(0:cg%nz+1) )
    1717        ALLOCATE( kflo(0:cg%nz+1) )
    1718        ALLOCATE( kfuw(0:cg%nz+1) )
    1719        ALLOCATE( kfuo(0:cg%nz+1) )
    1720        ALLOCATE( ijkfc_u(0:cg%nz+1,jcsa:jcna,icla:icra) )
    1721        ALLOCATE( ijkfc_v(0:cg%nz+1,jcsa:jcna,icla:icra) )
    1722        ALLOCATE( ijkfc_w(0:cg%nz+1,jcsa:jcna,icla:icra) )
    1723        ALLOCATE( ijkfc_s(0:cg%nz+1,jcsa:jcna,icla:icra) )
     1770       ALLOCATE( iflu(ipla:ipra) )
     1771       ALLOCATE( iflo(ipla:ipra) )
     1772       ALLOCATE( ifuu(ipla:ipra) )
     1773       ALLOCATE( ifuo(ipla:ipra) )
     1774       ALLOCATE( jflv(jpsa:jpna) )
     1775       ALLOCATE( jflo(jpsa:jpna) )
     1776       ALLOCATE( jfuv(jpsa:jpna) )
     1777       ALLOCATE( jfuo(jpsa:jpna) )       
     1778       ALLOCATE( kflw(0:pg%nz+1) )
     1779       ALLOCATE( kflo(0:pg%nz+1) )
     1780       ALLOCATE( kfuw(0:pg%nz+1) )
     1781       ALLOCATE( kfuo(0:pg%nz+1) )
     1782       ALLOCATE( ijkfc_u(0:pg%nz+1,jpsa:jpna,ipla:ipra) )
     1783       ALLOCATE( ijkfc_v(0:pg%nz+1,jpsa:jpna,ipla:ipra) )
     1784       ALLOCATE( ijkfc_w(0:pg%nz+1,jpsa:jpna,ipla:ipra) )
     1785       ALLOCATE( ijkfc_s(0:pg%nz+1,jpsa:jpna,ipla:ipra) )
    17241786
    17251787       ijkfc_u = 0
     
    17301792!--    i-indices of u for each ii-index value
    17311793       istart = nxlg
    1732        DO  ii = icla, icra
     1794       DO  ii = ipla, ipra
    17331795!
    17341796!--       The parent and child grid lines do always match in x, hence we
    17351797!--       use only the local k,j-child-grid plane for the anterpolation.
     1798!--       However, icru still has to be stored separately as these index bounds
     1799!--       are passed as arguments to the interpolation and anterpolation
     1800!--       subroutines.
    17361801          i = istart
    1737           DO WHILE ( coord_x(i) < cg%coord_x(ii) .AND. i < nxrg )
     1802          DO WHILE ( coord_x(i) < pg%coord_x(ii) .AND. i < nxrg )
    17381803             i = i + 1
    17391804          ENDDO
     
    17431808!
    17441809!--       Print out the index bounds for checking and debugging purposes
    1745           WRITE(9,"('pmci_define_index_mapping, ii, iflu, ifuu: ', 3(i4,2x))")    &
     1810          WRITE( 9, "('pmci_define_index_mapping, ii, iflu, ifuu: ', 3(i4,2x))" )                   &
    17461811               ii, iflu(ii), ifuu(ii)
    1747           FLUSH(9)
     1812          FLUSH( 9 )
    17481813       ENDDO
    1749        WRITE(9,*)
     1814       WRITE( 9, * )
    17501815!
    17511816!--    i-indices of others for each ii-index value
    17521817       istart = nxlg
    1753        DO  ii = icla, icra
     1818       DO  ii = ipla, ipra
    17541819          i = istart
    1755           DO  WHILE ( ( coord_x(i) + 0.5_wp * dx < cg%coord_x(ii) )  .AND.     &
     1820          DO WHILE ( ( coord_x(i) + 0.5_wp * dx < pg%coord_x(ii) )  .AND.     &
    17561821                      ( i < nxrg ) )
    17571822             i  = i + 1
     
    17591824          iflo(ii) = MIN( MAX( i, nxlg ), nxrg )
    17601825          ir = i
    1761           DO  WHILE ( ( coord_x(ir) + 0.5_wp * dx <= cg%coord_x(ii) + cg%dx )  &
     1826          DO WHILE ( ( coord_x(ir) + 0.5_wp * dx <= pg%coord_x(ii) + pg%dx )  &
    17621827                      .AND.  ( i < nxrg+1 ) )
    17631828             i  = i + 1
     
    17681833!
    17691834!--       Print out the index bounds for checking and debugging purposes
    1770           WRITE(9,"('pmci_define_index_mapping, ii, iflo, ifuo: ', 3(i4,2x))")    &
     1835          WRITE( 9, "('pmci_define_index_mapping, ii, iflo, ifuo: ', 3(i4,2x))" )                   &
    17711836               ii, iflo(ii), ifuo(ii)
    1772           FLUSH(9)
     1837          FLUSH( 9 )
    17731838       ENDDO
    1774        WRITE(9,*)
     1839       WRITE( 9, * )
    17751840!
    17761841!--    j-indices of v for each jj-index value
    17771842       jstart = nysg
    1778        DO  jj = jcsa, jcna
     1843       DO  jj = jpsa, jpna
    17791844!
    17801845!--       The parent and child grid lines do always match in y, hence we
    17811846!--       use only the local k,i-child-grid plane for the anterpolation.
     1847!--       However, jcnv still has to be stored separately as these index bounds
     1848!--       are passed as arguments to the interpolation and anterpolation
     1849!--       subroutines.
    17821850          j = jstart
    1783           DO WHILE ( coord_y(j) < cg%coord_y(jj) .AND. j < nyng )
     1851          DO WHILE ( coord_y(j) < pg%coord_y(jj) .AND. j < nyng )
    17841852             j = j + 1
    17851853          ENDDO
     
    17891857!
    17901858!--       Print out the index bounds for checking and debugging purposes
    1791           WRITE(9,"('pmci_define_index_mapping, jj, jflv, jfuv: ', 3(i4,2x))")    &
     1859          WRITE( 9, "('pmci_define_index_mapping, jj, jflv, jfuv: ', 3(i4,2x))" )                   &
    17921860               jj, jflv(jj), jfuv(jj)
    17931861          FLUSH(9)
    17941862       ENDDO
    1795        WRITE(9,*)
     1863       WRITE( 9, * )
    17961864!
    17971865!--    j-indices of others for each jj-index value
    17981866       jstart = nysg
    1799        DO  jj = jcsa, jcna
     1867       DO  jj = jpsa, jpna
    18001868          j = jstart
    1801           DO  WHILE ( ( coord_y(j) + 0.5_wp * dy < cg%coord_y(jj) )  .AND.     &
    1802                       ( j < nyng ) )
     1869          DO WHILE ( ( coord_y(j) + 0.5_wp * dy < pg%coord_y(jj) ) .AND. ( j < nyng ) )
    18031870             j  = j + 1
    18041871          ENDDO
    18051872          jflo(jj) = MIN( MAX( j, nysg ), nyng )
    18061873          jr = j
    1807           DO  WHILE ( ( coord_y(jr) + 0.5_wp * dy <= cg%coord_y(jj) + cg%dy )  &
    1808                       .AND.  ( j < nyng+1 ) )
     1874          DO WHILE ( ( coord_y(jr) + 0.5_wp * dy <= pg%coord_y(jj) + pg%dy ) .AND. ( j < nyng+1 ) )
    18091875             j  = j + 1
    18101876             jr = MIN( j, nyng )
     
    18141880!
    18151881!--       Print out the index bounds for checking and debugging purposes
    1816           WRITE(9,"('pmci_define_index_mapping, jj, jflo, jfuo: ', 3(i4,2x))")    &
     1882          WRITE( 9, "('pmci_define_index_mapping, jj, jflo, jfuo: ', 3(i4,2x))" )                   &
    18171883               jj, jflo(jj), jfuo(jj)
    1818           FLUSH(9)
     1884          FLUSH( 9 )
    18191885       ENDDO
    1820        WRITE(9,*)
     1886       WRITE( 9, * )
    18211887!
    18221888!--    k-indices of w for each kk-index value
     
    18261892       kflw(0) = 0
    18271893       kfuw(0) = 0
    1828        DO kk = 1, cg%nz+1
     1894       DO  kk = 1, pg%nz+1
    18291895!
    18301896!--       The parent and child grid lines do always match in z, hence we
    18311897!--       use only the local j,i-child-grid plane for the anterpolation.
     1898!--       However, kctw still has to be stored separately as these index bounds
     1899!--       are passed as arguments to the interpolation and anterpolation
     1900!--       subroutines.
    18321901          k = kstart
    1833           DO WHILE ( ( zw(k) < cg%zw(kk) )  .AND.  ( k < nzt+1 ) )
     1902          DO WHILE ( ( zw(k) < pg%zw(kk) )  .AND.  ( k < nzt+1 ) )
    18341903             k = k + 1
    18351904          ENDDO
     
    18391908!
    18401909!--       Print out the index bounds for checking and debugging purposes
    1841           WRITE(9,"('pmci_define_index_mapping, kk, kflw, kfuw: ', 4(i4,2x), 2(e12.5,2x))") &
    1842                kk, kflw(kk), kfuw(kk), nzt,  cg%zu(kk), cg%zw(kk)
    1843           FLUSH(9)
     1910          WRITE( 9, "('pmci_define_index_mapping, kk, kflw, kfuw: ', 4(i4,2x), 2(e12.5,2x))" )      &
     1911               kk, kflw(kk), kfuw(kk), nzt,  pg%zu(kk), pg%zw(kk)
     1912          FLUSH( 9 )
    18441913       ENDDO
    1845        WRITE(9,*)
     1914       WRITE( 9, * )
    18461915!
    18471916!--    k-indices of others for each kk-index value
     
    18521921!--    Note that anterpolation index limits are needed also for the top boundary
    18531922!--    ghost cell level because they are used also in the interpolation.
    1854        DO  kk = 1, cg%nz+1
     1923       DO  kk = 1, pg%nz+1
    18551924          k = kstart
    1856           DO  WHILE ( ( zu(k) < cg%zw(kk-1) )  .AND.  ( k <= nzt ) )
     1925          DO WHILE ( ( zu(k) < pg%zw(kk-1) )  .AND.  ( k <= nzt ) )
    18571926             k = k + 1
    18581927          ENDDO
    18591928          kflo(kk) = MIN( MAX( k, 1 ), nzt + 1 )
    1860           DO  WHILE ( ( zu(k) <= cg%zw(kk) )  .AND.  ( k <= nzt+1 ) )
     1929          DO WHILE ( ( zu(k) <= pg%zw(kk) )  .AND.  ( k <= nzt+1 ) )
    18611930             k = k + 1
    18621931             IF ( k > nzt + 1 ) EXIT  ! This EXIT is to prevent zu(k) from flowing over.
     
    18661935       ENDDO
    18671936!
    1868 !--    Set the k-index bounds separately for the parent-grid cells cg%nz and cg%nz+1       
     1937!--    Set the k-index bounds separately for the parent-grid cells pg%nz and pg%nz+1       
    18691938!--    although they are not actually needed.
    1870        kflo(cg%nz)   = nzt+1   
    1871        kfuo(cg%nz)   = nzt+kgsr
    1872        kflo(cg%nz+1) = nzt+kgsr
    1873        kfuo(cg%nz+1) = nzt+kgsr
     1939!  WHY IS THIS LIKE THIS? REVISE WITH CARE.
     1940       kflo(pg%nz)   = nzt+1   
     1941       kfuo(pg%nz)   = nzt+kgsr
     1942       kflo(pg%nz+1) = nzt+kgsr
     1943       kfuo(pg%nz+1) = nzt+kgsr
    18741944!
    18751945!--    Print out the index bounds for checking and debugging purposes
    1876        DO  kk = 1, cg%nz+1
    1877           WRITE(9,"('pmci_define_index_mapping, kk, kflo, kfuo: ', 4(i4,2x), 2(e12.5,2x))") &
    1878                kk, kflo(kk), kfuo(kk), nzt,  cg%zu(kk), cg%zw(kk)
    1879           FLUSH(9)
     1946       DO  kk = 1, pg%nz+1
     1947          WRITE( 9, "('pmci_define_index_mapping, kk, kflo, kfuo: ', 4(i4,2x), 2(e12.5,2x))" )      &
     1948               kk, kflo(kk), kfuo(kk), nzt,  pg%zu(kk), pg%zw(kk)
     1949          FLUSH( 9 )
    18801950       ENDDO
    1881        WRITE(9,*)
     1951       WRITE( 9, * )
    18821952!
    18831953!--    Precomputation of number of fine-grid nodes inside parent-grid cells.
    18841954!--    Note that ii, jj, and kk are parent-grid indices.
    1885 !--    This information is needed in anterpolation and in reversibility
    1886 !--    correction in interpolation.
    1887        DO  ii = icla, icra
    1888           DO  jj = jcsa, jcna
    1889              DO kk = 0, cg%nz+1
     1955!--    This information is needed in the anterpolation.
     1956!--    The indices for wall_flags_0 (kw,jw,iw) must be limited to the range
     1957!--    [-1,...,nx/ny/nzt+1] in order to avoid zero values on the outer ghost nodes.
     1958       DO  ii = ipla, ipra
     1959          DO  jj = jpsa, jpna
     1960             DO  kk = 0, pg%nz+1
    18901961!
    18911962!--             u-component
     
    18961967                      DO  k = kflo(kk), kfuo(kk)
    18971968                         kw = MIN( k, nzt+1 )               
    1898                          ijkfc_u(kk,jj,ii) = ijkfc_u(kk,jj,ii)                  &
     1969                         ijkfc_u(kk,jj,ii) = ijkfc_u(kk,jj,ii)                                      &
    18991970                              + MERGE( 1, 0, BTEST( wall_flags_0(kw,jw,iw), 1 ) )
    19001971                      ENDDO
     
    19091980                      DO  k = kflo(kk), kfuo(kk)
    19101981                         kw = MIN( k, nzt+1 )                                       
    1911                          ijkfc_v(kk,jj,ii) = ijkfc_v(kk,jj,ii)                  &
     1982                         ijkfc_v(kk,jj,ii) = ijkfc_v(kk,jj,ii)                                      &
    19121983                              + MERGE( 1, 0, BTEST( wall_flags_0(kw,jw,iw), 2 ) )
    19131984                      ENDDO
     
    19221993                      DO  k = kflo(kk), kfuo(kk)
    19231994                         kw = MIN( k, nzt+1 )
    1924                          ijkfc_s(kk,jj,ii) = ijkfc_s(kk,jj,ii)                  &
     1995                         ijkfc_s(kk,jj,ii) = ijkfc_s(kk,jj,ii)                                      &
    19251996                              + MERGE( 1, 0, BTEST( wall_flags_0(kw,jw,iw), 0 ) )
    19261997                      ENDDO
     
    19352006                      DO  k = kflw(kk), kfuw(kk)
    19362007                         kw = MIN( k, nzt+1 )
    1937                          ijkfc_w(kk,jj,ii) = ijkfc_w(kk,jj,ii) + MERGE( 1, 0,   &
    1938                               BTEST( wall_flags_0(kw,jw,iw), 3 ) )
     2008                         ijkfc_w(kk,jj,ii) = ijkfc_w(kk,jj,ii)                                      &
     2009                              + MERGE( 1, 0, BTEST( wall_flags_0(kw,jw,iw), 3 ) )
    19392010                      ENDDO
    19402011                   ENDDO
     
    19562027!
    19572028!--    Determine and store the PE-subdomain dependent index bounds
    1958        IF  ( bc_dirichlet_l )  THEN
    1959           iclw = icl + 1
     2029       IF ( bc_dirichlet_l )  THEN
     2030          iplw = ipl + 1
    19602031       ELSE
    1961           iclw = icl - 1
    1962        ENDIF
    1963 
    1964        IF  ( bc_dirichlet_r )  THEN
    1965           icrw = icr - 1
     2032          iplw = ipl - 1
     2033       ENDIF
     2034
     2035       IF ( bc_dirichlet_r )  THEN
     2036          iprw = ipr - 1
    19662037       ELSE
    1967           icrw = icr + 1
    1968        ENDIF
    1969 
    1970        IF  ( bc_dirichlet_s )  THEN
    1971           jcsw = jcs + 1
     2038          iprw = ipr + 1
     2039       ENDIF
     2040
     2041       IF ( bc_dirichlet_s )  THEN
     2042          jpsw = jps + 1
    19722043       ELSE
    1973           jcsw = jcs - 1
    1974        ENDIF
    1975 
    1976        IF  ( bc_dirichlet_n )  THEN
    1977           jcnw = jcn - 1
     2044          jpsw = jps - 1
     2045       ENDIF
     2046
     2047       IF ( bc_dirichlet_n )  THEN
     2048          jpnw = jpn - 1
    19782049       ELSE
    1979           jcnw = jcn + 1
    1980        ENDIF
    1981    
    1982        coarse_bound_w(1) = iclw
    1983        coarse_bound_w(2) = icrw
    1984        coarse_bound_w(3) = jcsw
    1985        coarse_bound_w(4) = jcnw
     2050          jpnw = jpn + 1
     2051       ENDIF
    19862052!
    19872053!--    Left and right boundaries.
    1988        ALLOCATE( workarrc_lr(0:cg%nz+1,jcsw:jcnw,0:2) )
     2054       ALLOCATE( workarr_lr(0:pg%nz+1,jpsw:jpnw,0:2) )
    19892055!
    19902056!--    South and north boundaries.
    1991        ALLOCATE( workarrc_sn(0:cg%nz+1,0:2,iclw:icrw) )
     2057       ALLOCATE( workarr_sn(0:pg%nz+1,0:2,iplw:iprw) )
    19922058!
    19932059!--    Top boundary.
    1994        ALLOCATE( workarrc_t(0:2,jcsw:jcnw,iclw:icrw) )
     2060       ALLOCATE( workarr_t(0:2,jpsw:jpnw,iplw:iprw) )
    19952061
    19962062    END SUBROUTINE pmci_allocate_workarrays
     
    20002066    SUBROUTINE pmci_create_workarray_exchange_datatypes
    20012067!
    2002 !--    Define specific MPI types for workarrc-exhchange.
     2068!--    Define specific MPI types for workarr-exchange.
    20032069       IMPLICIT NONE
    20042070
    2005 #if defined( __parallel )       
    20062071!
    20072072!--    For the left and right boundaries
    2008        CALL MPI_TYPE_VECTOR( 3, cg%nz+2, (jcnw-jcsw+1)*(cg%nz+2), MPI_REAL,     &
    2009             workarrc_lr_exchange_type, ierr )
    2010        CALL MPI_TYPE_COMMIT( workarrc_lr_exchange_type, ierr )
     2073       CALL MPI_TYPE_VECTOR( 3, pg%nz+2, (jpnw-jpsw+1)*(pg%nz+2), MPI_REAL,                         &
     2074            workarr_lr_exchange_type, ierr )
     2075       CALL MPI_TYPE_COMMIT( workarr_lr_exchange_type, ierr )
    20112076!
    20122077!--    For the south and north boundaries
    2013        CALL MPI_TYPE_VECTOR( 1, 3*(cg%nz+2), 3*(cg%nz+2), MPI_REAL,             &
    2014             workarrc_sn_exchange_type, ierr )
    2015        CALL MPI_TYPE_COMMIT( workarrc_sn_exchange_type, ierr )
     2078       CALL MPI_TYPE_VECTOR( 1, 3*(pg%nz+2), 3*(pg%nz+2), MPI_REAL,                                 &
     2079            workarr_sn_exchange_type, ierr )
     2080       CALL MPI_TYPE_COMMIT( workarr_sn_exchange_type, ierr )
    20162081!
    20172082!--    For the top-boundary x-slices
    2018        CALL MPI_TYPE_VECTOR( icrw-iclw+1, 3, 3*(jcnw-jcsw+1), MPI_REAL,         &
    2019             workarrc_t_exchange_type_x, ierr )
    2020        CALL MPI_TYPE_COMMIT( workarrc_t_exchange_type_x, ierr )
     2083       CALL MPI_TYPE_VECTOR( iprw-iplw+1, 3, 3*(jpnw-jpsw+1), MPI_REAL,                             &
     2084            workarr_t_exchange_type_x, ierr )
     2085       CALL MPI_TYPE_COMMIT( workarr_t_exchange_type_x, ierr )
    20212086!
    20222087!--    For the top-boundary y-slices
    2023        CALL MPI_TYPE_VECTOR( 1, 3*(jcnw-jcsw+1), 3*(jcnw-jcsw+1), MPI_REAL,     &
    2024             workarrc_t_exchange_type_y, ierr )
    2025        CALL MPI_TYPE_COMMIT( workarrc_t_exchange_type_y, ierr )
    2026 #endif
     2088       CALL MPI_TYPE_VECTOR( 1, 3*(jpnw-jpsw+1), 3*(jpnw-jpsw+1), MPI_REAL,                         &
     2089            workarr_t_exchange_type_y, ierr )
     2090       CALL MPI_TYPE_COMMIT( workarr_t_exchange_type_y, ierr )
    20272091       
    20282092    END SUBROUTINE pmci_create_workarray_exchange_datatypes
     
    20362100!--    the parent grid spacing in the respective direction.
    20372101       IMPLICIT NONE
    2038        REAL(wp), PARAMETER :: tolefac = 1.0E-6_wp      !< Relative tolerence for grid-line matching
    2039        REAL(wp) :: pesdwx                              !< Child subdomain width in x-direction
    2040        REAL(wp) :: pesdwy                              !< Child subdomain width in y-direction
    2041        REAL(wp) :: tolex                               !< Tolerance for grid-line matching in x-direction
    2042        REAL(wp) :: toley                               !< Tolerance for grid-line matching in y-direction
    2043        REAL(wp) :: tolez                               !< Tolerance for grid-line matching in z-direction
    2044        INTEGER(iwp) :: non_matching_lower_left_corner  !< Flag for non-matching lower left corner
    2045        INTEGER(iwp) :: non_int_gsr_x                   !< Flag for non-integer grid-spacing ration in x-direction
    2046        INTEGER(iwp) :: non_int_gsr_y                   !< Flag for non-integer grid-spacing ration in y-direction
    2047        INTEGER(iwp) :: non_int_gsr_z                   !< Flag for non-integer grid-spacing ration in z-direction
    2048        INTEGER(iwp) :: too_narrow_pesd_x               !< Flag for too narrow pe-subdomain in x-direction
    2049        INTEGER(iwp) :: too_narrow_pesd_y               !< Flag for too narrow pe-subdomain in y-direction
    2050 
    2051 
    2052        non_matching_lower_left_corner = 0
    2053        non_int_gsr_x = 0
    2054        non_int_gsr_y = 0
    2055        non_int_gsr_z = 0
    2056        too_narrow_pesd_x = 0
    2057        too_narrow_pesd_y = 0
    2058 
    2059        IF  ( myid == 0 )  THEN
     2102
     2103       INTEGER(iwp) ::  non_matching_height = 0              !< Flag for non-matching child-domain height
     2104       INTEGER(iwp) ::  non_matching_lower_left_corner = 0   !< Flag for non-matching lower left corner
     2105       INTEGER(iwp) ::  non_matching_upper_right_corner = 0  !< Flag for non-matching upper right corner
     2106       INTEGER(iwp) ::  non_int_gsr_x = 0                    !< Flag for non-integer grid-spacing ration in x-direction
     2107       INTEGER(iwp) ::  non_int_gsr_y = 0                    !< Flag for non-integer grid-spacing ration in y-direction
     2108       INTEGER(iwp) ::  non_int_gsr_z = 0                    !< Flag for non-integer grid-spacing ration in z-direction
     2109       INTEGER(iwp) ::  too_narrow_pesd_x = 0                !< Flag for too narrow pe-subdomain in x-direction
     2110       INTEGER(iwp) ::  too_narrow_pesd_y = 0                !< Flag for too narrow pe-subdomain in y-direction
     2111                                                         
     2112       REAL(wp), PARAMETER ::  tolefac = 1.0E-6_wp           !< Relative tolerence for grid-line matching
     2113                                                         
     2114       REAL(wp) ::  child_ngp_x_l                            !< Number of gridpoints in child subdomain in x-direction
     2115                                                             !< converted to REAL(wp)
     2116       REAL(wp) ::  child_ngp_y_l                            !< Number of gridpoints in child subdomain in y-direction
     2117                                                             !< converted to REAL(wp)
     2118       REAL(wp) ::  tolex                                    !< Tolerance for grid-line matching in x-direction
     2119       REAL(wp) ::  toley                                    !< Tolerance for grid-line matching in y-direction
     2120       REAL(wp) ::  tolez                                    !< Tolerance for grid-line matching in z-direction
     2121       REAL(wp) ::  upper_right_coord_x                      !< X-coordinate of the upper right corner of the child domain
     2122       REAL(wp) ::  upper_right_coord_y                      !< Y-coordinate of the upper right corner of the child domain
     2123
     2124       
     2125       IF ( myid == 0 )  THEN
    20602126
    20612127          tolex = tolefac * dx
    20622128          toley = tolefac * dy
    2063           tolez = tolefac * MINVAL( dzw )
    2064 !
    2065 !--       First check that the child grid lower left corner matches the paren grid lines.
    2066           IF  ( MOD( lower_left_coord_x, cg%dx ) > tolex ) non_matching_lower_left_corner = 1
    2067           IF  ( MOD( lower_left_coord_y, cg%dy ) > toley ) non_matching_lower_left_corner = 1
    2068 !
    2069 !--       Then check that the grid-spacing ratios in each direction are integer valued.   
    2070           IF  ( MOD( cg%dx, dx ) > tolex )  non_int_gsr_x = 1
    2071           IF  ( MOD( cg%dy, dy ) > toley )  non_int_gsr_y = 1
     2129          tolez = tolefac * dz(1)
     2130!
     2131!--       First check that the child domain lower left corner matches the parent grid lines.
     2132          IF ( MOD( lower_left_coord_x, pg%dx ) > tolex ) non_matching_lower_left_corner = 1
     2133          IF ( MOD( lower_left_coord_y, pg%dy ) > toley ) non_matching_lower_left_corner = 1
     2134!
     2135!--       Then check that the child doman upper right corner matches the parent grid lines.
     2136          upper_right_coord_x = lower_left_coord_x + ( nx + 1 ) * dx
     2137          upper_right_coord_y = lower_left_coord_y + ( ny + 1 ) * dy
     2138          IF ( MOD( upper_right_coord_x, pg%dx ) > tolex ) non_matching_upper_right_corner = 1
     2139          IF ( MOD( upper_right_coord_y, pg%dy ) > toley ) non_matching_upper_right_corner = 1
     2140!
     2141!--       Also check that the cild domain height matches the parent grid lines.
     2142          IF ( MOD( zw(nzt), pg%dz ) > tolez ) non_matching_height = 1
     2143!
     2144!--       Check that the grid-spacing ratios in each direction are integer valued.   
     2145          IF ( MOD( pg%dx, dx ) > tolex )  non_int_gsr_x = 1
     2146          IF ( MOD( pg%dy, dy ) > toley )  non_int_gsr_y = 1
     2147!
     2148!--       In the z-direction, all levels need to be checked separately against grid stretching 
     2149!--       which is not allowed.
    20722150          DO  n = 0, kctw+1
    2073              IF  ( ABS( cg%zw(n) - zw(kflw(n)) ) > tolez )  non_int_gsr_z = 1
     2151             IF ( ABS( pg%zw(n) - zw(kflw(n)) ) > tolez )  non_int_gsr_z = 1
    20742152          ENDDO
    20752153
    2076           pesdwx = REAL( nxr - nxl + 1, KIND=wp )
    2077           IF  ( pesdwx / REAL( igsr, KIND=wp ) < 1.0_wp )  too_narrow_pesd_x = 1
    2078           pesdwy = REAL( nyn - nys + 1, KIND=wp )
    2079           IF  ( pesdwy / REAL( jgsr, KIND=wp ) < 1.0_wp )  too_narrow_pesd_y = 1
    2080                          
    2081        ENDIF
    2082 
    2083        CALL MPI_BCAST( non_matching_lower_left_corner, 1, MPI_INTEGER, 0,       &
    2084             comm2d, ierr )
    2085        IF  ( non_matching_lower_left_corner > 0 )  THEN
    2086           WRITE ( message_string, * )  'nested child domain lower left ',       &
    2087                'corner must match its parent grid lines'
    2088           CALL message( 'pmci_check_grid_matching', 'PA0414', 3, 2, 0, 6, 0 )
    2089        ENDIF
    2090 
    2091        CALL MPI_BCAST( non_int_gsr_x, 1, MPI_INTEGER, 0, comm2d, ierr )
    2092        IF  ( non_int_gsr_x > 0 )  THEN
    2093           WRITE ( message_string, * )  'nesting grid-spacing ratio ',           &
    2094                '( parent dx / child dx ) must have an integer value'
    2095           CALL message( 'pmci_check_grid_matching', 'PA0416', 3, 2, 0, 6, 0 )
    2096        ENDIF
    2097 
    2098        CALL MPI_BCAST( non_int_gsr_y, 1, MPI_INTEGER, 0, comm2d, ierr )
    2099        IF  ( non_int_gsr_y > 0 )  THEN
    2100           WRITE ( message_string, * )  'nesting grid-spacing ratio ',           &
    2101                '( parent dy / child dy ) must have an integer value'
    2102           CALL message( 'pmci_check_grid_matching', 'PA0416', 3, 2, 0, 6, 0 )
    2103        ENDIF
    2104 
    2105        CALL MPI_BCAST( non_int_gsr_z, 1, MPI_INTEGER, 0, comm2d, ierr )
    2106        IF  ( non_int_gsr_z > 0 )  THEN
    2107           WRITE ( message_string, * )  'nesting grid-spacing ratio ',           &
    2108                '( parent dz / child dz ) must have an integer value for each z-level'
    2109           CALL message( 'pmci_check_grid_matching', 'PA0416', 3, 2, 0, 6, 0 )
    2110        ENDIF   
    2111 
    2112        CALL MPI_BCAST( too_narrow_pesd_x, 1, MPI_INTEGER, 0, comm2d, ierr )
    2113        IF  ( too_narrow_pesd_x > 0 )  THEN
    2114           WRITE ( message_string, * )  'child subdomain width in x-direction ',    &
    2115                'must not be smaller than its parent grid dx. Change the PE-grid ', &
    2116                'setting (npex, npey) to satisfy this requirement.' 
    2117           CALL message( 'pmci_check_grid_matching', 'PA0587', 3, 2, 0, 6, 0 )
    2118        ENDIF
     2154          child_ngp_x_l = REAL( nxr - nxl + 1, KIND=wp )
     2155          IF ( child_ngp_x_l / REAL( igsr, KIND=wp ) < 1.0_wp )  too_narrow_pesd_x = 1
     2156          child_ngp_y_l = REAL( nyn - nys + 1, KIND=wp )
     2157          IF ( child_ngp_y_l / REAL( jgsr, KIND=wp ) < 1.0_wp )  too_narrow_pesd_y = 1
     2158         
     2159          IF ( non_matching_height > 0 )  THEN
     2160             WRITE( message_string, * ) 'nested child domain height must match ',                   &
     2161                                        'its parent grid lines'
     2162             CALL message( 'pmci_check_grid_matching', 'PA0414', 3, 2, 0, 6, 0 )
     2163          ENDIF
     2164
     2165          IF ( non_matching_lower_left_corner > 0 )  THEN
     2166             WRITE( message_string, * ) 'nested child domain lower left ',                          &
     2167                                        'corner must match its parent grid lines'
     2168             CALL message( 'pmci_check_grid_matching', 'PA0414', 3, 2, 0, 6, 0 )
     2169          ENDIF
     2170
     2171          IF ( non_matching_upper_right_corner > 0 )  THEN
     2172             WRITE( message_string, * ) 'nested child domain upper right ',                         &
     2173                                        'corner must match its parent grid lines'
     2174             CALL message( 'pmci_check_grid_matching', 'PA0414', 3, 2, 0, 6, 0 )
     2175          ENDIF
     2176
     2177          IF ( non_int_gsr_x > 0 )  THEN
     2178             WRITE( message_string, * ) 'nesting grid-spacing ratio ( parent dx / child dx ) ',     &
     2179                                        'must have an integer value'
     2180             CALL message( 'pmci_check_grid_matching', 'PA0416', 3, 2, 0, 6, 0 )
     2181          ENDIF
     2182
     2183          IF ( non_int_gsr_y > 0 )  THEN
     2184             WRITE( message_string, * ) 'nesting grid-spacing ratio ( parent dy / child dy ) ',     &
     2185                                        'must have an integer value'
     2186             CALL message( 'pmci_check_grid_matching', 'PA0416', 3, 2, 0, 6, 0 )
     2187          ENDIF
     2188
     2189          IF ( non_int_gsr_z > 0 )  THEN
     2190             WRITE( message_string, * ) 'nesting grid-spacing ratio ( parent dz / child dz ) ',     &
     2191                                        'must have an integer value for each z-level'
     2192             CALL message( 'pmci_check_grid_matching', 'PA0416', 3, 2, 0, 6, 0 )
     2193          ENDIF
     2194
     2195          IF ( too_narrow_pesd_x > 0 )  THEN
     2196             WRITE( message_string, * ) 'child subdomain width in x-direction must not be ',        &
     2197                                        'smaller than its parent grid dx. Change the PE-grid ',     &
     2198                                        'setting (npex, npey) to satisfy this requirement.' 
     2199             CALL message( 'pmci_check_grid_matching', 'PA0587', 3, 2, 0, 6, 0 )
     2200          ENDIF
    21192201 
    2120        CALL MPI_BCAST( too_narrow_pesd_y, 1, MPI_INTEGER, 0, comm2d, ierr )
    2121        IF  ( too_narrow_pesd_y > 0 )  THEN
    2122           WRITE ( message_string, * )  'child subdomain width in y-direction ',    &
    2123                'must not be smaller than its parent grid dy. Change the PE-grid ', &
    2124                'setting (npex, npey) to satisfy this requirement.' 
    2125           CALL message( 'pmci_check_grid_matching', 'PA0587', 3, 2, 0, 6, 0 )
    2126        ENDIF       
    2127 
    2128      END SUBROUTINE pmci_check_grid_matching
    2129 
     2202          IF ( too_narrow_pesd_y > 0 )  THEN
     2203             WRITE( message_string, * ) 'child subdomain width in y-direction must not be ',        &
     2204                                        'smaller than its parent grid dy. Change the PE-grid ',     &
     2205                                        'setting (npex, npey) to satisfy this requirement.' 
     2206             CALL message( 'pmci_check_grid_matching', 'PA0587', 3, 2, 0, 6, 0 )
     2207          ENDIF
     2208                 
     2209       ENDIF  !  ( myid == 0 )
     2210       
     2211    END SUBROUTINE pmci_check_grid_matching
     2212     
    21302213#endif 
    21312214 END SUBROUTINE pmci_setup_child
     
    22032286!
    22042287!-- Chemistry, depends on number of species
    2205     IF ( air_chemistry  .AND.  nest_chemistry )                                &
    2206        pmc_max_array = pmc_max_array + nspec
    2207 !
    2208 !-- Salsa, depens on the number aerosol size bins and chemical components +
     2288    IF ( air_chemistry  .AND.  nest_chemistry )  pmc_max_array = pmc_max_array + nspec
     2289!
     2290!-- SALSA, depens on the number aerosol size bins and chemical components +
    22092291!-- the number of default gases
    2210     IF ( salsa  .AND.  nest_salsa )                                            &
    2211        pmc_max_array = pmc_max_array + nbins_aerosol + nbins_aerosol *         &
    2212                        ncomponents_mass
    2213        IF ( .NOT. salsa_gases_from_chem )  pmc_max_array = pmc_max_array +     &
    2214                                                            ngases_salsa
     2292    IF ( salsa  .AND.  nest_salsa )  pmc_max_array = pmc_max_array + nbins_aerosol +                &
     2293         nbins_aerosol * ncomponents_mass
     2294    IF ( .NOT. salsa_gases_from_chem )  pmc_max_array = pmc_max_array + ngases_salsa
    22152295
    22162296
     
    22202300
    22212301
    2222 
    2223  SUBROUTINE pmci_set_array_pointer( name, child_id, nz_cl, n )
     2302 SUBROUTINE pmci_set_array_pointer( name, child_id, nz_child, n )
    22242303
    22252304    IMPLICIT NONE
    2226 
    2227     INTEGER(iwp), INTENT(IN)          ::  child_id    !<
    2228     INTEGER(iwp), INTENT(IN)          ::  nz_cl       !<
    2229     INTEGER(iwp), INTENT(IN),OPTIONAL ::  n           !< index of chemical
    2230                                                       !< species / salsa variables
    2231 
     2305   
     2306    INTEGER(iwp), INTENT(IN) ::  child_id  !<
     2307    INTEGER(iwp), INTENT(IN) ::  nz_child  !<
     2308   
     2309    INTEGER(iwp), INTENT(IN), OPTIONAL ::  n          !< index of chemical species
     2310   
    22322311    CHARACTER(LEN=*), INTENT(IN) ::  name             !<
    2233 
    2234 #if defined( __parallel )
    2235     INTEGER(iwp) ::  ierr                            !< MPI error code
    2236 
    2237     REAL(wp), POINTER, DIMENSION(:,:)     ::  p_2d        !<
    2238     REAL(wp), POINTER, DIMENSION(:,:,:)   ::  p_3d        !<
    2239     REAL(wp), POINTER, DIMENSION(:,:,:)   ::  p_3d_sec    !<
    2240     INTEGER(idp), POINTER, DIMENSION(:,:) ::  i_2d        !<
    2241 
     2312!
     2313!-- Local variables:       
     2314    INTEGER(iwp) ::  ierr                             !< MPI error code
     2315
     2316    INTEGER(idp), POINTER, DIMENSION(:,:) ::  i_2d    !<
     2317       
     2318    REAL(wp), POINTER, DIMENSION(:,:)   ::  p_2d      !<
     2319    REAL(wp), POINTER, DIMENSION(:,:,:) ::  p_3d      !<
     2320    REAL(wp), POINTER, DIMENSION(:,:,:) ::  p_3d_sec  !<
     2321   
    22422322
    22432323    NULLIFY( p_3d )
     
    22672347       p_3d => salsa_gas(n)%conc
    22682348!
    2269 !-- Next line is just an example for a 2D array (not active for coupling!)
    2270 !-- Please note, that z0 has to be declared as TARGET array in modules.f90
     2349!-- Next line is just an example for a 2D array (not active for coupling!) 
     2350!-- Please note, that z0 has to be declared as TARGET array in modules.f90.
    22712351!    IF ( TRIM(name) == "z0" )    p_2d => z0
    22722352    IF ( TRIM(name) == "u"    )  p_3d_sec => u_2
     
    22892369
    22902370    IF ( ASSOCIATED( p_3d ) )  THEN
    2291        CALL pmc_s_set_dataarray( child_id, p_3d, nz_cl, nz,                    &
    2292                                  array_2 = p_3d_sec )
    2293     ELSEIF ( ASSOCIATED( p_2d ) )  THEN
     2371       CALL pmc_s_set_dataarray( child_id, p_3d, nz_child, nz, array_2 = p_3d_sec )
     2372    ELSEIF  ( ASSOCIATED( p_2d ) )  THEN
    22942373       CALL pmc_s_set_dataarray( child_id, p_2d )
    2295     ELSEIF ( ASSOCIATED( i_2d ) )  THEN
     2374    ELSEIF  ( ASSOCIATED( i_2d ) )  THEN
    22962375       CALL pmc_s_set_dataarray( child_id, i_2d )
    22972376    ELSE
    22982377!
    22992378!--    Give only one message for the root domain
    2300        IF ( myid == 0  .AND.  cpl_id == 1 )  THEN
    2301 
    2302           message_string = 'pointer for array "' // TRIM( name ) //            &
    2303                            '" can''t be associated'
     2379       IF ( myid == 0  .AND.  cpl_id == 1 )  THEN             
     2380          message_string = 'pointer for array "' // TRIM( name ) // '" can''t be associated'
    23042381          CALL message( 'pmci_set_array_pointer', 'PA0117', 3, 2, 0, 6, 0 )
    23052382       ELSE
     
    23082385          CALL MPI_BARRIER( comm2d, ierr )
    23092386       ENDIF
    2310 
    2311    ENDIF
    2312 
     2387       
     2388    ENDIF
     2389   
     2390 END SUBROUTINE pmci_set_array_pointer
     2391
     2392
     2393     
     2394 INTEGER FUNCTION get_number_of_children()
     2395
     2396    IMPLICIT NONE
     2397
     2398   
     2399#if defined( __parallel )
     2400    get_number_of_children = SIZE( pmc_parent_for_child ) - 1
     2401#else
     2402    get_number_of_children = 0
    23132403#endif
    2314 END SUBROUTINE pmci_set_array_pointer
    2315 
    2316 
    2317 
    2318 INTEGER FUNCTION get_number_of_childs ()     ! Change the name to "get_number_of_children"
    2319 
    2320    IMPLICIT NONE
    2321 
     2404
     2405    RETURN
     2406
     2407 END FUNCTION get_number_of_children
     2408
     2409
     2410 
     2411 INTEGER FUNCTION get_childid( id_index )
     2412
     2413    IMPLICIT NONE
     2414
     2415    INTEGER, INTENT(IN) ::  id_index   !<
     2416
     2417   
    23222418#if defined( __parallel )
    2323    get_number_of_childs = SIZE( pmc_parent_for_child ) - 1
     2419    get_childid = pmc_parent_for_child(id_index)
    23242420#else
    2325    get_number_of_childs = 0
     2421    get_childid = 0
    23262422#endif
    23272423
    2328    RETURN
    2329 
    2330 END FUNCTION get_number_of_childs
    2331 
    2332 
    2333 INTEGER FUNCTION get_childid (id_index)
    2334 
    2335    IMPLICIT NONE
    2336 
    2337    INTEGER,INTENT(IN)                 :: id_index
    2338 
    2339 #if defined( __parallel )
    2340    get_childid = pmc_parent_for_child(id_index)
    2341 #else
    2342    get_childid = 0
    2343 #endif
    2344 
    2345    RETURN
    2346 
    2347 END FUNCTION get_childid
    2348 
    2349 
    2350 
    2351 SUBROUTINE  get_child_edges (m, lx_coord, lx_coord_b, rx_coord, rx_coord_b,    &
    2352                                sy_coord, sy_coord_b, ny_coord, ny_coord_b,     &
    2353                                uz_coord, uz_coord_b)
    2354    IMPLICIT NONE
    2355    INTEGER,INTENT(IN)             ::  m
    2356    REAL(wp),INTENT(OUT)           ::  lx_coord, lx_coord_b
    2357    REAL(wp),INTENT(OUT)           ::  rx_coord, rx_coord_b
    2358    REAL(wp),INTENT(OUT)           ::  sy_coord, sy_coord_b
    2359    REAL(wp),INTENT(OUT)           ::  ny_coord, ny_coord_b
    2360    REAL(wp),INTENT(OUT)           ::  uz_coord, uz_coord_b
    2361 
    2362    lx_coord = childgrid(m)%lx_coord
    2363    rx_coord = childgrid(m)%rx_coord
    2364    sy_coord = childgrid(m)%sy_coord
    2365    ny_coord = childgrid(m)%ny_coord
    2366    uz_coord = childgrid(m)%uz_coord
    2367 
    2368    lx_coord_b = childgrid(m)%lx_coord_b
    2369    rx_coord_b = childgrid(m)%rx_coord_b
    2370    sy_coord_b = childgrid(m)%sy_coord_b
    2371    ny_coord_b = childgrid(m)%ny_coord_b
    2372    uz_coord_b = childgrid(m)%uz_coord_b
    2373 
    2374 END SUBROUTINE get_child_edges
    2375 
    2376 
    2377 
    2378 SUBROUTINE  get_child_gridspacing( m, dx,dy,dz )
    2379 
    2380    IMPLICIT NONE
    2381    INTEGER,INTENT(IN)             ::  m
    2382    REAL(wp),INTENT(OUT)           ::  dx,dy
    2383    REAL(wp),INTENT(OUT),OPTIONAL  ::  dz
    2384 
    2385    dx = childgrid(m)%dx
    2386    dy = childgrid(m)%dy
    2387    IF(PRESENT(dz))   THEN
    2388       dz = childgrid(m)%dz
    2389    ENDIF
    2390 
    2391 END SUBROUTINE get_child_gridspacing
    2392 
    2393 
    2394 
    2395 SUBROUTINE pmci_create_child_arrays( name, is, ie, js, je, nzc, n  )
    2396 
     2424    RETURN
     2425
     2426 END FUNCTION get_childid
     2427
     2428
     2429
     2430 SUBROUTINE get_child_edges( m, lx_coord, lx_coord_b, rx_coord, rx_coord_b, sy_coord, sy_coord_b,   &
     2431      ny_coord, ny_coord_b, uz_coord, uz_coord_b )
     2432   
    23972433    IMPLICIT NONE
    23982434
    2399     CHARACTER(LEN=*), INTENT(IN) ::  name    !<
    2400 
    2401     INTEGER(iwp), INTENT(IN) ::  ie      !<
     2435    INTEGER,INTENT(IN)   ::  m                     !<
     2436
     2437    REAL(wp),INTENT(OUT) ::  lx_coord, lx_coord_b  !<
     2438    REAL(wp),INTENT(OUT) ::  rx_coord, rx_coord_b  !<
     2439    REAL(wp),INTENT(OUT) ::  sy_coord, sy_coord_b  !<
     2440    REAL(wp),INTENT(OUT) ::  ny_coord, ny_coord_b  !<
     2441    REAL(wp),INTENT(OUT) ::  uz_coord, uz_coord_b  !<
     2442
     2443   
     2444    lx_coord = childgrid(m)%lx_coord
     2445    rx_coord = childgrid(m)%rx_coord
     2446    sy_coord = childgrid(m)%sy_coord
     2447    ny_coord = childgrid(m)%ny_coord
     2448    uz_coord = childgrid(m)%uz_coord
     2449   
     2450    lx_coord_b = childgrid(m)%lx_coord_b
     2451    rx_coord_b = childgrid(m)%rx_coord_b
     2452    sy_coord_b = childgrid(m)%sy_coord_b
     2453    ny_coord_b = childgrid(m)%ny_coord_b
     2454    uz_coord_b = childgrid(m)%uz_coord_b
     2455   
     2456 END SUBROUTINE get_child_edges
     2457
     2458
     2459
     2460 SUBROUTINE  get_child_gridspacing( m, dx, dy,dz )
     2461
     2462    IMPLICIT NONE
     2463   
     2464    INTEGER, INTENT(IN)             ::  m      !<
     2465
     2466    REAL(wp), INTENT(OUT)           ::  dx,dy  !<
     2467
     2468    REAL(wp), INTENT(OUT), OPTIONAL ::  dz     !<
     2469
     2470   
     2471    dx = childgrid(m)%dx
     2472    dy = childgrid(m)%dy
     2473    IF ( PRESENT( dz ) )  THEN
     2474       dz = childgrid(m)%dz
     2475    ENDIF
     2476   
     2477 END SUBROUTINE get_child_gridspacing
     2478
     2479
     2480
     2481 SUBROUTINE pmci_create_childs_parent_grid_arrays( name, is, ie, js, je, nzc, n  )
     2482
     2483    IMPLICIT NONE
     2484
     2485    INTEGER(iwp), INTENT(IN) ::  ie      !<  RENAME ie, is, je, js?
    24022486    INTEGER(iwp), INTENT(IN) ::  is      !<
    24032487    INTEGER(iwp), INTENT(IN) ::  je      !<
    24042488    INTEGER(iwp), INTENT(IN) ::  js      !<
    2405     INTEGER(iwp), INTENT(IN) ::  nzc     !<  nzc is cg%nz, but note that cg%nz is not the original nz of parent, but the highest parent-grid level needed for nesting.
    2406 
    2407     INTEGER(iwp), INTENT(IN), OPTIONAL ::  n  !< number of chemical species /
    2408                                               !< salsa variables
    2409 
    2410 #if defined( __parallel )
     2489    INTEGER(iwp), INTENT(IN) ::  nzc     !<  nzc is pg%nz, but note that pg%nz is not the original nz of parent,
     2490                                            !<  but the highest parent-grid level needed for nesting.
     2491    INTEGER(iwp), INTENT(IN), OPTIONAL ::  n  !< number of chemical species / salsa variables
     2492   
     2493    CHARACTER(LEN=*), INTENT(IN) ::  name    !<
     2494!       
     2495!-- Local variables:
    24112496    INTEGER(iwp) ::  ierr    !<
    2412 
     2497   
     2498    INTEGER(idp), POINTER,DIMENSION(:,:)   ::  i_2d    !<
     2499   
    24132500    REAL(wp), POINTER,DIMENSION(:,:)       ::  p_2d    !<
    24142501    REAL(wp), POINTER,DIMENSION(:,:,:)     ::  p_3d    !<
    2415     INTEGER(idp), POINTER,DIMENSION(:,:)   ::  i_2d    !<
    2416 
    2417 
     2502   
    24182503    NULLIFY( p_3d )
    24192504    NULLIFY( p_2d )
     
    24642549       i_2d => part_adrc
    24652550    ELSEIF ( TRIM( name(1:5) ) == "chem_" )  THEN
    2466        IF ( .NOT. ALLOCATED( chem_spec_c ) )                                   &
    2467           ALLOCATE( chem_spec_c(0:nzc+1,js:je,is:ie,1:nspec) )
     2551       IF ( .NOT. ALLOCATED( chem_spec_c ) ) ALLOCATE( chem_spec_c(0:nzc+1,js:je,is:ie,1:nspec) )
    24682552       p_3d => chem_spec_c(:,:,:,n)
    24692553    ELSEIF ( TRIM( name(1:3) ) == "an_" )  THEN
     
    24932577    ELSE
    24942578!
    2495 !--    Give only one message for the first child domain
     2579!-- Give only one message for the first child domain.
    24962580       IF ( myid == 0  .AND.  cpl_id == 2 )  THEN
    2497 
    24982581          message_string = 'pointer for array "' // TRIM( name ) //            &
    2499                            '" can''t be associated'
    2500           CALL message( 'pmci_create_child_arrays', 'PA0170', 3, 2, 0, 6, 0 )
     2582               '" can''t be associated'
     2583          CALL message( 'pmci_create_childs_parent_grid_arrays', 'PA0170', 3, 2, 0, 6, 0 )
    25012584       ELSE
    25022585!
    2503 !--       Prevent others from continuing
     2586!--          Prevent others from continuing in case the abort is to come.
    25042587          CALL MPI_BARRIER( comm2d, ierr )
    25052588       ENDIF
     2589
    25062590    ENDIF
    25072591
    2508 #endif
    2509  END SUBROUTINE pmci_create_child_arrays
    2510 
    2511 
    2512 
     2592 END SUBROUTINE pmci_create_childs_parent_grid_arrays
     2593
     2594
     2595!
     2596! E N D   O F    S E T U P   R O U T I N E S
     2597!
    25132598 SUBROUTINE pmci_parent_initialize
    25142599
     
    25422627    IMPLICIT NONE
    25432628
    2544     INTEGER(iwp) ::  i          !<
    2545     INTEGER(iwp) ::  ib         !< running index for aerosol size bins
    2546     INTEGER(iwp) ::  ic         !< running index for aerosol mass bins
    2547     INTEGER(iwp) ::  icl        !<
    2548     INTEGER(iwp) ::  icla       !<
    2549     INTEGER(iwp) ::  iclw       !<
    2550     INTEGER(iwp) ::  icr        !<
    2551     INTEGER(iwp) ::  icra       !<
    2552     INTEGER(iwp) ::  icrw       !<
    2553     INTEGER(iwp) ::  ig         !< running index for salsa gases
    2554     INTEGER(iwp) ::  j          !<
    2555     INTEGER(iwp) ::  jcn        !<
    2556     INTEGER(iwp) ::  jcna       !<
    2557     INTEGER(iwp) ::  jcnw       !<
    2558     INTEGER(iwp) ::  jcs        !<
    2559     INTEGER(iwp) ::  jcsa       !<
    2560     INTEGER(iwp) ::  jcsw       !<
    2561     INTEGER(iwp) ::  k          !<
    2562     INTEGER(iwp) ::  n          !< running index for chemical species
    2563 
    2564     REAL(wp) ::  waittime       !<
     2629    INTEGER(iwp) ::  ic         !< Child-grid index in x-direction
     2630    INTEGER(iwp) ::  jc         !< Child-grid index in y-direction
     2631    INTEGER(iwp) ::  kc         !< Child-grid index in z-direction
     2632    INTEGER(iwp) ::  lb         !< Running index for aerosol size bins
     2633    INTEGER(iwp) ::  lc         !< Running index for aerosol mass bins
     2634    INTEGER(iwp) ::  lg         !< Running index for salsa gases
     2635    INTEGER(iwp) ::  n          !< Running index for chemical species
     2636    REAL(wp) ::  waittime       !< Waiting time
    25652637
    25662638!
    25672639!-- Root model is never anyone's child
    25682640    IF ( cpl_id > 1 )  THEN
    2569 !
    2570 !--    Child domain boundaries in the parent index space
    2571        icl  = coarse_bound(1)
    2572        icr  = coarse_bound(2)
    2573        jcs  = coarse_bound(3)
    2574        jcn  = coarse_bound(4)
    2575        icla = coarse_bound_aux(1)
    2576        icra = coarse_bound_aux(2)
    2577        jcsa = coarse_bound_aux(3)
    2578        jcna = coarse_bound_aux(4)
    2579        iclw = coarse_bound_w(1)
    2580        icrw = coarse_bound_w(2)
    2581        jcsw = coarse_bound_w(3)
    2582        jcnw = coarse_bound_w(4)
    2583 
    25842641!
    25852642!--    Get data from the parent
     
    26332690
    26342691       IF ( salsa  .AND.  nest_salsa )  THEN
    2635           DO  ib = 1, nbins_aerosol
    2636              CALL pmci_interp_1sto_all ( aerosol_number(ib)%conc, aerosol_number_c(:,:,:,ib),        &
     2692          DO  lb = 1, nbins_aerosol
     2693             CALL pmci_interp_1sto_all ( aerosol_number(lb)%conc, aerosol_number_c(:,:,:,lb),       &
    26372694                                         kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 's' )
    26382695          ENDDO
    2639           DO  ic = 1, nbins_aerosol * ncomponents_mass
    2640              CALL pmci_interp_1sto_all ( aerosol_mass(ic)%conc, aerosol_mass_c(:,:,:,ic),            &
     2696          DO  lc = 1, nbins_aerosol * ncomponents_mass
     2697             CALL pmci_interp_1sto_all ( aerosol_mass(lc)%conc, aerosol_mass_c(:,:,:,lc),           &
    26412698                                         kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 's' )
    26422699          ENDDO
    26432700          IF ( .NOT. salsa_gases_from_chem )  THEN
    2644              DO  ig = 1, ngases_salsa
    2645                 CALL pmci_interp_1sto_all ( salsa_gas(ig)%conc, salsa_gas_c(:,:,:,ig),             &
     2701             DO  lg = 1, ngases_salsa
     2702                CALL pmci_interp_1sto_all ( salsa_gas(lg)%conc, salsa_gas_c(:,:,:,lg),              &
    26462703                                            kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 's' )
    26472704             ENDDO
     
    26512708       IF ( topography /= 'flat' )  THEN
    26522709!
    2653 !--       Inside buildings set velocities and TKE back to zero.
    2654 !--       Other scalars (pt, q, s, km, kh, p, sa, ...) are ignored at present,
    2655 !--       maybe revise later.
    2656           DO   i = nxlg, nxrg
    2657              DO   j = nysg, nyng
    2658                 DO  k = nzb, nzt
    2659                    u(k,j,i)   = MERGE( u(k,j,i), 0.0_wp,                       &
    2660                                        BTEST( wall_flags_0(k,j,i), 1 ) )
    2661                    v(k,j,i)   = MERGE( v(k,j,i), 0.0_wp,                       &
    2662                                        BTEST( wall_flags_0(k,j,i), 2 ) )
    2663                    w(k,j,i)   = MERGE( w(k,j,i), 0.0_wp,                       &
    2664                                        BTEST( wall_flags_0(k,j,i), 3 ) )
    2665 !                    e(k,j,i)   = MERGE( e(k,j,i), 0.0_wp,                       &
    2666 !                                        BTEST( wall_flags_0(k,j,i), 0 ) )
    2667                    u_p(k,j,i) = MERGE( u_p(k,j,i), 0.0_wp,                     &
    2668                                        BTEST( wall_flags_0(k,j,i), 1 ) )
    2669                    v_p(k,j,i) = MERGE( v_p(k,j,i), 0.0_wp,                     &
    2670                                        BTEST( wall_flags_0(k,j,i), 2 ) )
    2671                    w_p(k,j,i) = MERGE( w_p(k,j,i), 0.0_wp,                     &
    2672                                        BTEST( wall_flags_0(k,j,i), 3 ) )
    2673 !                    e_p(k,j,i) = MERGE( e_p(k,j,i), 0.0_wp,                     &
    2674 !                                        BTEST( wall_flags_0(k,j,i), 0 ) )
     2710!--       Inside buildings set velocities back to zero.
     2711          DO  ic = nxlg, nxrg
     2712             DO  jc = nysg, nyng
     2713                DO  kc = nzb, nzt
     2714                   u(kc,jc,ic)   = MERGE( u(kc,jc,ic), 0.0_wp, BTEST( wall_flags_0(kc,jc,ic), 1 ) )
     2715                   v(kc,jc,ic)   = MERGE( v(kc,jc,ic), 0.0_wp, BTEST( wall_flags_0(kc,jc,ic), 2 ) )
     2716                   w(kc,jc,ic)   = MERGE( w(kc,jc,ic), 0.0_wp, BTEST( wall_flags_0(kc,jc,ic), 3 ) )
     2717                   u_p(kc,jc,ic) = MERGE( u_p(kc,jc,ic), 0.0_wp, BTEST( wall_flags_0(kc,jc,ic), 1 ) )
     2718                   v_p(kc,jc,ic) = MERGE( v_p(kc,jc,ic), 0.0_wp, BTEST( wall_flags_0(kc,jc,ic), 2 ) )
     2719                   w_p(kc,jc,ic) = MERGE( w_p(kc,jc,ic), 0.0_wp, BTEST( wall_flags_0(kc,jc,ic), 3 ) )
    26752720                ENDDO
    26762721             ENDDO
     
    26832728
    26842729
    2685     SUBROUTINE pmci_interp_1sto_all( f, fc, kct, ifl, ifu, jfl, jfu, kfl, kfu, var )
     2730    SUBROUTINE pmci_interp_1sto_all( child_array, parent_array, kct, ifl, ifu, jfl, jfu, kfl, kfu,  &
     2731         var )
    26862732!
    26872733!--    Interpolation of the internal values for the child-domain initialization
    26882734       IMPLICIT NONE
    26892735
    2690        REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(INOUT) :: f  !< Child-grid array
    2691        REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr), INTENT(IN) :: fc        !< Parent-grid array
    2692        INTEGER(iwp) :: kct                                    !< The parent-grid index in z-direction just below the boundary value node
    2693        INTEGER(iwp), DIMENSION(icla:icra), INTENT(IN) ::  ifl !< Indicates start index of child cells belonging to certain parent cell - x direction
    2694        INTEGER(iwp), DIMENSION(icla:icra), INTENT(IN) ::  ifu !< Indicates end index of child cells belonging to certain parent cell - x direction
    2695        INTEGER(iwp), DIMENSION(jcsa:jcna), INTENT(IN) ::  jfl !< Indicates start index of child cells belonging to certain parent cell - y direction
    2696        INTEGER(iwp), DIMENSION(jcsa:jcna), INTENT(IN) ::  jfu !< Indicates end index of child cells belonging to certain parent cell - y direction
    2697        INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN) ::  kfl !< Indicates start index of child cells belonging to certain parent cell - z direction
    2698        INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN) ::  kfu !< Indicates end index of child cells belonging to certain parent cell - z direction
    2699        CHARACTER(LEN=1), INTENT(IN) :: var                    !< Variable symbol: 'u', 'v', 'w' or 's'
     2736       INTEGER(iwp), INTENT(IN) ::  kct  !< The parent-grid index in z-direction just below the boundary value node
     2737
     2738       INTEGER(iwp), DIMENSION(ipla:ipra), INTENT(IN) ::  ifl  !<  Indicates start index of child cells belonging to certain
     2739                                                               !<  parent cell - x direction
     2740       INTEGER(iwp), DIMENSION(ipla:ipra), INTENT(IN) ::  ifu  !<  Indicates end index of child cells belonging to certain
     2741                                                               !<  parent cell - x direction
     2742       INTEGER(iwp), DIMENSION(jpsa:jpna), INTENT(IN) ::  jfl  !<  Indicates start index of child cells belonging to certain
     2743                                                               !<  parent cell - y direction
     2744       INTEGER(iwp), DIMENSION(jpsa:jpna), INTENT(IN) ::  jfu  !<  Indicates end index of child cells belonging to certain
     2745                                                               !<  parent cell - y direction
     2746       INTEGER(iwp), DIMENSION(0:pg%nz+1), INTENT(IN) ::  kfl  !<  Indicates start index of child cells belonging to certain
     2747                                                               !<  parent cell - z direction
     2748       INTEGER(iwp), DIMENSION(0:pg%nz+1), INTENT(IN) ::  kfu  !<  Indicates end index of child cells belonging to certain
     2749                                                               !<  parent cell - z direction
     2750       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(INOUT) ::  child_array  !<  Child-grid array
     2751       REAL(wp), DIMENSION(0:pg%nz+1,jps:jpn,ipl:ipr), INTENT(IN) ::  parent_array        !<  Parent-grid array
     2752
     2753       CHARACTER(LEN=1), INTENT(IN) ::  var  !<  Variable symbol: 'u', 'v', 'w' or 's'
    27002754!
    27012755!--    Local variables:
    2702        INTEGER(iwp) ::  i        !<
    2703        INTEGER(iwp) ::  ib       !<
    2704        INTEGER(iwp) ::  ie       !<
    2705        INTEGER(iwp) ::  ifirst   !<
    2706        INTEGER(iwp) ::  ilast    !<
    2707        INTEGER(iwp) ::  j        !<
    2708        INTEGER(iwp) ::  jb       !<
    2709        INTEGER(iwp) ::  je       !<
    2710        INTEGER(iwp) ::  jfirst   !<
    2711        INTEGER(iwp) ::  jlast    !<
    2712        INTEGER(iwp) ::  k        !<
    2713        INTEGER(iwp) ::  l        !<
    2714        INTEGER(iwp) ::  lb       !<
    2715        INTEGER(iwp) ::  le       !<
    2716        INTEGER(iwp) ::  m        !<
    2717        INTEGER(iwp) ::  mb       !<
    2718        INTEGER(iwp) ::  me       !<
    2719        INTEGER(iwp) ::  n        !<
    2720 
    2721 
    2722        lb = icl
    2723        le = icr
    2724        mb = jcs
    2725        me = jcn
    2726        ifirst = nxl
    2727        ilast = nxr
    2728        jfirst = nys
    2729        jlast = nyn
     2756       INTEGER(iwp) ::  ic        !< Running child-grid index in the x-direction
     2757       INTEGER(iwp) ::  icfirst   !< Leftmost child-grid index initialized by the main loops (usually icfirst == icl_init)
     2758       INTEGER(iwp) ::  iclast    !< Rightmost child-grid index initialized by the main loops (usually iclast == icr_init)
     2759       INTEGER(iwp) ::  icl_init  !< Left child-grid index bound for initialization in the x-direction
     2760       INTEGER(iwp) ::  icr_init  !< Right child-grid index bound for initialization in the x-direction
     2761       INTEGER(iwp) ::  jc        !< Running child-grid index in the y-direction
     2762       INTEGER(iwp) ::  jcfirst   !< Southmost child-grid index initialized by the main loops (usually jcfirst == jcs_init)
     2763       INTEGER(iwp) ::  jclast    !< Northmost child-grid index initialized by the main loops (usually jclast == jcn_init)
     2764       INTEGER(iwp) ::  jcs_init  !< South child-grid index bound for initialization in the y-direction
     2765       INTEGER(iwp) ::  jcn_init  !< North child-grid index bound for initialization in the y-direction
     2766       INTEGER(iwp) ::  kc        !< Running child-grid index in the z-direction
     2767       INTEGER(iwp) ::  ip        !< Running parent-grid index in the x-direction
     2768       INTEGER(iwp) ::  ipl_init  !< Left parent-grid index bound for initialization in the x-direction
     2769       INTEGER(iwp) ::  ipr_init  !< Right parent-grid index bound for initialization in the x-direction
     2770       INTEGER(iwp) ::  jp        !< Running parent-grid index in the y-direction
     2771       INTEGER(iwp) ::  jps_init  !< South parent-grid index bound for initialization in the y-direction
     2772       INTEGER(iwp) ::  jpn_init  !< North parent-grid index bound for initialization in the y-direction
     2773       INTEGER(iwp) ::  kp        !< Running parent-grid index in the z-direction
     2774
     2775
     2776       ipl_init = ipl
     2777       ipr_init = ipr
     2778       jps_init = jps
     2779       jpn_init = jpn
     2780       icl_init = nxl
     2781       icr_init = nxr
     2782       jcs_init = nys
     2783       jcn_init = nyn
    27302784
    27312785       IF ( nesting_mode /= 'vertical' )  THEN
    27322786          IF ( bc_dirichlet_l )  THEN
    2733              lb     = icl + 1
    2734              ifirst = nxl - 1
     2787             ipl_init = ipl + 1
     2788             icl_init = nxl - 1
    27352789!
    27362790!--          For u, nxl is a ghost node, but not for the other variables
    27372791             IF ( var == 'u' )  THEN
    2738                 lb     = icl + 2
    2739                 ifirst = nxl
     2792                ipl_init = ipl + 2
     2793                icl_init = nxl
    27402794             ENDIF
    27412795          ENDIF
    27422796          IF ( bc_dirichlet_s )  THEN
    2743              mb     = jcs + 1
    2744              jfirst = nys - 1
     2797             jps_init = jps + 1
     2798             jcs_init = nys - 1
    27452799!
    27462800!--          For v, nys is a ghost node, but not for the other variables
    27472801             IF ( var == 'v' )  THEN
    2748                 mb     = jcs + 2
    2749                 jfirst = nys
     2802                jps_init = jps + 2
     2803                jcs_init = nys
    27502804             ENDIF
    27512805          ENDIF
    27522806          IF ( bc_dirichlet_r )  THEN
    2753              le    = icr - 1
    2754              ilast = nxr + 1
     2807             ipr_init = ipr - 1
     2808             icr_init = nxr + 1
    27552809          ENDIF
    27562810          IF ( bc_dirichlet_n )  THEN
    2757              me    = jcn - 1
    2758              jlast = nyn + 1
     2811             jpn_init = jpn - 1
     2812             jcn_init = nyn + 1
    27592813          ENDIF
    27602814       ENDIF     
    27612815
    2762        f(:,:,:) = 0.0_wp
    2763 
    2764        IF  ( var == 'u' )  THEN
    2765 
    2766           ib = ifl(lb)
    2767           ie = ifl(le+1) - 1
    2768           jb = jfl(mb)
    2769           je = jfu(me)
    2770           DO  l = lb, le
    2771              DO  m = mb, me
    2772                 DO n = 0, kct + 1
    2773 
    2774                    DO  i = ifl(l), ifl(l+1)-1
    2775                       DO  j = jfl(m), jfu(m)
    2776                          DO  k = kfl(n), MIN( kfu(n), nzt+1 )
    2777                             f(k,j,i) = fc(n,m,l)
     2816       child_array(:,:,:) = 0.0_wp
     2817
     2818       IF ( var == 'u' )  THEN
     2819
     2820          icfirst = ifl(ipl_init)
     2821          iclast  = ifl(ipr_init+1) - 1
     2822          jcfirst = jfl(jps_init)
     2823          jclast  = jfu(jpn_init)
     2824          DO  ip = ipl_init, ipr_init
     2825             DO  jp = jps_init, jpn_init
     2826                DO  kp = 0, kct + 1
     2827
     2828                   DO  ic = ifl(ip), ifl(ip+1)-1
     2829                      DO  jc = jfl(jp), jfu(jp)
     2830                         DO  kc = kfl(kp), MIN( kfu(kp), nzt+1 )
     2831                            child_array(kc,jc,ic) = parent_array(kp,jp,ip)
    27782832                         ENDDO
    27792833                      ENDDO
     
    27842838          ENDDO
    27852839
    2786        ELSE IF  ( var == 'v' )  THEN
    2787 
    2788           ib = ifl(lb)
    2789           ie = ifu(le)
    2790           jb = jfl(mb)
    2791           je = jfl(me+1) - 1
    2792           DO  l = lb, le
    2793              DO  m = mb, me
    2794                 DO n = 0, kct + 1 
    2795 
    2796                    DO i = ifl(l), ifu(l)
    2797                       DO  j = jfl(m), jfl(m+1)-1
    2798                          DO  k = kfl(n), MIN( kfu(n), nzt+1 )
    2799                             f(k,j,i) = fc(n,m,l)
     2840       ELSE IF ( var == 'v' )  THEN
     2841
     2842          icfirst = ifl(ipl_init)
     2843          iclast  = ifu(ipr_init)
     2844          jcfirst = jfl(jps_init)
     2845          jclast  = jfl(jpn_init+1) - 1
     2846          DO  ip = ipl_init, ipr_init
     2847             DO  jp = jps_init, jpn_init
     2848                DO  kp = 0, kct + 1 
     2849
     2850                   DO  ic = ifl(ip), ifu(ip)
     2851                      DO  jc = jfl(jp), jfl(jp+1)-1
     2852                         DO  kc = kfl(kp), MIN( kfu(kp), nzt+1 )
     2853                            child_array(kc,jc,ic) = parent_array(kp,jp,ip)
    28002854                         ENDDO
    28012855                      ENDDO
     
    28062860          ENDDO
    28072861
    2808        ELSE IF  ( var == 'w' )  THEN
    2809 
    2810           ib = ifl(lb)
    2811           ie = ifu(le)
    2812           jb = jfl(mb)
    2813           je = jfu(me)
    2814           DO  l = lb, le
    2815              DO  m = mb, me
    2816                 DO n = 1, kct + 1 
    2817 
    2818                    DO i = ifl(l), ifu(l)
    2819                       DO  j = jfl(m), jfu(m)
    2820                          f(nzb,j,i) = 0.0_wp   ! Because the n-loop starts from n=1 instead of 0
    2821                          DO  k = kfu(n-1)+1, kfu(n)
    2822                             f(k,j,i) = fc(n,m,l)
     2862       ELSE IF ( var == 'w' )  THEN
     2863
     2864          icfirst = ifl(ipl_init)
     2865          iclast  = ifu(ipr_init)
     2866          jcfirst = jfl(jps_init)
     2867          jclast  = jfu(jpn_init)
     2868          DO  ip = ipl_init, ipr_init
     2869             DO  jp = jps_init, jpn_init
     2870                DO  kp = 1, kct + 1 
     2871
     2872                   DO  ic = ifl(ip), ifu(ip)
     2873                      DO  jc = jfl(jp), jfu(jp)
     2874!                         
     2875!--                      Because the kp-loop for w starts from kp=1 instead of 0
     2876                         child_array(nzb,jc,ic) = 0.0_wp
     2877                         DO  kc = kfu(kp-1)+1, kfu(kp)
     2878                            child_array(kc,jc,ic) = parent_array(kp,jp,ip)
    28232879                         ENDDO
    28242880                      ENDDO
     
    28312887       ELSE   ! scalars
    28322888
    2833           ib = ifl(lb)
    2834           ie = ifu(le)
    2835           jb = jfl(mb)
    2836           je = jfu(me)
    2837           DO  l = lb, le
    2838              DO  m = mb, me
    2839                 DO n = 0, kct + 1
     2889          icfirst = ifl(ipl_init)
     2890          iclast  = ifu(ipr_init)
     2891          jcfirst = jfl(jps_init)
     2892          jclast  = jfu(jpn_init)
     2893          DO  ip = ipl_init, ipr_init
     2894             DO  jp = jps_init, jpn_init
     2895                DO  kp = 0, kct + 1
    28402896                                     
    2841                    DO i = ifl(l), ifu(l)
    2842                       DO  j = jfl(m), jfu(m)                         
    2843                          DO  k = kfl(n), MIN( kfu(n), nzt+1 )
    2844                             f(k,j,i) = fc(n,m,l)
     2897                   DO  ic = ifl(ip), ifu(ip)
     2898                      DO  jc = jfl(jp), jfu(jp)                         
     2899                         DO  kc = kfl(kp), MIN( kfu(kp), nzt+1 )
     2900                            child_array(kc,jc,ic) = parent_array(kp,jp,ip)
    28452901                         ENDDO
    28462902                      ENDDO
     
    28532909       ENDIF  ! var
    28542910!
    2855 !--    If the subdomain i- and/or j-dimension (nx/npex and/or ny/npey) is
    2856 !--    not integer divisible by the grid spacing ratio in its direction,
    2857 !--    the above loops will return with unfilled gaps in the initial fields.
    2858 !--    These gaps, if present, are filled here. 
    2859        IF  ( ib > ifirst )  THEN
    2860           DO  i = ifirst, ib-1
    2861              f(:,:,i) = f(:,:,ib)
     2911!--    If the number of grid points in child subdomain in x- or y-direction
     2912!--    (nxr - nxl + 1 and/or nyn - nys + 1) is not integer divisible by the grid spacing
     2913!--    ratio in its direction (igsr and/or jgsr), the above loops will return with
     2914!--    unfilled gaps in the initial fields. These gaps, if present, are filled here. 
     2915       IF ( icfirst > icl_init )  THEN
     2916          DO  ic = icl_init, icfirst - 1
     2917             child_array(:,:,ic) = child_array(:,:,icfirst)
    28622918          ENDDO
    28632919       ENDIF
    2864        IF  ( ie < ilast )  THEN
    2865           DO  i = ie+1, ilast
    2866              f(:,:,i) = f(:,:,ie)
     2920       IF ( iclast < icr_init )  THEN
     2921          DO  ic = iclast + 1, icr_init
     2922             child_array(:,:,ic) = child_array(:,:,iclast)
    28672923          ENDDO
    28682924       ENDIF
    2869        IF  ( jb > jfirst )  THEN
    2870           DO  j = jfirst, jb-1
    2871              f(:,j,:) = f(:,jb,:)
     2925       IF ( jcfirst > jcs_init )  THEN
     2926          DO  jc = jcs_init, jcfirst - 1
     2927             child_array(:,jc,:) = child_array(:,jcfirst,:)
    28722928          ENDDO
    28732929       ENDIF
    2874        IF  ( je < jlast )  THEN
    2875           DO  j = je+1, jlast
    2876              f(:,j,:) = f(:,je,:)
     2930       IF ( jclast < jcn_init )  THEN
     2931          DO  jc = jclast + 1, jcn_init
     2932             child_array(:,jc,:) = child_array(:,jclast,:)
    28772933          ENDDO
    28782934       ENDIF
     
    28872943 SUBROUTINE pmci_check_setting_mismatches
    28882944!
    2889 !-- Check for mismatches between settings of master and child variables
     2945!-- Check for mismatches between settings of root and child variables
    28902946!-- (e.g., all children have to follow the end_time settings of the root model).
    28912947!-- The root model overwrites variables in the other models, so these variables
     
    28942950#if defined( __parallel )
    28952951
    2896     USE control_parameters,                                                    &
     2952    USE control_parameters,                                                                         &
    28972953        ONLY:  dt_restart, end_time, message_string, restart_time, time_restart
    28982954
    28992955    IMPLICIT NONE
    29002956
    2901     INTEGER ::  ierr
    2902 
    2903     REAL(wp) ::  dt_restart_root
    2904     REAL(wp) ::  end_time_root
    2905     REAL(wp) ::  restart_time_root
    2906     REAL(wp) ::  time_restart_root
     2957    INTEGER ::  ierr                 !<  MPI error code
     2958
     2959    REAL(wp) ::  dt_restart_root     !<
     2960    REAL(wp) ::  end_time_root       !< 
     2961    REAL(wp) ::  restart_time_root   !<
     2962    REAL(wp) ::  time_restart_root   !< 
    29072963
    29082964!
     
    29162972    IF ( .NOT. pmc_is_rootmodel() )  THEN
    29172973       IF ( end_time /= end_time_root )  THEN
    2918           WRITE( message_string, * )  'mismatch between root model and ',      &
    2919                'child settings:& end_time(root) = ', end_time_root,            &
    2920                '& end_time(child) = ', end_time, '& child value is set',       &
     2974          WRITE( message_string, * )  'mismatch between root model and ',                           &
     2975               'child settings:& end_time(root) = ', end_time_root,                                 &
     2976               '& end_time(child) = ', end_time, '& child value is set',                            &
    29212977               ' to root value'
    2922           CALL message( 'pmci_check_setting_mismatches', 'PA0419', 0, 1, 0, 6, &
     2978          CALL message( 'pmci_check_setting_mismatches', 'PA0419', 0, 1, 0, 6,                      &
    29232979                        0 )
    29242980          end_time = end_time_root
     
    29903046   IMPLICIT NONE
    29913047
    2992    INTEGER(iwp)           :: ierr  !<
    2993    REAL(wp), DIMENSION(1) :: dtl   !<
    2994    REAL(wp), DIMENSION(1) :: dtg   !<
     3048   INTEGER(iwp) ::  ierr  !<  MPI error code
     3049   REAL(wp) ::  dtl       !<  Local time step of the current process
     3050   REAL(wp) ::  dtg       !<  Global time step defined as the global minimum of dtl of all processes
    29953051
    29963052   
    2997    dtl(1) = dt_3d
     3053   dtl = dt_3d
    29983054   CALL MPI_ALLREDUCE( dtl, dtg, 1, MPI_REAL, MPI_MIN, MPI_COMM_WORLD, ierr )
    2999    dt_3d  = dtg(1)
     3055   dt_3d  = dtg
    30003056
    30013057#endif
     
    30123068    IMPLICIT NONE
    30133069
    3014     INTEGER(iwp), INTENT(IN) ::  swaplevel  !< swaplevel (1 or 2) of PALM's
    3015                                             !< timestep
    3016 
    3017     INTEGER(iwp)            ::  child_id    !<
    3018     INTEGER(iwp)            ::  m           !<
     3070    INTEGER(iwp), INTENT(IN) ::  swaplevel  !< swaplevel (1 or 2) of PALM's timestep
     3071
     3072    INTEGER(iwp) ::  child_id    !<  Child id of the child number m
     3073    INTEGER(iwp) ::  m           !<  Loop index over all children of the current parent
    30193074
    30203075#if defined( __parallel )
    3021     DO  m = 1, SIZE( pmc_parent_for_child )-1
     3076    DO  m = 1, SIZE( pmc_parent_for_child ) - 1
    30223077       child_id = pmc_parent_for_child(m)
    30233078       CALL pmc_s_set_active_data_array( child_id, swaplevel )
     
    30423097    IMPLICIT NONE
    30433098
    3044     CHARACTER(LEN=*), INTENT(IN) ::  local_nesting_mode
     3099    CHARACTER(LEN=*), INTENT(IN) ::  local_nesting_mode  !<  Nesting mode: 'one-way', 'two-way' or 'vertical'
    30453100
    30463101
     
    30523107    ELSE
    30533108
    3054        IF( nesting_datatransfer_mode == 'cascade' )  THEN
     3109       IF ( nesting_datatransfer_mode == 'cascade' )  THEN
    30553110
    30563111          CALL pmci_child_datatrans( parent_to_child )
     
    30603115          CALL pmci_child_datatrans( child_to_parent )
    30613116
    3062        ELSEIF( nesting_datatransfer_mode == 'overlap')  THEN
     3117       ELSEIF ( nesting_datatransfer_mode == 'overlap')  THEN
    30633118
    30643119          CALL pmci_parent_datatrans( parent_to_child )
     
    30683123          CALL pmci_parent_datatrans( child_to_parent )
    30693124
    3070        ELSEIF( TRIM( nesting_datatransfer_mode ) == 'mixed' )  THEN
     3125       ELSEIF ( TRIM( nesting_datatransfer_mode ) == 'mixed' )  THEN
    30713126
    30723127          CALL pmci_parent_datatrans( parent_to_child )
     
    30883143    IMPLICIT NONE
    30893144
    3090     INTEGER(iwp), INTENT(IN) ::  direction   !<
     3145    INTEGER(iwp), INTENT(IN) ::  direction   !<  Direction of the data transfer: 'parent_to_child' or 'child_to_parent'
    30913146
    30923147#if defined( __parallel )
    3093     INTEGER(iwp) ::  child_id    !<
    3094     INTEGER(iwp) ::  i           !<
    3095     INTEGER(iwp) ::  j           !<
    3096     INTEGER(iwp) ::  k           !<
    3097     INTEGER(iwp) ::  m           !<
     3148    INTEGER(iwp) ::  child_id    !<  Child id of the child number m
     3149    INTEGER(iwp) ::  i           !<  Parent-grid index in x-direction
     3150    INTEGER(iwp) ::  j           !<  Parent-grid index in y-direction
     3151    INTEGER(iwp) ::  k           !<  Parent-grid index in z-direction
     3152    INTEGER(iwp) ::  m           !<  Loop index over all children of the current parent
    30983153
    30993154
     
    31243179                DO   j = nysg, nyng
    31253180                   DO  k = nzb, nzt+1
    3126                       u(k,j,i)  = MERGE( u(k,j,i), 0.0_wp,                     &
    3127                                          BTEST( wall_flags_0(k,j,i), 1 ) )
    3128                       v(k,j,i)  = MERGE( v(k,j,i), 0.0_wp,                     &
    3129                                          BTEST( wall_flags_0(k,j,i), 2 ) )
    3130                       w(k,j,i)  = MERGE( w(k,j,i), 0.0_wp,                     &
    3131                                          BTEST( wall_flags_0(k,j,i), 3 ) )
     3181                      u(k,j,i) = MERGE( u(k,j,i), 0.0_wp, BTEST( wall_flags_0(k,j,i), 1 ) )
     3182                      v(k,j,i) = MERGE( v(k,j,i), 0.0_wp, BTEST( wall_flags_0(k,j,i), 2 ) )
     3183                      w(k,j,i) = MERGE( w(k,j,i), 0.0_wp, BTEST( wall_flags_0(k,j,i), 3 ) )
    31323184!
    31333185!--                 TO_DO: zero setting of temperature within topography creates
     
    31423194          ENDIF
    31433195       ENDIF
    3144     ENDDO
     3196    ENDDO  ! m
    31453197
    31463198#endif
     
    31563208
    31573209#if defined( __parallel )
    3158     INTEGER(iwp) ::  icl         !< Parent-grid array index bound, left
    3159     INTEGER(iwp) ::  icr         !< Parent-grid array index bound, right
    3160     INTEGER(iwp) ::  jcn         !< Parent-grid array index bound, north
    3161     INTEGER(iwp) ::  jcs         !< Parent-grid array index bound, south
    3162     INTEGER(iwp) ::  icla        !< Auxiliary-array (index-mapping etc) index bound, left
    3163     INTEGER(iwp) ::  icra        !< Auxiliary-array (index-mapping etc) index bound, right
    3164     INTEGER(iwp) ::  jcna        !< Auxiliary-array (index-mapping etc) index bound, north
    3165     INTEGER(iwp) ::  jcsa        !< Auxiliary-array (index-mapping etc) index bound, south
    3166     INTEGER(iwp) ::  iclw        !< Parent-grid work array index bound, left
    3167     INTEGER(iwp) ::  icrw        !< Parent-grid work array index bound, right
    3168     INTEGER(iwp) ::  jcnw        !< Parent-grid work array index bound, north
    3169     INTEGER(iwp) ::  jcsw        !< Parent-grid work array index bound, south
    3170 
    3171     REAL(wp), DIMENSION(1) ::  dtl         !< Time step size
     3210
     3211    REAL(wp), DIMENSION(1) ::  dtl          !< Time step size
    31723212
    31733213
    31743214    dtl = dt_3d
    31753215    IF ( cpl_id > 1 )  THEN
    3176 !
    3177 !--    Child domain boundaries in the parent indice space.
    3178        icl  = coarse_bound(1)
    3179        icr  = coarse_bound(2)
    3180        jcs  = coarse_bound(3)
    3181        jcn  = coarse_bound(4)
    3182        icla = coarse_bound_aux(1)
    3183        icra = coarse_bound_aux(2)
    3184        jcsa = coarse_bound_aux(3)
    3185        jcna = coarse_bound_aux(4)
    3186        iclw = coarse_bound_w(1)
    3187        icrw = coarse_bound_w(2)
    3188        jcsw = coarse_bound_w(3)
    3189        jcnw = coarse_bound_w(4)
    31903216
    31913217       IF ( direction == parent_to_child )  THEN
     
    32133239    ENDIF
    32143240
    3215   CONTAINS
     3241 CONTAINS
    32163242
    32173243   
     
    32233249       IMPLICIT NONE
    32243250
    3225        INTEGER(iwp) ::  ibgp       !< index running over the nbgp boundary ghost points in i-direction
    3226        INTEGER(iwp) ::  jbgp       !< index running over the nbgp boundary ghost points in j-direction
    3227        INTEGER(iwp) ::  ib         !< running index for aerosol size bins
    3228        INTEGER(iwp) ::  ic         !< running index for aerosol mass bins
    3229        INTEGER(iwp) ::  ig         !< running index for salsa gases
    3230        INTEGER(iwp) ::  n          !< running index for number of chemical species
     3251       INTEGER(iwp) ::  ibgp       !< Index running over the nbgp boundary ghost points in i-direction
     3252       INTEGER(iwp) ::  jbgp       !< Index running over the nbgp boundary ghost points in j-direction
     3253       INTEGER(iwp) ::  lb         !< Running index for aerosol size bins
     3254       INTEGER(iwp) ::  lc         !< Running index for aerosol mass bins
     3255       INTEGER(iwp) ::  lg         !< Running index for salsa gases
     3256       INTEGER(iwp) ::  n          !< Running index for number of chemical species
    32313257     
    32323258!
     
    32423268             CALL pmci_interp_1sto_lr( w, wc, kctw, jflo, jfuo, kflw, kfuw, 'l', 'w' )
    32433269
    3244              IF ( (        rans_mode_parent  .AND.         rans_mode )  .OR.                        &
    3245                   (  .NOT. rans_mode_parent  .AND.  .NOT.  rans_mode  .AND.                         &
    3246                      .NOT. constant_diffusion ) )  THEN
     3270             IF ( (         rans_mode_parent  .AND.         rans_mode )  .OR.                       &
     3271                  (  .NOT.  rans_mode_parent  .AND.  .NOT.  rans_mode  .AND.                        &
     3272                     .NOT.  constant_diffusion ) )  THEN
    32473273!                CALL pmci_interp_1sto_lr( e, ec, kcto, jflo, jfuo, kflo, kfuo, 'l', 'e' )
    32483274!
    32493275!--             Interpolation of e is replaced by the Neumann condition.
    3250                 DO ibgp = -nbgp, -1
     3276                DO  ibgp = -nbgp, -1
    32513277                   e(nzb:nzt,nys:nyn,ibgp) = e(nzb:nzt,nys:nyn,0)
    32523278                ENDDO
     
    32903316
    32913317             IF ( salsa  .AND.  nest_salsa )  THEN
    3292                 DO  ib = 1, nbins_aerosol
    3293                    CALL pmci_interp_1sto_lr( aerosol_number(ib)%conc, aerosol_number_c(:,:,:,ib),    &
     3318                DO  lb = 1, nbins_aerosol
     3319                   CALL pmci_interp_1sto_lr( aerosol_number(lb)%conc, aerosol_number_c(:,:,:,lb),   &
    32943320                                             kcto, jflo, jfuo, kflo, kfuo, 'l', 's')
    32953321                ENDDO
    3296                 DO  ic = 1, nbins_aerosol * ncomponents_mass
    3297                    CALL pmci_interp_1sto_lr( aerosol_mass(ic)%conc, aerosol_mass_c(:,:,:,ic),        &
     3322                DO  lc = 1, nbins_aerosol * ncomponents_mass
     3323                   CALL pmci_interp_1sto_lr( aerosol_mass(lc)%conc, aerosol_mass_c(:,:,:,lc),       &
    32983324                                             kcto, jflo, jfuo, kflo, kfuo, 'l', 's')
    32993325                ENDDO
    33003326                IF ( .NOT. salsa_gases_from_chem )  THEN
    3301                    DO  ig = 1, ngases_salsa
    3302                       CALL pmci_interp_1sto_lr( salsa_gas(ig)%conc, salsa_gas_c(:,:,:,ig),         &
     3327                   DO  lg = 1, ngases_salsa
     3328                      CALL pmci_interp_1sto_lr( salsa_gas(lg)%conc, salsa_gas_c(:,:,:,lg),          &
    33033329                                                kcto, jflo, jfuo, kflo, kfuo, 'l', 's')
    33043330                   ENDDO
     
    33153341             CALL pmci_interp_1sto_lr( w, wc, kctw, jflo, jfuo, kflw, kfuw, 'r', 'w' )
    33163342
    3317              IF ( (        rans_mode_parent  .AND.         rans_mode )  .OR.                        &
    3318                   (  .NOT. rans_mode_parent  .AND.  .NOT.  rans_mode  .AND.                         &
    3319                      .NOT. constant_diffusion ) )  THEN
     3343             IF ( (         rans_mode_parent  .AND.         rans_mode )  .OR.                       &
     3344                  (  .NOT.  rans_mode_parent  .AND.  .NOT.  rans_mode  .AND.                        &
     3345                     .NOT.  constant_diffusion ) )  THEN
    33203346!                CALL pmci_interp_1sto_lr( e, ec, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, 'r', 'e' )
    33213347!
    33223348!--             Interpolation of e is replaced by the Neumann condition.
    3323                 DO ibgp = nx+1, nx+nbgp
     3349                DO  ibgp = nx+1, nx+nbgp
    33243350                   e(nzb:nzt,nys:nyn,ibgp) = e(nzb:nzt,nys:nyn,nx)
    33253351                ENDDO
     
    33283354             IF ( rans_mode_parent  .AND.  rans_mode  .AND.  rans_tke_e )  THEN
    33293355                CALL pmci_interp_1sto_lr( diss, dissc, kcto, jflo, jfuo, kflo, kfuo, 'r', 's' )
    3330 
    33313356             ENDIF
    33323357
    3333              IF ( .NOT. neutral )  THEN
     3358             IF (  .NOT. neutral )  THEN
    33343359                CALL pmci_interp_1sto_lr( pt, ptc, kcto, jflo, jfuo, kflo, kfuo, 'r', 's' )
    33353360             ENDIF
     
    33623387
    33633388             IF ( salsa  .AND.  nest_salsa )  THEN
    3364                 DO  ib = 1, nbins_aerosol
    3365                    CALL pmci_interp_1sto_lr( aerosol_number(ib)%conc, aerosol_number_c(:,:,:,ib),    &
     3389                DO  lb = 1, nbins_aerosol
     3390                   CALL pmci_interp_1sto_lr( aerosol_number(lb)%conc, aerosol_number_c(:,:,:,lb),   &
    33663391                                             kcto, jflo, jfuo, kflo, kfuo, 'r', 's' )
    33673392                ENDDO
    3368                 DO  ic = 1, nbins_aerosol * ncomponents_mass
    3369                    CALL pmci_interp_1sto_lr( aerosol_mass(ic)%conc, aerosol_mass_c(:,:,:,ic),        &
     3393                DO  lc = 1, nbins_aerosol * ncomponents_mass
     3394                   CALL pmci_interp_1sto_lr( aerosol_mass(lc)%conc, aerosol_mass_c(:,:,:,lc),       &
    33703395                                             kcto, jflo, jfuo, kflo, kfuo, 'r', 's' )
    33713396                ENDDO
    33723397                IF ( .NOT. salsa_gases_from_chem )  THEN
    3373                    DO  ig = 1, ngases_salsa
    3374                       CALL pmci_interp_1sto_lr( salsa_gas(ig)%conc, salsa_gas_c(:,:,:,ig),         &
     3398                   DO  lg = 1, ngases_salsa
     3399                      CALL pmci_interp_1sto_lr( salsa_gas(lg)%conc, salsa_gas_c(:,:,:,lg),          &
    33753400                                                kcto, jflo, jfuo, kflo, kfuo, 'r', 's' )
    33763401                   ENDDO
     
    33873412             CALL pmci_interp_1sto_sn( u, uc, kcto, iflu, ifuu, kflo, kfuo, 's', 'u' )
    33883413
    3389              IF ( (        rans_mode_parent  .AND.         rans_mode )  .OR.   &
    3390                   (  .NOT. rans_mode_parent  .AND.  .NOT.  rans_mode  .AND.    &
    3391                      .NOT. constant_diffusion ) )  THEN
     3414             IF ( (         rans_mode_parent  .AND.         rans_mode )  .OR.                       &
     3415                  (  .NOT.  rans_mode_parent  .AND.  .NOT.  rans_mode  .AND.                        &
     3416                     .NOT.  constant_diffusion ) )  THEN
    33923417!                CALL pmci_interp_1sto_sn( e, ec, kcto, iflo, ifuo, kflo, kfuo, 's', 'e' )
    33933418!
    33943419!--             Interpolation of e is replaced by the Neumann condition.
    3395                 DO jbgp = -nbgp, -1
     3420                DO  jbgp = -nbgp, -1
    33963421                   e(nzb:nzt,jbgp,nxl:nxr) = e(nzb:nzt,0,nxl:nxr)
    33973422                ENDDO
     
    34023427             ENDIF
    34033428
    3404              IF ( .NOT. neutral )  THEN
     3429             IF (  .NOT. neutral )  THEN
    34053430                CALL pmci_interp_1sto_sn( pt, ptc, kcto, iflo, ifuo, kflo, kfuo, 's', 's' )
    34063431             ENDIF
     
    34333458             
    34343459             IF ( salsa  .AND.  nest_salsa )  THEN
    3435                 DO  ib = 1, nbins_aerosol
    3436                    CALL pmci_interp_1sto_sn( aerosol_number(ib)%conc, aerosol_number_c(:,:,:,ib),    &
     3460                DO  lb = 1, nbins_aerosol
     3461                   CALL pmci_interp_1sto_sn( aerosol_number(lb)%conc, aerosol_number_c(:,:,:,lb),   &
    34373462                                             kcto, iflo, ifuo, kflo, kfuo, 's', 's' )
    34383463                ENDDO
    3439                 DO  ic = 1, nbins_aerosol * ncomponents_mass
    3440                    CALL pmci_interp_1sto_sn( aerosol_mass(ic)%conc, aerosol_mass_c(:,:,:,ic),        &
     3464                DO  lc = 1, nbins_aerosol * ncomponents_mass
     3465                   CALL pmci_interp_1sto_sn( aerosol_mass(lc)%conc, aerosol_mass_c(:,:,:,lc),       &
    34413466                                             kcto, iflo, ifuo, kflo, kfuo, 's', 's' )
    34423467                ENDDO
    34433468                IF ( .NOT. salsa_gases_from_chem )  THEN
    3444                    DO  ig = 1, ngases_salsa
    3445                       CALL pmci_interp_1sto_sn( salsa_gas(ig)%conc, salsa_gas_c(:,:,:,ig),         &
     3469                   DO  lg = 1, ngases_salsa
     3470                      CALL pmci_interp_1sto_sn( salsa_gas(lg)%conc, salsa_gas_c(:,:,:,lg),          &
    34463471                                                kcto, iflo, ifuo, kflo, kfuo, 's', 's' )
    34473472                   ENDDO
     
    34583483             CALL pmci_interp_1sto_sn( u, uc, kcto, iflu, ifuu, kflo, kfuo, 'n', 'u' )
    34593484
    3460              IF ( (        rans_mode_parent  .AND.         rans_mode )  .OR.                        &
    3461                   (  .NOT. rans_mode_parent  .AND.  .NOT.  rans_mode  .AND.                         &
    3462                      .NOT. constant_diffusion ) )  THEN
     3485             IF ( (         rans_mode_parent  .AND.         rans_mode )  .OR.                       &
     3486                  (  .NOT.  rans_mode_parent  .AND.  .NOT.  rans_mode  .AND.                        &
     3487                     .NOT.  constant_diffusion ) )  THEN
    34633488!                CALL pmci_interp_1sto_sn( e, ec, kcto, iflo, ifuo, kflo, kfuo, 'n', 'e' )
    34643489!
    34653490!--             Interpolation of e is replaced by the Neumann condition.
    3466                 DO jbgp = ny+1, ny+nbgp
     3491                DO  jbgp = ny+1, ny+nbgp
    34673492                   e(nzb:nzt,jbgp,nxl:nxr) = e(nzb:nzt,ny,nxl:nxr)
    34683493                ENDDO
     
    34733498             ENDIF
    34743499
    3475              IF ( .NOT. neutral )  THEN
     3500             IF (  .NOT. neutral )  THEN
    34763501                CALL pmci_interp_1sto_sn( pt, ptc, kcto, iflo, ifuo, kflo, kfuo, 'n', 's' )
    34773502             ENDIF
     
    35043529             
    35053530             IF ( salsa  .AND.  nest_salsa )  THEN
    3506                 DO  ib = 1, nbins_aerosol
    3507                    CALL pmci_interp_1sto_sn( aerosol_number(ib)%conc, aerosol_number_c(:,:,:,ib),    &
     3531                DO  lb = 1, nbins_aerosol
     3532                   CALL pmci_interp_1sto_sn( aerosol_number(lb)%conc, aerosol_number_c(:,:,:,lb),   &
    35083533                                             kcto, iflo, ifuo, kflo, kfuo, 'n', 's' )
    35093534                ENDDO
    3510                 DO  ic = 1, nbins_aerosol * ncomponents_mass
    3511                    CALL pmci_interp_1sto_sn( aerosol_mass(ic)%conc, aerosol_mass_c(:,:,:,ic),        &
     3535                DO  lc = 1, nbins_aerosol * ncomponents_mass
     3536                   CALL pmci_interp_1sto_sn( aerosol_mass(lc)%conc, aerosol_mass_c(:,:,:,lc),       &
    35123537                                             kcto, iflo, ifuo, kflo, kfuo, 'n', 's' )
    35133538                ENDDO
    35143539                IF ( .NOT. salsa_gases_from_chem )  THEN
    3515                    DO  ig = 1, ngases_salsa
    3516                       CALL pmci_interp_1sto_sn( salsa_gas(ig)%conc, salsa_gas_c(:,:,:,ig),         &
     3540                   DO  lg = 1, ngases_salsa
     3541                      CALL pmci_interp_1sto_sn( salsa_gas(lg)%conc, salsa_gas_c(:,:,:,lg),          &
    35173542                                                kcto, iflo, ifuo, kflo, kfuo, 'n', 's' )
    35183543                   ENDDO
     
    35293554       CALL pmci_interp_1sto_t( v, vc, kcto, iflo, ifuo, jflv, jfuv, 'v' )
    35303555
    3531        IF ( (        rans_mode_parent  .AND.         rans_mode )  .OR.         &
    3532             (  .NOT. rans_mode_parent  .AND.  .NOT.  rans_mode  .AND.          &
    3533                .NOT. constant_diffusion ) )  THEN
     3556       IF ( (         rans_mode_parent  .AND.         rans_mode )  .OR.                             &
     3557            (  .NOT.  rans_mode_parent  .AND.  .NOT.  rans_mode  .AND.                              &
     3558               .NOT.  constant_diffusion ) )  THEN
    35343559!          CALL pmci_interp_1sto_t( e, ec, kcto, iflo, ifuo, jflo, jfuo, 'e' )
    35353560!
     
    35703595       
    35713596       IF ( salsa  .AND.  nest_salsa )  THEN
    3572           DO  ib = 1, nbins_aerosol
    3573              CALL pmci_interp_1sto_t( aerosol_number(ib)%conc, aerosol_number_c(:,:,:,ib),           &
     3597          DO  lb = 1, nbins_aerosol
     3598             CALL pmci_interp_1sto_t( aerosol_number(lb)%conc, aerosol_number_c(:,:,:,lb),          &
    35743599                                      kcto, iflo, ifuo, jflo, jfuo, 's' )
    35753600          ENDDO
    3576           DO  ic = 1, nbins_aerosol * ncomponents_mass
    3577              CALL pmci_interp_1sto_t( aerosol_mass(ic)%conc, aerosol_mass_c(:,:,:,ic),               &
     3601          DO  lc = 1, nbins_aerosol * ncomponents_mass
     3602             CALL pmci_interp_1sto_t( aerosol_mass(lc)%conc, aerosol_mass_c(:,:,:,lc),              &
    35783603                                      kcto, iflo, ifuo, jflo, jfuo, 's' )
    35793604          ENDDO
    35803605          IF ( .NOT. salsa_gases_from_chem )  THEN
    3581              DO  ig = 1, ngases_salsa
    3582                 CALL pmci_interp_1sto_t( salsa_gas(ig)%conc, salsa_gas_c(:,:,:,ig),                &
     3606             DO  lg = 1, ngases_salsa
     3607                CALL pmci_interp_1sto_t( salsa_gas(lg)%conc, salsa_gas_c(:,:,:,lg),                 &
    35833608                                         kcto, iflo, ifuo, jflo, jfuo, 's' )
    35843609             ENDDO
     
    35963621!--   Note that TKE is not anterpolated.
    35973622      IMPLICIT NONE
    3598       INTEGER(iwp) ::  ib         !< running index for aerosol size bins
    3599       INTEGER(iwp) ::  ic         !< running index for aerosol mass bins
    3600       INTEGER(iwp) ::  n          !< running index for number of chemical species
    3601       INTEGER(iwp) ::  ig         !< running index for salsa gases
    3602 
    3603 
     3623      INTEGER(iwp) ::  lb         !< Running index for aerosol size bins
     3624      INTEGER(iwp) ::  lc         !< Running index for aerosol mass bins
     3625      INTEGER(iwp) ::  lg         !< Running index for salsa gases
     3626      INTEGER(iwp) ::  n          !< Running index for number of chemical species
     3627
     3628     
    36043629      CALL pmci_anterp_tophat( u,  uc,  kcto, iflu, ifuu, jflo, jfuo, kflo, kfuo, ijkfc_u, 'u' )
    36053630      CALL pmci_anterp_tophat( v,  vc,  kcto, iflo, ifuo, jflv, jfuv, kflo, kfuo, ijkfc_v, 'v' )
     
    36133638!--      Anterpolation of dissipation rate only if TKE-e closure is applied.
    36143639         IF ( rans_tke_e )  THEN
    3615             CALL pmci_anterp_tophat( diss, dissc, kcto, iflo, ifuo, jflo, jfuo,&
    3616                                      kflo, kfuo, ijkfc_s, 'diss' )
     3640            CALL pmci_anterp_tophat( diss, dissc, kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo,         &
     3641                 ijkfc_s, 'diss' )
    36173642         ENDIF
    36183643
     
    36613686     
    36623687      IF ( salsa  .AND.  nest_salsa )  THEN
    3663          DO  ib = 1, nbins_aerosol
    3664             CALL pmci_anterp_tophat( aerosol_number(ib)%conc, aerosol_number_c(:,:,:,ib),            &
     3688         DO  lb = 1, nbins_aerosol
     3689            CALL pmci_anterp_tophat( aerosol_number(lb)%conc, aerosol_number_c(:,:,:,lb),           &
    36653690                                     kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, ijkfc_s, 's' )
    36663691         ENDDO
    3667          DO  ic = 1, nbins_aerosol * ncomponents_mass
    3668             CALL pmci_anterp_tophat( aerosol_mass(ic)%conc, aerosol_mass_c(:,:,:,ic),                &
     3692         DO  lc = 1, nbins_aerosol * ncomponents_mass
     3693            CALL pmci_anterp_tophat( aerosol_mass(lc)%conc, aerosol_mass_c(:,:,:,lc),               &
    36693694                                     kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, ijkfc_s, 's' )
    36703695         ENDDO
    36713696         IF ( .NOT. salsa_gases_from_chem )  THEN
    3672             DO  ig = 1, ngases_salsa
    3673                CALL pmci_anterp_tophat( salsa_gas(ig)%conc, salsa_gas_c(:,:,:,ig),                 &
     3697            DO  lg = 1, ngases_salsa
     3698               CALL pmci_anterp_tophat( salsa_gas(lg)%conc, salsa_gas_c(:,:,:,lg),                  &
    36743699                                        kcto, iflo, ifuo, jflo, jfuo, kflo, kfuo, ijkfc_s, 's' )
    36753700            ENDDO
     
    36813706
    36823707
    3683    SUBROUTINE pmci_interp_1sto_lr( f, fc, kct, jfl, jfu, kfl, kfu, edge, var )
     3708   SUBROUTINE pmci_interp_1sto_lr( child_array, parent_array, kct, jfl, jfu, kfl, kfu, edge, var )
    36843709!
    36853710!--   Interpolation of ghost-node values used as the child-domain boundary
     
    36873712      IMPLICIT NONE
    36883713
    3689       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(INOUT) ::  f   !< Child-grid array
    3690       REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr), INTENT(IN)        ::  fc  !< Parent-grid array
    3691       INTEGER(iwp) :: kct                                     !< The parent-grid index in z-direction just below the boundary value node
    3692       INTEGER(iwp), DIMENSION(jcsa:jcna), INTENT(IN) ::  jfl  !< Indicates start index of child cells belonging to certain parent cell - y direction
    3693       INTEGER(iwp), DIMENSION(jcsa:jcna), INTENT(IN) ::  jfu  !< Indicates end index of child cells belonging to certain parent cell - y direction
    3694       INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN) ::  kfl  !< Indicates start index of child cells belonging to certain parent cell - z direction
    3695       INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN) ::  kfu  !< Indicates end index of child cells belonging to certain parent cell - z direction
     3714      INTEGER(iwp), INTENT(IN) ::  kct  !< The parent-grid index in z-direction just below the boundary value node
     3715     
     3716      INTEGER(iwp), DIMENSION(jpsa:jpna), INTENT(IN) ::  jfl  !< Indicates start index of child cells belonging to certain
     3717                                                              !< parent cell - y direction
     3718      INTEGER(iwp), DIMENSION(jpsa:jpna), INTENT(IN) ::  jfu  !< Indicates end index of child cells belonging to certain
     3719                                                              !< parent cell - y direction
     3720      INTEGER(iwp), DIMENSION(0:pg%nz+1), INTENT(IN) ::  kfl  !< Indicates start index of child cells belonging to certain
     3721                                                              !< parent cell - z direction
     3722      INTEGER(iwp), DIMENSION(0:pg%nz+1), INTENT(IN) ::  kfu  !< Indicates end index of child cells belonging to certain
     3723                                                              !< parent cell - z direction
     3724
     3725      REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(INOUT) ::  child_array   !< Child-grid array
     3726      REAL(wp), DIMENSION(0:pg%nz+1,jps:jpn,ipl:ipr), INTENT(IN)        ::  parent_array  !< Parent-grid array
     3727
    36963728      CHARACTER(LEN=1), INTENT(IN) ::  edge                   !< Edge symbol: 'l' or 'r'
    3697       CHARACTER(LEN=1), INTENT(IN) ::  var                    !< Variable symbol: 'u', 'v', 'w' or 's'
     3729      CHARACTER(LEN=1), INTENT(IN) ::  var                    !< Variable symbol: 'u', 'v', 'w' or 's'     
    36983730!
    36993731!--   Local variables:
    3700       INTEGER(iwp) ::  ib       !< Fixed i-index pointing to the node just behind the boundary-value node
    3701       INTEGER(iwp) ::  ibc      !< Fixed i-index pointing to the boundary-value nodes (either i or iend)
    3702       INTEGER(iwp) ::  ibgp     !< Index running over the redundant boundary ghost points in i-direction
     3732      INTEGER(iwp) ::  icb      !< Fixed child-grid index in the x-direction pointing to the node just behind the
     3733                                !< boundary-value node
     3734      INTEGER(iwp) ::  icbc     !< Fixed child-grid index in the x-direction pointing to the boundary-value nodes
     3735      INTEGER(iwp) ::  icbgp    !< Index running over the redundant boundary ghost points in the x-direction
    37033736      INTEGER(iwp) ::  ierr     !< MPI error code
    3704       INTEGER(iwp) ::  j        !< Running index in the y-direction
    3705       INTEGER(iwp) ::  k        !< Running index in the z-direction
    3706       INTEGER(iwp) ::  lbeg     !< l-index pointing to the starting point of workarrc_lr in the l-direction
    3707       INTEGER(iwp) ::  lw       !< Reduced l-index for workarrc_lr pointing to the boundary ghost node
    3708       INTEGER(iwp) ::  lwp      !< Reduced l-index for workarrc_lr pointing to the first prognostic node
    3709       INTEGER(iwp) ::  m        !< Parent-grid running index in the y-direction
    3710       INTEGER(iwp) ::  n        !< Parent-grid running index in the z-direction
     3737      INTEGER(iwp) ::  ipbeg    !< Parent-grid index in the x-direction pointing to the starting point of workarr_lr
     3738                                !< in the parent-grid array
     3739      INTEGER(iwp) ::  ipw      !< Reduced parent-grid index in the x-direction for workarr_lr pointing to
     3740                                !< the boundary ghost node
     3741      INTEGER(iwp) ::  ipwp     !< Reduced parent-grid index in the x-direction for workarr_lr pointing to
     3742                                !< the first prognostic node
     3743      INTEGER(iwp) ::  jc       !< Running child-grid index in the y-direction
     3744      INTEGER(iwp) ::  jp       !< Running parent-grid index in the y-direction
     3745      INTEGER(iwp) ::  kc       !< Running child-grid index in the z-direction
     3746      INTEGER(iwp) ::  kp       !< Running parent-grid index in the z-direction     
     3747     
    37113748      REAL(wp) ::  cb           !< Interpolation coefficient for the boundary ghost node 
    37123749      REAL(wp) ::  cp           !< Interpolation coefficient for the first prognostic node
    3713       REAL(wp) ::  f_interp_1   !< Value interpolated in x direction from the parent-grid data
    3714       REAL(wp) ::  f_interp_2   !< Auxiliary value interpolated in x direction from the parent-grid data
     3750      REAL(wp) ::  c_interp_1   !< Value interpolated to the flux point in x direction from the parent-grid data
     3751      REAL(wp) ::  c_interp_2   !< Auxiliary value interpolated  to the flux point in x direction from the parent-grid data
    37153752
    37163753!
     
    37203757!--      For u, nxl is a ghost node, but not for the other variables
    37213758         IF ( var == 'u' )  THEN
    3722             ibc   = nxl   
    3723             ib    = ibc - 1
    3724             lw    = 2
    3725             lwp   = lw        ! This is redundant when var == 'u'
    3726             lbeg  = icl
     3759            icbc  = nxl   
     3760            icb   = icbc - 1
     3761            ipw   = 2
     3762            ipwp  = ipw        ! This is redundant when var == 'u'
     3763            ipbeg = ipl
    37273764         ELSE
    3728             ibc   = nxl - 1
    3729             ib    = ibc - 1
    3730             lw    = 1
    3731             lwp   = 2
    3732             lbeg  = icl
     3765            icbc  = nxl - 1
     3766            icb   = icbc - 1
     3767            ipw   = 1
     3768            ipwp  = 2
     3769            ipbeg = ipl
    37333770         ENDIF       
    37343771      ELSEIF ( edge == 'r' )  THEN
    37353772         IF ( var == 'u' )  THEN
    3736             ibc   = nxr + 1
    3737             ib    = ibc + 1
    3738             lw    = 1
    3739             lwp   = lw        ! This is redundant when var == 'u'           
    3740             lbeg  = icr - 2
     3773            icbc  = nxr + 1
     3774            icb   = icbc + 1
     3775            ipw   = 1
     3776            ipwp  = ipw        ! This is redundant when var == 'u'           
     3777            ipbeg = ipr - 2
    37413778         ELSE
    3742             ibc   = nxr + 1
    3743             ib    = ibc + 1
    3744             lw    = 1
    3745             lwp   = 0
    3746             lbeg  = icr - 2
     3779            icbc  = nxr + 1
     3780            icb   = icbc + 1
     3781            ipw   = 1
     3782            ipwp  = 0
     3783            ipbeg = ipr - 2
    37473784         ENDIF         
    37483785      ENDIF
    37493786!
    37503787!--   Interpolation coefficients
    3751       IF  ( interpolation_scheme_lrsn == 1 )  THEN
     3788      IF ( interpolation_scheme_lrsn == 1 )  THEN
    37523789         cb = 1.0_wp  ! 1st-order upwind
    3753       ELSE IF  ( interpolation_scheme_lrsn == 2 )  THEN
     3790      ELSE IF ( interpolation_scheme_lrsn == 2 )  THEN
    37543791         cb = 0.5_wp  ! 2nd-order central
    37553792      ELSE
    37563793         cb = 0.5_wp  ! 2nd-order central (default)
    37573794      ENDIF         
    3758       cp    = 1.0_wp - cb
    3759 !
    3760 !--   Substitute the necessary parent-grid data to the work array workarrc_lr.
    3761       workarrc_lr = 0.0_wp     
    3762       IF  ( pdims(2) > 1 )  THEN
     3795      cp = 1.0_wp - cb
     3796!
     3797!--   Substitute the necessary parent-grid data to the work array workarr_lr.
     3798      workarr_lr = 0.0_wp     
     3799      IF ( pdims(2) > 1 )  THEN
    37633800#if defined( __parallel )
    3764          IF  ( bc_dirichlet_s )  THEN
    3765             workarrc_lr(0:cg%nz+1,jcsw:jcnw-1,0:2)                              &
    3766                  = fc(0:cg%nz+1,jcsw:jcnw-1,lbeg:lbeg+2)
    3767          ELSE IF  ( bc_dirichlet_n )  THEN
    3768             workarrc_lr(0:cg%nz+1,jcsw+1:jcnw,0:2)                              &
    3769                  = fc(0:cg%nz+1,jcsw+1:jcnw,lbeg:lbeg+2)
     3801         IF ( bc_dirichlet_s )  THEN
     3802            workarr_lr(0:pg%nz+1,jpsw:jpnw-1,0:2) = parent_array(0:pg%nz+1,jpsw:jpnw-1,ipbeg:ipbeg+2)
     3803         ELSE IF ( bc_dirichlet_n )  THEN
     3804            workarr_lr(0:pg%nz+1,jpsw+1:jpnw,0:2) = parent_array(0:pg%nz+1,jpsw+1:jpnw,ipbeg:ipbeg+2)
    37703805         ELSE
    3771             workarrc_lr(0:cg%nz+1,jcsw+1:jcnw-1,0:2)                            &
    3772                  = fc(0:cg%nz+1,jcsw+1:jcnw-1,lbeg:lbeg+2)
     3806            workarr_lr(0:pg%nz+1,jpsw+1:jpnw-1,0:2)                                                 &
     3807                 = parent_array(0:pg%nz+1,jpsw+1:jpnw-1,ipbeg:ipbeg+2)
    37733808         ENDIF
    37743809!
     
    37783813!--      because the nest domain is not cyclic.
    37793814!--      From south to north
    3780          CALL MPI_SENDRECV( workarrc_lr(0,jcsw+1,0), 1,                         &
    3781               workarrc_lr_exchange_type, psouth,  0,                            &
    3782               workarrc_lr(0,jcnw,0), 1,                                         &
    3783               workarrc_lr_exchange_type, pnorth,  0,                            &
    3784               comm2d, status, ierr )                                     
    3785 !                                                                         
    3786 !--      From north to south                                             
    3787          CALL MPI_SENDRECV( workarrc_lr(0,jcnw-1,0), 1,                         &
    3788               workarrc_lr_exchange_type, pnorth,  1,                            &
    3789               workarrc_lr(0,jcsw,0), 1,                                         &
    3790               workarrc_lr_exchange_type, psouth,  1,                            &
    3791               comm2d, status, ierr )                                     
    3792 #endif                                                                   
    3793       ELSE                                                               
    3794          workarrc_lr(0:cg%nz+1,jcsw:jcnw,0:2)                                   &
    3795               = fc(0:cg%nz+1,jcsw:jcnw,lbeg:lbeg+2)           
     3815         CALL MPI_SENDRECV( workarr_lr(0,jpsw+1,0), 1, workarr_lr_exchange_type, psouth,  0,        &
     3816                            workarr_lr(0,jpnw,0), 1, workarr_lr_exchange_type, pnorth,  0, comm2d,  &
     3817                            status, ierr )                             
     3818!                                                                             
     3819!--      From north to south                                                 
     3820         CALL MPI_SENDRECV( workarr_lr(0,jpnw-1,0), 1, workarr_lr_exchange_type, pnorth,  1,        &
     3821                            workarr_lr(0,jpsw,0), 1, workarr_lr_exchange_type, psouth,  1, comm2d,  &
     3822                            status, ierr )                               
     3823#endif                                                                       
     3824      ELSE                                                                   
     3825         workarr_lr(0:pg%nz+1,jpsw:jpnw,0:2) = parent_array(0:pg%nz+1,jpsw:jpnw,ipbeg:ipbeg+2)           
    37963826      ENDIF
    37973827
    3798       IF  ( var == 'u' )  THEN
    3799 
    3800          DO  m = jcsw, jcnw
    3801             DO n = 0, kct
     3828      IF ( var == 'u' )  THEN
     3829
     3830         DO  jp = jpsw, jpnw
     3831            DO  kp = 0, kct
    38023832               
    3803                DO  j = jfl(m), jfu(m)
    3804                   DO  k = kfl(n), kfu(n)
    3805                      f(k,j,ibc) = workarrc_lr(n,m,lw)
     3833               DO  jc = jfl(jp), jfu(jp)
     3834                  DO  kc = kfl(kp), kfu(kp)
     3835                     child_array(kc,jc,icbc) = workarr_lr(kp,jp,ipw)
    38063836                  ENDDO
    38073837               ENDDO
     
    38103840         ENDDO
    38113841
    3812       ELSE IF  ( var == 'v' )  THEN
     3842      ELSE IF ( var == 'v' )  THEN
    38133843         
    3814          DO  m = jcsw, jcnw-1
    3815             DO n = 0, kct
     3844         DO  jp = jpsw, jpnw-1
     3845            DO  kp = 0, kct
    38163846!
    38173847!--            First interpolate to the flux point
    3818                f_interp_1 = cb * workarrc_lr(n,m,lw)   + cp * workarrc_lr(n,m,lwp)
    3819                f_interp_2 = cb * workarrc_lr(n,m+1,lw) + cp * workarrc_lr(n,m+1,lwp)
     3848               c_interp_1 = cb * workarr_lr(kp,jp,ipw)   + cp * workarr_lr(kp,jp,ipwp)
     3849               c_interp_2 = cb * workarr_lr(kp,jp+1,ipw) + cp * workarr_lr(kp,jp+1,ipwp)
    38203850!
    38213851!--            Use averages of the neighbouring matching grid-line values
    3822                DO  j = jfl(m), jfl(m+1)
    3823                   f(kfl(n):kfu(n),j,ibc) = 0.5_wp * ( f_interp_1 + f_interp_2 )
     3852               DO  jc = jfl(jp), jfl(jp+1)
     3853                  child_array(kfl(kp):kfu(kp),jc,icbc) = 0.5_wp * ( c_interp_1 + c_interp_2 )
    38243854               ENDDO
    38253855!
    38263856!--            Then set the values along the matching grid-lines 
    3827                IF  ( MOD( jfl(m), jgsr ) == 0 )  THEN
    3828                   f(kfl(n):kfu(n),jfl(m),ibc) = f_interp_1
     3857               IF  ( MOD( jfl(jp), jgsr ) == 0 )  THEN
     3858                  child_array(kfl(kp):kfu(kp),jfl(jp),icbc) = c_interp_1
    38293859               ENDIF
    38303860            ENDDO
     
    38323862!
    38333863!--      Finally, set the values along the last matching grid-line 
    3834          IF  ( MOD( jfl(jcnw), jgsr ) == 0 )  THEN
    3835             DO  n = 0, kct
    3836                f_interp_1 = cb * workarrc_lr(n,jcnw,lw) + cp * workarrc_lr(n,jcnw,lwp)
    3837                f(kfl(n):kfu(n),jfl(jcnw),ibc) = f_interp_1
     3864         IF ( MOD( jfl(jpnw), jgsr ) == 0 )  THEN
     3865            DO  kp = 0, kct
     3866               c_interp_1 = cb * workarr_lr(kp,jpnw,ipw) + cp * workarr_lr(kp,jpnw,ipwp)
     3867               child_array(kfl(kp):kfu(kp),jfl(jpnw),icbc) = c_interp_1
    38383868            ENDDO
    38393869         ENDIF
     
    38433873!--      gap. Note however, this operation may produce some additional
    38443874!--      momentum conservation error.
    3845          IF  ( jfl(jcnw) < nyn )  THEN
    3846             DO  n = 0, kct
    3847                DO  j = jfl(jcnw)+1, nyn
    3848                   f(kfl(n):kfu(n),j,ibc) = f(kfl(n):kfu(n),jfl(jcnw),ibc)
     3875         IF ( jfl(jpnw) < nyn )  THEN
     3876            DO  kp = 0, kct
     3877               DO  jc = jfl(jpnw) + 1, nyn
     3878                  child_array(kfl(kp):kfu(kp),jc,icbc) = child_array(kfl(kp):kfu(kp),jfl(jpnw),icbc)
    38493879               ENDDO
    38503880            ENDDO
    38513881         ENDIF
    38523882
    3853       ELSE IF  ( var == 'w' )  THEN
    3854 
    3855          DO  m = jcsw, jcnw
    3856             DO n = 0, kct + 1   ! It is important to go up to kct+1 
     3883      ELSE IF ( var == 'w' )  THEN
     3884
     3885         DO  jp = jpsw, jpnw
     3886            DO  kp = 0, kct + 1   ! It is important to go up to kct+1 
    38573887!
    38583888!--            Interpolate to the flux point
    3859                f_interp_1 = cb * workarrc_lr(n,m,lw) + cp * workarrc_lr(n,m,lwp)
     3889               c_interp_1 = cb * workarr_lr(kp,jp,ipw) + cp * workarr_lr(kp,jp,ipwp)
    38603890!
    38613891!--            First substitute only the matching-node values
    3862                f(kfu(n),jfl(m):jfu(m),ibc) = f_interp_1
     3892               child_array(kfu(kp),jfl(jp):jfu(jp),icbc) = c_interp_1
    38633893                 
    38643894            ENDDO
    38653895         ENDDO
    38663896
    3867          DO  m = jcsw, jcnw
    3868             DO n = 1, kct + 1   ! It is important to go up to kct+1 
     3897         DO  jp = jpsw, jpnw
     3898            DO  kp = 1, kct + 1   ! It is important to go up to kct+1 
    38693899!
    38703900!--            Then fill up the nodes in between with the averages                 
    3871                DO  k = kfu(n-1)+1, kfu(n)-1
    3872                   f(k,jfl(m):jfu(m),ibc) = 0.5_wp * ( f(kfu(n-1),jfl(m):jfu(m),ibc) &
    3873                        + f(kfu(n),jfl(m):jfu(m),ibc) )
     3901               DO  kc = kfu(kp-1) + 1, kfu(kp) - 1
     3902                  child_array(kc,jfl(jp):jfu(jp),icbc) =                                            &
     3903                       0.5_wp * ( child_array(kfu(kp-1),jfl(jp):jfu(jp),icbc)                       &
     3904                       + child_array(kfu(kp),jfl(jp):jfu(jp),icbc) )
    38743905               ENDDO
    38753906                 
     
    38793910      ELSE   ! any scalar
    38803911         
    3881          DO  m = jcsw, jcnw
    3882             DO n = 0, kct
     3912         DO  jp = jpsw, jpnw
     3913            DO  kp = 0, kct
    38833914!
    38843915!--            Interpolate to the flux point
    3885                f_interp_1 = cb * workarrc_lr(n,m,lw) + cp * workarrc_lr(n,m,lwp)
    3886                DO  j = jfl(m), jfu(m)
    3887                   DO  k = kfl(n), kfu(n)
    3888                      f(k,j,ibc) = f_interp_1
     3916               c_interp_1 = cb * workarr_lr(kp,jp,ipw) + cp * workarr_lr(kp,jp,ipwp)
     3917               DO  jc = jfl(jp), jfu(jp)
     3918                  DO  kc = kfl(kp), kfu(kp)
     3919                     child_array(kc,jc,icbc) = c_interp_1
    38893920                  ENDDO
    38903921               ENDDO
     
    38973928!--   Fill up also the redundant 2nd and 3rd ghost-node layers
    38983929      IF ( edge == 'l' )  THEN
    3899          DO  ibgp = -nbgp, ib
    3900             f(0:nzt+1,nysg:nyng,ibgp) = f(0:nzt+1,nysg:nyng,ibc)
     3930         DO  icbgp = -nbgp, icb
     3931            child_array(0:nzt+1,nysg:nyng,icbgp) = child_array(0:nzt+1,nysg:nyng,icbc)
    39013932         ENDDO
    39023933      ELSEIF ( edge == 'r' )  THEN
    3903          DO  ibgp = ib, nx+nbgp
    3904             f(0:nzt+1,nysg:nyng,ibgp) = f(0:nzt+1,nysg:nyng,ibc)
     3934         DO  icbgp = icb, nx+nbgp
     3935            child_array(0:nzt+1,nysg:nyng,icbgp) = child_array(0:nzt+1,nysg:nyng,icbc)
    39053936         ENDDO
    39063937      ENDIF
     
    39103941
    39113942
    3912    SUBROUTINE pmci_interp_1sto_sn( f, fc, kct, ifl, ifu, kfl, kfu, edge, var )
     3943   SUBROUTINE pmci_interp_1sto_sn( child_array, parent_array, kct, ifl, ifu, kfl, kfu, edge, var )
    39133944!
    39143945!--   Interpolation of ghost-node values used as the child-domain boundary
     
    39163947      IMPLICIT NONE
    39173948
    3918       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(INOUT) ::  f   !< Child-grid array
    3919       REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr), INTENT(IN)        ::  fc  !< Parent-grid array
    3920       INTEGER(iwp) :: kct                                     !< The parent-grid index in z-direction just below the boundary value node
    3921       INTEGER(iwp), DIMENSION(icla:icra), INTENT(IN) ::  ifl  !< Indicates start index of child cells belonging to certain parent cell - x direction
    3922       INTEGER(iwp), DIMENSION(icla:icra), INTENT(IN) ::  ifu  !< Indicates end index of child cells belonging to certain parent cell - x direction
    3923       INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN) ::  kfl  !< Indicates start index of child cells belonging to certain parent cell - z direction
    3924       INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN) ::  kfu  !< Indicates end index of child cells belonging to certain parent cell - z direction
     3949      INTEGER(iwp), INTENT(IN) ::  kct  !< The parent-grid index in z-direction just below the boundary value node
     3950     
     3951      INTEGER(iwp), DIMENSION(ipla:ipra), INTENT(IN) ::  ifl  !< Indicates start index of child cells belonging to certain
     3952                                                              !< parent cell - x direction
     3953      INTEGER(iwp), DIMENSION(ipla:ipra), INTENT(IN) ::  ifu  !< Indicates end index of child cells belonging to certain
     3954                                                              !< parent cell - x direction
     3955      INTEGER(iwp), DIMENSION(0:pg%nz+1), INTENT(IN) ::  kfl  !< Indicates start index of child cells belonging to certain
     3956                                                              !< parent cell - z direction
     3957      INTEGER(iwp), DIMENSION(0:pg%nz+1), INTENT(IN) ::  kfu  !< Indicates end index of child cells belonging to certain
     3958                                                              !< parent cell - z direction
     3959     
     3960      REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(INOUT) ::  child_array   !< Child-grid array
     3961      REAL(wp), DIMENSION(0:pg%nz+1,jps:jpn,ipl:ipr), INTENT(IN)        ::  parent_array  !< Parent-grid array
     3962
    39253963      CHARACTER(LEN=1), INTENT(IN) ::  edge   !< Edge symbol: 's' or 'n'
    39263964      CHARACTER(LEN=1), INTENT(IN) ::  var    !< Variable symbol: 'u', 'v', 'w' or 's'
    39273965!
    39283966!--   Local variables:     
    3929       INTEGER(iwp) ::  i        !< Running index in the x-direction
     3967      INTEGER(iwp) ::  ic       !< Running child-grid index in the x-direction
    39303968      INTEGER(iwp) ::  ierr     !< MPI error code
    3931       INTEGER(iwp) ::  jb       !< Fixed j-index pointing to the node just behind the boundary-value node
    3932       INTEGER(iwp) ::  jbc      !< Fixed j-index pointing to the boundary-value nodes (either j or jend)
    3933       INTEGER(iwp) ::  jbgp     !< Index running over the redundant boundary ghost points in j-direction
    3934       INTEGER(iwp) ::  k        !< Running index in the z-direction
    3935       INTEGER(iwp) ::  l        !< Parent-grid running index in the x-direction
    3936       INTEGER(iwp) ::  mbeg     !< m-index pointing to the starting point of workarrc_sn in the m-direction
    3937       INTEGER(iwp) ::  mw       !< Reduced m-index for workarrc_sn pointing to the boundary ghost node
    3938       INTEGER(iwp) ::  mwp      !< Reduced m-index for workarrc_sn pointing to the first prognostic node
    3939       INTEGER(iwp) ::  n        !< Parent-grid running index in the z-direction
     3969      INTEGER(iwp) ::  ip       !< Running parent-grid index in the x-direction
     3970      INTEGER(iwp) ::  jcb      !< Fixed child-grid index in the y-direction pointing to the node just behind the
     3971                                !< boundary-value node
     3972      INTEGER(iwp) ::  jcbc     !< Fixed child-grid index in the y-direction pointing to the boundary-value nodes
     3973      INTEGER(iwp) ::  jcbgp    !< Index running over the redundant boundary ghost points in y-direction
     3974      INTEGER(iwp) ::  kc       !< Running child-grid index in the z-direction     
     3975      INTEGER(iwp) ::  kp       !< Running parent-grid index in the z-direction
     3976      INTEGER(iwp) ::  jpbeg    !< Parent-grid index in the y-direction pointing to the starting point of workarr_sn
     3977                                !< in the parent-grid array
     3978      INTEGER(iwp) ::  jpw      !< Reduced parent-grid index in the y-direction for workarr_sn pointing to
     3979                                !< the boundary ghost node
     3980      INTEGER(iwp) ::  jpwp     !< Reduced parent-grid index in the y-direction for workarr_sn pointing to
     3981                                !< the first prognostic node
    39403982      REAL(wp) ::  cb           !< Interpolation coefficient for the boundary ghost node 
    39413983      REAL(wp) ::  cp           !< Interpolation coefficient for the first prognostic node
    3942       REAL(wp) ::  f_interp_1   !< Value interpolated in y direction from the parent-grid data
    3943       REAL(wp) ::  f_interp_2   !< Auxiliary value interpolated in y direction from the parent-grid data
    3944 
     3984      REAL(wp) ::  c_interp_1   !< Value interpolated to the flux point in x direction from the parent-grid data
     3985      REAL(wp) ::  c_interp_2   !< Auxiliary value interpolated  to the flux point in x direction from the parent-grid data
     3986     
    39453987!
    39463988!--   Check which edge is to be handled: south or north
     
    39493991!--      For v, nys is a ghost node, but not for the other variables
    39503992         IF ( var == 'v' )  THEN
    3951             jbc   = nys
    3952             jb    = jbc - 1
    3953             mw    = 2
    3954             mwp   = 2         ! This is redundant when var == 'v'
    3955             mbeg  = jcs
     3993            jcbc  = nys
     3994            jcb   = jcbc - 1
     3995            jpw   = 2
     3996            jpwp  = 2         ! This is redundant when var == 'v'
     3997            jpbeg = jps
    39563998         ELSE
    3957             jbc   = nys - 1
    3958             jb    = jbc - 1
    3959             mw    = 1
    3960             mwp   = 2
    3961             mbeg  = jcs
     3999            jcbc  = nys - 1
     4000            jcb   = jcbc - 1
     4001            jpw   = 1
     4002            jpwp  = 2
     4003            jpbeg = jps
    39624004         ENDIF
    39634005      ELSEIF ( edge == 'n' )  THEN
    39644006         IF ( var == 'v' )  THEN
    3965             jbc   = nyn + 1
    3966             jb    = jbc + 1
    3967             mw    = 1
    3968             mwp   = 0         ! This is redundant when var == 'v'     
    3969             mbeg  = jcn - 2
     4007            jcbc  = nyn + 1
     4008            jcb   = jcbc + 1
     4009            jpw   = 1
     4010            jpwp  = 0         ! This is redundant when var == 'v'     
     4011            jpbeg = jpn - 2
    39704012         ELSE
    3971             jbc   = nyn + 1
    3972             jb    = jbc + 1
    3973             mw    = 1
    3974             mwp   = 0
    3975             mbeg  = jcn - 2
     4013            jcbc  = nyn + 1
     4014            jcb   = jcbc + 1
     4015            jpw   = 1
     4016            jpwp  = 0
     4017            jpbeg = jpn - 2
    39764018         ENDIF
    39774019      ENDIF
    39784020!
    39794021!--   Interpolation coefficients
    3980       IF  ( interpolation_scheme_lrsn == 1 )  THEN
     4022      IF ( interpolation_scheme_lrsn == 1 )  THEN
    39814023         cb = 1.0_wp  ! 1st-order upwind
    3982       ELSE IF  ( interpolation_scheme_lrsn == 2 )  THEN
     4024      ELSE IF ( interpolation_scheme_lrsn == 2 )  THEN
    39834025         cb = 0.5_wp  ! 2nd-order central
    39844026      ELSE
    39854027         cb = 0.5_wp  ! 2nd-order central (default)
    39864028      ENDIF         
    3987       cp    = 1.0_wp - cb
    3988 !
    3989 !--   Substitute the necessary parent-grid data to the work array workarrc_sn.
    3990       workarrc_sn = 0.0_wp     
    3991       IF  ( pdims(1) > 1 )  THEN
     4029      cp = 1.0_wp - cb
     4030!
     4031!--   Substitute the necessary parent-grid data to the work array workarr_sn.
     4032      workarr_sn = 0.0_wp     
     4033      IF ( pdims(1) > 1 )  THEN
    39924034#if defined( __parallel )
    3993          IF  ( bc_dirichlet_l )  THEN
    3994             workarrc_sn(0:cg%nz+1,0:2,iclw:icrw-1)                              &
    3995                  = fc(0:cg%nz+1,mbeg:mbeg+2,iclw:icrw-1)
    3996          ELSE IF  ( bc_dirichlet_r )  THEN
    3997             workarrc_sn(0:cg%nz+1,0:2,iclw+1:icrw)                              &
    3998                  = fc(0:cg%nz+1,mbeg:mbeg+2,iclw+1:icrw)
     4035         IF ( bc_dirichlet_l )  THEN
     4036            workarr_sn(0:pg%nz+1,0:2,iplw:iprw-1) = parent_array(0:pg%nz+1,jpbeg:jpbeg+2,iplw:iprw-1)
     4037         ELSE IF ( bc_dirichlet_r )  THEN
     4038            workarr_sn(0:pg%nz+1,0:2,iplw+1:iprw) = parent_array(0:pg%nz+1,jpbeg:jpbeg+2,iplw+1:iprw)
    39994039         ELSE
    4000             workarrc_sn(0:cg%nz+1,0:2,iclw+1:icrw-1)                            &
    4001                  = fc(0:cg%nz+1,mbeg:mbeg+2,iclw+1:icrw-1)
     4040            workarr_sn(0:pg%nz+1,0:2,iplw+1:iprw-1)                                                 &
     4041                 = parent_array(0:pg%nz+1,jpbeg:jpbeg+2,iplw+1:iprw-1)
    40024042         ENDIF
    40034043!
     
    40074047!--      the nest domain is not cyclic.
    40084048!--      From left to right
    4009          CALL MPI_SENDRECV( workarrc_sn(0,0,iclw+1), 1,                         &
    4010               workarrc_sn_exchange_type, pleft,   0,                            &
    4011               workarrc_sn(0,0,icrw), 1,                                         &
    4012               workarrc_sn_exchange_type, pright,  0,                            &
    4013               comm2d, status, ierr )
    4014 !
    4015 !--      From right to left       
    4016          CALL MPI_SENDRECV( workarrc_sn(0,0,icrw-1), 1,                         &
    4017               workarrc_sn_exchange_type, pright,  1,                            &
    4018               workarrc_sn(0,0,iclw), 1,                                         &
    4019               workarrc_sn_exchange_type, pleft,   1,                            &
    4020               comm2d, status, ierr )
    4021 #endif     
    4022       ELSE
    4023          workarrc_sn(0:cg%nz+1,0:2,iclw+1:icrw-1)                               &
    4024               = fc(0:cg%nz+1,mbeg:mbeg+2,iclw+1:icrw-1)
     4049         CALL MPI_SENDRECV( workarr_sn(0,0,iplw+1), 1, workarr_sn_exchange_type, pleft,   0,        &
     4050                            workarr_sn(0,0,iprw), 1, workarr_sn_exchange_type, pright, 0, comm2d,   &
     4051                            status, ierr )
     4052!                                                                           
     4053!--      From right to left                                                 
     4054         CALL MPI_SENDRECV( workarr_sn(0,0,iprw-1), 1, workarr_sn_exchange_type, pright,  1,        &
     4055                            workarr_sn(0,0,iplw), 1, workarr_sn_exchange_type, pleft, 1, comm2d,    &
     4056                            status, ierr )
     4057#endif                                                                     
     4058      ELSE                                                                 
     4059         workarr_sn(0:pg%nz+1,0:2,iplw+1:iprw-1)                                                    &
     4060              = parent_array(0:pg%nz+1,jpbeg:jpbeg+2,iplw+1:iprw-1)
    40254061      ENDIF
    40264062
    4027       IF  ( var == 'v' )  THEN
    4028 
    4029          DO  l = iclw, icrw
    4030             DO n = 0, kct
     4063      IF ( var == 'v' )  THEN
     4064
     4065         DO  ip = iplw, iprw
     4066            DO  kp = 0, kct
    40314067               
    4032                DO  i = ifl(l), ifu(l)
    4033                   DO  k = kfl(n), kfu(n)
    4034                      f(k,jbc,i) = workarrc_sn(n,mw,l)
     4068               DO  ic = ifl(ip), ifu(ip)
     4069                  DO  kc = kfl(kp), kfu(kp)
     4070                     child_array(kc,jcbc,ic) = workarr_sn(kp,jpw,ip)
    40354071                  ENDDO
    40364072               ENDDO
     
    40394075         ENDDO
    40404076
    4041       ELSE IF  ( var == 'u' )  THEN
     4077      ELSE IF ( var == 'u' )  THEN
    40424078         
    4043          DO  l = iclw, icrw-1
    4044             DO n = 0, kct
     4079         DO  ip = iplw, iprw - 1
     4080            DO  kp = 0, kct
    40454081!
    40464082!--            First interpolate to the flux point
    4047                f_interp_1 = cb * workarrc_sn(n,mw,l)   + cp * workarrc_sn(n,mwp,l)
    4048                f_interp_2 = cb * workarrc_sn(n,mw,l+1) + cp * workarrc_sn(n,mwp,l+1)
     4083               c_interp_1 = cb * workarr_sn(kp,jpw,ip)   + cp * workarr_sn(kp,jpwp,ip)
     4084               c_interp_2 = cb * workarr_sn(kp,jpw,ip+1) + cp * workarr_sn(kp,jpwp,ip+1)
    40494085!
    40504086!--            Use averages of the neighbouring matching grid-line values
    4051                DO  i = ifl(l), ifl(l+1)
    4052                   f(kfl(n):kfu(n),jbc,i) = 0.5_wp * ( f_interp_1 + f_interp_2 )
     4087               DO  ic = ifl(ip), ifl(ip+1)
     4088                  child_array(kfl(kp):kfu(kp),jcbc,ic) = 0.5_wp * ( c_interp_1 + c_interp_2 )
    40534089               ENDDO
    40544090!
    40554091!--            Then set the values along the matching grid-lines 
    4056                IF  ( MOD( ifl(l), igsr ) == 0 )  THEN
    4057                   f(kfl(n):kfu(n),jbc,ifl(l)) = f_interp_1
     4092               IF ( MOD( ifl(ip), igsr ) == 0 )  THEN
     4093                  child_array(kfl(kp):kfu(kp),jcbc,ifl(ip)) = c_interp_1
    40584094               ENDIF
    40594095
     
    40624098!
    40634099!--      Finally, set the values along the last matching grid-line 
    4064          IF  ( MOD( ifl(icrw), igsr ) == 0 )  THEN
    4065             DO  n = 0, kct
    4066                f_interp_1 = cb * workarrc_sn(n,mw,icrw) + cp * workarrc_sn(n,mwp,icrw)
    4067                f(kfl(n):kfu(n),jbc,ifl(icrw)) = f_interp_1
     4100         IF ( MOD( ifl(iprw), igsr ) == 0 )  THEN
     4101            DO  kp = 0, kct
     4102               c_interp_1 = cb * workarr_sn(kp,jpw,iprw) + cp * workarr_sn(kp,jpwp,iprw)
     4103               child_array(kfl(kp):kfu(kp),jcbc,ifl(iprw)) = c_interp_1
    40684104            ENDDO
    40694105         ENDIF
     
    40734109!--      gap. Note however, this operation may produce some additional
    40744110!--      momentum conservation error.
    4075          IF  ( ifl(icrw) < nxr )  THEN
    4076             DO  n = 0, kct
    4077                DO  i = ifl(icrw)+1, nxr
    4078                   f(kfl(n):kfu(n),jbc,i) = f(kfl(n):kfu(n),jbc,ifl(icrw))
     4111         IF ( ifl(iprw) < nxr )  THEN
     4112            DO  kp = 0, kct
     4113               DO  ic = ifl(iprw) + 1, nxr
     4114                  child_array(kfl(kp):kfu(kp),jcbc,ic) = child_array(kfl(kp):kfu(kp),jcbc,ifl(iprw))
    40794115               ENDDO
    40804116            ENDDO
    40814117         ENDIF
    40824118
    4083       ELSE IF  ( var == 'w' )  THEN
    4084 
    4085          DO  l = iclw, icrw
    4086             DO n = 0, kct + 1   ! It is important to go up to kct+1 
     4119      ELSE IF ( var == 'w' )  THEN
     4120
     4121         DO  ip = iplw, iprw
     4122            DO  kp = 0, kct + 1   ! It is important to go up to kct+1 
    40874123!
    40884124!--            Interpolate to the flux point
    4089                f_interp_1 = cb * workarrc_sn(n,mw,l) + cp * workarrc_sn(n,mwp,l)
    4090 !                 
    4091 !--            First substitute only the matching-node values                 
    4092                f(kfu(n),jbc,ifl(l):ifu(l)) = f_interp_1
     4125               c_interp_1 = cb * workarr_sn(kp,jpw,ip) + cp * workarr_sn(kp,jpwp,ip)
     4126!
     4127!--            First substitute only the matching-node values
     4128               child_array(kfu(kp),jcbc,ifl(ip):ifu(ip)) = c_interp_1
    40934129
    40944130            ENDDO
    40954131         ENDDO
    40964132
    4097          DO  l = iclw, icrw
    4098             DO n = 1, kct + 1   ! It is important to go up to kct+
     4133         DO  ip = iplw, iprw
     4134            DO  kp = 1, kct + 1   ! It is important to go up to kct +
    40994135!
    41004136!--            Then fill up the nodes in between with the averages
    4101                DO  k = kfu(n-1)+1, kfu(n)-1
    4102                   f(k,jbc,ifl(l):ifu(l)) = 0.5_wp * ( f(kfu(n-1),jbc,ifl(l):ifu(l)) &
    4103                        + f(kfu(n),jbc,ifl(l):ifu(l)) )
     4137               DO  kc = kfu(kp-1) + 1, kfu(kp) - 1
     4138                  child_array(kc,jcbc,ifl(ip):ifu(ip)) =                                            &
     4139                       0.5_wp * ( child_array(kfu(kp-1),jcbc,ifl(ip):ifu(ip))                       &
     4140                       + child_array(kfu(kp),jcbc,ifl(ip):ifu(ip)) )
    41044141               ENDDO
    41054142
     
    41094146      ELSE   ! Any scalar
    41104147         
    4111          DO  l = iclw, icrw
    4112             DO n = 0, kct
     4148         DO  ip = iplw, iprw
     4149            DO  kp = 0, kct
    41134150!
    41144151!--            Interpolate to the flux point
    4115                f_interp_1 = cb * workarrc_sn(n,mw,l) + cp * workarrc_sn(n,mwp,l)
    4116                DO  i = ifl(l), ifu(l)
    4117                   DO  k = kfl(n), kfu(n)
    4118                      f(k,jbc,i) = f_interp_1
     4152               c_interp_1 = cb * workarr_sn(kp,jpw,ip) + cp * workarr_sn(kp,jpwp,ip)
     4153               DO  ic = ifl(ip), ifu(ip)
     4154                  DO  kc = kfl(kp), kfu(kp)
     4155                     child_array(kc,jcbc,ic) = c_interp_1
    41194156                  ENDDO
    41204157               ENDDO
     
    41274164!--   Fill up also the redundant 2nd and 3rd ghost-node layers
    41284165      IF ( edge == 's' )  THEN
    4129          DO  jbgp = -nbgp, jb
    4130             f(0:nzt+1,jbgp,nxlg:nxrg) = f(0:nzt+1,jbc,nxlg:nxrg)
     4166         DO  jcbgp = -nbgp, jcb
     4167            child_array(0:nzt+1,jcbgp,nxlg:nxrg) = child_array(0:nzt+1,jcbc,nxlg:nxrg)
    41314168         ENDDO
    41324169      ELSEIF ( edge == 'n' )  THEN
    4133          DO  jbgp = jb, ny+nbgp
    4134             f(0:nzt+1,jbgp,nxlg:nxrg) = f(0:nzt+1,jbc,nxlg:nxrg)
     4170         DO  jcbgp = jcb, ny+nbgp
     4171            child_array(0:nzt+1,jcbgp,nxlg:nxrg) = child_array(0:nzt+1,jcbc,nxlg:nxrg)
    41354172         ENDDO
    41364173      ENDIF
     
    41404177
    41414178
    4142    SUBROUTINE pmci_interp_1sto_t( f, fc, kct, ifl, ifu, jfl, jfu, var )
     4179   SUBROUTINE pmci_interp_1sto_t( child_array, parent_array, kct, ifl, ifu, jfl, jfu, var )
    41434180!
    41444181!--   Interpolation of ghost-node values used as the child-domain boundary
     
    41464183      IMPLICIT NONE
    41474184
    4148       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(INOUT) ::  f    !< Child-grid array
    4149       REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr), INTENT(IN)        ::  fc   !< Parent-grid array
    4150       INTEGER(iwp), DIMENSION(icla:icra), INTENT(IN)    ::  ifl  !< Indicates start index of child cells belonging to certain parent cell - x direction
    4151       INTEGER(iwp), DIMENSION(icla:icra), INTENT(IN)    ::  ifu  !< Indicates end index of child cells belonging to certain parent cell - x direction
    4152       INTEGER(iwp), DIMENSION(jcsa:jcna), INTENT(IN)    ::  jfl  !< Indicates start index of child cells belonging to certain parent cell - y direction
    4153       INTEGER(iwp), DIMENSION(jcsa:jcna), INTENT(IN)    ::  jfu  !< Indicates end index of child cells belonging to certain parent cell - y direction
    4154       INTEGER(iwp) :: kct                                        !< The parent-grid index in z-direction just below the boundary value node
    4155       CHARACTER(LEN=1), INTENT(IN) :: var                        !< Variable symbol: 'u', 'v', 'w' or 's'
    4156 !
    4157 !--   Local variables:
     4185      INTEGER(iwp), INTENT(IN) ::  kct  !< The parent-grid index in z-direction just below the boundary value node
     4186     
     4187      INTEGER(iwp), DIMENSION(ipla:ipra), INTENT(IN) ::  ifl  !< Indicates start index of child cells belonging to certain
     4188                                                              !< parent cell - x direction
     4189      INTEGER(iwp), DIMENSION(ipla:ipra), INTENT(IN) ::  ifu  !< Indicates end index of child cells belonging to certain
     4190                                                              !< parent cell - x direction
     4191      INTEGER(iwp), DIMENSION(jpsa:jpna), INTENT(IN) ::  jfl  !< Indicates start index of child cells belonging to certain
     4192                                                              !< parent cell - y direction
     4193      INTEGER(iwp), DIMENSION(jpsa:jpna), INTENT(IN) ::  jfu  !< Indicates end index of child cells belonging to certain
     4194                                                              !< parent cell - y direction
     4195
     4196      REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(INOUT) ::  child_array   !< Child-grid array
     4197      REAL(wp), DIMENSION(0:pg%nz+1,jps:jpn,ipl:ipr), INTENT(IN)        ::  parent_array  !< Parent-grid array
     4198
     4199      CHARACTER(LEN=1), INTENT(IN) ::  var                    !< Variable symbol: 'u', 'v', 'w' or 's'
     4200!
     4201!--   Local variables:     
     4202      INTEGER(iwp) ::  ic          !< Running child-grid index in the x-direction
     4203      INTEGER(iwp) ::  ierr        !< MPI error code
     4204      INTEGER(iwp) ::  iplc        !< Lower parent-grid index limit in the x-direction for copying parent-grid
     4205                                   !< array data to workarr_t
     4206      INTEGER(iwp) ::  iprc        !< Upper parent-grid index limit in the x-direction for copying parent-grid
     4207                                   !< array data to workarr_t
     4208      INTEGER(iwp) ::  jc          !< Running child-grid index in the y-direction
     4209      INTEGER(iwp) ::  jpsc        !< Lower parent-grid index limit in the y-direction for copying parent-grid
     4210                                   !< array data to workarr_t
     4211      INTEGER(iwp) ::  jpnc        !< Upper parent-grid-index limit in the y-direction for copying parent-grid
     4212                                   !< array data to workarr_t
     4213      INTEGER(iwp) ::  kc          !< Vertical child-grid index fixed to the boundary-value level
     4214      INTEGER(iwp) ::  ip          !< Running parent-grid index in the x-direction
     4215      INTEGER(iwp) ::  jp          !< Running parent-grid index in the y-direction
     4216      INTEGER(iwp) ::  kpw         !< Reduced parent-grid index in the z-direction for workarr_t pointing to
     4217                                   !< the boundary ghost node
    41584218      REAL(wp)     ::  c31         !< Interpolation coefficient for the 3rd-order WS scheme
    41594219      REAL(wp)     ::  c32         !< Interpolation coefficient for the 3rd-order WS scheme
    41604220      REAL(wp)     ::  c33         !< Interpolation coefficient for the 3rd-order WS scheme
    4161       REAL(wp)     ::  f_interp_1  !< Value interpolated in z direction from the parent-grid data
    4162       REAL(wp)     ::  f_interp_2  !< Auxiliary value interpolated in z direction from the parent-grid data
    4163       INTEGER(iwp) ::  i           !< Child-grid index in x-direction
    4164       INTEGER(iwp) ::  iclc        !< Lower i-index limit for copying fc-data to workarrc_t
    4165       INTEGER(iwp) ::  icrc        !< Upper i-index limit for copying fc-data to workarrc_t
    4166       INTEGER(iwp) ::  ierr        !< MPI error code
    4167       INTEGER(iwp) ::  j           !< Child-grid index in y-direction
    4168       INTEGER(iwp) ::  jcsc        !< Lower j-index limit for copying fc-data to workarrc_t
    4169       INTEGER(iwp) ::  jcnc        !< Upper j-index limit for copying fc-data to workarrc_t
    4170       INTEGER(iwp) ::  k           !< Vertical child-grid index fixed to the boundary-value level
    4171       INTEGER(iwp) ::  l           !< Parent-grid index in x-direction
    4172       INTEGER(iwp) ::  m           !< Parent-grid index in y-direction
    4173       INTEGER(iwp) ::  nw          !< Reduced n-index for workarrc_t pointing to the boundary ghost node
     4221      REAL(wp)     ::  c_interp_1  !< Value interpolated to the flux point in z direction from the parent-grid data
     4222      REAL(wp)     ::  c_interp_2  !< Auxiliary value interpolated to the flux point in z direction from the parent-grid data
    41744223
    41754224
    41764225      IF ( var == 'w' )  THEN
    4177          k    = nzt
     4226         kc = nzt
    41784227      ELSE
    4179          k    = nzt + 1
     4228         kc = nzt + 1
    41804229      ENDIF
    4181       nw = 1
     4230      kpw = 1
    41824231!
    41834232!--   Interpolation coefficients
    4184       IF  ( interpolation_scheme_t == 1 )  THEN
     4233      IF ( interpolation_scheme_t == 1 )  THEN
    41854234         c31 =  0.0_wp           ! 1st-order upwind
    41864235         c32 =  1.0_wp
    41874236         c33 =  0.0_wp
    4188       ELSE IF  ( interpolation_scheme_t == 2 )  THEN
     4237      ELSE IF ( interpolation_scheme_t == 2 )  THEN
    41894238         c31 =  0.5_wp           ! 2nd-order central
    41904239         c32 =  0.5_wp
     
    41974246!
    41984247!--   Substitute the necessary parent-grid data to the work array.
    4199 !--   Note that the dimension of workarrc_t is (0:2,jcsw:jcnw,iclw:icrw),
     4248!--   Note that the dimension of workarr_t is (0:2,jpsw:jpnw,iplw:iprw),
    42004249!--   And the jc?w and ic?w-index bounds depend on the location of the PE-
    42014250!--   subdomain relative to the side boundaries.
    4202       iclc = iclw + 1
    4203       icrc = icrw - 1     
    4204       jcsc = jcsw + 1
    4205       jcnc = jcnw - 1
    4206       IF  ( bc_dirichlet_l )  THEN
    4207          iclc = iclw
     4251      iplc = iplw + 1
     4252      iprc = iprw - 1     
     4253      jpsc = jpsw + 1
     4254      jpnc = jpnw - 1
     4255      IF ( bc_dirichlet_l )  THEN
     4256         iplc = iplw
    42084257      ENDIF
    4209       IF  ( bc_dirichlet_r )  THEN
    4210          icrc = icrw
     4258      IF ( bc_dirichlet_r )  THEN
     4259         iprc = iprw
    42114260      ENDIF
    4212       IF  ( bc_dirichlet_s )  THEN
    4213          jcsc = jcsw
     4261      IF ( bc_dirichlet_s )  THEN
     4262         jpsc = jpsw
    42144263      ENDIF
    4215       IF  ( bc_dirichlet_n )  THEN
    4216          jcnc = jcnw
     4264      IF ( bc_dirichlet_n )  THEN
     4265         jpnc = jpnw
    42174266      ENDIF
    4218       workarrc_t = 0.0_wp
    4219 !      workarrc_t(-2:3,jcsc:jcnc,iclc:icrc) = fc(kct-2:kct+3,jcsc:jcnc,iclc:icrc)
    4220       workarrc_t(0:2,jcsc:jcnc,iclc:icrc) = fc(kct:kct+2,jcsc:jcnc,iclc:icrc)
     4267      workarr_t = 0.0_wp
     4268      workarr_t(0:2,jpsc:jpnc,iplc:iprc) = parent_array(kct:kct+2,jpsc:jpnc,iplc:iprc)
    42214269!
    42224270!--   Left-right exchange if more than one PE subdomain in the x-direction.
     
    42244272!--   not exchanged because the nest domain is not cyclic.
    42254273#if defined( __parallel )
    4226       IF  ( pdims(1) > 1 )  THEN
     4274      IF ( pdims(1) > 1 )  THEN
    42274275!
    42284276!--      From left to right
    4229          CALL MPI_SENDRECV( workarrc_t(0,jcsw,iclw+1), 1,                       &
    4230               workarrc_t_exchange_type_y, pleft,  0,                            &
    4231               workarrc_t(0,jcsw,icrw), 1,                                       &
    4232               workarrc_t_exchange_type_y, pright, 0,                            &
    4233               comm2d, status, ierr )
    4234 !
    4235 !--      From right to left       
    4236          CALL MPI_SENDRECV( workarrc_t(0,jcsw,icrw-1), 1,                       &
    4237               workarrc_t_exchange_type_y, pright, 1,                            &
    4238               workarrc_t(0,jcsw,iclw), 1,                                       &
    4239               workarrc_t_exchange_type_y, pleft,  1,                            &
    4240               comm2d, status, ierr )
    4241       ENDIF
    4242 !
    4243 !--   South-north exchange if more than one PE subdomain in the y-direction.
    4244 !--   Note that in case of 3-D nesting the south and north boundaries are
    4245 !--   not exchanged because the nest domain is not cyclic.
    4246       IF  ( pdims(2) > 1 )  THEN
    4247 !
    4248 !--      From south to north         
    4249          CALL MPI_SENDRECV( workarrc_t(0,jcsw+1,iclw), 1,                       &
    4250               workarrc_t_exchange_type_x, psouth, 2,                            &
    4251               workarrc_t(0,jcnw,iclw), 1,                                       &
    4252               workarrc_t_exchange_type_x, pnorth, 2,                            &
    4253               comm2d, status, ierr )
    4254 !
    4255 !--      From north to south       
    4256          CALL MPI_SENDRECV( workarrc_t(0,jcnw-1,iclw), 1,                       &
    4257               workarrc_t_exchange_type_x, pnorth, 3,                            &
    4258               workarrc_t(0,jcsw,iclw), 1,                                       &
    4259               workarrc_t_exchange_type_x, psouth, 3,                            &
    4260               comm2d, status, ierr )
     4277         CALL MPI_SENDRECV( workarr_t(0,jpsw,iplw+1), 1, workarr_t_exchange_type_y, pleft, 0,       &
     4278                            workarr_t(0,jpsw,iprw), 1, workarr_t_exchange_type_y, pright, 0,        &
     4279                            comm2d, status, ierr )
     4280!                                                                             
     4281!--      From right to left                                                   
     4282         CALL MPI_SENDRECV( workarr_t(0,jpsw,iprw-1), 1, workarr_t_exchange_type_y, pright, 1,      &
     4283                            workarr_t(0,jpsw,iplw), 1, workarr_t_exchange_type_y, pleft,  1,        &
     4284                            comm2d, status, ierr )                                           
     4285      ENDIF                                                                   
     4286!                                                                             
     4287!--   South-north exchange if more than one PE subdomain in the y-direction.   
     4288!--   Note that in case of 3-D nesting the south and north boundaries are     
     4289!--   not exchanged because the nest domain is not cyclic.                     
     4290      IF ( pdims(2) > 1 )  THEN                                               
     4291!                                                                             
     4292!--      From south to north                                                   
     4293         CALL MPI_SENDRECV( workarr_t(0,jpsw+1,iplw), 1, workarr_t_exchange_type_x, psouth, 2,      &
     4294                            workarr_t(0,jpnw,iplw), 1, workarr_t_exchange_type_x, pnorth, 2,        &
     4295                            comm2d, status, ierr )                                           
     4296!                                                                             
     4297!--      From north to south                                                   
     4298         CALL MPI_SENDRECV( workarr_t(0,jpnw-1,iplw), 1, workarr_t_exchange_type_x, pnorth, 3,      &
     4299                            workarr_t(0,jpsw,iplw), 1, workarr_t_exchange_type_x, psouth, 3,        &
     4300                            comm2d, status, ierr )
    42614301      ENDIF
    42624302#endif     
    42634303
    42644304      IF  ( var == 'w' )  THEN
    4265          DO  l = iclw, icrw
    4266             DO  m = jcsw, jcnw
     4305         DO  ip = iplw, iprw
     4306            DO  jp = jpsw, jpnw
    42674307 
    4268                DO  i = ifl(l), ifu(l)
    4269                   DO  j = jfl(m), jfu(m)
    4270                      f(k,j,i) = workarrc_t(nw,m,l)
     4308               DO  ic = ifl(ip), ifu(ip)
     4309                  DO  jc = jfl(jp), jfu(jp)
     4310                     child_array(kc,jc,ic) = workarr_t(kpw,jp,ip)
    42714311                  ENDDO
    42724312               ENDDO
     
    42774317      ELSE IF  ( var == 'u' )  THEN
    42784318
    4279          DO  l = iclw, icrw-1
    4280             DO  m = jcsw, jcnw
     4319         DO  ip = iplw, iprw - 1
     4320            DO  jp = jpsw, jpnw
    42814321!
    42824322!--            First interpolate to the flux point using the 3rd-order WS scheme
    4283                f_interp_1 = c31 * workarrc_t(nw-1,m,l)   + c32 * workarrc_t(nw,m,l)   + c33 * workarrc_t(nw+1,m,l)
    4284                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)
     4323               c_interp_1 = c31 * workarr_t(kpw-1,jp,ip)   + c32 * workarr_t(kpw,jp,ip)             &
     4324                          + c33 * workarr_t(kpw+1,jp,ip)
     4325               c_interp_2 = c31 * workarr_t(kpw-1,jp,ip+1) + c32 * workarr_t(kpw,jp,ip+1)           &
     4326                          + c33 * workarr_t(kpw+1,jp,ip+1)
    42854327!
    42864328!--            Use averages of the neighbouring matching grid-line values
    4287                DO  i = ifl(l), ifl(l+1)
    4288 !                  f(k,jfl(m):jfu(m),i) = 0.5_wp * ( workarrc_t(nw,m,l)   &
    4289 !                       + workarrc_t(nw,m,l+1) )
    4290                   f(k,jfl(m):jfu(m),i) = 0.5_wp * ( f_interp_1 + f_interp_2 )
     4329               DO  ic = ifl(ip), ifl(ip+1)
     4330                  child_array(kc,jfl(jp):jfu(jp),ic) = 0.5_wp * ( c_interp_1 + c_interp_2 )
    42914331               ENDDO
    42924332!
    42934333!--            Then set the values along the matching grid-lines 
    4294                IF  ( MOD( ifl(l), igsr ) == 0 )  THEN
    4295 !
    4296 !--            First interpolate to the flux point using the 3rd-order WS scheme
    4297                   f_interp_1 = c31 * workarrc_t(nw-1,m,l) + c32 * workarrc_t(nw,m,l) + c33 * workarrc_t(nw+1,m,l)                 
    4298 !                  f(k,jfl(m):jfu(m),ifl(l)) = workarrc_t(nw,m,l)
    4299                   f(k,jfl(m):jfu(m),ifl(l)) = f_interp_1
     4334               IF ( MOD( ifl(ip), igsr ) == 0 )  THEN
     4335!
     4336!--               First interpolate to the flux point using the 3rd-order WS scheme
     4337                  c_interp_1 = c31 * workarr_t(kpw-1,jp,ip) + c32 * workarr_t(kpw,jp,ip)            &
     4338                             + c33 * workarr_t(kpw+1,jp,ip)                 
     4339                  child_array(kc,jfl(jp):jfu(jp),ifl(ip)) = c_interp_1
    43004340               ENDIF
    43014341
     
    43044344!
    43054345!--      Finally, set the values along the last matching grid-line 
    4306          IF  ( MOD( ifl(icrw), igsr ) == 0 )  THEN
    4307             DO  m = jcsw, jcnw
     4346         IF  ( MOD( ifl(iprw), igsr ) == 0 )  THEN
     4347            DO  jp = jpsw, jpnw
    43084348!
    43094349!--            First interpolate to the flux point using the 3rd-order WS scheme
    4310                f_interp_1 = c31 * workarrc_t(nw-1,m,icrw) + c32 * workarrc_t(nw,m,icrw) + c33 * workarrc_t(nw+1,m,icrw)
    4311 !               f(k,jfl(m):jfu(m),ifl(icrw)) = workarrc_t(nw,m,icrw)
    4312                f(k,jfl(m):jfu(m),ifl(icrw)) = f_interp_1
     4350               c_interp_1 = c31 * workarr_t(kpw-1,jp,iprw) + c32 * workarr_t(kpw,jp,iprw)           &
     4351                          + c33 * workarr_t(kpw+1,jp,iprw)
     4352               child_array(kc,jfl(jp):jfu(jp),ifl(iprw)) = c_interp_1
    43134353            ENDDO
    43144354         ENDIF
     
    43184358!--      gap. Note however, this operation may produce some additional
    43194359!--      momentum conservation error.
    4320          IF  ( ifl(icrw) < nxr )  THEN
    4321             DO  m = jcsw, jcnw
    4322                DO  i = ifl(icrw)+1, nxr
    4323                   f(k,jfl(m):jfu(m),i) = f(k,jfl(m):jfu(m),ifl(icrw))
     4360         IF ( ifl(iprw) < nxr )  THEN
     4361            DO  jp = jpsw, jpnw
     4362               DO  ic = ifl(iprw) + 1, nxr
     4363                  child_array(kc,jfl(jp):jfu(jp),ic) = child_array(kc,jfl(jp):jfu(jp),ifl(iprw))
    43244364               ENDDO
    43254365            ENDDO
     
    43284368      ELSE IF  ( var == 'v' )  THEN
    43294369
    4330          DO  l = iclw, icrw
    4331             DO  m = jcsw, jcnw-1
     4370         DO  ip = iplw, iprw
     4371            DO  jp = jpsw, jpnw-1
    43324372!
    43334373!--            First interpolate to the flux point using the 3rd-order WS scheme
    4334                f_interp_1 = c31 * workarrc_t(nw-1,m,l)   + c32 * workarrc_t(nw,m,l)   + c33 * workarrc_t(nw+1,m,l)
    4335                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)
     4374               c_interp_1 = c31 * workarr_t(kpw-1,jp,ip)   + c32 * workarr_t(kpw,jp,ip)             &
     4375                          + c33 * workarr_t(kpw+1,jp,ip)
     4376               c_interp_2 = c31 * workarr_t(kpw-1,jp+1,ip) + c32 * workarr_t(kpw,jp+1,ip)           &
     4377                          + c33 * workarr_t(kpw+1,jp+1,ip)
    43364378!
    43374379!--            Use averages of the neighbouring matching grid-line values
    4338                DO  j = jfl(m), jfl(m+1)         
    4339 !                  f(k,j,ifl(l):ifu(l)) = 0.5_wp * ( workarrc_t(nw,m,l)   &
    4340 !                       + workarrc_t(nw,m+1,l) )
    4341                   f(k,j,ifl(l):ifu(l)) = 0.5_wp * ( f_interp_1 + f_interp_2 )
     4380               DO  jc = jfl(jp), jfl(jp+1)         
     4381                  child_array(kc,jc,ifl(ip):ifu(ip)) = 0.5_wp * ( c_interp_1 + c_interp_2 )
    43424382               ENDDO
    43434383!
    43444384!--            Then set the values along the matching grid-lines 
    4345                IF  ( MOD( jfl(m), jgsr ) == 0 )  THEN
    4346                   f_interp_1 = c31 * workarrc_t(nw-1,m,l) + c32 * workarrc_t(nw,m,l) + c33 * workarrc_t(nw+1,m,l)
    4347 !                  f(k,jfl(m),ifl(l):ifu(l)) = workarrc_t(nw,m,l)
    4348                   f(k,jfl(m),ifl(l):ifu(l)) = f_interp_1
     4385               IF ( MOD( jfl(jp), jgsr ) == 0 )  THEN
     4386                  c_interp_1 = c31 * workarr_t(kpw-1,jp,ip) + c32 * workarr_t(kpw,jp,ip)            &
     4387                             + c33 * workarr_t(kpw+1,jp,ip)
     4388                  child_array(kc,jfl(jp),ifl(ip):ifu(ip)) = c_interp_1
    43494389               ENDIF
    43504390               
     
    43544394!
    43554395!--      Finally, set the values along the last matching grid-line
    4356          IF  ( MOD( jfl(jcnw), jgsr ) == 0 )  THEN
    4357             DO  l = iclw, icrw
     4396         IF ( MOD( jfl(jpnw), jgsr ) == 0 )  THEN
     4397            DO  ip = iplw, iprw
    43584398!
    43594399!--            First interpolate to the flux point using the 3rd-order WS scheme
    4360                f_interp_1 = c31 * workarrc_t(nw-1,jcnw,l) + c32 * workarrc_t(nw,jcnw,l) + c33 * workarrc_t(nw+1,jcnw,l)
    4361 !               f(k,jfl(jcnw),ifl(l):ifu(l)) = workarrc_t(nw,jcnw,l)
    4362                f(k,jfl(jcnw),ifl(l):ifu(l)) = f_interp_1
     4400               c_interp_1 = c31 * workarr_t(kpw-1,jpnw,ip) + c32 * workarr_t(kpw,jpnw,ip)           &
     4401                          + c33 * workarr_t(kpw+1,jpnw,ip)
     4402               child_array(kc,jfl(jpnw),ifl(ip):ifu(ip)) = c_interp_1
    43634403            ENDDO
    43644404         ENDIF
     
    43684408!--      gap. Note however, this operation may produce some additional
    43694409!--      momentum conservation error.
    4370          IF  ( jfl(jcnw) < nyn )  THEN
    4371             DO  l = iclw, icrw
    4372                DO  j = jfl(jcnw)+1, nyn
    4373                   f(k,j,ifl(l):ifu(l)) = f(k,jfl(jcnw),ifl(l):ifu(l))
     4410         IF  ( jfl(jpnw) < nyn )  THEN
     4411            DO  ip = iplw, iprw
     4412               DO  jc = jfl(jpnw)+1, nyn
     4413                  child_array(kc,jc,ifl(ip):ifu(ip)) = child_array(kc,jfl(jpnw),ifl(ip):ifu(ip))
    43744414               ENDDO
    43754415            ENDDO
     
    43784418      ELSE  ! any scalar variable
    43794419
    4380          DO  l = iclw, icrw
    4381             DO  m = jcsw, jcnw
     4420         DO  ip = iplw, iprw
     4421            DO  jp = jpsw, jpnw
    43824422!
    43834423!--            First interpolate to the flux point using the 3rd-order WS scheme
    4384                f_interp_1 = c31 * workarrc_t(nw-1,m,l) + c32 * workarrc_t(nw,m,l) + c33 * workarrc_t(nw+1,m,l)
    4385                DO  i = ifl(l), ifu(l)
    4386                   DO  j = jfl(m), jfu(m)
    4387 !                     f(k,j,i) = workarrc_t(nw,m,l)
    4388                      f(k,j,i) = f_interp_1
     4424               c_interp_1 = c31 * workarr_t(kpw-1,jp,ip) + c32 * workarr_t(kpw,jp,ip)               &
     4425                          + c33 * workarr_t(kpw+1,jp,ip)
     4426               DO  ic = ifl(ip), ifu(ip)
     4427                  DO  jc = jfl(jp), jfu(jp)
     4428                     child_array(kc,jc,ic) = c_interp_1
    43894429                  ENDDO
    43904430               ENDDO
     
    43974437!--   Just fill up the redundant second ghost-node layer in case of var == w.
    43984438      IF ( var == 'w' )  THEN
    4399          f(nzt+1,:,:) = f(nzt,:,:)
     4439         child_array(nzt+1,:,:) = child_array(nzt,:,:)
    44004440      ENDIF
    44014441
     
    44044444
    44054445
    4406    SUBROUTINE pmci_anterp_tophat( f, fc, kct, ifl, ifu, jfl, jfu, kfl, kfu, ijkfc, var )
     4446   SUBROUTINE pmci_anterp_tophat( child_array, parent_array, kct, ifl, ifu, jfl, jfu, kfl, kfu,     &
     4447                                  ijkfc, var )
    44074448!
    44084449!--   Anterpolation of internal-node values to be used as the parent-domain
     
    44134454      IMPLICIT NONE
    44144455
    4415       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(IN) ::  f         !< Child-grid array
    4416       REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr), INTENT(INOUT)  ::  fc        !< Parent-grid array
    4417       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
    4418       INTEGER(iwp), INTENT(IN) ::  kct                                             !< Top boundary index for anterpolation along z
    4419       INTEGER(iwp), DIMENSION(icla:icra), INTENT(IN) ::  ifl !< Indicates start index of child cells belonging to certain parent cell - x direction
    4420       INTEGER(iwp), DIMENSION(icla:icra), INTENT(IN) ::  ifu !< Indicates end index of child cells belonging to certain parent cell - x direction
    4421       INTEGER(iwp), DIMENSION(jcsa:jcna), INTENT(IN) ::  jfl !< Indicates start index of child cells belonging to certain parent cell - y direction
    4422       INTEGER(iwp), DIMENSION(jcsa:jcna), INTENT(IN) ::  jfu !< Indicates end index of child cells belonging to certain parent cell - y direction
    4423       INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN) ::  kfl !< Indicates start index of child cells belonging to certain parent cell - z direction
    4424       INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN) ::  kfu !< Indicates end index of child cells belonging to certain parent cell - z direction
     4456      INTEGER(iwp), INTENT(IN) ::  kct  !< Top boundary index for anterpolation along z
     4457     
     4458      INTEGER(iwp), DIMENSION(0:pg%nz+1,jpsa:jpna,ipla:ipra), INTENT(IN) ::  ijkfc  !< number of child grid points contributing
     4459                                                                                    !< to a parent grid box
     4460      INTEGER(iwp), DIMENSION(ipla:ipra), INTENT(IN) ::  ifl  !< Indicates start index of child cells belonging to certain
     4461                                                              !< parent cell - x direction
     4462      INTEGER(iwp), DIMENSION(ipla:ipra), INTENT(IN) ::  ifu  !< Indicates end index of child cells belonging to certain
     4463                                                              !< parent cell - x direction
     4464      INTEGER(iwp), DIMENSION(jpsa:jpna), INTENT(IN) ::  jfl  !< Indicates start index of child cells belonging to certain
     4465                                                              !< parent cell - y direction
     4466      INTEGER(iwp), DIMENSION(jpsa:jpna), INTENT(IN) ::  jfu  !< Indicates end index of child cells belonging to certain
     4467                                                              !< parent cell - y direction
     4468      INTEGER(iwp), DIMENSION(0:pg%nz+1), INTENT(IN) ::  kfl  !< Indicates start index of child cells belonging to certain
     4469                                                              !< parent cell - z direction
     4470      INTEGER(iwp), DIMENSION(0:pg%nz+1), INTENT(IN) ::  kfu  !< Indicates end index of child cells belonging to certain
     4471                                                              !< parent cell - z direction
     4472
     4473      REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(IN) ::  child_array   !< Child-grid array
     4474      REAL(wp), DIMENSION(0:pg%nz+1,jps:jpn,ipl:ipr), INTENT(INOUT)  ::  parent_array  !< Parent-grid array
     4475
    44254476      CHARACTER(LEN=*), INTENT(IN) ::  var                   !< Variable symbol: 'u', 'v', 'w' or 's'
    44264477!
    44274478!--   Local variables: 
     4479      INTEGER(iwp) ::  ic              !< Running index x-direction - child grid
     4480      INTEGER(iwp) ::  ipl_anterp      !< Left boundary index for anterpolation along x
     4481      INTEGER(iwp) ::  ipr_anterp      !< Right boundary index for anterpolation along x
     4482      INTEGER(iwp) ::  jc              !< Running index y-direction - child grid
     4483      INTEGER(iwp) ::  jpn_anterp      !< North boundary index for anterpolation along y
     4484      INTEGER(iwp) ::  jps_anterp      !< South boundary index for anterpolation along y
     4485      INTEGER(iwp) ::  kc              !< Running index z-direction - child grid     
     4486      INTEGER(iwp) ::  kpb_anterp = 0  !< Bottom boundary index for anterpolation along z
     4487      INTEGER(iwp) ::  kpt_anterp      !< Top boundary index for anterpolation along z
     4488      INTEGER(iwp) ::  ip              !< Running index x-direction - parent grid
     4489      INTEGER(iwp) ::  jp              !< Running index y-direction - parent grid
     4490      INTEGER(iwp) ::  kp              !< Running index z-direction - parent grid
     4491      INTEGER(iwp) ::  var_flag        !< bit number used to flag topography on respective grid
     4492
    44284493      REAL(wp) ::  cellsum       !< sum of respective child cells belonging to parent cell
    4429       INTEGER(iwp) ::  i         !< Running index x-direction - child grid
    4430       INTEGER(iwp) ::  iclant    !< Left boundary index for anterpolation along x
    4431       INTEGER(iwp) ::  icrant    !< Right boundary index for anterpolation along x
    4432       INTEGER(iwp) ::  j         !< Running index y-direction - child grid
    4433       INTEGER(iwp) ::  jcnant    !< North boundary index for anterpolation along y
    4434       INTEGER(iwp) ::  jcsant    !< South boundary index for anterpolation along y
    4435       INTEGER(iwp) ::  k         !< Running index z-direction - child grid     
    4436       INTEGER(iwp) ::  kcb = 0   !< Bottom boundary index for anterpolation along z
    4437       INTEGER(iwp) ::  kctant    !< Top boundary index for anterpolation along z
    4438       INTEGER(iwp) ::  l         !< Running index x-direction - parent grid
    4439       INTEGER(iwp) ::  m         !< Running index y-direction - parent grid
    4440       INTEGER(iwp) ::  n         !< Running index z-direction - parent grid
    4441       INTEGER(iwp) ::  var_flag  !< bit number used to flag topography on respective grid
    4442 
    4443 !
    4444 !--   Define the index bounds iclant, icrant, jcsant and jcnant.
    4445 !--   Note that kcb is simply zero and kct enters here as a parameter and it is
    4446 !--   determined in pmci_define_index_mapping.
     4494
     4495!
     4496!--   Define the index bounds ipl_anterp, ipr_anterp, jps_anterp and jpn_anterp.
     4497!--   Note that kcb_anterp is simply zero and kct_anterp enters here as a
     4498!--   parameter and it is determined in pmci_define_index_mapping.
    44474499!--   Note that the grid points used also for interpolation (from parent to
    4448 !--   child) are excluded in anterpolation, e.g. anterpolation is only from
    4449 !--   nzb:kct-1, as kct is used for interpolation. An additional buffer is
     4500!--   child) are always excluded from anterpolation, e.g. anterpolation is maximally
     4501!--   only from nzb:kct-1, as kct is used for interpolation. Similar restriction is
     4502!--   applied to the lateral boundaries as well. An additional buffer is
    44504503!--   also applied (default value for anterpolation_buffer_width = 2) in order
    44514504!--   to avoid unphysical accumulation of kinetic energy.
    4452       iclant = icl
    4453       icrant = icr
    4454       jcsant = jcs
    4455       jcnant = jcn
    4456 !      kctant = kct - 1
    4457       kctant = kct - 1 - anterpolation_buffer_width
    4458       kcb  = 0
     4505      ipl_anterp = ipl
     4506      ipr_anterp = ipr
     4507      jps_anterp = jps
     4508      jpn_anterp = jpn
     4509      kpb_anterp = 0
     4510      kpt_anterp = kct - 1 - anterpolation_buffer_width
     4511
    44594512      IF ( nesting_mode /= 'vertical' )  THEN
    44604513!
    44614514!--      Set the anterpolation buffers on the lateral boundaries
    4462          iclant = MAX( icl, iplg + 3 + anterpolation_buffer_width )
    4463          icrant = MIN( icr, iprg - 3 - anterpolation_buffer_width )
    4464          jcsant = MAX( jcs, jpsg + 3 + anterpolation_buffer_width )
    4465          jcnant = MIN( jcn, jpng - 3 - anterpolation_buffer_width )
     4515         ipl_anterp = MAX( ipl, iplg + 3 + anterpolation_buffer_width )
     4516         ipr_anterp = MIN( ipr, iprg - 3 - anterpolation_buffer_width )
     4517         jps_anterp = MAX( jps, jpsg + 3 + anterpolation_buffer_width )
     4518         jpn_anterp = MIN( jpn, jpng - 3 - anterpolation_buffer_width )
    44664519         
    44674520      ENDIF
     
    44784531      ENDIF
    44794532!
    4480 !--   Note that l, m, and n are parent-grid indices and i,j, and k
     4533!--   Note that ip, jp, and kp are parent-grid indices and ic,jc, and kc
    44814534!--   are child-grid indices.
    4482       DO  l = iclant, icrant
    4483          DO  m = jcsant, jcnant
     4535      DO  ip = ipl_anterp, ipr_anterp
     4536         DO  jp = jps_anterp, jpn_anterp
    44844537!
    44854538!--         For simplicity anterpolate within buildings and under elevated
    44864539!--         terrain too
    4487             DO  n = kcb, kctant
     4540            DO  kp = kpb_anterp, kpt_anterp
    44884541               cellsum = 0.0_wp
    4489                DO  i = ifl(l), ifu(l)
    4490                   DO  j = jfl(m), jfu(m)
    4491                      DO  k = kfl(n), kfu(n)
    4492                         cellsum = cellsum + MERGE( f(k,j,i), 0.0_wp,          &
    4493                              BTEST( wall_flags_0(k,j,i), var_flag ) )
     4542               DO  ic = ifl(ip), ifu(ip)
     4543                  DO  jc = jfl(jp), jfu(jp)
     4544                     DO  kc = kfl(kp), kfu(kp)
     4545                        cellsum = cellsum + MERGE( child_array(kc,jc,ic), 0.0_wp,                   &
     4546                             BTEST( wall_flags_0(kc,jc,ic), var_flag ) )
    44944547                     ENDDO
    44954548                  ENDDO
     
    45014554!--            particular for the temperature. Therefore, in case cellsum is
    45024555!--            zero, keep the parent solution at this point.
    4503 
    4504                IF ( ijkfc(n,m,l) /= 0 )  THEN
    4505                   fc(n,m,l) = cellsum / REAL( ijkfc(n,m,l), KIND=wp )
     4556               IF ( ijkfc(kp,jp,ip) /= 0 )  THEN
     4557                  parent_array(kp,jp,ip) = cellsum / REAL( ijkfc(kp,jp,ip), KIND=wp )
    45064558               ENDIF
    45074559
     
    45394591    IMPLICIT NONE
    45404592
    4541     INTEGER(iwp) ::  i   !< Index along x-direction
    4542     INTEGER(iwp) ::  ib  !< running index for aerosol size bins
    4543     INTEGER(iwp) ::  ic  !< running index for aerosol mass bins
    4544     INTEGER(iwp) ::  ig  !< running index for salsa gases
    4545     INTEGER(iwp) ::  j   !< Index along y-direction
    4546     INTEGER(iwp) ::  k   !< Index along z-direction
     4593    INTEGER(iwp) ::  ic  !< Index along x-direction
     4594    INTEGER(iwp) ::  jc  !< Index along y-direction
     4595    INTEGER(iwp) ::  kc  !< Index along z-direction
     4596    INTEGER(iwp) ::  lb  !< Running index for aerosol size bins
     4597    INTEGER(iwp) ::  lc  !< Running index for aerosol mass bins
     4598    INTEGER(iwp) ::  lg  !< Running index for salsa gases
    45474599    INTEGER(iwp) ::  m   !< Running index for surface type
    4548     INTEGER(iwp) ::  n   !< running index for number of chemical species
    4549 
     4600    INTEGER(iwp) ::  n   !< Running index for number of chemical species
     4601   
    45504602!
    45514603!-- Set Dirichlet boundary conditions for horizontal velocity components
     
    45544606!--    Upward-facing surfaces
    45554607       DO  m = 1, bc_h(0)%ns
    4556           i = bc_h(0)%i(m)           
    4557           j = bc_h(0)%j(m)
    4558           k = bc_h(0)%k(m)
    4559           u(k-1,j,i) = 0.0_wp
    4560           v(k-1,j,i) = 0.0_wp
     4608          ic = bc_h(0)%i(m)           
     4609          jc = bc_h(0)%j(m)
     4610          kc = bc_h(0)%k(m)
     4611          u(kc-1,jc,ic) = 0.0_wp
     4612          v(kc-1,jc,ic) = 0.0_wp
    45614613       ENDDO
    45624614!
    45634615!--    Downward-facing surfaces
    45644616       DO  m = 1, bc_h(1)%ns
    4565           i = bc_h(1)%i(m)           
    4566           j = bc_h(1)%j(m)
    4567           k = bc_h(1)%k(m)
    4568           u(k+1,j,i) = 0.0_wp
    4569           v(k+1,j,i) = 0.0_wp
     4617          ic = bc_h(1)%i(m)           
     4618          jc = bc_h(1)%j(m)
     4619          kc = bc_h(1)%k(m)
     4620          u(kc+1,jc,ic) = 0.0_wp
     4621          v(kc+1,jc,ic) = 0.0_wp
    45704622       ENDDO
    45714623    ENDIF
     
    45744626!-- Upward-facing surfaces
    45754627    DO  m = 1, bc_h(0)%ns
    4576        i = bc_h(0)%i(m)           
    4577        j = bc_h(0)%j(m)
    4578        k = bc_h(0)%k(m)
    4579        w(k-1,j,i) = 0.0_wp
     4628       ic = bc_h(0)%i(m)           
     4629       jc = bc_h(0)%j(m)
     4630       kc = bc_h(0)%k(m)
     4631       w(kc-1,jc,ic) = 0.0_wp
    45804632    ENDDO
    45814633!
    45824634!-- Downward-facing surfaces
    45834635    DO  m = 1, bc_h(1)%ns
    4584        i = bc_h(1)%i(m)           
    4585        j = bc_h(1)%j(m)
    4586        k = bc_h(1)%k(m)
    4587        w(k+1,j,i) = 0.0_wp
     4636       ic = bc_h(1)%i(m)           
     4637       jc = bc_h(1)%j(m)
     4638       kc = bc_h(1)%k(m)
     4639       w(kc+1,jc,ic) = 0.0_wp
    45884640    ENDDO
    45894641!
     
    45924644       IF ( ibc_pt_b == 1 )  THEN
    45934645          DO  m = 1, bc_h(0)%ns
    4594              i = bc_h(0)%i(m)           
    4595              j = bc_h(0)%j(m)
    4596              k = bc_h(0)%k(m)
    4597              pt(k-1,j,i) = pt(k,j,i)
     4646             ic = bc_h(0)%i(m)           
     4647             jc = bc_h(0)%j(m)
     4648             kc = bc_h(0)%k(m)
     4649             pt(kc-1,jc,ic) = pt(kc,jc,ic)
    45984650          ENDDO
    45994651          DO  m = 1, bc_h(1)%ns
    4600              i = bc_h(1)%i(m)           
    4601              j = bc_h(1)%j(m)
    4602              k = bc_h(1)%k(m)
    4603              pt(k+1,j,i) = pt(k,j,i)
     4652             ic = bc_h(1)%i(m)           
     4653             jc = bc_h(1)%j(m)
     4654             kc = bc_h(1)%k(m)
     4655             pt(kc+1,jc,ic) = pt(kc,jc,ic)
    46044656          ENDDO   
    46054657       ENDIF
     
    46104662       IF ( ibc_q_b == 1 )  THEN
    46114663          DO  m = 1, bc_h(0)%ns
    4612              i = bc_h(0)%i(m)           
    4613              j = bc_h(0)%j(m)
    4614              k = bc_h(0)%k(m)
    4615              q(k-1,j,i) = q(k,j,i)
     4664             ic = bc_h(0)%i(m)           
     4665             jc = bc_h(0)%j(m)
     4666             kc = bc_h(0)%k(m)
     4667             q(kc-1,jc,ic) = q(kc,jc,ic)
    46164668          ENDDO 
    46174669          DO  m = 1, bc_h(1)%ns
    4618              i = bc_h(1)%i(m)           
    4619              j = bc_h(1)%j(m)
    4620              k = bc_h(1)%k(m)
    4621              q(k+1,j,i) = q(k,j,i)
     4670             ic = bc_h(1)%i(m)           
     4671             jc = bc_h(1)%j(m)
     4672             kc = bc_h(1)%k(m)
     4673             q(kc+1,jc,ic) = q(kc,jc,ic)
    46224674          ENDDO 
    46234675       ENDIF
    46244676       IF ( bulk_cloud_model  .AND.  microphysics_morrison )  THEN
    46254677          DO  m = 1, bc_h(0)%ns
    4626              i = bc_h(0)%i(m)           
    4627              j = bc_h(0)%j(m)
    4628              k = bc_h(0)%k(m)
    4629              nc(k-1,j,i) = 0.0_wp
    4630              qc(k-1,j,i) = 0.0_wp
     4678             ic = bc_h(0)%i(m)           
     4679             jc = bc_h(0)%j(m)
     4680             kc = bc_h(0)%k(m)
     4681             nc(kc-1,jc,ic) = 0.0_wp
     4682             qc(kc-1,jc,ic) = 0.0_wp
    46314683          ENDDO 
    46324684          DO  m = 1, bc_h(1)%ns
    4633              i = bc_h(1)%i(m)           
    4634              j = bc_h(1)%j(m)
    4635              k = bc_h(1)%k(m)
    4636 
    4637              nc(k+1,j,i) = 0.0_wp
    4638              qc(k+1,j,i) = 0.0_wp
     4685             ic = bc_h(1)%i(m)           
     4686             jc = bc_h(1)%j(m)
     4687             kc = bc_h(1)%k(m)
     4688
     4689             nc(kc+1,jc,ic) = 0.0_wp
     4690             qc(kc+1,jc,ic) = 0.0_wp
    46394691          ENDDO 
    46404692       ENDIF
     
    46424694       IF ( bulk_cloud_model  .AND.  microphysics_seifert )  THEN
    46434695          DO  m = 1, bc_h(0)%ns
    4644              i = bc_h(0)%i(m)           
    4645              j = bc_h(0)%j(m)
    4646              k = bc_h(0)%k(m)
    4647              nr(k-1,j,i) = 0.0_wp
    4648              qr(k-1,j,i) = 0.0_wp
     4696             ic = bc_h(0)%i(m)           
     4697             jc = bc_h(0)%j(m)
     4698             kc = bc_h(0)%k(m)
     4699             nr(kc-1,jc,ic) = 0.0_wp
     4700             qr(kc-1,jc,ic) = 0.0_wp
    46494701          ENDDO 
    46504702          DO  m = 1, bc_h(1)%ns
    4651              i = bc_h(1)%i(m)           
    4652              j = bc_h(1)%j(m)
    4653              k = bc_h(1)%k(m)
    4654              nr(k+1,j,i) = 0.0_wp
    4655              qr(k+1,j,i) = 0.0_wp
     4703             ic = bc_h(1)%i(m)           
     4704             jc = bc_h(1)%j(m)
     4705             kc = bc_h(1)%k(m)
     4706             nr(kc+1,jc,ic) = 0.0_wp
     4707             qr(kc+1,jc,ic) = 0.0_wp
    46564708          ENDDO 
    46574709       ENDIF
     
    46634715       IF ( ibc_s_b == 1 )  THEN
    46644716          DO  m = 1, bc_h(0)%ns
    4665              i = bc_h(0)%i(m)           
    4666              j = bc_h(0)%j(m)
    4667              k = bc_h(0)%k(m)
    4668              s(k-1,j,i) = s(k,j,i)
     4717             ic = bc_h(0)%i(m)           
     4718             jc = bc_h(0)%j(m)
     4719             kc = bc_h(0)%k(m)
     4720             s(kc-1,jc,ic) = s(kc,jc,ic)
    46694721          ENDDO
    46704722          DO  m = 1, bc_h(1)%ns
    4671              i = bc_h(1)%i(m)           
    4672              j = bc_h(1)%j(m)
    4673              k = bc_h(1)%k(m)
    4674              s(k+1,j,i) = s(k,j,i)
     4723             ic = bc_h(1)%i(m)           
     4724             jc = bc_h(1)%j(m)
     4725             kc = bc_h(1)%k(m)
     4726             s(kc+1,jc,ic) = s(kc,jc,ic)
    46754727          ENDDO 
    46764728       ENDIF
     
    46824734          DO  n = 1, nspec
    46834735             DO  m = 1, bc_h(0)%ns
    4684                 i = bc_h(0)%i(m)           
    4685                 j = bc_h(0)%j(m)
    4686                 k = bc_h(0)%k(m)
    4687                 chem_species(n)%conc(k-1,j,i) = chem_species(n)%conc(k,j,i)
     4736                ic = bc_h(0)%i(m)           
     4737                jc = bc_h(0)%j(m)
     4738                kc = bc_h(0)%k(m)
     4739                chem_species(n)%conc(kc-1,jc,ic) = chem_species(n)%conc(kc,jc,ic)
    46884740             ENDDO
    46894741             DO  m = 1, bc_h(1)%ns
    4690                 i = bc_h(1)%i(m)           
    4691                 j = bc_h(1)%j(m)
    4692                 k = bc_h(1)%k(m)
    4693                 chem_species(n)%conc(k+1,j,i) = chem_species(n)%conc(k,j,i)
     4742                ic = bc_h(1)%i(m)           
     4743                jc = bc_h(1)%j(m)
     4744                kc = bc_h(1)%k(m)
     4745                chem_species(n)%conc(kc+1,jc,ic) = chem_species(n)%conc(kc,jc,ic)
    46944746             ENDDO
    46954747          ENDDO
     
    47014753       IF ( ibc_salsa_b == 1 )  THEN
    47024754          DO  m = 1, bc_h(0)%ns
    4703              i = bc_h(0)%i(m)
    4704              j = bc_h(0)%j(m)
    4705              k = bc_h(0)%k(m)
    4706              DO  ib = 1, nbins_aerosol
    4707                 aerosol_number(ib)%conc(k-1,j,i) = aerosol_number(ib)%conc(k,j,i)
     4755             ic = bc_h(0)%i(m)
     4756             jc = bc_h(0)%j(m)
     4757             kc = bc_h(0)%k(m)
     4758             DO  lb = 1, nbins_aerosol
     4759                aerosol_number(lb)%conc(kc-1,jc,ic) = aerosol_number(lb)%conc(kc,jc,ic)
    47084760             ENDDO
    4709              DO  ic = 1, nbins_aerosol * ncomponents_mass
    4710                 aerosol_mass(ic)%conc(k-1,j,i) = aerosol_mass(ic)%conc(k,j,i)
     4761             DO  lc = 1, nbins_aerosol * ncomponents_mass
     4762                aerosol_mass(lc)%conc(kc-1,jc,ic) = aerosol_mass(lc)%conc(kc,jc,ic)
    47114763             ENDDO
    47124764             IF ( .NOT. salsa_gases_from_chem )  THEN
    4713                 DO  ig = 1, ngases_salsa
    4714                    salsa_gas(ig)%conc(k-1,j,i) = salsa_gas(ig)%conc(k,j,i)
     4765                DO  lg = 1, ngases_salsa
     4766                   salsa_gas(lg)%conc(kc-1,jc,ic) = salsa_gas(lg)%conc(kc,jc,ic)
    47154767                ENDDO
    47164768             ENDIF
    47174769          ENDDO
    47184770          DO  m = 1, bc_h(1)%ns
    4719              i = bc_h(1)%i(m)
    4720              j = bc_h(1)%j(m)
    4721              k = bc_h(1)%k(m)
    4722              DO  ib = 1, nbins_aerosol
    4723                 aerosol_number(ib)%conc(k+1,j,i) = aerosol_number(ib)%conc(k,j,i)
     4771             ic = bc_h(1)%i(m)
     4772             jc = bc_h(1)%j(m)
     4773             kc = bc_h(1)%k(m)
     4774             DO  lb = 1, nbins_aerosol
     4775                aerosol_number(lb)%conc(kc+1,jc,ic) = aerosol_number(lb)%conc(kc,jc,ic)
    47244776             ENDDO
    4725              DO  ic = 1, nbins_aerosol * ncomponents_mass
    4726                 aerosol_mass(ic)%conc(k+1,j,i) = aerosol_mass(ic)%conc(k,j,i)
     4777             DO  lc = 1, nbins_aerosol * ncomponents_mass
     4778                aerosol_mass(lc)%conc(kc+1,jc,ic) = aerosol_mass(lc)%conc(kc,jc,ic)
    47274779             ENDDO
    47284780             IF ( .NOT. salsa_gases_from_chem )  THEN
    4729                 DO  ig = 1, ngases_salsa
    4730                    salsa_gas(ig)%conc(k+1,j,i) = salsa_gas(ig)%conc(k,j,i)
     4781                DO  lg = 1, ngases_salsa
     4782                   salsa_gas(lg)%conc(kc+1,jc,ic) = salsa_gas(lg)%conc(kc,jc,ic)
    47314783                ENDDO
    47324784             ENDIF
     
    47364788
    47374789 END SUBROUTINE pmci_boundary_conds
    4738 
    4739 
     4790   
    47404791END MODULE pmc_interface
  • palm/trunk/SOURCE/pmc_particle_interface.f90

    r3655 r3883  
    2626! -----------------!
    2727! $Id$
     28! Function get_number_of_childs renamed to get_number_of_children and cg
     29! renamed to pg according to their definitions in pmc_interface_mod
     30!
     31! 3655 2019-01-07 16:51:22Z knoop
    2832! unused variables removed
    2933!
     
    102106
    103107   USE pmc_interface,                                                          &
    104        ONLY: cpl_id, get_number_of_childs, nr_part,  part_adr, nested_run,     &
    105              get_childid, get_child_edges, nr_partc,  part_adrc,               &
    106              coarse_bound, coord_x, coord_y, cg,   get_child_gridspacing,      &
     108       ONLY: cpl_id, get_number_of_children, nr_part, part_adr, nested_run,    &
     109             get_childid, get_child_edges, nr_partc, part_adrc,                &
     110             coarse_bound, coord_x, coord_y, pg, get_child_gridspacing,        &
    107111             lower_left_coord_x, lower_left_coord_y
    108112
     
    199203#if defined( __parallel )
    200204
    201     nr_childs = get_number_of_childs()
     205    nr_childs = get_number_of_children()
    202206!
    203207!-- Check if the current model has child models
     
    293297!
    294298!-- If the model has child models prepare the structures for transfer
    295     nr_childs = get_number_of_childs()
     299    nr_childs = get_number_of_children()
    296300    IF ( nr_childs > 0 )   THEN
    297301       ALLOCATE( particle_win_parent(nr_childs) )
     
    452456!
    453457!--    compute number of fine grid cells in coarse grid (one direction)
    454        xx = (cg%dx + eps) / dx ! +eps to avoid rounding error
    455        yy = (cg%dy + eps) / dy
     458       xx = ( pg%dx + eps ) / dx ! +eps to avoid rounding error
     459       yy = ( pg%dy + eps ) / dy
    456460       nr_fine_in_coarse = MAX( INT(xx), INT(yy) )
    457461
    458        IF ( MOD( coord_x(0), cg%dx ) /= 0.0 .OR. MOD( coord_y(0), cg%dy ) /= 0.0 ) THEN
     462       IF ( MOD( coord_x(0), pg%dx ) /= 0.0 .OR. MOD( coord_y(0), pg%dy ) /= 0.0 ) THEN
    459463          nr_fine_in_coarse = nr_fine_in_coarse + 1
    460464       ENDIF
     
    555559    TYPE(pedef), POINTER ::  ape !< TO_DO Klaus: give a description and better name of the variable
    556560
    557     DO  m = 1, get_number_of_childs()
     561    DO  m = 1, get_number_of_children()
    558562
    559563       child_id = get_childid(m)
     
    664668
    665669#if defined( __parallel )
    666     DO  m = 1, get_number_of_childs()
     670    DO  m = 1, get_number_of_children()
    667671
    668672       child_id = get_childid(m)
     
    728732   
    729733#if defined( __parallel )
    730     DO  m = 1, get_number_of_childs()
     734    DO  m = 1, get_number_of_children()
    731735       CALL get_child_edges( m, lx_coord, lx_coord_b, rx_coord, rx_coord_b,    &
    732736                                sy_coord, sy_coord_b, ny_coord, ny_coord_b,    &
     
    10471051
    10481052                   IF ( boundary_particle ) THEN                     
    1049