Changeset 3484 for palm


Ignore:
Timestamp:
Nov 2, 2018 2:41:25 PM (6 years ago)
Author:
hellstea
Message:

Nesting interpolation made mass-conservative

Location:
palm/trunk/SOURCE
Files:
3 edited

Legend:

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

    r3458 r3484  
    2525! -----------------
    2626! $Id$
     27! pmci_ensure_nest_mass_conservation removed permanently
     28!
     29! 3458 2018-10-30 14:51:23Z kanani
    2730! from chemistry branch r3443, forkel:
    2831! removed double do_emis check around CALL chem_init
     
    308311    USE pmc_interface,                                                         &
    309312        ONLY:  nested_run, pmci_child_initialize, pmci_init,                   &
    310                pmci_modelconfiguration, pmci_parent_initialize,                &
    311                pmci_ensure_nest_mass_conservation
     313               pmci_modelconfiguration, pmci_parent_initialize
    312314
    313315    USE write_restart_data_mod,                                                &
  • palm/trunk/SOURCE/pmc_interface_mod.f90

    r3274 r3484  
    2525! -----------------
    2626! $Id$
     27! Introduction of reversibility correction to the interpolation routines in order to
     28! guarantee mass and scalar conservation through the nest boundaries. Several errors
     29! are corrected and pmci_ensure_nest_mass_conservation is permanently removed.
     30!
     31! 3274 2018-09-24 15:42:55Z knoop
    2732! Modularization of all bulk cloud physics code components
    2833!
     
    366371    USE pegrid,                                                                &
    367372        ONLY:  collective_wait, comm1dx, comm1dy, comm2d, myid, myidx, myidy,  &
    368                numprocs
     373               numprocs, pleft, pnorth, pright, psouth, status
    369374
    370375    USE pmc_child,                                                             &
     
    417422    INTEGER(iwp), SAVE      ::  cpl_parent_id         !<
    418423!
    419 !-- Control parameters, will be made input parameters later
     424!-- Control parameters
    420425    CHARACTER(LEN=7), SAVE ::  nesting_datatransfer_mode = 'mixed'  !< steering
    421426                                                         !< parameter for data-
     
    441446
    442447!
    443 !-- Child coarse data arrays
    444     INTEGER(iwp), DIMENSION(5),PUBLIC           ::  coarse_bound   !<
     448!-- Children's parent-grid arrays
     449    INTEGER(iwp), SAVE, DIMENSION(5), PUBLIC    ::  coarse_bound        !< subdomain index bounds for children's parent-grid arrays
     450    INTEGER(iwp), SAVE, DIMENSION(4), PUBLIC    ::  coarse_bound_anterp !< subdomain index bounds for anterpolation
    445451
    446452    REAL(wp), SAVE                              ::  xexl           !<
     
    492498    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r1zw   !<
    493499    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r2zw   !<
     500    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  celltmpd !<
    494501!
    495502!-- Child index arrays and log-ratio arrays for the log-law near-wall
     
    534541!
    535542!-- Upper bounds for k in anterpolation.
    536     INTEGER(iwp), SAVE ::  kctu   !<
     543    INTEGER(iwp), SAVE ::  kcto   !<
    537544    INTEGER(iwp), SAVE ::  kctw   !<
    538545!
     
    599606
    600607    TYPE(coarsegrid_def), SAVE, PUBLIC     ::  cg   !<
    601 
    602 !-  Variables for particle coupling
    603 
     608!
     609!-- Variables for particle coupling
    604610    TYPE, PUBLIC :: childgrid_def
    605611       INTEGER(iwp)                        ::  nx                   !<
     
    641647    END INTERFACE pmci_datatrans
    642648
    643     INTERFACE pmci_ensure_nest_mass_conservation
    644        MODULE PROCEDURE pmci_ensure_nest_mass_conservation
    645     END INTERFACE
    646 
    647649    INTERFACE pmci_init
    648650       MODULE PROCEDURE pmci_init
     
    687689    PUBLIC pmci_child_initialize
    688690    PUBLIC pmci_datatrans
    689     PUBLIC pmci_ensure_nest_mass_conservation
    690691    PUBLIC pmci_init
    691692    PUBLIC pmci_modelconfiguration
     
    891892       IF ( myid == 0 )  THEN
    892893
    893           CALL pmc_recv_from_child( child_id, val,  size(val),  0, 123, ierr )
    894           CALL pmc_recv_from_child( child_id, fval, size(fval), 0, 124, ierr )
     894          CALL pmc_recv_from_child( child_id, val,  SIZE(val),  0, 123, ierr )
     895          CALL pmc_recv_from_child( child_id, fval, SIZE(fval), 0, 124, ierr )
    895896         
    896897          nx_cl     = val(1)
     
    983984                   mid = pmc_parent_for_child(mm)
    984985!
    985 !--                Check Only different nest level
     986!--                Check only different nest levels
    986987                   IF (m_couplers(child_id)%parent_id /= m_couplers(mid)%parent_id)  THEN
    987988                      IF ( ( ch_xl(m) < ch_xr(mm) .OR.                         &
     
    10001001          DEALLOCATE( cl_coord_x )
    10011002          DEALLOCATE( cl_coord_y )
    1002 
    10031003!
    10041004!--       Send information about operating mode (LES or RANS) to child. This will be
     
    12191219
    12201220    INTEGER(iwp) ::  i          !<
    1221     INTEGER(iwp) ::  ierr       !<
    1222     INTEGER(iwp) ::  icl        !<
    1223     INTEGER(iwp) ::  icr        !<
    1224     INTEGER(iwp) ::  j          !<
    1225     INTEGER(iwp) ::  jcn        !<
    1226     INTEGER(iwp) ::  jcs        !<
     1221    INTEGER(iwp) ::  ierr       !<
     1222    INTEGER(iwp) ::  icl        !< left index limit for children's parent-grid arrays
     1223    INTEGER(iwp) ::  icla       !< left index limit for anterpolation
     1224    INTEGER(iwp) ::  icr        !< left index limit for children's parent-grid arrays
     1225    INTEGER(iwp) ::  icra       !< right index limit for anterpolation
     1226    INTEGER(iwp) ::  j          !<
     1227    INTEGER(iwp) ::  jcn        !< north index limit for children's parent-grid arrays
     1228    INTEGER(iwp) ::  jcna       !< north index limit for anterpolation
     1229    INTEGER(iwp) ::  jcs        !< sout index limit for children's parent-grid arrays
     1230    INTEGER(iwp) ::  jcsa       !< south index limit for anterpolation
    12271231    INTEGER(iwp) ::  n          !< running index for number of chemical species
    12281232
     
    13741378!--    Get coarse grid coordinates and values of the z-direction from the parent
    13751379       IF ( myid == 0)  THEN
    1376 
    13771380          CALL pmc_recv_from_parent( cg%coord_x, cg%nx+1+2*nbgp, 0, 24, ierr )
    13781381          CALL pmc_recv_from_parent( cg%coord_y, cg%ny+1+2*nbgp, 0, 25, ierr )
    1379           CALL pmc_recv_from_parent( cg%dzu, cg%nz + 1, 0, 26, ierr )
    1380           CALL pmc_recv_from_parent( cg%dzw, cg%nz + 1, 0, 27, ierr )
    1381           CALL pmc_recv_from_parent( cg%zu, cg%nz + 2, 0, 28, ierr )
    1382           CALL pmc_recv_from_parent( cg%zw, cg%nz + 2, 0, 29, ierr )
    1383 
     1382          CALL pmc_recv_from_parent( cg%dzu, cg%nz+1, 0, 26, ierr )
     1383          CALL pmc_recv_from_parent( cg%dzw, cg%nz+1, 0, 27, ierr )
     1384          CALL pmc_recv_from_parent( cg%zu, cg%nz+2, 0, 28, ierr )
     1385          CALL pmc_recv_from_parent( cg%zw, cg%nz+2, 0, 29, ierr )
    13841386       ENDIF
    13851387!
     
    13921394       CALL MPI_BCAST( cg%zw, cg%nz+2,  MPI_REAL, 0, comm2d, ierr )
    13931395       CALL MPI_BCAST( rans_mode_parent, 1, MPI_LOGICAL, 0, comm2d, ierr )
    1394  
    13951396!
    13961397!--    Find the index bounds for the nest domain in the coarse-grid index space
     
    14411442!--    Precompute the index arrays and relaxation functions for the
    14421443!--    anterpolation
    1443        IF ( TRIM( nesting_mode ) == 'two-way' .OR.                             &
    1444                   nesting_mode == 'vertical' )  THEN
    1445           CALL pmci_init_anterp_tophat
    1446        ENDIF
     1444!
     1445!--    Note that the anterpolation index bounds are needed also in case
     1446!--    of one-way coupling because of the reversibility correction
     1447!--    included in the interpolation algorithms.
     1448       CALL pmci_init_anterp_tophat
    14471449!
    14481450!--    Finally, compute the total area of the top-boundary face of the domain.
     
    14631465       INTEGER(iwp), DIMENSION(5,numprocs) ::  coarse_bound_all   !<
    14641466       INTEGER(iwp), DIMENSION(2)          ::  size_of_array      !<
    1465                                              
     1467                                   
     1468       INTEGER(iwp) :: i        !<   
     1469       INTEGER(iwp) :: ijaux    !<
     1470       INTEGER(iwp) :: j        !<
    14661471       REAL(wp) ::  loffset     !<
    14671472       REAL(wp) ::  noffset     !<
     
    15361541       coarse_bound(5) = myid
    15371542!
     1543!--    Determine the anterpolation index limits. If at least half of the
     1544!--    parent-grid cell is within the current child sub-domain, then it
     1545!--    is included in the current sub-domain's anterpolation domain.
     1546!--    Else the parent-grid cell is included in the neighbouring subdomain's
     1547!--    anterpolation domain, or not included at all if we are at the outer
     1548!--    edge of the child domain.
     1549       DO  i = 0, cg%nx
     1550          IF ( cg%coord_x(i) + 0.5_wp * cg%dx >= coord_x(nxl) )  THEN
     1551             icla = MAX( 0, i )
     1552             EXIT
     1553          ENDIF
     1554       ENDDO
     1555       DO  i = cg%nx, 0 , -1
     1556          IF ( cg%coord_x(i) + 0.5_wp * cg%dx <= coord_x(nxr+1) )  THEN
     1557             icra = MIN( cg%nx, i )
     1558             EXIT
     1559          ENDIF
     1560       ENDDO
     1561       DO  j = 0, cg%ny
     1562          IF ( cg%coord_y(j) + 0.5_wp * cg%dy >= coord_y(nys) )  THEN
     1563             jcsa = MAX( 0, j )
     1564             EXIT
     1565          ENDIF
     1566       ENDDO
     1567       DO  j = cg%ny, 0 , -1
     1568          IF ( cg%coord_y(j) + 0.5_wp * cg%dy <= coord_y(nyn+1) )  THEN
     1569             jcna = MIN( cg%ny, j )
     1570             EXIT
     1571          ENDIF
     1572       ENDDO
     1573!
     1574!--    Make sure that the indexing is contiguous
     1575       IF ( nxl == 0 )  THEN
     1576          CALL MPI_SEND( icra, 1, MPI_INTEGER, pright, 717, comm2d, ierr )
     1577       ELSE IF ( nxr == nx )  THEN
     1578          CALL MPI_RECV( ijaux, 1, MPI_INTEGER, pleft, 717, comm2d, status, ierr )
     1579          icla = ijaux + 1
     1580       ELSE
     1581          CALL MPI_SEND( icra, 1, MPI_INTEGER, pright, 717, comm2d, ierr )
     1582          CALL MPI_RECV( ijaux, 1, MPI_INTEGER, pleft, 717, comm2d, status, ierr )
     1583          icla = ijaux + 1
     1584       ENDIF
     1585       IF ( nys == 0 )  THEN
     1586          CALL MPI_SEND( jcna, 1, MPI_INTEGER, pnorth, 719, comm2d, ierr )
     1587       ELSE IF ( nyn == ny )  THEN
     1588          CALL MPI_RECV( ijaux, 1, MPI_INTEGER, psouth, 719, comm2d, status, ierr )
     1589          jcsa = ijaux + 1
     1590       ELSE
     1591          CALL MPI_SEND( jcna, 1, MPI_INTEGER, pnorth, 719, comm2d, ierr )
     1592          CALL MPI_RECV( ijaux, 1, MPI_INTEGER, psouth, 719, comm2d, status, ierr )
     1593          jcsa = ijaux + 1
     1594       ENDIF
     1595
     1596       write(9,"('Anterpolation bounds: ',4(i3,2x))") icla, icra, jcsa, jcna
     1597       flush(9)
     1598       coarse_bound_anterp(1) = icla
     1599       coarse_bound_anterp(2) = icra
     1600       coarse_bound_anterp(3) = jcsa
     1601       coarse_bound_anterp(4) = jcna
     1602!
    15381603!--    Note that MPI_Gather receives data from all processes in the rank order
    15391604!--    TO_DO: refer to the line where this fact becomes important
     
    15611626       IMPLICIT NONE
    15621627
     1628       INTEGER(iwp) ::  acsize  !<
    15631629       INTEGER(iwp) ::  i       !<
    15641630       INTEGER(iwp) ::  j       !<
     
    15681634       INTEGER(iwp) ::  kdzw    !<       
    15691635
     1636       REAL(wp) ::  dzmin       !<
     1637       REAL(wp) ::  parentdzmax !<
    15701638       REAL(wp) ::  xb          !<
    15711639       REAL(wp) ::  xcsu        !<
     
    15831651       REAL(wp) ::  zfsw        !<
    15841652     
    1585 
     1653       
    15861654       xb = nxl * dx
    15871655       yb = nys * dy
     
    16581726          r1zo(k) = 1.0_wp - r2zo(k)
    16591727       ENDDO
     1728!
     1729!--    Determine the maximum dimension of anterpolation cells and allocate the
     1730!--    work array celltmpd needed in the reversibility correction in the
     1731!--    interpolation
     1732       dzmin = 999999.9_wp
     1733       DO k = 1, nzt+1
     1734          dzmin = MIN( dzmin, dzu(k), dzw(k) )
     1735       ENDDO
     1736       parentdzmax = 0.0_wp
     1737       DO k = 1, cg%nz+1
     1738          parentdzmax = MAX(parentdzmax , cg%dzu(k), cg%dzw(k) )
     1739       ENDDO
     1740       acsize = CEILING( cg%dx / dx ) * CEILING( cg%dy / dy ) *                 &
     1741            CEILING( parentdzmax / dzmin )
     1742       ALLOCATE( celltmpd(1:acsize) )
     1743!       write(9,"('acsize: ',i3,2(e12.5,2x))") acsize, dzmin, parentdzmax
    16601744     
    16611745    END SUBROUTINE pmci_init_interp_tril
     
    30073091       REAL(wp)     ::  xi       !<
    30083092       REAL(wp)     ::  eta      !<
     3093       REAL(wp)     ::  tolerance !<
    30093094       REAL(wp)     ::  zeta     !<
    30103095     
     
    30273112       ENDIF
    30283113!
    3029 !--    First determine kctu and kctw that are the coarse-grid upper bounds for
     3114!--    First determine kcto and kctw that are the coarse-grid upper bounds for
    30303115!--    index k
    30313116       kk = 0
     
    30333118          kk = kk + 1
    30343119       ENDDO
    3035        kctu = kk - 1
     3120       kcto = kk - 1
    30363121
    30373122       kk = 0
     
    30493134       ALLOCATE( jfuv(jcs:jcn) )
    30503135       ALLOCATE( jfuo(jcs:jcn) )
    3051        ALLOCATE( kflw(0:kctw) )
    3052        ALLOCATE( kflo(0:kctu) )
    3053        ALLOCATE( kfuw(0:kctw) )
    3054        ALLOCATE( kfuo(0:kctu) )
    3055 
    3056        ALLOCATE( ijkfc_u(0:kctu,jcs:jcn,icl:icr) )
    3057        ALLOCATE( ijkfc_v(0:kctu,jcs:jcn,icl:icr) )
    3058        ALLOCATE( ijkfc_w(0:kctw,jcs:jcn,icl:icr) )
    3059        ALLOCATE( ijkfc_s(0:kctu,jcs:jcn,icl:icr) )
     3136       ALLOCATE( kflw(0:cg%nz+1) )
     3137       ALLOCATE( kflo(0:cg%nz+1) )
     3138       ALLOCATE( kfuw(0:cg%nz+1) )
     3139       ALLOCATE( kfuo(0:cg%nz+1) )
     3140
     3141       ALLOCATE( ijkfc_u(0:cg%nz+1,jcs:jcn,icl:icr) )
     3142       ALLOCATE( ijkfc_v(0:cg%nz+1,jcs:jcn,icl:icr) )
     3143       ALLOCATE( ijkfc_w(0:cg%nz+1,jcs:jcn,icl:icr) )
     3144       ALLOCATE( ijkfc_s(0:cg%nz+1,jcs:jcn,icl:icr) )
     3145
    30603146       ijkfc_u = 0
    30613147       ijkfc_v = 0
     
    30653151!--    i-indices of u for each ii-index value
    30663152!--    ii=icr is redundant for anterpolation
     3153       tolerance = 0.000001_wp * dx
    30673154       istart = nxlg
    30683155       DO  ii = icl, icr-1
     3156!
     3157!--       In case the child and parent grid lines match in x
     3158!--       use only the local k,j-child-grid plane for the anterpolation,
     3159!--       i.e use 2-D anterpolation. Else, use a 3-D anterpolation.
    30693160          i = istart
    3070           DO  WHILE ( ( coord_x(i) < cg%coord_x(ii) - 0.5_wp * cg%dx )  .AND.  &
    3071                       ( i < nxrg ) )
    3072              i  = i + 1
     3161          DO WHILE ( coord_x(i) < cg%coord_x(ii) - tolerance  .AND.  i < nxrg )
     3162             i = i + 1
    30733163          ENDDO
    3074           iflu(ii) = MIN( MAX( i, nxlg ), nxrg )
    3075           ir = i
    3076           DO  WHILE ( ( coord_x(ir) <= cg%coord_x(ii) + 0.5_wp * cg%dx )  .AND.&
    3077                       ( i < nxrg+1 ) )
    3078              i  = i + 1
    3079              ir = MIN( i, nxrg )
    3080           ENDDO
    3081           ifuu(ii) = MIN( MAX( i-1, iflu(ii) ), nxrg )
    3082           istart = iflu(ii)
     3164          IF ( ABS( coord_x(i) - cg%coord_x(ii) ) < tolerance )  THEN
     3165             i = istart
     3166             DO WHILE ( coord_x(i) < cg%coord_x(ii) .AND. i < nxrg )
     3167                i = i + 1
     3168             ENDDO
     3169             iflu(ii) = MIN( MAX( i, nxlg ), nxrg )
     3170             ifuu(ii) = iflu(ii)
     3171             istart   = iflu(ii)
     3172          ELSE
     3173             i = istart
     3174             DO  WHILE ( ( coord_x(i) < cg%coord_x(ii) - 0.5_wp * cg%dx )       &
     3175                  .AND.  ( i < nxrg ) )
     3176                i  = i + 1
     3177             ENDDO
     3178             iflu(ii) = MIN( MAX( i, nxlg ), nxrg )
     3179             ir = i
     3180             DO  WHILE ( ( coord_x(ir) <= cg%coord_x(ii) + 0.5_wp * cg%dx )     &
     3181                  .AND.  ( i < nxrg+1 ) )
     3182                i  = i + 1
     3183                ir = MIN( i, nxrg )
     3184             ENDDO
     3185             ifuu(ii) = MIN( MAX( i-1, iflu(ii) ), nxrg )
     3186             istart = iflu(ii)
     3187          ENDIF
     3188!AH
     3189          write(9,"('pmci_init_anterp_tophat, ii, iflu, ifuu: ', 3(i4,2x))")    &
     3190               ii, iflu(ii), ifuu(ii)
     3191          flush(9)
     3192
    30833193       ENDDO
    30843194       iflu(icr) = nxrg
     
    31043214          istart = iflo(ii)
    31053215       ENDDO
     3216!AH
     3217       write(9,"('pmci_init_anterp_tophat, ii, iflo, ifuo: ', 3(i4,2x))")    &
     3218            ii, iflo(ii), ifuo(ii)
     3219       flush(9)
     3220         
    31063221       iflo(icr) = nxrg
    31073222       ifuo(icr) = nxrg
     
    31093224!--    j-indices of v for each jj-index value
    31103225!--    jj=jcn is redundant for anterpolation
     3226       tolerance = 0.000001_wp * dy
    31113227       jstart = nysg
    31123228       DO  jj = jcs, jcn-1
     3229!
     3230!--       In case the child and parent grid lines match in y
     3231!--       use only the local k,i-child-grid plane for the anterpolation,
     3232!--       i.e use 2-D anterpolation. Else, use a 3-D anterpolation.
    31133233          j = jstart
    3114           DO  WHILE ( ( coord_y(j) < cg%coord_y(jj) - 0.5_wp * cg%dy )  .AND.  &
    3115                       ( j < nyng ) )
    3116              j  = j + 1
     3234          DO WHILE ( coord_y(j) < cg%coord_y(jj) - tolerance  .AND.  j < nyng )
     3235             j = j + 1
    31173236          ENDDO
    3118           jflv(jj) = MIN( MAX( j, nysg ), nyng )
    3119           jr = j
    3120           DO  WHILE ( ( coord_y(jr) <= cg%coord_y(jj) + 0.5_wp * cg%dy )  .AND.&
    3121                       ( j < nyng+1 ) )
    3122              j  = j + 1
    3123              jr = MIN( j, nyng )
    3124           ENDDO
    3125           jfuv(jj) = MIN( MAX( j-1, jflv(jj) ), nyng )
    3126           jstart = jflv(jj)
     3237          IF ( ABS( coord_y(j) - cg%coord_y(jj) ) < tolerance )  THEN
     3238             j = jstart
     3239             DO WHILE ( coord_y(j) < cg%coord_y(jj) .AND. j < nyng )
     3240                j = j + 1
     3241             ENDDO
     3242             jflv(jj) = MIN( MAX( j, nysg ), nyng )
     3243             jfuv(jj) = jflv(jj)
     3244             jstart   = jflv(jj)
     3245          ELSE
     3246             j = jstart
     3247             DO  WHILE ( ( coord_y(j) < cg%coord_y(jj) - 0.5_wp * cg%dy )       &
     3248                  .AND.  ( j < nyng ) )
     3249                j  = j + 1
     3250             ENDDO
     3251             jflv(jj) = MIN( MAX( j, nysg ), nyng )
     3252             jr = j
     3253             DO  WHILE ( ( coord_y(jr) <= cg%coord_y(jj) + 0.5_wp * cg%dy )     &
     3254                  .AND.  ( j < nyng+1 ) )
     3255                j  = j + 1
     3256                jr = MIN( j, nyng )
     3257             ENDDO
     3258             jfuv(jj) = MIN( MAX( j-1, jflv(jj) ), nyng )
     3259             jstart = jflv(jj)
     3260          ENDIF
     3261!AH
     3262          write(9,"('pmci_init_anterp_tophat, jj, jflv, jfuv: ', 3(i4,2x))")    &
     3263               jj, jflv(jj), jfuv(jj)
     3264          flush(9)
     3265
    31273266       ENDDO
    31283267       jflv(jcn) = nyng
     
    31473286          jfuo(jj) = MIN( MAX( j-1, jflo(jj) ), nyng )
    31483287          jstart = jflo(jj)
     3288!AH
     3289          write(9,"('pmci_init_anterp_tophat, ii, jflo, jfuo: ', 3(i4,2x))")    &
     3290               jj, jflo(jj), jfuo(jj)
     3291          flush(9)
     3292
    31493293       ENDDO
    31503294       jflo(jcn) = nyng
     
    31523296!
    31533297!--    k-indices of w for each kk-index value
     3298!--    Note that anterpolation index limits are needed also for the top boundary
     3299!--    ghost cell level because of the reversibility correction in the interpolation.
    31543300       kstart  = 0
    31553301       kflw(0) = 0
    31563302       kfuw(0) = 0
    3157        DO  kk = 1, kctw
     3303       tolerance = 0.000001_wp * dzw(1)
     3304       DO kk = 1, cg%nz+1
     3305!
     3306!--       In case the child and parent grid lines match in z
     3307!--       use only the local j,i-child-grid plane for the anterpolation,
     3308!--       i.e use 2-D anterpolation. Else, use a 3-D anterpolation.
    31583309          k = kstart
    3159           DO  WHILE ( ( zw(k) < cg%zu(kk) )  .AND.  ( k < nzt ) )
     3310          DO WHILE ( zw(k) < cg%zw(kk) - tolerance  .AND.  k < nzt+1 )
    31603311             k = k + 1
    31613312          ENDDO
    3162           kflw(kk) = MIN( MAX( k, 1 ), nzt + 1 )
    3163           DO  WHILE ( ( zw(k) <= cg%zu(kk+1) )  .AND.  ( k < nzt+1 ) )
    3164              k  = k + 1
    3165           ENDDO
    3166           kfuw(kk) = MIN( MAX( k-1, kflw(kk) ), nzt + 1 )
    3167           kstart = kflw(kk)
     3313          IF ( ABS( zw(k) - cg%zw(kk) ) < tolerance )  THEN
     3314             k = kstart
     3315             DO WHILE ( ( zw(k) < cg%zw(kk) )  .AND.  ( k < nzt+1 ) )
     3316                k = k + 1
     3317             ENDDO
     3318             kflw(kk) = MIN( MAX( k, 1 ), nzt + 1 )
     3319             kfuw(kk) = kflw(kk)
     3320             kstart   = kflw(kk)
     3321          ELSE
     3322             k = kstart
     3323             DO  WHILE ( ( zw(k) < cg%zu(kk) )  .AND.  ( k < nzt ) )
     3324                k = k + 1
     3325             ENDDO
     3326             kflw(kk) = MIN( MAX( k, 1 ), nzt + 1 )
     3327             IF ( kk+1 <= cg%nz+1 )  THEN
     3328                DO  WHILE ( ( zw(k) <= cg%zu(kk+1) )  .AND.  ( k < nzt+1 ) )
     3329                   k  = k + 1
     3330                   IF ( k > nzt + 1 ) EXIT  ! This EXIT is to prevent zu(k) from flowing over.
     3331                ENDDO
     3332                kfuw(kk) = MIN( MAX( k-1, kflw(kk) ), nzt + 1 )
     3333             ELSE
     3334                kfuw(kk) = kflw(kk)
     3335             ENDIF
     3336             kstart = kflw(kk)
     3337          ENDIF
     3338!AH
     3339          write(9,"('pmci_init_anterp_tophat, kk, kflw, kfuw: ', 3(i4,2x))") &
     3340               kk, kflw(kk), kfuw(kk)
     3341          flush(9)
     3342
    31683343       ENDDO
    31693344!
     
    31723347       kflo(0) = 0
    31733348       kfuo(0) = 0
    3174        DO  kk = 1, kctu
     3349!
     3350!--    Note that anterpolation index limits are needed also for the top boundary
     3351!--    ghost cell level because of the reversibility correction in the interpolation.
     3352!AH       DO  kk = 1, kcto+1
     3353       DO  kk = 1, cg%nz+1
    31753354          k = kstart
    3176           DO  WHILE ( ( zu(k) < cg%zw(kk-1) )  .AND.  ( k < nzt ) )
     3355!AH          DO  WHILE ( ( zu(k) < cg%zw(kk-1) )  .AND.  ( k < nzt ) )
     3356!--       Note that this is an IMPORTANT correction for the reversibility correction
     3357          DO  WHILE ( ( zu(k) < cg%zw(kk-1) )  .AND.  ( k <= nzt ) )
    31773358             k = k + 1
    31783359          ENDDO
    31793360          kflo(kk) = MIN( MAX( k, 1 ), nzt + 1 )
    3180           DO  WHILE ( ( zu(k) <= cg%zw(kk) )  .AND.  ( k < nzt+1 ) )
     3361!AH          DO  WHILE ( ( zu(k) <= cg%zw(kk) )  .AND.  ( k < nzt+1 ) )
     3362!--       Note that this is an IMPORTANT correction for the reversibility correction
     3363          DO  WHILE ( ( zu(k) <= cg%zw(kk) )  .AND.  ( k <= nzt+1 ) )
    31813364             k = k + 1
     3365             IF ( k > nzt + 1 ) EXIT  ! This EXIT is to prevent zu(k) from flowing over.
    31823366          ENDDO
    31833367          kfuo(kk) = MIN( MAX( k-1, kflo(kk) ), nzt + 1 )
    31843368          kstart = kflo(kk)
     3369!AH
     3370          write(9,"('init kflo, kfuo: ', 4(i3,2x), e12.5)") kk, kflo(kk), kfuo(kk), nzt,  cg%zw(kk)
     3371          flush(9)
    31853372       ENDDO
    31863373!
    3187 !--    Precomputation of number of fine-grid nodes inside coarse-grid ij-faces.
    3188 !--    Note that ii, jj, and kk are coarse-grid indices.
     3374!--    Precomputation of number of fine-grid nodes inside parent-grid cells.
     3375!--    Note that ii, jj, and kk are parent-grid indices.
    31893376!--    This information is needed in anterpolation.
    31903377       DO  ii = icl, icr
    31913378          DO  jj = jcs, jcn
    3192              DO kk = 0, kctu
     3379!AH             DO kk = 0, kcto+1
     3380             DO kk = 0, cg%nz+1
    31933381!
    31943382!--             u-component
     
    32233411             ENDDO
    32243412
    3225              DO kk = 0, kctw
     3413!AH             DO kk = 0, kctw+1
     3414             DO kk = 0, cg%nz+1
    32263415!
    32273416!--             w-component
     
    32593448             ENDIF
    32603449          ENDDO
    3261 
    32623450
    32633451          DO  jj = jcs, jcn
     
    32753463       ENDIF
    32763464     
    3277        ALLOCATE( fraz(0:kctu) )
    3278        DO  kk = 0, kctu
     3465       ALLOCATE( fraz(0:kcto) )
     3466       DO  kk = 0, kcto
    32793467          zeta = ( ( zu(nzt) - cg%zu(kk) ) / anterp_relax_length_t )**4
    32803468          fraz(kk) = zeta / ( 1.0_wp + zeta )
     
    34623650       coord_x(i) = lower_left_coord_x + i * dx
    34633651    ENDDO
    3464      
     3652
    34653653    DO  j = -nbgp, ny + nbgp
    34663654       coord_y(j) = lower_left_coord_y + j * dy
     
    34723660
    34733661
    3474 
    34753662 SUBROUTINE pmci_set_array_pointer( name, child_id, nz_cl, n )
    34763663
     
    34873674
    34883675    REAL(wp), POINTER, DIMENSION(:,:)     ::  p_2d        !<
     3676    REAL(wp), POINTER, DIMENSION(:,:)     ::  p_2d_sec    !<
    34893677    REAL(wp), POINTER, DIMENSION(:,:,:)   ::  p_3d        !<
    34903678    REAL(wp), POINTER, DIMENSION(:,:,:)   ::  p_3d_sec    !<
     
    35843772
    35853773
     3774
    35863775INTEGER FUNCTION get_number_of_childs ()
    35873776
     
    36143803
    36153804END FUNCTION get_childid
     3805
    36163806
    36173807
     
    36413831END SUBROUTINE get_child_edges
    36423832
     3833
     3834
    36433835SUBROUTINE  get_child_gridspacing (m, dx,dy,dz)
    36443836
     
    36563848END SUBROUTINE get_child_gridspacing
    36573849
    3658 SUBROUTINE pmci_create_child_arrays( name, is, ie, js, je, nzc,n  )
     3850
     3851
     3852SUBROUTINE pmci_create_child_arrays( name, is, ie, js, je, nzc, n  )
    36593853
    36603854    IMPLICIT NONE
     
    36663860    INTEGER(iwp), INTENT(IN) ::  je      !<
    36673861    INTEGER(iwp), INTENT(IN) ::  js      !<
    3668     INTEGER(iwp), INTENT(IN) ::  nzc     !<  Note that nzc is cg%nz
     3862    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.
    36693863
    36703864    INTEGER(iwp), INTENT(IN), OPTIONAL ::  n  !< number of chemical species
     
    38194013!--    The interpolation.
    38204014       CALL pmci_interp_tril_all ( u,  uc,  icu, jco, kco, r1xu, r2xu, r1yo,   &
    3821                                    r2yo, r1zo, r2zo, 'u' )
     4015                                   r2yo, r1zo, r2zo, kcto, iflu, ifuu,         &
     4016                                   jflo, jfuo, kflo, kfuo, ijkfc_u, 'u' )
    38224017       CALL pmci_interp_tril_all ( v,  vc,  ico, jcv, kco, r1xo, r2xo, r1yv,   &
    3823                                    r2yv, r1zo, r2zo, 'v' )
     4018                                   r2yv, r1zo, r2zo, kcto, iflo, ifuo,         &
     4019                                   jflv, jfuv, kflo, kfuo, ijkfc_v, 'v' )
    38244020       CALL pmci_interp_tril_all ( w,  wc,  ico, jco, kcw, r1xo, r2xo, r1yo,   &
    3825                                    r2yo, r1zw, r2zw, 'w' )
     4021                                   r2yo, r1zw, r2zw, kctw, iflo, ifuo,         &
     4022                                   jflo, jfuo, kflw, kfuw, ijkfc_w, 'w' )
    38264023
    38274024       IF ( (        rans_mode_parent  .AND.         rans_mode )  .OR.          &
     
    38294026               .NOT. constant_diffusion ) )  THEN
    38304027          CALL pmci_interp_tril_all ( e,  ec,  ico, jco, kco, r1xo, r2xo, r1yo, &
    3831                                       r2yo, r1zo, r2zo, 'e' )
     4028                                      r2yo, r1zo, r2zo, kcto, iflo, ifuo,       &
     4029                                      jflo, jfuo, kflo, kfuo, ijkfc_s, 'e' )
    38324030       ENDIF
    38334031
    38344032       IF ( rans_mode_parent  .AND.  rans_mode  .AND.  rans_tke_e )  THEN
    38354033          CALL pmci_interp_tril_all ( diss,  dissc,  ico, jco, kco, r1xo, r2xo,&
    3836                                       r1yo, r2yo, r1zo, r2zo, 's' )
     4034                                      r1yo, r2yo, r1zo, r2zo, kcto, iflo, ifuo,&
     4035                                      jflo, jfuo, kflo, kfuo, ijkfc_s, 's' )
    38374036       ENDIF
    38384037
    38394038       IF ( .NOT. neutral )  THEN
    38404039          CALL pmci_interp_tril_all ( pt, ptc, ico, jco, kco, r1xo, r2xo,      &
    3841                                       r1yo, r2yo, r1zo, r2zo, 's' )
     4040                                      r1yo, r2yo, r1zo, r2zo, kcto, iflo, ifuo,&
     4041                                      jflo, jfuo, kflo, kfuo, ijkfc_s, 's' )
    38424042       ENDIF
    38434043
     
    38454045
    38464046          CALL pmci_interp_tril_all ( q, q_c, ico, jco, kco, r1xo, r2xo, r1yo, &
    3847                                       r2yo, r1zo, r2zo, 's' )
     4047                                      r2yo, r1zo, r2zo, kcto, iflo, ifuo,      &
     4048                                      jflo, jfuo, kflo, kfuo, ijkfc_s, 's' )
    38484049
    38494050          IF ( bulk_cloud_model  .AND.  microphysics_morrison )  THEN
    38504051             CALL pmci_interp_tril_all ( qc, qcc, ico, jco, kco, r1xo, r2xo,   &
    3851                                           r1yo, r2yo, r1zo, r2zo, 's' )
     4052                                         r1yo, r2yo, r1zo, r2zo, kcto,         &
     4053                                         iflo, ifuo, jflo, jfuo, kflo, kfuo,   &
     4054                                         ijkfc_s, 's' )
    38524055             CALL pmci_interp_tril_all ( nc, ncc, ico, jco, kco, r1xo, r2xo,   &
    3853                                          r1yo, r2yo, r1zo, r2zo, 's' )   
     4056                                         r1yo, r2yo, r1zo, r2zo, kcto,         &
     4057                                         iflo, ifuo, jflo, jfuo, kflo, kfuo,   &
     4058                                         ijkfc_s, 's' )   
    38544059          ENDIF
    38554060
    38564061          IF ( bulk_cloud_model  .AND.  microphysics_seifert )  THEN
    38574062             CALL pmci_interp_tril_all ( qr, qrc, ico, jco, kco, r1xo, r2xo,   &
    3858                                          r1yo, r2yo, r1zo, r2zo, 's' )
     4063                                         r1yo, r2yo, r1zo, r2zo, kcto,         &
     4064                                         iflo, ifuo, jflo, jfuo, kflo, kfuo,   &
     4065                                         ijkfc_s, 's' )
    38594066             CALL pmci_interp_tril_all ( nr, nrc, ico, jco, kco, r1xo, r2xo,   &
    3860                                          r1yo, r2yo, r1zo, r2zo, 's' )
     4067                                         r1yo, r2yo, r1zo, r2zo, kcto,         &
     4068                                         iflo, ifuo, jflo, jfuo, kflo, kfuo,   &
     4069                                         ijkfc_s, 's' )
    38614070          ENDIF
    38624071
     
    38654074       IF ( passive_scalar )  THEN
    38664075          CALL pmci_interp_tril_all ( s, sc, ico, jco, kco, r1xo, r2xo, r1yo,  &
    3867                                       r2yo, r1zo, r2zo, 's' )
     4076                                      r2yo, r1zo, r2zo, kcto, iflo, ifuo,      &
     4077                                      jflo, jfuo, kflo, kfuo, ijkfc_s, 's' )
    38684078       ENDIF
    38694079
     
    38734083                                         chem_spec_c(:,:,:,n),                 &
    38744084                                         ico, jco, kco, r1xo, r2xo, r1yo,      &
    3875                                          r2yo, r1zo, r2zo, 's' )
     4085                                         r2yo, r1zo, r2zo, kcto, iflo, ifuo,   &
     4086                                         jflo, jfuo, kflo, kfuo, ijkfc_s, 's' )
    38764087          ENDDO
    38774088       ENDIF
     
    39124123
    39134124    SUBROUTINE pmci_interp_tril_all( f, fc, ic, jc, kc, r1x, r2x, r1y, r2y,    &
    3914                                      r1z, r2z, var )
     4125                                     r1z, r2z, kct, ifl, ifu, jfl, jfu,        &
     4126                                     kfl, kfu, ijkfc, var )
    39154127!
    39164128!--    Interpolation of the internal values for the child-domain initialization
     
    39254137       INTEGER(iwp), DIMENSION(nzb:nzt+1), INTENT(IN)           ::  kc    !<
    39264138
     4139       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(INOUT) :: f !<
     4140       REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr), INTENT(IN) :: fc       !<
     4141       REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN) :: r1x   !<
     4142       REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN) :: r2x   !<
     4143       REAL(wp), DIMENSION(nysg:nyng), INTENT(IN) :: r1y   !<
     4144       REAL(wp), DIMENSION(nysg:nyng), INTENT(IN) :: r2y   !<
     4145       REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN) :: r1z   !<
     4146       REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN) :: r2z   !<
     4147
     4148       INTEGER(iwp) :: kct
     4149       INTEGER(iwp), DIMENSION(icl:icr), INTENT(IN) ::  ifl !< Indicates start index of child cells belonging to certain parent cell - x direction
     4150       INTEGER(iwp), DIMENSION(icl:icr), INTENT(IN) ::  ifu !< Indicates end index of child cells belonging to certain parent cell - x direction
     4151       INTEGER(iwp), DIMENSION(jcs:jcn), INTENT(IN) ::  jfl !< Indicates start index of child cells belonging to certain parent cell - y direction
     4152       INTEGER(iwp), DIMENSION(jcs:jcn), INTENT(IN) ::  jfu !< Indicates start index of child cells belonging to certain parent cell - y direction
     4153       INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN)   ::  kfl !< Indicates start index of child cells belonging to certain parent cell - z direction
     4154       INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN)   ::  kfu !< Indicates start index of child cells belonging to certain parent cell - z direction
     4155       INTEGER(iwp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr), INTENT(IN) :: ijkfc !< number of child grid points contributing to a parent grid box
     4156
    39274157       INTEGER(iwp) ::  i        !<
    39284158       INTEGER(iwp) ::  ib       !<
    39294159       INTEGER(iwp) ::  ie       !<
     4160       INTEGER(iwp) ::  ijk      !<
    39304161       INTEGER(iwp) ::  j        !<
    39314162       INTEGER(iwp) ::  jb       !<
     
    39394170       INTEGER(iwp) ::  m        !<
    39404171       INTEGER(iwp) ::  n        !<
    3941 
    3942        REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(INOUT) :: f !<
    3943        REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr), INTENT(IN) :: fc       !<
    3944        REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN) :: r1x   !<
    3945        REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN) :: r2x   !<
    3946        REAL(wp), DIMENSION(nysg:nyng), INTENT(IN) :: r1y   !<
    3947        REAL(wp), DIMENSION(nysg:nyng), INTENT(IN) :: r2y   !<
    3948        REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN) :: r1z   !<
    3949        REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN) :: r2z   !<
    3950 
     4172       INTEGER(iwp) ::  var_flag !<
     4173
     4174       REAL(wp) ::  cellsum    !<
     4175       REAL(wp) ::  cellsumd   !<
    39514176       REAL(wp) ::  fk         !<
    39524177       REAL(wp) ::  fkj        !<
     
    39574182       REAL(wp) ::  logratio   !<
    39584183       REAL(wp) ::  logzuc1    !<
     4184       REAL(wp) ::  rcorr      !<
     4185       REAL(wp) ::  rcorr_ijk  !<       
    39594186       REAL(wp) ::  zuc1       !<
    39604187       REAL(wp) ::  z0_topo    !<  roughness at vertical walls
     
    39654192       jb = nys
    39664193       je = nyn
     4194       kb = 0
    39674195       IF ( nesting_mode /= 'vertical' )  THEN
    39684196          IF ( bc_dirichlet_l )  THEN
     
    39894217          ENDIF
    39904218       ENDIF
     4219
     4220       IF ( var == 'u' )  THEN
     4221          var_flag = 1
     4222       ELSEIF ( var == 'v' )  THEN
     4223          var_flag = 2
     4224       ELSEIF ( var == 'w' )  THEN
     4225          var_flag = 3
     4226       ELSE
     4227          var_flag = 0
     4228       ENDIF
    39914229!
    39924230!--    Trilinear interpolation.
     
    39974235!--          topography top at grid point (j,i) in order to not overwrite
    39984236!--          the bottom BC.
    3999              kb = get_topography_top_index_ji( j, i, TRIM ( var ) ) + 1
     4237!             kb = get_topography_top_index_ji( j, i, TRIM ( var ) ) + 1             
    40004238             DO  k = kb, nzt + 1
    40014239                l = ic(i)
     
    40624300
    40634301       ENDIF
     4302!
     4303!--    Apply the reversibility correction.
     4304       DO  l = icl, icr
     4305          DO  m = jcs, jcn
     4306             DO  n = 0, kct+1
     4307                ijk = 1
     4308                cellsum   = 0.0_wp
     4309                cellsumd  = 0.0_wp
     4310!
     4311!--             Note that the index name i must not be used here as a loop
     4312!--             index name since i is the constant boundary index, hence
     4313!--             the name ia.
     4314                DO  i = ifl(l), ifu(l)   
     4315                   DO  j = jfl(m), jfu(m)
     4316                      DO  k = kfl(n), kfu(n)
     4317                         cellsum = cellsum + MERGE( f(k,j,i), 0.0_wp,           &
     4318                              BTEST( wall_flags_0(k,j,i), var_flag ) )
     4319                         celltmpd(ijk) = ABS( fc(n,m,l) - f(k,j,i) )
     4320                         cellsumd      = cellsumd  + MERGE( celltmpd(ijk),      &
     4321                              0.0_wp, BTEST( wall_flags_0(k,j,i), var_flag ) )
     4322                         ijk = ijk + 1
     4323                      ENDDO
     4324                   ENDDO
     4325                ENDDO
     4326               
     4327                IF ( ijkfc(n,m,l) /= 0 )  THEN
     4328                   cellsum   = cellsum / REAL( ijkfc(n,m,l), KIND=wp )
     4329                   rcorr     = fc(n,m,l) - cellsum
     4330                   cellsumd  = cellsumd / REAL( ijkfc(n,m,l), KIND=wp )
     4331                ELSE
     4332                   cellsum   = 0.0_wp                 
     4333                   rcorr     = 0.0_wp
     4334                   cellsumd  = 1.0_wp
     4335                   celltmpd  = 1.0_wp
     4336                ENDIF
     4337!
     4338!--             Distribute the correction term to the child nodes according to
     4339!--             their relative difference to the parent value such that the
     4340!--             node with the largest difference gets the largest share of the
     4341!--             correction. The distribution is skipped if rcorr is negligibly
     4342!--             small in order to avoid division by zero.
     4343                IF ( ABS(rcorr) < 0.000001_wp )  THEN                 
     4344                   cellsumd  = 1.0_wp
     4345                   celltmpd  = 1.0_wp
     4346                ENDIF
     4347
     4348                ijk = 1
     4349                DO  i = ifl(l), ifu(l)
     4350                   DO  j = jfl(m), jfu(m)
     4351                      DO  k = kfl(n), kfu(n)
     4352                         rcorr_ijk = rcorr * celltmpd(ijk) / cellsumd
     4353                         f(k,j,i) = f(k,j,i) + rcorr_ijk
     4354                         ijk = ijk + 1
     4355                      ENDDO
     4356                   ENDDO
     4357                ENDDO
     4358             
     4359             ENDDO  ! n
     4360          ENDDO  ! m
     4361       ENDDO  ! l
    40644362
    40654363    END SUBROUTINE pmci_interp_tril_all
     
    41654463
    41664464
    4167  SUBROUTINE pmci_ensure_nest_mass_conservation
    4168 
    4169 !
    4170 !-- Adjust the volume-flow rate through the top boundary so that the net volume
    4171 !-- flow through all boundaries of the current nest domain becomes zero.
    4172     IMPLICIT NONE
    4173 
    4174     INTEGER(iwp) ::  i                           !<
    4175     INTEGER(iwp) ::  ierr                        !<
    4176     INTEGER(iwp) ::  j                           !<
    4177     INTEGER(iwp) ::  k                           !<
    4178 
    4179     REAL(wp) ::  dxdy                            !<
    4180     REAL(wp) ::  innor                           !<
    4181     REAL(wp) ::  w_lt                            !<
    4182     REAL(wp), DIMENSION(1:3) ::  volume_flow_l   !<
    4183 
    4184 !
    4185 !-- Sum up the volume flow through the left/right boundaries
    4186     volume_flow(1)   = 0.0_wp
    4187     volume_flow_l(1) = 0.0_wp
    4188 
    4189     IF ( bc_dirichlet_l )  THEN
    4190        i = 0
    4191        innor = dy
    4192        DO   j = nys, nyn
    4193           DO   k = nzb+1, nzt
    4194              volume_flow_l(1) = volume_flow_l(1) + innor * u(k,j,i) * dzw(k)   &
    4195                                      * MERGE( 1.0_wp, 0.0_wp,                  &
    4196                                               BTEST( wall_flags_0(k,j,i), 1 ) )
    4197           ENDDO
    4198        ENDDO
    4199     ENDIF
    4200 
    4201     IF ( bc_dirichlet_r )  THEN
    4202        i = nx + 1
    4203        innor = -dy
    4204        DO   j = nys, nyn
    4205           DO   k = nzb+1, nzt
    4206              volume_flow_l(1) = volume_flow_l(1) + innor * u(k,j,i) * dzw(k)   &
    4207                                      * MERGE( 1.0_wp, 0.0_wp,                  &
    4208                                               BTEST( wall_flags_0(k,j,i), 1 ) )
    4209           ENDDO
    4210        ENDDO
    4211     ENDIF
    4212 
    4213 #if defined( __parallel )
    4214     IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
    4215     CALL MPI_ALLREDUCE( volume_flow_l(1), volume_flow(1), 1, MPI_REAL,         &
    4216                         MPI_SUM, comm2d, ierr )
    4217 #else
    4218     volume_flow(1) = volume_flow_l(1)
    4219 #endif
    4220    
    4221 !
    4222 !-- Sum up the volume flow through the south/north boundaries
    4223     volume_flow(2)   = 0.0_wp
    4224     volume_flow_l(2) = 0.0_wp
    4225 
    4226     IF ( bc_dirichlet_s )  THEN
    4227        j = 0
    4228        innor = dx
    4229        DO   i = nxl, nxr
    4230           DO   k = nzb+1, nzt
    4231              volume_flow_l(2) = volume_flow_l(2) + innor * v(k,j,i) * dzw(k)   &
    4232                                      * MERGE( 1.0_wp, 0.0_wp,                  &
    4233                                               BTEST( wall_flags_0(k,j,i), 2 ) )
    4234           ENDDO
    4235        ENDDO
    4236     ENDIF
    4237 
    4238     IF ( bc_dirichlet_n )  THEN
    4239        j = ny + 1
    4240        innor = -dx
    4241        DO   i = nxl, nxr
    4242           DO   k = nzb+1, nzt
    4243              volume_flow_l(2) = volume_flow_l(2) + innor * v(k,j,i) * dzw(k)   &
    4244                                      * MERGE( 1.0_wp, 0.0_wp,                  &
    4245                                               BTEST( wall_flags_0(k,j,i), 2 ) )
    4246           ENDDO
    4247        ENDDO
    4248     ENDIF
    4249 
    4250 #if defined( __parallel )
    4251     IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
    4252     CALL MPI_ALLREDUCE( volume_flow_l(2), volume_flow(2), 1, MPI_REAL,         &
    4253                         MPI_SUM, comm2d, ierr )
    4254 #else
    4255     volume_flow(2) = volume_flow_l(2)
    4256 #endif
    4257 
    4258 !
    4259 !-- Sum up the volume flow through the top boundary
    4260     volume_flow(3)   = 0.0_wp
    4261     volume_flow_l(3) = 0.0_wp
    4262     dxdy = dx * dy
    4263     k = nzt
    4264     DO   i = nxl, nxr
    4265        DO   j = nys, nyn
    4266           volume_flow_l(3) = volume_flow_l(3) - w(k,j,i) * dxdy
    4267        ENDDO
    4268     ENDDO
    4269 
    4270 #if defined( __parallel )
    4271     IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
    4272     CALL MPI_ALLREDUCE( volume_flow_l(3), volume_flow(3), 1, MPI_REAL,         &
    4273                         MPI_SUM, comm2d, ierr )
    4274 #else
    4275     volume_flow(3) = volume_flow_l(3)
    4276 #endif
    4277 
    4278 !
    4279 !-- Correct the top-boundary value of w
    4280     w_lt = (volume_flow(1) + volume_flow(2) + volume_flow(3)) / area_t
    4281     DO   i = nxl, nxr
    4282        DO   j = nys, nyn
    4283           DO  k = nzt, nzt + 1
    4284              w(k,j,i) = w(k,j,i) + w_lt
    4285           ENDDO
    4286        ENDDO
    4287     ENDDO
    4288 
    4289  END SUBROUTINE pmci_ensure_nest_mass_conservation
    4290 
    4291 
    4292 
    42934465 SUBROUTINE pmci_synchronize
    42944466
     
    44094581    DO  m = 1, SIZE( pmc_parent_for_child ) - 1
    44104582       child_id = pmc_parent_for_child(m)
    4411        
    44124583       IF ( direction == parent_to_child )  THEN
    44134584          CALL cpu_log( log_point_s(71), 'pmc parent send', 'start' )
     
    44844655
    44854656       IF ( direction == parent_to_child )  THEN
    4486 
     4657   
    44874658          CALL cpu_log( log_point_s(73), 'pmc child recv', 'start' )
    44884659          CALL pmc_c_getbuffer( )
     
    44924663          CALL pmci_interpolation
    44934664          CALL cpu_log( log_point_s(75), 'pmc interpolation', 'stop' )
    4494 
     4665     
    44954666       ELSE
    44964667!
     
    45174688       IMPLICIT NONE
    45184689
     4690       INTEGER(iwp) ::  ibgp       !< index running over the nbgp boundary ghost points in i-direction
     4691       INTEGER(iwp) ::  jbgp       !< index running over the nbgp boundary ghost points in j-direction
    45194692       INTEGER(iwp) ::  n          !< running index for number of chemical species
    45204693     
     
    45274700!--       Left border pe:
    45284701          IF ( bc_dirichlet_l )  THEN
    4529              
    4530              CALL pmci_interp_tril_lr( u,  uc,  icu, jco, kco, r1xu, r2xu,     &
    4531                                        r1yo, r2yo, r1zo, r2zo,                 &
    4532                                        logc_u_l, logc_ratio_u_l,               &
    4533                                        logc_kbounds_u_l,                       &
    4534                                        nzt_topo_nestbc_l, 'l', 'u' )
    4535 
    4536              CALL pmci_interp_tril_lr( v,  vc,  ico, jcv, kco, r1xo, r2xo,     &
    4537                                        r1yv, r2yv, r1zo, r2zo,                 &
    4538                                        logc_v_l, logc_ratio_v_l,               &
    4539                                        logc_kbounds_v_l,                       &               
    4540                                        nzt_topo_nestbc_l, 'l', 'v' )
    4541 
    4542              CALL pmci_interp_tril_lr( w,  wc,  ico, jco, kcw, r1xo, r2xo,     &
    4543                                        r1yo, r2yo, r1zw, r2zw,                 &
    4544                                        logc_w_l, logc_ratio_w_l,               &
    4545                                        logc_kbounds_w_l,                       &
    4546                                        nzt_topo_nestbc_l, 'l', 'w' )
     4702
     4703             CALL pmci_interp_tril_lr( u,  uc,  icu, jco, kco, r1xu, r2xu,      &
     4704                                       r1yo, r2yo, r1zo, r2zo,                  &
     4705                                       logc_u_l, logc_ratio_u_l,                &
     4706                                       logc_kbounds_u_l, nzt_topo_nestbc_l,     &
     4707                                       kcto, iflu, ifuu, jflo, jfuo, kflo,      &
     4708                                       kfuo, ijkfc_u, 'l', 'u' )
     4709
     4710             CALL pmci_interp_tril_lr( v,  vc,  ico, jcv, kco, r1xo, r2xo,      &
     4711                                       r1yv, r2yv, r1zo, r2zo,                  &
     4712                                       logc_v_l, logc_ratio_v_l,                &
     4713                                       logc_kbounds_v_l, nzt_topo_nestbc_l,     &
     4714                                       kcto, iflo, ifuo, jflv, jfuv, kflo,      &
     4715                                       kfuo, ijkfc_v, 'l', 'v' )
     4716
     4717             CALL pmci_interp_tril_lr( w,  wc,  ico, jco, kcw, r1xo, r2xo,      &
     4718                                       r1yo, r2yo, r1zw, r2zw,                  &
     4719                                       logc_w_l, logc_ratio_w_l,                &
     4720                                       logc_kbounds_w_l, nzt_topo_nestbc_l,     &
     4721                                       kctw, iflo, ifuo, jflo, jfuo, kflw,      &
     4722                                       kfuw, ijkfc_w, 'l', 'w' )
    45474723
    45484724             IF ( (        rans_mode_parent  .AND.         rans_mode )  .OR.   &
    45494725                  (  .NOT. rans_mode_parent  .AND.  .NOT.  rans_mode  .AND.    &
    45504726                     .NOT. constant_diffusion ) )  THEN
    4551                 CALL pmci_interp_tril_lr( e,  ec,  ico, jco, kco, r1xo, r2xo,  &
    4552                                           r1yo, r2yo, r1zo, r2zo,              &
    4553                                           logc_w_l, logc_ratio_w_l,            &
    4554                                           logc_kbounds_w_l,                    &
    4555                                           nzt_topo_nestbc_l, 'l', 'e' )
     4727!                CALL pmci_interp_tril_lr( e,  ec,  ico, jco, kco, r1xo, r2xo,  &
     4728!                                          r1yo, r2yo, r1zo, r2zo,              &
     4729!                                          logc_w_l, logc_ratio_w_l,            &
     4730!                                          logc_kbounds_w_l, nzt_topo_nestbc_l, &
     4731!                                          kcto, iflo, ifuo, jflo, jfuo, kflo,  &
     4732!                                          kfuo, ijkfc_s, 'l', 'e' )
     4733!
     4734!--             Interpolation of e is replaced by the Neumann condition.
     4735                DO ibgp = -nbgp, -1
     4736                   e(nzb:nzt,nys:nyn,ibgp) = e(nzb:nzt,nys:nyn,0)
     4737                ENDDO
     4738
    45564739             ENDIF
    45574740
     
    45604743                                          r2xo, r1yo, r2yo, r1zo, r2zo,        &
    45614744                                          logc_w_l, logc_ratio_w_l,            &
    4562                                           logc_kbounds_w_l,                    &
    4563                                           nzt_topo_nestbc_l, 'l', 's' )
     4745                                          logc_kbounds_w_l, nzt_topo_nestbc_l, &
     4746                                          kcto, iflo, ifuo, jflo, jfuo, kflo,  &
     4747                                          kfuo, ijkfc_s, 'l', 's' )
    45644748             ENDIF
    45654749
     
    45684752                                          r1yo, r2yo, r1zo, r2zo,              &
    45694753                                          logc_w_l, logc_ratio_w_l,            &
    4570                                           logc_kbounds_w_l,                    &               
    4571                                           nzt_topo_nestbc_l, 'l', 's' )
     4754                                          logc_kbounds_w_l, nzt_topo_nestbc_l, &
     4755                                          kcto, iflo, ifuo, jflo, jfuo, kflo,  &
     4756                                          kfuo, ijkfc_s, 'l', 's' )
    45724757             ENDIF
    45734758
     
    45774762                                          r1yo, r2yo, r1zo, r2zo,              &
    45784763                                          logc_w_l, logc_ratio_w_l,            &
    4579                                           logc_kbounds_w_l,                    &
    4580                                           nzt_topo_nestbc_l, 'l', 's' )
     4764                                          logc_kbounds_w_l, nzt_topo_nestbc_l, &
     4765                                          kcto, iflo, ifuo, jflo, jfuo, kflo,  &
     4766                                          kfuo, ijkfc_s, 'l', 's' )
    45814767
    45824768                IF ( bulk_cloud_model  .AND.  microphysics_morrison )  THEN
     
    45854771                                             logc_w_l, logc_ratio_w_l,         &
    45864772                                             logc_kbounds_w_l,                 &
    4587                                              nzt_topo_nestbc_l, 'l', 's' ) 
     4773                                             nzt_topo_nestbc_l,                &
     4774                                             kcto, iflo, ifuo, jflo, jfuo,     &
     4775                                             kflo, kfuo, ijkfc_s, 'l', 's' ) 
    45884776
    45894777                   CALL pmci_interp_tril_lr( nc, ncc, ico, jco, kco, r1xo,     &
     
    45914779                                             logc_w_l, logc_ratio_w_l,         &
    45924780                                             logc_kbounds_w_l,                 &
    4593                                              nzt_topo_nestbc_l, 'l', 's' )         
     4781                                             nzt_topo_nestbc_l,                &
     4782                                             kcto, iflo, ifuo, jflo, jfuo,     &
     4783                                             kflo, kfuo, ijkfc_s, 'l', 's' )         
    45944784                ENDIF
    45954785
     
    45994789                                             logc_w_l, logc_ratio_w_l,         &
    46004790                                             logc_kbounds_w_l,                 &
    4601                                              nzt_topo_nestbc_l, 'l', 's' )
     4791                                             nzt_topo_nestbc_l,                &
     4792                                             kcto, iflo, ifuo, jflo, jfuo,     &
     4793                                             kflo, kfuo, ijkfc_s, 'l', 's' )
    46024794
    46034795                   CALL pmci_interp_tril_lr( nr, nrc, ico, jco, kco, r1xo,     &
    46044796                                             r2xo, r1yo, r2yo, r1zo, r2zo,     &
    46054797                                             logc_w_l, logc_ratio_w_l,         &
    4606                                              logc_kbounds_w_l,                 &               
    4607                                              nzt_topo_nestbc_l, 'l', 's' )             
     4798                                             logc_kbounds_w_l,                 &
     4799                                             nzt_topo_nestbc_l,                &
     4800                                             kcto, iflo, ifuo, jflo, jfuo,     &
     4801                                             kflo, kfuo, ijkfc_s, 'l', 's' )             
    46084802                ENDIF
    46094803
     
    46154809                                          logc_w_l, logc_ratio_w_l,            &
    46164810                                          logc_kbounds_w_l,                    &
    4617                                           nzt_topo_nestbc_l, 'l', 's' )
     4811                                          nzt_topo_nestbc_l,                   &
     4812                                          kcto, iflo, ifuo, jflo, jfuo,        &
     4813                                          kflo, kfuo, ijkfc_s, 'l', 's' )
    46184814             ENDIF
    46194815
     
    46264822                                             logc_w_l, logc_ratio_w_l,         &
    46274823                                             logc_kbounds_w_l,                 &
    4628                                              nzt_topo_nestbc_l, 'l', 's' )
     4824                                             nzt_topo_nestbc_l,                &
     4825                                             kcto, iflo, ifuo, jflo, jfuo,     &
     4826                                             kflo, kfuo, ijkfc_s, 'l', 's' )
    46294827                ENDDO
    46304828             ENDIF
     
    46384836                                       r1yo, r2yo, r1zo, r2zo,                 &
    46394837                                       logc_u_r, logc_ratio_u_r,               &
    4640                                        logc_kbounds_u_r,                       &
    4641                                        nzt_topo_nestbc_r, 'r', 'u' )
     4838                                       logc_kbounds_u_r, nzt_topo_nestbc_r,    &
     4839                                       kcto, iflu, ifuu, jflo, jfuo, kflo,     &
     4840                                       kfuo, ijkfc_u, 'r', 'u' )
    46424841
    46434842             CALL pmci_interp_tril_lr( v,  vc,  ico, jcv, kco, r1xo, r2xo,     &
    46444843                                       r1yv, r2yv, r1zo, r2zo,                 &
    46454844                                       logc_v_r, logc_ratio_v_r,               &
    4646                                        logc_kbounds_v_r,                       &
    4647                                        nzt_topo_nestbc_r, 'r', 'v' )
     4845                                       logc_kbounds_v_r, nzt_topo_nestbc_r,    &
     4846                                       kcto, iflo, ifuo, jflv, jfuv, kflo,     &
     4847                                       kfuo, ijkfc_v, 'r', 'v' )
    46484848
    46494849             CALL pmci_interp_tril_lr( w,  wc,  ico, jco, kcw, r1xo, r2xo,     &
    46504850                                       r1yo, r2yo, r1zw, r2zw,                 &
    46514851                                       logc_w_r, logc_ratio_w_r,               &
    4652                                        logc_kbounds_w_r,                       &
    4653                                        nzt_topo_nestbc_r, 'r', 'w' )
     4852                                       logc_kbounds_w_r, nzt_topo_nestbc_r,    &
     4853                                       kctw, iflo, ifuo, jflo, jfuo, kflw,     &
     4854                                       kfuw, ijkfc_w, 'r', 'w' )
    46544855
    46554856             IF ( (        rans_mode_parent  .AND.         rans_mode )  .OR.   &
    46564857                  (  .NOT. rans_mode_parent  .AND.  .NOT.  rans_mode  .AND.    &
    46574858                     .NOT. constant_diffusion ) )  THEN
    4658                 CALL pmci_interp_tril_lr( e,  ec,  ico, jco, kco, r1xo, r2xo,  &
    4659                                           r1yo,r2yo, r1zo, r2zo,               &
    4660                                           logc_w_r, logc_ratio_w_r,            &
    4661                                           logc_kbounds_w_r,                    &
    4662                                           nzt_topo_nestbc_r, 'r', 'e' )
    4663 
     4859!                CALL pmci_interp_tril_lr( e,  ec,  ico, jco, kco, r1xo, r2xo,  &
     4860!                                          r1yo,r2yo, r1zo, r2zo,               &
     4861!                                          logc_w_r, logc_ratio_w_r,            &
     4862!                                          logc_kbounds_w_r, nzt_topo_nestbc_r, &
     4863!                                          kcto, iflo, ifuo, jflo, jfuo, kflo,  &
     4864!                                          kfuo, ijkfc_s, 'r', 'e' )
     4865!
     4866!--             Interpolation of e is replaced by the Neumann condition.
     4867                DO ibgp = nx+1, nx+nbgp
     4868                   e(nzb:nzt,nys:nyn,ibgp) = e(nzb:nzt,nys:nyn,nx)
     4869                ENDDO
    46644870             ENDIF
    46654871
     
    46684874                                          r2xo, r1yo,r2yo, r1zo, r2zo,         &
    46694875                                          logc_w_r, logc_ratio_w_r,            &
    4670                                           logc_kbounds_w_r,                    &
    4671                                           nzt_topo_nestbc_r, 'r', 's' )
     4876                                          logc_kbounds_w_r, nzt_topo_nestbc_r, &
     4877                                          kcto, iflo, ifuo, jflo, jfuo, kflo,  &
     4878                                          kfuo, ijkfc_s, 'r', 's' )
    46724879
    46734880             ENDIF
     
    46774884                                          r1yo, r2yo, r1zo, r2zo,              &
    46784885                                          logc_w_r, logc_ratio_w_r,            &
    4679                                           logc_kbounds_w_r,                    &
    4680                                           nzt_topo_nestbc_r, 'r', 's' )
     4886                                          logc_kbounds_w_r, nzt_topo_nestbc_r, &
     4887                                          kcto, iflo, ifuo, jflo, jfuo, kflo,  &
     4888                                          kfuo, ijkfc_s, 'r', 's' )
    46814889             ENDIF
    46824890
     
    46854893                                          r1yo, r2yo, r1zo, r2zo,              &
    46864894                                          logc_w_r, logc_ratio_w_r,            &
    4687                                           logc_kbounds_w_r,                    &
    4688                                           nzt_topo_nestbc_r, 'r', 's' )
     4895                                          logc_kbounds_w_r, nzt_topo_nestbc_r, &
     4896                                          kcto, iflo, ifuo, jflo, jfuo, kflo,  &
     4897                                          kfuo, ijkfc_s, 'r', 's' )
    46894898
    46904899                IF ( bulk_cloud_model  .AND.  microphysics_morrison )  THEN
     
    46944903                                             logc_w_r, logc_ratio_w_r,         &
    46954904                                             logc_kbounds_w_r,                 &
    4696                                              nzt_topo_nestbc_r, 'r', 's' )
     4905                                             nzt_topo_nestbc_r,                &
     4906                                             kcto, iflo, ifuo, jflo, jfuo,     &
     4907                                             kflo, kfuo, ijkfc_s, 'r', 's' )
    46974908     
    46984909                   CALL pmci_interp_tril_lr( nc, ncc, ico, jco, kco, r1xo,     &
     
    47004911                                             logc_w_r, logc_ratio_w_r,         &
    47014912                                             logc_kbounds_w_r,                 &
    4702                                              nzt_topo_nestbc_r, 'r', 's' )
    4703 
     4913                                             nzt_topo_nestbc_r,                &
     4914                                             kcto, iflo, ifuo, jflo, jfuo,     &
     4915                                             kflo, kfuo, ijkfc_s, 'r', 's' )
    47044916
    47054917                ENDIF
     
    47124924                                             logc_w_r, logc_ratio_w_r,         &
    47134925                                             logc_kbounds_w_r,                 &
    4714                                              nzt_topo_nestbc_r, 'r', 's' )
     4926                                             nzt_topo_nestbc_r,                &
     4927                                             kcto, iflo, ifuo, jflo, jfuo,     &
     4928                                             kflo, kfuo, ijkfc_s,              &
     4929                                             'r', 's' )
    47154930
    47164931                   CALL pmci_interp_tril_lr( nr, nrc, ico, jco, kco, r1xo,     &
     
    47184933                                             logc_w_r, logc_ratio_w_r,         &
    47194934                                             logc_kbounds_w_r,                 &
    4720                                              nzt_topo_nestbc_r, 'r', 's' )
     4935                                             nzt_topo_nestbc_r,                &
     4936                                             kcto, iflo, ifuo, jflo, jfuo,     &
     4937                                             kflo, kfuo, ijkfc_s, 'r', 's' )
    47214938
    47224939                ENDIF
     
    47294946                                          logc_w_r, logc_ratio_w_r,            &
    47304947                                          logc_kbounds_w_r,                    &
    4731                                           nzt_topo_nestbc_r, 'r', 's' )
     4948                                          nzt_topo_nestbc_r,                   &
     4949                                          kcto, iflo, ifuo, jflo, jfuo,        &
     4950                                          kflo, kfuo, ijkfc_s, 'r', 's' )
    47324951             ENDIF
    47334952
     
    47404959                                             logc_w_r, logc_ratio_w_r,         &
    47414960                                             logc_kbounds_w_r,                 &
    4742                                              nzt_topo_nestbc_r, 'r', 's' )
     4961                                             nzt_topo_nestbc_r,                &
     4962                                             kcto, iflo, ifuo, jflo, jfuo,     &
     4963                                             kflo, kfuo, ijkfc_s, 'r', 's' )
    47434964                ENDDO
    47444965             ENDIF
     
    47514972                                       r1yo, r2yo, r1zo, r2zo,                 &
    47524973                                       logc_u_s, logc_ratio_u_s,               &
    4753                                        logc_kbounds_u_s,                       &
    4754                                        nzt_topo_nestbc_s, 's', 'u' )
     4974                                       logc_kbounds_u_s, nzt_topo_nestbc_s,    &
     4975                                       kcto, iflu, ifuu, jflo, jfuo, kflo,     &
     4976                                       kfuo, ijkfc_u, 's', 'u' )
    47554977
    47564978             CALL pmci_interp_tril_sn( v,  vc,  ico, jcv, kco, r1xo, r2xo,     &
    47574979                                       r1yv, r2yv, r1zo, r2zo,                 &
    47584980                                       logc_v_s, logc_ratio_v_s,               &
    4759                                        logc_kbounds_v_s,                       &
    4760                                        nzt_topo_nestbc_s, 's', 'v' )
     4981                                       logc_kbounds_v_s, nzt_topo_nestbc_s,    &
     4982                                       kcto, iflo, ifuo, jflv, jfuv, kflo,     &
     4983                                       kfuo, ijkfc_v, 's', 'v' )
    47614984
    47624985             CALL pmci_interp_tril_sn( w,  wc,  ico, jco, kcw, r1xo, r2xo,     &
    47634986                                       r1yo, r2yo, r1zw, r2zw,                 &
    47644987                                       logc_w_s, logc_ratio_w_s,               &
    4765                                        logc_kbounds_w_s,                       &
    4766                                        nzt_topo_nestbc_s, 's','w' )
     4988                                       logc_kbounds_w_s, nzt_topo_nestbc_s,    &
     4989                                       kctw, iflo, ifuo, jflo, jfuo, kflw,     &
     4990                                       kfuw, ijkfc_w, 's','w' )
    47674991
    47684992             IF ( (        rans_mode_parent  .AND.         rans_mode )  .OR.   &
    47694993                  (  .NOT. rans_mode_parent  .AND.  .NOT.  rans_mode  .AND.    &
    47704994                     .NOT. constant_diffusion ) )  THEN
    4771                 CALL pmci_interp_tril_sn( e,  ec,  ico, jco, kco, r1xo, r2xo,  &
    4772                                           r1yo, r2yo, r1zo, r2zo,              &
    4773                                           logc_w_s, logc_ratio_w_s,            &
    4774                                           logc_kbounds_w_s,                    &
    4775                                           nzt_topo_nestbc_s, 's', 'e' )
    4776 
     4995!                CALL pmci_interp_tril_sn( e,  ec,  ico, jco, kco, r1xo, r2xo,  &
     4996!                                          r1yo, r2yo, r1zo, r2zo,              &
     4997!                                          logc_w_s, logc_ratio_w_s,            &
     4998!                                          logc_kbounds_w_s, nzt_topo_nestbc_s, &
     4999!                                          kcto, iflo, ifuo, jflo, jfuo, kflo,  &
     5000!                                          kfuo, ijkfc_s, 's', 'e' )
     5001!
     5002!--             Interpolation of e is replaced by the Neumann condition.
     5003                DO jbgp = -nbgp, -1
     5004                   e(nzb:nzt,jbgp,nxl:nxr) = e(nzb:nzt,0,nxl:nxr)
     5005                ENDDO
    47775006             ENDIF
    47785007
     
    47815010                                          r2xo, r1yo, r2yo, r1zo, r2zo,        &
    47825011                                          logc_w_s, logc_ratio_w_s,            &
    4783                                           logc_kbounds_w_s,                   &
    4784                                           nzt_topo_nestbc_s, 's', 's' )
    4785 
     5012                                          logc_kbounds_w_s, nzt_topo_nestbc_s, &
     5013                                          kcto, iflo, ifuo, jflo, jfuo, kflo,  &
     5014                                          kfuo, ijkfc_s, 's', 's' )
    47865015             ENDIF
    47875016
     
    47905019                                          r1yo, r2yo, r1zo, r2zo,              &
    47915020                                          logc_w_s, logc_ratio_w_s,            &
    4792                                           logc_kbounds_w_s,                    &
    4793                                           nzt_topo_nestbc_s, 's', 's' )
     5021                                          logc_kbounds_w_s, nzt_topo_nestbc_s, &
     5022                                          kcto, iflo, ifuo, jflo, jfuo, kflo,  &
     5023                                          kfuo, ijkfc_s, 's', 's' )
    47945024             ENDIF
    47955025
     
    47985028                                          r1yo,r2yo, r1zo, r2zo,               &
    47995029                                          logc_w_s, logc_ratio_w_s,            &
    4800                                           logc_kbounds_w_s,                    &
    4801                                           nzt_topo_nestbc_s, 's', 's' )
     5030                                          logc_kbounds_w_s, nzt_topo_nestbc_s, &
     5031                                          kcto, iflo, ifuo, jflo, jfuo, kflo,  &
     5032                                          kfuo, ijkfc_s, 's', 's' )
    48025033
    48035034                IF ( bulk_cloud_model  .AND.  microphysics_morrison )  THEN
     
    48075038                                             logc_w_s, logc_ratio_w_s,         &
    48085039                                             logc_kbounds_w_s,                 &
    4809                                              nzt_topo_nestbc_s, 's', 's' )
     5040                                             nzt_topo_nestbc_s,                &
     5041                                             kcto, iflo, ifuo, jflo, jfuo,     &
     5042                                             kflo, kfuo, ijkfc_s, 's', 's' )
    48105043
    48115044                   CALL pmci_interp_tril_sn( nc, ncc, ico, jco, kco, r1xo,     &
     
    48135046                                             logc_w_s, logc_ratio_w_s,         &
    48145047                                             logc_kbounds_w_s,                 &
    4815                                              nzt_topo_nestbc_s, 's', 's' )
     5048                                             nzt_topo_nestbc_s,                &
     5049                                             kcto, iflo, ifuo, jflo, jfuo,     &
     5050                                             kflo, kfuo, ijkfc_s, 's', 's' )
    48165051
    48175052                ENDIF
     
    48235058                                             logc_w_s, logc_ratio_w_s,         &
    48245059                                             logc_kbounds_w_s,                 &
    4825                                              nzt_topo_nestbc_s, 's', 's' )
     5060                                             nzt_topo_nestbc_s,                &
     5061                                             kcto, iflo, ifuo, jflo, jfuo,     &
     5062                                             kflo, kfuo, ijkfc_s, 's', 's' )
    48265063
    48275064                   CALL pmci_interp_tril_sn( nr, nrc, ico, jco, kco, r1xo,     &
     
    48295066                                             logc_w_s, logc_ratio_w_s,         &
    48305067                                             logc_kbounds_w_s,                 &
    4831                                              nzt_topo_nestbc_s, 's', 's' )
     5068                                             nzt_topo_nestbc_s,                &
     5069                                             kcto, iflo, ifuo, jflo, jfuo,     &
     5070                                             kflo, kfuo, ijkfc_s, 's', 's' )
    48325071
    48335072                ENDIF
     
    48405079                                          logc_w_s, logc_ratio_w_s,            &
    48415080                                          logc_kbounds_w_s,                    &
    4842                                           nzt_topo_nestbc_s, 's', 's' )
     5081                                          nzt_topo_nestbc_s,                   &
     5082                                          kcto, iflo, ifuo, jflo, jfuo,        &
     5083                                          kflo, kfuo, ijkfc_s, 's', 's' )
    48435084             ENDIF
    48445085
     
    48515092                                             logc_w_s, logc_ratio_w_s,         &
    48525093                                             logc_kbounds_w_s,                 &
    4853                                              nzt_topo_nestbc_s, 's', 's' )
     5094                                             nzt_topo_nestbc_s,                &
     5095                                             kcto, iflo, ifuo, jflo, jfuo,     &
     5096                                             kflo, kfuo, ijkfc_s, 's', 's' )
    48545097                ENDDO
    48555098             ENDIF
     
    48625105                                       r1yo, r2yo, r1zo, r2zo,                 &
    48635106                                       logc_u_n, logc_ratio_u_n,               &
    4864                                        logc_kbounds_u_n,                       &
    4865                                        nzt_topo_nestbc_n, 'n', 'u' )
     5107                                       logc_kbounds_u_n, nzt_topo_nestbc_n,    &
     5108                                       kcto, iflu, ifuu, jflo, jfuo, kflo,     &
     5109                                       kfuo, ijkfc_u, 'n', 'u' )
    48665110
    48675111             CALL pmci_interp_tril_sn( v,  vc,  ico, jcv, kco, r1xo, r2xo,     &
    48685112                                       r1yv, r2yv, r1zo, r2zo,                 &
    48695113                                       logc_v_n, logc_ratio_v_n,               &
    4870                                        logc_kbounds_v_n,                       &
    4871                                        nzt_topo_nestbc_n, 'n', 'v' )
     5114                                       logc_kbounds_v_n, nzt_topo_nestbc_n,    &
     5115                                       kcto, iflo, ifuo, jflv, jfuv, kflo,     &
     5116                                       kfuo, ijkfc_v, 'n', 'v' )
    48725117
    48735118             CALL pmci_interp_tril_sn( w,  wc,  ico, jco, kcw, r1xo, r2xo,     &
    48745119                                       r1yo, r2yo, r1zw, r2zw,                 &
    48755120                                       logc_w_n, logc_ratio_w_n,               &
    4876                                        logc_kbounds_w_n,                       &
    4877                                        nzt_topo_nestbc_n, 'n', 'w' )
     5121                                       logc_kbounds_w_n, nzt_topo_nestbc_n,    &
     5122                                       kctw, iflo, ifuo, jflo, jfuo, kflw,     &
     5123                                       kfuw, ijkfc_w, 'n', 'w' )
    48785124
    48795125             IF ( (        rans_mode_parent  .AND.         rans_mode )  .OR.   &
    48805126                  (  .NOT. rans_mode_parent  .AND.  .NOT.  rans_mode  .AND.    &
    48815127                     .NOT. constant_diffusion ) )  THEN
    4882                 CALL pmci_interp_tril_sn( e,  ec,  ico, jco, kco, r1xo, r2xo,  &
    4883                                           r1yo, r2yo, r1zo, r2zo,              &
    4884                                           logc_w_n, logc_ratio_w_n,            &
    4885                                           logc_kbounds_w_n,                    &
    4886                                           nzt_topo_nestbc_n, 'n', 'e' )
    4887 
     5128!                CALL pmci_interp_tril_sn( e,  ec,  ico, jco, kco, r1xo, r2xo,  &
     5129!                                          r1yo, r2yo, r1zo, r2zo,              &
     5130!                                          logc_w_n, logc_ratio_w_n,            &
     5131!                                          logc_kbounds_w_n, nzt_topo_nestbc_n, &
     5132!                                          kcto, iflo, ifuo, jflo, jfuo, kflo,  &
     5133!                                          kfuo, ijkfc_s, 'n', 'e' )
     5134!
     5135!--             Interpolation of e is replaced by the Neumann condition.
     5136                DO jbgp = ny+1, ny+nbgp
     5137                   e(nzb:nzt,jbgp,nxl:nxr) = e(nzb:nzt,ny,nxl:nxr)
     5138                ENDDO
    48885139             ENDIF
    48895140
     
    48925143                                          r2xo, r1yo, r2yo, r1zo, r2zo,        &
    48935144                                          logc_w_n, logc_ratio_w_n,            &
    4894                                           logc_kbounds_w_n,                    &
    4895                                           nzt_topo_nestbc_n, 'n', 's' )
     5145                                          logc_kbounds_w_n, nzt_topo_nestbc_n, &
     5146                                          kcto, iflo, ifuo, jflo, jfuo, kflo,  &
     5147                                          kfuo, ijkfc_s, 'n', 's' )
    48965148
    48975149             ENDIF
     
    49015153                                          r1yo, r2yo, r1zo, r2zo,              &
    49025154                                          logc_w_n, logc_ratio_w_n,            &
    4903                                           logc_kbounds_w_n,                    &
    4904                                           nzt_topo_nestbc_n, 'n', 's' )
     5155                                          logc_kbounds_w_n, nzt_topo_nestbc_n, &
     5156                                          kcto, iflo, ifuo, jflo, jfuo, kflo,  &
     5157                                          kfuo, ijkfc_s, 'n', 's' )
    49055158             ENDIF
    49065159
     
    49095162                                          r1yo, r2yo, r1zo, r2zo,              &
    49105163                                          logc_w_n, logc_ratio_w_n,            &
    4911                                           logc_kbounds_w_n,                    &
    4912                                           nzt_topo_nestbc_n, 'n', 's' )
     5164                                          logc_kbounds_w_n, nzt_topo_nestbc_n, &
     5165                                          kcto, iflo, ifuo, jflo, jfuo, kflo,  &
     5166                                          kfuo, ijkfc_s, 'n', 's' )
    49135167
    49145168                IF ( bulk_cloud_model  .AND.  microphysics_morrison )  THEN
     
    49185172                                             logc_w_n, logc_ratio_w_n,         &
    49195173                                             logc_kbounds_w_n,                 &
    4920                                              nzt_topo_nestbc_n, 'n', 's' )
     5174                                             nzt_topo_nestbc_n,                &
     5175                                             kcto, iflo, ifuo, jflo, jfuo,     &
     5176                                             kflo, kfuo, ijkfc_s, 'n', 's' )
    49215177
    49225178                   CALL pmci_interp_tril_sn( nc, ncc, ico, jco, kco, r1xo,     &
     
    49245180                                             logc_u_n, logc_ratio_u_n,         &
    49255181                                             logc_kbounds_w_n,                 &
    4926                                              nzt_topo_nestbc_n, 'n', 's' )
     5182                                             nzt_topo_nestbc_n,                &
     5183                                             kcto, iflo, ifuo, jflo, jfuo,     &
     5184                                             kflo, kfuo, ijkfc_s, 'n', 's' )
    49275185
    49285186                ENDIF
     
    49345192                                             logc_w_n, logc_ratio_w_n,         &
    49355193                                             logc_kbounds_w_n,                 &
    4936                                              nzt_topo_nestbc_n, 'n', 's' )
     5194                                             nzt_topo_nestbc_n,                &
     5195                                             kcto, iflo, ifuo, jflo, jfuo,     &
     5196                                             kflo, kfuo, ijkfc_s, 'n', 's' )
    49375197
    49385198                   CALL pmci_interp_tril_sn( nr, nrc, ico, jco, kco, r1xo,     &
     
    49405200                                             logc_w_n, logc_ratio_w_n,         &
    49415201                                             logc_kbounds_w_n,                 &
    4942                                              nzt_topo_nestbc_n, 'n', 's' )
     5202                                             nzt_topo_nestbc_n,                &
     5203                                             kcto, iflo, ifuo, jflo, jfuo,     &
     5204                                             kflo, kfuo, ijkfc_s, 'n', 's' )
    49435205
    49445206                ENDIF
     
    49515213                                          logc_w_n, logc_ratio_w_n,            &
    49525214                                          logc_kbounds_w_n,                    &
    4953                                           nzt_topo_nestbc_n, 'n', 's' )
     5215                                          nzt_topo_nestbc_n,                   &
     5216                                          kcto, iflo, ifuo, jflo, jfuo,        &
     5217                                          kflo, kfuo, ijkfc_s, 'n', 's' )
    49545218             ENDIF
    49555219
     
    49625226                                             logc_w_n, logc_ratio_w_n,         &
    49635227                                             logc_kbounds_w_n,                 &
    4964                                              nzt_topo_nestbc_n, 'n', 's' )
     5228                                             nzt_topo_nestbc_n,                &
     5229                                             kcto, iflo, ifuo, jflo, jfuo,     &
     5230                                             kflo, kfuo, ijkfc_s, 'n', 's' )
    49655231                ENDDO
    49665232             ENDIF
     
    49715237!--    All PEs are top-border PEs
    49725238       CALL pmci_interp_tril_t( u,  uc,  icu, jco, kco, r1xu, r2xu, r1yo,      &
    4973                                 r2yo, r1zo, r2zo, 'u' )
     5239                                r2yo, r1zo, r2zo, kcto, iflu, ifuu,            &
     5240                                jflo, jfuo, kflo, kfuo, ijkfc_u, 'u' )
    49745241       CALL pmci_interp_tril_t( v,  vc,  ico, jcv, kco, r1xo, r2xo, r1yv,      &
    4975                                 r2yv, r1zo, r2zo, 'v' )
     5242                                r2yv, r1zo, r2zo, kcto, iflo, ifuo,            &
     5243                                jflv, jfuv, kflo, kfuo, ijkfc_v, 'v' )
    49765244       CALL pmci_interp_tril_t( w,  wc,  ico, jco, kcw, r1xo, r2xo, r1yo,      &
    4977                                 r2yo, r1zw, r2zw, 'w' )
     5245                                r2yo, r1zw, r2zw, kctw, iflo, ifuo,            &
     5246                                jflo, jfuo, kflw, kfuw, ijkfc_w, 'w' )
    49785247
    49795248       IF ( (        rans_mode_parent  .AND.         rans_mode )  .OR.         &
    49805249            (  .NOT. rans_mode_parent  .AND.  .NOT.  rans_mode  .AND.          &
    49815250               .NOT. constant_diffusion ) )  THEN
    4982           CALL pmci_interp_tril_t( e,  ec,  ico, jco, kco, r1xo, r2xo, r1yo,   &
    4983                                    r2yo, r1zo, r2zo, 'e' )
     5251!          CALL pmci_interp_tril_t( e,  ec,  ico, jco, kco, r1xo, r2xo, r1yo,   &
     5252!                                   r2yo, r1zo, r2zo, kcto, iflo, ifuo,         &
     5253!                                   jflo, jfuo, kflo, kfuo, ijkfc_s, 'e' )
     5254!
     5255!--       Interpolation of e is replaced by the Neumann condition.
     5256          e(nzt+1,nys:nyn,nxl:nxr) = e(nzt,nys:nyn,nxl:nxr)
     5257
    49845258       ENDIF
    49855259
    49865260       IF ( rans_mode_parent  .AND.  rans_mode  .AND.  rans_tke_e )  THEN
    49875261          CALL pmci_interp_tril_t( diss, dissc, ico, jco, kco, r1xo, r2xo,     &
    4988                                    r1yo, r2yo, r1zo, r2zo, 's' )
     5262                                   r1yo, r2yo, r1zo, r2zo, kcto, iflo, ifuo,   &
     5263                                   jflo, jfuo, kflo, kfuo, ijkfc_s, 's' )
    49895264       ENDIF
    49905265
    49915266       IF ( .NOT. neutral )  THEN
    4992           CALL pmci_interp_tril_t( pt, ptc, ico, jco, kco, r1xo, r2xo, r1yo,   &
    4993                                    r2yo, r1zo, r2zo, 's' )
     5267          CALL pmci_interp_tril_t( pt, ptc, ico, jco, kco, r1xo, r2xo,         &
     5268                                   r1yo, r2yo, r1zo, r2zo, kcto, iflo, ifuo,   &
     5269                                   jflo, jfuo, kflo, kfuo, ijkfc_s, 's' )
    49945270       ENDIF
    49955271
     
    49975273
    49985274          CALL pmci_interp_tril_t( q, q_c, ico, jco, kco, r1xo, r2xo, r1yo,    &
    4999                                    r2yo, r1zo, r2zo, 's' )
     5275                                   r2yo, r1zo, r2zo, kcto, iflo, ifuo,         &
     5276                                   jflo, jfuo, kflo, kfuo, ijkfc_s, 's' )
    50005277
    50015278          IF ( bulk_cloud_model  .AND.  microphysics_morrison )  THEN
    50025279
    50035280             CALL pmci_interp_tril_t( qc, qcc, ico, jco, kco, r1xo, r2xo, r1yo,&
    5004                                       r2yo, r1zo, r2zo, 's' )
     5281                                      r2yo, r1zo, r2zo, kcto, iflo, ifuo,      &
     5282                                      jflo, jfuo, kflo, kfuo, ijkfc_s, 's' )
    50055283
    50065284             CALL pmci_interp_tril_t( nc, ncc, ico, jco, kco, r1xo, r2xo, r1yo,&
    5007                                       r2yo, r1zo, r2zo, 's' )
     5285                                      r2yo, r1zo, r2zo, kcto, iflo, ifuo,      &
     5286                                      jflo, jfuo, kflo, kfuo, ijkfc_s, 's' )
    50085287
    50095288          ENDIF
     
    50135292
    50145293             CALL pmci_interp_tril_t( qr, qrc, ico, jco, kco, r1xo, r2xo, r1yo,&
    5015                                       r2yo, r1zo, r2zo, 's' )
     5294                                      r2yo, r1zo, r2zo, kcto, iflo, ifuo,      &
     5295                                      jflo, jfuo, kflo, kfuo, ijkfc_s, 's' )
    50165296
    50175297             CALL pmci_interp_tril_t( nr, nrc, ico, jco, kco, r1xo, r2xo, r1yo,&
    5018                                       r2yo, r1zo, r2zo, 's' )
     5298                                      r2yo, r1zo, r2zo, kcto, iflo, ifuo,      &
     5299                                      jflo, jfuo, kflo, kfuo, ijkfc_s, 's' )
    50195300
    50205301          ENDIF
     
    50245305       IF ( passive_scalar )  THEN
    50255306          CALL pmci_interp_tril_t( s, sc, ico, jco, kco, r1xo, r2xo, r1yo,     &
    5026                                    r2yo, r1zo, r2zo, 's' )
     5307                                   r2yo, r1zo, r2zo, kcto, iflo, ifuo,         &
     5308                                   jflo, jfuo, kflo, kfuo, ijkfc_s, 's' )
    50275309       ENDIF
    50285310
     
    50335315                                      ico, jco, kco, r1xo, r2xo,               &
    50345316                                      r1yo, r2yo, r1zo, r2zo,                  &
    5035                                       's' )
     5317                                      kcto, iflo, ifuo, jflo, jfuo,            &
     5318                                      kflo, kfuo, ijkfc_s, 's' )
    50365319          ENDDO
    50375320       ENDIF
     
    50505333      INTEGER(iwp) ::  n          !< running index for number of chemical species
    50515334
    5052 
    5053 
    5054       CALL pmci_anterp_tophat( u,  uc,  kctu, iflu, ifuu, jflo, jfuo, kflo,    &
     5335      CALL pmci_anterp_tophat( u,  uc,  kcto, iflu, ifuu, jflo, jfuo, kflo,    &
    50555336                               kfuo, ijkfc_u, 'u' )
    5056       CALL pmci_anterp_tophat( v,  vc,  kctu, iflo, ifuo, jflv, jfuv, kflo,    &
     5337      CALL pmci_anterp_tophat( v,  vc,  kcto, iflo, ifuo, jflv, jfuv, kflo,    &
    50575338                               kfuo, ijkfc_v, 'v' )
    50585339      CALL pmci_anterp_tophat( w,  wc,  kctw, iflo, ifuo, jflo, jfuo, kflw,    &
     
    50625343!--   RANS mode.
    50635344      IF ( rans_mode_parent  .AND.  rans_mode )  THEN
    5064          CALL pmci_anterp_tophat( e, ec, kctu, iflo, ifuo, jflo, jfuo, kflo,   &
     5345         CALL pmci_anterp_tophat( e, ec, kcto, iflo, ifuo, jflo, jfuo, kflo,   &
    50655346                                  kfuo, ijkfc_s, 'e' )
    50665347!
    50675348!--      Anterpolation of dissipation rate only if TKE-e closure is applied.
    50685349         IF ( rans_tke_e )  THEN
    5069             CALL pmci_anterp_tophat( diss, dissc, kctu, iflo, ifuo, jflo, jfuo,&
     5350            CALL pmci_anterp_tophat( diss, dissc, kcto, iflo, ifuo, jflo, jfuo,&
    50705351                                     kflo, kfuo, ijkfc_s, 'diss' )
    50715352         ENDIF
     
    50745355
    50755356      IF ( .NOT. neutral )  THEN
    5076          CALL pmci_anterp_tophat( pt, ptc, kctu, iflo, ifuo, jflo, jfuo, kflo, &
     5357         CALL pmci_anterp_tophat( pt, ptc, kcto, iflo, ifuo, jflo, jfuo, kflo, &
    50775358                                  kfuo, ijkfc_s, 'pt' )
    50785359      ENDIF
     
    50805361      IF ( humidity )  THEN
    50815362
    5082          CALL pmci_anterp_tophat( q, q_c, kctu, iflo, ifuo, jflo, jfuo, kflo,  &
     5363         CALL pmci_anterp_tophat( q, q_c, kcto, iflo, ifuo, jflo, jfuo, kflo,  &
    50835364                                  kfuo, ijkfc_s, 'q' )
    50845365
    50855366         IF ( bulk_cloud_model  .AND.  microphysics_morrison )  THEN
    50865367
    5087             CALL pmci_anterp_tophat( qc, qcc, kctu, iflo, ifuo, jflo, jfuo,    &
     5368            CALL pmci_anterp_tophat( qc, qcc, kcto, iflo, ifuo, jflo, jfuo,    &
    50885369                                     kflo, kfuo, ijkfc_s, 'qc' )
    50895370
    5090             CALL pmci_anterp_tophat( nc, ncc, kctu, iflo, ifuo, jflo, jfuo,    &
     5371            CALL pmci_anterp_tophat( nc, ncc, kcto, iflo, ifuo, jflo, jfuo,    &
    50915372                                     kflo, kfuo, ijkfc_s, 'nc' )
    50925373
     
    50955376         IF ( bulk_cloud_model  .AND.  microphysics_seifert )  THEN
    50965377
    5097             CALL pmci_anterp_tophat( qr, qrc, kctu, iflo, ifuo, jflo, jfuo,    &
     5378            CALL pmci_anterp_tophat( qr, qrc, kcto, iflo, ifuo, jflo, jfuo,    &
    50985379                                     kflo, kfuo, ijkfc_s, 'qr' )
    50995380
    5100             CALL pmci_anterp_tophat( nr, nrc, kctu, iflo, ifuo, jflo, jfuo,    &
     5381            CALL pmci_anterp_tophat( nr, nrc, kcto, iflo, ifuo, jflo, jfuo,    &
    51015382                                     kflo, kfuo, ijkfc_s, 'nr' )
    51025383
     
    51065387
    51075388      IF ( passive_scalar )  THEN
    5108          CALL pmci_anterp_tophat( s, sc, kctu, iflo, ifuo, jflo, jfuo, kflo,   &
     5389         CALL pmci_anterp_tophat( s, sc, kcto, iflo, ifuo, jflo, jfuo, kflo,   &
    51095390                                  kfuo, ijkfc_s, 's' )
    51105391      ENDIF
     
    51145395            CALL pmci_anterp_tophat( chem_species(n)%conc,                     &
    51155396                                     chem_spec_c(:,:,:,n),                     &
    5116                                      kctu, iflo, ifuo, jflo, jfuo, kflo,       &
     5397                                     kcto, iflo, ifuo, jflo, jfuo, kflo,       &
    51175398                                     kfuo, ijkfc_s, 's' )
    51185399         ENDDO
     
    51255406   SUBROUTINE pmci_interp_tril_lr( f, fc, ic, jc, kc, r1x, r2x, r1y, r2y, r1z, &
    51265407                                   r2z, logc, logc_ratio, logc_kbounds,        &
    5127                                    nzt_topo_nestbc, edge, var )
     5408                                   nzt_topo_nestbc,                            &
     5409                                   kct, ifl, ifu, jfl, jfu, kfl, kfu, ijkfc,   &
     5410                                   edge, var )
    51285411!
    51295412!--   Interpolation of ghost-node values used as the child-domain boundary
     
    51325415
    51335416      IMPLICIT NONE
    5134 
    5135       INTEGER(iwp) ::  nzt_topo_nestbc   !<
    51365417
    51375418      REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                      &
     
    51525433      INTEGER(iwp), DIMENSION(nzb:nzt+1), INTENT(IN)           ::  kc     !<
    51535434      INTEGER(iwp), DIMENSION(1:2,nzb:nzt_topo_nestbc,nys:nyn),                &
    5154                                           INTENT(IN)           ::  logc   !<
    5155       INTEGER(iwp), DIMENSION(1:2,nys:nyn), INTENT(IN)         ::  logc_kbounds !<
     5435                                          INTENT(IN)           :: logc   !<
     5436      INTEGER(iwp), DIMENSION(1:2,nys:nyn), INTENT(IN)         :: logc_kbounds !<
     5437
     5438      INTEGER(iwp) :: kct
     5439      INTEGER(iwp), DIMENSION(icl:icr), INTENT(IN) ::  ifl !< Indicates start index of child cells belonging to certain parent cell - x direction
     5440      INTEGER(iwp), DIMENSION(icl:icr), INTENT(IN) ::  ifu !< Indicates end index of child cells belonging to certain parent cell - x direction
     5441      INTEGER(iwp), DIMENSION(jcs:jcn), INTENT(IN) ::  jfl !< Indicates start index of child cells belonging to certain parent cell - y direction
     5442      INTEGER(iwp), DIMENSION(jcs:jcn), INTENT(IN) ::  jfu !< Indicates start index of child cells belonging to certain parent cell - y direction
     5443!AH      INTEGER(iwp), DIMENSION(0:kct), INTENT(IN)   ::  kfl !< Indicates start index of child cells belonging to certain parent cell - z direction
     5444!AH      INTEGER(iwp), DIMENSION(0:kct), INTENT(IN)   ::  kfu !< Indicates start index of child cells belonging to certain parent cell - z direction
     5445      INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN)   ::  kfl !< Indicates start index of child cells belonging to certain parent cell - z direction
     5446      INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN)   ::  kfu !< Indicates start index of child cells belonging to certain parent cell - z direction
     5447
     5448!AH      INTEGER(iwp), DIMENSION(0:kct,jcs:jcn,icl:icr), INTENT(IN) :: ijkfc !< number of child grid points contributing to a parent grid box
     5449      INTEGER(iwp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr), INTENT(IN) :: ijkfc !< number of child grid points contributing to a parent grid box
     5450
     5451      INTEGER(iwp) ::  nzt_topo_nestbc   !<
    51565452
    51575453      CHARACTER(LEN=1), INTENT(IN) ::  edge   !<
     
    51595455
    51605456      INTEGER(iwp) ::  i        !<
     5457      INTEGER(iwp) ::  ia       !<
    51615458      INTEGER(iwp) ::  ib       !<
    51625459      INTEGER(iwp) ::  ibgp     !<
     5460      INTEGER(iwp) ::  ijk      !<
     5461      INTEGER(iwp) ::  iw       !<
    51635462      INTEGER(iwp) ::  j        !<
    51645463      INTEGER(iwp) ::  jco      !<
    51655464      INTEGER(iwp) ::  jcorr    !<
    51665465      INTEGER(iwp) ::  jinc     !<
     5466      INTEGER(iwp) ::  jw       !<
    51675467      INTEGER(iwp) ::  j1       !<
    51685468      INTEGER(iwp) ::  k        !<
     
    51745474      INTEGER(iwp) ::  m        !<
    51755475      INTEGER(iwp) ::  n        !<
    5176      
     5476      INTEGER(iwp) ::  kbc      !<
     5477      INTEGER(iwp) ::  var_flag !<     
     5478
     5479      REAL(wp) ::  cellsum     !<
     5480      REAL(wP) ::  cellsumd    !<
    51775481      REAL(wp) ::  fkj         !<
    51785482      REAL(wp) ::  fkjp        !<
     
    51815485      REAL(wp) ::  fk          !<
    51825486      REAL(wp) ::  fkp         !<
    5183      
     5487      REAL(wp) ::  rcorr       !<
     5488      REAL(wp) ::  rcorr_ijk   !<
     5489 
    51845490!
    51855491!--   Check which edge is to be handled
     
    51985504         ib = nxr + 2
    51995505      ENDIF
    5200      
     5506
     5507      IF ( var == 'u' )  THEN
     5508         var_flag = 1
     5509      ELSEIF ( var == 'v' )  THEN
     5510         var_flag = 2
     5511      ELSEIF ( var == 'w' )  THEN
     5512         var_flag = 3
     5513      ELSE
     5514         var_flag = 0
     5515      ENDIF
     5516   
    52015517      DO  j = nys, nyn+1
    52025518!
    52035519!--      Determine vertical index of topography top at grid point (j,i)
    5204          k_wall = get_topography_top_index_ji( j, i, TRIM( var ) )
    5205 
    5206          DO  k = k_wall, nzt+1
     5520!AH         k_wall = get_topography_top_index_ji( j, i, TRIM( var ) )
     5521
     5522         DO  k = nzb, nzt+1 !k_wall, nzt+1
    52075523            l = ic(i)
    52085524            m = jc(j)
     
    52355551               DO  kcorr = 0, ncorr - 1
    52365552                  kco = k + kcorr
    5237                   f(kco,j,i) = logc_ratio(1,kcorr,k,j) * f(k1,j,i)
     5553!AH                  f(kco,j,i) = logc_ratio(1,kcorr,k,j) * f(k1,j,i)
    52385554               ENDDO
    52395555            ENDIF
     
    52615577                        jco = j + jinc * jcorr
    52625578                        IF ( jco >= nys .AND. jco <= nyn )  THEN
    5263                            f(k,jco,i) = logc_ratio(2,jcorr,k,j) * f(k,j1,i)
     5579!AH                           f(k,jco,i) = logc_ratio(2,jcorr,k,j) * f(k,j1,i)
    52645580                        ENDIF
    52655581                     ENDDO
     
    52825598                        DO  kcorr = 0, ncorr-1
    52835599                           kco = k + kcorr
    5284                            f(kco,jco,i) = 0.5_wp * ( logc_ratio(1,kcorr,k,j) * &
    5285                                                      f(k1,j,i)                 &
    5286                                                    + logc_ratio(2,jcorr,k,j) * &
    5287                                                      f(k,j1,i) )
     5600!AH                           f(kco,jco,i) = 0.5_wp * ( logc_ratio(1,kcorr,k,j) * &
     5601!AH                                                     f(k1,j,i)                 &
     5602!AH                                                   + logc_ratio(2,jcorr,k,j) * &
     5603!AH                                                     f(k,j1,i) )
    52885604                        ENDDO
    52895605                     ENDIF
     
    52955611      ENDIF  ! ( topography /= 'flat' )
    52965612!
    5297 !--   Rescale if f is the TKE.
    5298       IF ( var == 'e')  THEN
    5299          IF ( edge == 'l' )  THEN
    5300             DO  j = nys, nyn + 1
    5301 !
    5302 !--            Determine vertical index of topography top at grid point (j,i)
    5303                k_wall = get_topography_top_index_ji( j, i, 's' )
    5304 
    5305                DO  k = k_wall, nzt + 1
    5306                   f(k,j,i) = tkefactor_l(k,j) * f(k,j,i)
     5613!--   Apply the reversibility correction to the boundary-normal velocity-
     5614!--   component u and the scalars. It must not be applied to the boundary-
     5615!--   tangential velocity components v and w because their 2-D anterpolation
     5616!--   cells do not cover all the child-grid nodes on the boundary.
     5617      IF ( .NOT. ( ( var == 'v' ) .OR. ( var == 'w' ) ) )  THEN
     5618         l = ic(i)
     5619         DO  m = jcs, jcn
     5620            DO  n = 0, kct+1
     5621               ijk = 1
     5622               cellsum   = 0.0_wp
     5623               cellsumd  = 0.0_wp
     5624!
     5625!--            Note that the index name i must not be used here as a loop
     5626!--            index name since i is the constant boundary index, hence
     5627!--            the name ia.
     5628               DO  ia = ifl(l), ifu(l)   
     5629                  DO  j = jfl(m), jfu(m)
     5630                     DO  k = kfl(n), kfu(n)
     5631                        cellsum = cellsum + MERGE( f(k,j,ia), 0.0_wp,           &
     5632                             BTEST( wall_flags_0(k,j,ia), var_flag ) )
     5633                        celltmpd(ijk) = ABS( fc(n,m,l) - f(k,j,ia) )
     5634                        cellsumd      = cellsumd  + MERGE( celltmpd(ijk),       &
     5635                             0.0_wp, BTEST( wall_flags_0(k,j,ia), var_flag ) )
     5636                        ijk = ijk + 1
     5637                     ENDDO
     5638                  ENDDO
    53075639               ENDDO
    5308             ENDDO
    5309          ELSEIF ( edge == 'r' )  THEN           
    5310             DO  j = nys, nyn+1
    5311 !
    5312 !--            Determine vertical index of topography top at grid point (j,i)
    5313                k_wall = get_topography_top_index_ji( j, i, 's' )
    5314 
    5315                DO  k = k_wall, nzt+1
    5316                   f(k,j,i) = tkefactor_r(k,j) * f(k,j,i)
     5640
     5641               IF ( ijkfc(n,m,l) /= 0 )  THEN
     5642                  cellsum   = cellsum / REAL( ijkfc(n,m,l), KIND=wp )
     5643                  rcorr     = fc(n,m,l) - cellsum
     5644                  cellsumd  = cellsumd / REAL( ijkfc(n,m,l), KIND=wp )
     5645               ELSE
     5646                  cellsum   = 0.0_wp                 
     5647                  rcorr     = 0.0_wp
     5648                  cellsumd  = 1.0_wp
     5649                  celltmpd  = 1.0_wp
     5650               ENDIF
     5651!
     5652!--            Distribute the correction term to the child nodes according to
     5653!--            their relative difference to the parent value such that the
     5654!--            node with the largest difference gets the largest share of the
     5655!--            correction. The distribution is skipped if rcorr is negligibly
     5656!--            small in order to avoid division by zero.
     5657               IF ( ABS(rcorr) < 0.000001_wp )  THEN                 
     5658                  cellsumd  = 1.0_wp
     5659                  celltmpd  = 1.0_wp
     5660               ENDIF
     5661
     5662               ijk = 1
     5663               DO  ia = ifl(l), ifu(l)
     5664                  DO  j = jfl(m), jfu(m)
     5665                     DO  k = kfl(n), kfu(n)
     5666                        rcorr_ijk = rcorr * celltmpd(ijk) / cellsumd
     5667                        f(k,j,ia) = f(k,j,ia) + rcorr_ijk
     5668                        ijk = ijk + 1
     5669                     ENDDO
     5670                  ENDDO
    53175671               ENDDO
    5318             ENDDO
    5319          ENDIF
    5320       ENDIF
     5672               
     5673            ENDDO  ! n
     5674         ENDDO  ! m
     5675         
     5676      ENDIF  ! var not v or w
    53215677!
    53225678!--   Store the boundary values also into the other redundant ghost node layers.
    5323 !--   Please note, in case of only one ghost node layer, e.g. for the PW
     5679!--   Note that in case of only one ghost node layer, e.g. for the PW
    53245680!--   scheme, the following loops will not be entered.
    53255681      IF ( edge == 'l' )  THEN
     
    53395695   SUBROUTINE pmci_interp_tril_sn( f, fc, ic, jc, kc, r1x, r2x, r1y, r2y, r1z, &
    53405696                                   r2z, logc, logc_ratio, logc_kbounds,        &
    5341                                    nzt_topo_nestbc, edge, var )
     5697                                   nzt_topo_nestbc,                            &
     5698                                   kct, ifl, ifu, jfl, jfu, kfl, kfu, ijkfc,   &
     5699                                   edge, var )
    53425700
    53435701!
     
    53475705
    53485706      IMPLICIT NONE
    5349 
    5350       INTEGER(iwp) ::  nzt_topo_nestbc   !<
    53515707
    53525708      REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                      &
     
    53705726      INTEGER(iwp), DIMENSION(1:2,nxl:nxr), INTENT(IN)         ::  logc_kbounds  !<
    53715727
     5728      INTEGER(iwp) :: kct
     5729      INTEGER(iwp), DIMENSION(icl:icr), INTENT(IN) ::  ifl !< Indicates start index of child cells belonging to certain parent cell - x direction
     5730      INTEGER(iwp), DIMENSION(icl:icr), INTENT(IN) ::  ifu !< Indicates end index of child cells belonging to certain parent cell - x direction
     5731      INTEGER(iwp), DIMENSION(jcs:jcn), INTENT(IN) ::  jfl !< Indicates start index of child cells belonging to certain parent cell - y direction
     5732      INTEGER(iwp), DIMENSION(jcs:jcn), INTENT(IN) ::  jfu !< Indicates start index of child cells belonging to certain parent cell - y direction
     5733!AH      INTEGER(iwp), DIMENSION(0:kct), INTENT(IN)   ::  kfl !< Indicates start index of child cells belonging to certain parent cell - z direction
     5734!AH      INTEGER(iwp), DIMENSION(0:kct), INTENT(IN)   ::  kfu !< Indicates start index of child cells belonging to certain parent cell - z direction
     5735      INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN)   ::  kfl !< Indicates start index of child cells belonging to certain parent cell - z direction
     5736      INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN)   ::  kfu !< Indicates start index of child cells belonging to certain parent cell - z direction
     5737!AH      INTEGER(iwp), DIMENSION(0:kct,jcs:jcn,icl:icr), INTENT(IN) :: ijkfc !< number of child grid points contributing to a parent grid box
     5738      INTEGER(iwp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr), INTENT(IN) :: ijkfc !< number of child grid points contributing to a parent grid box
     5739
     5740      INTEGER(iwp) ::  nzt_topo_nestbc   !<
     5741
    53725742      CHARACTER(LEN=1), INTENT(IN) ::  edge   !<
    53735743      CHARACTER(LEN=1), INTENT(IN) ::  var    !<
     
    53775747      INTEGER(iwp) ::  icorr   !<
    53785748      INTEGER(iwp) ::  ico     !<
     5749      INTEGER(iwp) ::  ijk     !<
    53795750      INTEGER(iwp) ::  i1      !<
    53805751      INTEGER(iwp) ::  j       !<
     5752      INTEGER(iwp) ::  ja      !<
    53815753      INTEGER(iwp) ::  jb      !<
    53825754      INTEGER(iwp) ::  jbgp    !<
    53835755      INTEGER(iwp) ::  k       !<
    5384       INTEGER(iwp) ::  k_wall   !< vertical index of topography top
     5756      INTEGER(iwp) ::  k_wall  !< vertical index of topography top
    53855757      INTEGER(iwp) ::  kcorr   !<
    53865758      INTEGER(iwp) ::  kco     !<
     
    53895761      INTEGER(iwp) ::  m       !<
    53905762      INTEGER(iwp) ::  n       !<
    5391                            
     5763      INTEGER(iwp) ::  var_flag !<
     5764
     5765      REAL(wp) ::  cellsum     !<
     5766      REAL(wp) ::  cellsumd    !<
    53925767      REAL(wp) ::  fk          !<
    53935768      REAL(wp) ::  fkj         !<
     
    53965771      REAL(wp) ::  fkpjp       !<
    53975772      REAL(wp) ::  fkp         !<
     5773      REAL(wp) ::  rcorr       !<
     5774      REAL(wp) ::  rcorr_ijk   !<
    53985775     
    53995776!
     
    54145791      ENDIF
    54155792
     5793      IF ( var == 'u' )  THEN
     5794         var_flag = 1
     5795      ELSEIF ( var == 'v' )  THEN
     5796         var_flag = 2
     5797      ELSEIF ( var == 'w' )  THEN
     5798         var_flag = 3
     5799      ELSE
     5800         var_flag = 0
     5801      ENDIF
     5802
    54165803      DO  i = nxl, nxr+1
    54175804!
    54185805!--      Determine vertical index of topography top at grid point (j,i)
    5419          k_wall = get_topography_top_index_ji( j, i, TRIM( var ) )
    5420 
    5421          DO  k = k_wall, nzt+1
     5806!AH         k_wall = get_topography_top_index_ji( j, i, TRIM( var ) )
     5807
     5808         DO  k = nzb, nzt+1 !AH k_wall, nzt+1
    54225809            l = ic(i)
    54235810            m = jc(j)
     
    54505837               DO  kcorr = 0, ncorr-1
    54515838                  kco = k + kcorr
    5452                   f(kco,j,i) = logc_ratio(1,kcorr,k,i) * f(k1,j,i)
     5839!AH                  f(kco,j,i) = logc_ratio(1,kcorr,k,i) * f(k1,j,i)
    54535840               ENDDO
    54545841            ENDIF
     
    54775864                        ico = i + iinc * icorr
    54785865                        IF ( ico >= nxl .AND. ico <= nxr )  THEN
    5479                            f(k,j,ico) = logc_ratio(2,icorr,k,i) * f(k,j,i1)
     5866!AH                           f(k,j,ico) = logc_ratio(2,icorr,k,i) * f(k,j,i1)
    54805867                        ENDIF
    54815868                     ENDDO
     
    54985885                        DO  kcorr = 0, ncorr-1
    54995886                           kco = k + kcorr
    5500                            f(kco,j,ico) = 0.5_wp * ( logc_ratio(1,kcorr,k,i) * &
    5501                                                      f(k1,j,i)                 &
    5502                                                    + logc_ratio(2,icorr,k,i) * &
    5503                                                      f(k,j,i1) )
     5887!AH                           f(kco,j,ico) = 0.5_wp * ( logc_ratio(1,kcorr,k,i) * &
     5888!AH                                                     f(k1,j,i)                 &
     5889!AH                                                   + logc_ratio(2,icorr,k,i) * &
     5890!AH                                                     f(k,j,i1) )
    55045891                        ENDDO
    55055892                     ENDIF
     
    55115898      ENDIF  ! ( topography /= 'flat' )
    55125899!
    5513 !--   Rescale if f is the TKE.
    5514       IF ( var == 'e')  THEN
    5515          IF ( edge == 's' )  THEN
    5516             DO  i = nxl, nxr + 1
    5517 !
    5518 !--            Determine vertical index of topography top at grid point (j,i)
    5519                k_wall = get_topography_top_index_ji( j, i, 's' )
    5520                DO  k = k_wall, nzt+1
    5521                   f(k,j,i) = tkefactor_s(k,i) * f(k,j,i)
     5900!--   Apply the reversibility correction to the boundary-normal velocity-
     5901!--   component v and the scalars. It must not be applied to the boundary-
     5902!--   tangential velocity components u and w because their 2-D anterpolation
     5903!--   cells do not cover all the child-grid nodes on the boundary.
     5904      IF ( .NOT. ( ( var == 'u' ) .OR. ( var == 'w' ) ) )  THEN
     5905         m = jc(j)
     5906         DO  l = icl, icr
     5907            DO  n = 0, kct+1
     5908               ijk = 1
     5909               cellsum   = 0.0_wp
     5910               cellsumd  = 0.0_wp
     5911               DO  i = ifl(l), ifu(l)
     5912                  DO  ja = jfl(m), jfu(m)
     5913                     DO  k = kfl(n), kfu(n)
     5914                        cellsum = cellsum + MERGE( f(k,ja,i), 0.0_wp,           &
     5915                             BTEST( wall_flags_0(k,ja,i), var_flag ) )                       
     5916                        celltmpd(ijk) = ABS( fc(n,m,l) - f(k,ja,i) )
     5917                        cellsumd      = cellsumd  + MERGE( celltmpd(ijk),       &
     5918                             0.0_wp, BTEST( wall_flags_0(k,ja,i), var_flag ) )
     5919                        ijk = ijk + 1
     5920                     ENDDO
     5921                  ENDDO
    55225922               ENDDO
    5523             ENDDO
    5524          ELSEIF ( edge == 'n' )  THEN
    5525             DO  i = nxl, nxr + 1
    5526 !
    5527 !--            Determine vertical index of topography top at grid point (j,i)
    5528                k_wall = get_topography_top_index_ji( j, i, 's' )
    5529                DO  k = k_wall, nzt+1
    5530                   f(k,j,i) = tkefactor_n(k,i) * f(k,j,i)
     5923
     5924               IF ( ijkfc(n,m,l) /= 0 )  THEN
     5925                  cellsum   = cellsum / REAL( ijkfc(n,m,l), KIND=wp )
     5926                  rcorr     = fc(n,m,l) - cellsum
     5927                  cellsumd  = cellsumd / REAL( ijkfc(n,m,l), KIND=wp )
     5928               ELSE
     5929                  cellsum   = 0.0_wp                 
     5930                  rcorr     = 0.0_wp
     5931                  cellsumd  = 1.0_wp
     5932                  celltmpd  = 1.0_wp
     5933               ENDIF
     5934!
     5935!--            Distribute the correction term to the child nodes according to
     5936!--            their relative difference to the parent value such that the
     5937!--            node with the largest difference gets the largest share of the
     5938!--            correction. The distribution is skipped if rcorr is negligibly
     5939!--            small in order to avoid division by zero.
     5940               IF ( ABS(rcorr) < 0.000001_wp )  THEN                 
     5941                  cellsumd  = 1.0_wp
     5942                  celltmpd  = 1.0_wp
     5943               ENDIF
     5944           
     5945               ijk = 1           
     5946               DO  i = ifl(l), ifu(l)
     5947                  DO  ja = jfl(m), jfu(m)
     5948                     DO  k = kfl(n), kfu(n)
     5949                        rcorr_ijk = rcorr * celltmpd(ijk) / cellsumd
     5950                        f(k,ja,i) = f(k,ja,i) + rcorr_ijk
     5951                        ijk = ijk + 1
     5952                     ENDDO
     5953                  ENDDO
    55315954               ENDDO
    5532             ENDDO
    5533          ENDIF
    5534       ENDIF
     5955               
     5956            ENDDO  ! n
     5957         ENDDO  ! l
     5958
     5959      ENDIF  ! var not u or w
    55355960!
    55365961!--   Store the boundary values also into the other redundant ghost node layers.
    5537 !--   Please note, in case of only one ghost node layer, e.g. for the PW
     5962!--   Note that in case of only one ghost node layer, e.g. for the PW
    55385963!--   scheme, the following loops will not be entered.
    55395964      IF ( edge == 's' )  THEN
     
    55515976 
    55525977
    5553    SUBROUTINE pmci_interp_tril_t( f, fc, ic, jc, kc, r1x, r2x, r1y, r2y, r1z,  &
    5554                                   r2z, var )
     5978   SUBROUTINE pmci_interp_tril_t( f, fc, ic, jc, kc, r1x, r2x, r1y, r2y,       &
     5979                                  r1z, r2z, kct, ifl, ifu, jfl, jfu, kfl, kfu, &
     5980                                  ijkfc, var )
    55555981
    55565982!
     
    55766002      INTEGER(iwp), DIMENSION(nzb:nzt+1), INTENT(IN) ::  kc    !<
    55776003     
     6004      INTEGER(iwp) :: kct
     6005      INTEGER(iwp), DIMENSION(icl:icr), INTENT(IN) ::  ifl !< Indicates start index of child cells belonging to certain parent cell - x direction
     6006      INTEGER(iwp), DIMENSION(icl:icr), INTENT(IN) ::  ifu !< Indicates end index of child cells belonging to certain parent cell - x direction
     6007      INTEGER(iwp), DIMENSION(jcs:jcn), INTENT(IN) ::  jfl !< Indicates start index of child cells belonging to certain parent cell - y direction
     6008      INTEGER(iwp), DIMENSION(jcs:jcn), INTENT(IN) ::  jfu !< Indicates start index of child cells belonging to certain parent cell - y direction
     6009!AH      INTEGER(iwp), DIMENSION(0:kct), INTENT(IN)   ::  kfl !< Indicates start index of child cells belonging to certain parent cell - z direction
     6010!AH      INTEGER(iwp), DIMENSION(0:kct), INTENT(IN)   ::  kfu !< Indicates start index of child cells belonging to certain parent cell - z direction
     6011      INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN)   ::  kfl !< Indicates start index of child cells belonging to certain parent cell - z direction
     6012      INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN)   ::  kfu !< Indicates start index of child cells belonging to certain parent cell - z direction
     6013!AH      INTEGER(iwp), DIMENSION(0:kct,jcs:jcn,icl:icr), INTENT(IN) :: ijkfc !< number of child grid points contributing to a parent grid box
     6014      INTEGER(iwp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr), INTENT(IN) :: ijkfc !< number of child grid points contributing to a parent grid box
     6015
    55786016      CHARACTER(LEN=1), INTENT(IN) :: var   !<
    55796017
     
    55816019      INTEGER(iwp) ::  ib  !<
    55826020      INTEGER(iwp) ::  ie  !<
     6021      INTEGER(iwp) ::  ijk !<
    55836022      INTEGER(iwp) ::  j   !<
    5584       INTEGER(iwp) ::  jb   !<
    5585       INTEGER(iwp) ::  je   !<     
     6023      INTEGER(iwp) ::  jb  !<
     6024      INTEGER(iwp) ::  je  !<     
    55866025      INTEGER(iwp) ::  k   !<
     6026      INTEGER(iwp) ::  ka  !<
    55876027      INTEGER(iwp) ::  l   !<
    55886028      INTEGER(iwp) ::  m   !<
    55896029      INTEGER(iwp) ::  n   !<
     6030      INTEGER(iwp) ::  var_flag  !<
    55906031     
     6032      REAL(wp) ::  cellsum     !<
     6033      REAL(wp) ::  cellsumd    !<
    55916034      REAL(wp) ::  fk          !<
    55926035      REAL(wp) ::  fkj         !<
     
    55956038      REAL(wp) ::  fkpjp       !<
    55966039      REAL(wp) ::  fkp         !<
    5597 
    5598      
     6040      REAL(wp) ::  rcorr       !<
     6041      REAL(wp) ::  rcorr_ijk   !<
     6042
     6043
    55996044      IF ( var == 'w' )  THEN
    56006045         k  = nzt
     
    56106055      jb = nys-1
    56116056      je = nyn+1
    5612 !
    5613 !--   The exceedings must not be made past the outer edges in
    5614 !--   case of pure vertical nesting.
    5615       IF ( nesting_mode == 'vertical' )  THEN
    5616          IF ( nxl == 0  )  ib = nxl
    5617          IF ( nxr == nx )  ie = nxr
    5618          IF ( nys == 0  )  jb = nys
    5619          IF ( nyn == ny )  je = nyn
     6057
     6058      IF ( var == 'u' )  THEN
     6059         var_flag = 1
     6060      ELSEIF ( var == 'v' )  THEN
     6061         var_flag = 2
     6062      ELSEIF ( var == 'w' )  THEN
     6063         var_flag = 3
     6064      ELSE
     6065         var_flag = 0
    56206066      ENDIF
    56216067         
     
    56356081      ENDDO
    56366082!
    5637 !--   Just fill up the second ghost-node layer for w.
     6083!--   Apply the reversibility correction to the boundary-normal velocity-
     6084!--   component w and scalars. It must not be applied to the boundary-
     6085!--   tangential velocity components u and v because their 2-D anterpolation
     6086!--   cells do not cover all the child-grid nodes on the boundary.
     6087      IF ( .NOT. ( ( var == 'u' ) .OR. ( var == 'v' ) ) )  THEN 
     6088         IF ( var == 'w' )  THEN
     6089            n = kc(k)
     6090         ELSE
     6091            n = kc(k) + 1
     6092         ENDIF
     6093
     6094         DO  l = icl, icr
     6095            DO  m = jcs, jcn
     6096               ijk = 1
     6097               cellsum   = 0.0_wp
     6098               cellsumd  = 0.0_wp
     6099               DO  i = ifl(l), ifu(l)
     6100                  DO  j = jfl(m), jfu(m)
     6101                     DO  ka = kfl(n), kfu(n)
     6102                        cellsum = cellsum + MERGE( f(ka,j,i), 0.0_wp,           &
     6103                             BTEST( wall_flags_0(ka,j,i), var_flag ) )
     6104                        celltmpd(ijk) = ABS( fc(n,m,l) - f(ka,j,i) )
     6105                        cellsumd      = cellsumd  + MERGE( celltmpd(ijk),       &
     6106                             0.0_wp, BTEST( wall_flags_0(ka,j,i), var_flag ) )                     
     6107                        ijk = ijk + 1
     6108                     ENDDO
     6109                  ENDDO
     6110               ENDDO
     6111
     6112               IF ( ijkfc(n,m,l) /= 0 )  THEN
     6113                  cellsum   = cellsum / REAL( ijkfc(n,m,l), KIND=wp )
     6114                  rcorr     = fc(n,m,l) - cellsum
     6115                  cellsumd  = cellsumd / REAL( ijkfc(n,m,l), KIND=wp )
     6116               ELSE
     6117                  cellsum   = 0.0_wp
     6118                  rcorr     = 0.0_wp
     6119                  cellsumd  = 1.0_wp
     6120                  celltmpd  = 1.0_wp
     6121               ENDIF
     6122
     6123               IF ( ABS(rcorr) < 0.000001_wp )  THEN                 
     6124                  cellsumd  = 1.0_wp
     6125                  celltmpd  = 1.0_wp
     6126               ENDIF
     6127
     6128               ijk = 1
     6129               DO  i = ifl(l), ifu(l)
     6130                  DO  j = jfl(m), jfu(m)
     6131                     DO  ka = kfl(n), kfu(n)
     6132                        rcorr_ijk = rcorr * celltmpd(ijk) / cellsumd
     6133                        f(ka,j,i) = f(ka,j,i) + rcorr_ijk
     6134                        ijk = ijk + 1
     6135                     ENDDO
     6136                  ENDDO
     6137               ENDDO
     6138               
     6139            ENDDO  ! m
     6140         ENDDO  ! l
     6141
     6142      ENDIF  ! var not u or v
     6143!
     6144!--   Just fill up the redundant second ghost-node layer for w.
    56386145      IF ( var == 'w' )  THEN
    56396146         f(nzt+1,:,:) = f(nzt,:,:)
    5640       ENDIF
    5641 !
    5642 !--   Rescale if f is the TKE.
    5643 !--   It is assumed that the bottom surface never reaches the top boundary of a
    5644 !--   nest domain.
    5645       IF ( var == 'e' )  THEN
    5646          DO  i = nxl, nxr
    5647             DO  j = nys, nyn
    5648                f(k,j,i) = tkefactor_t(j,i) * f(k,j,i)
    5649             ENDDO
    5650          ENDDO
    56516147      ENDIF
    56526148
     
    56676163       CHARACTER(LEN=*), INTENT(IN) ::  var   !< identifyer for treated variable
    56686164
     6165!AH       INTEGER(iwp), DIMENSION(0:kct,jcs:jcn,icl:icr), INTENT(IN) :: ijkfc !< number of child grid points contributing to a parent grid box
     6166       INTEGER(iwp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr), INTENT(IN) :: ijkfc !< number of child grid points contributing to a parent grid box
     6167
    56696168       INTEGER(iwp) ::  i         !< Running index x-direction - fine-grid
     6169       INTEGER(iwp) ::  icla      !< Left boundary index for anterpolation along x
     6170       INTEGER(iwp) ::  icra      !< Right boundary index for anterpolation along x
    56706171       INTEGER(iwp) ::  ii        !< Running index x-direction - coarse grid
    5671        INTEGER(iwp) ::  iclp      !< Left boundary index for anterpolation along x
    5672        INTEGER(iwp) ::  icrm      !< Right boundary index for anterpolation along x
    56736172       INTEGER(iwp) ::  j         !< Running index y-direction - fine-grid
     6173       INTEGER(iwp) ::  jcna      !< North boundary index for anterpolation along y
     6174       INTEGER(iwp) ::  jcsa      !< South boundary index for anterpolation along y
    56746175       INTEGER(iwp) ::  jj        !< Running index y-direction - coarse grid
    5675        INTEGER(iwp) ::  jcnm      !< North boundary index for anterpolation along y
    5676        INTEGER(iwp) ::  jcsp      !< South boundary index for anterpolation along y
    56776176       INTEGER(iwp) ::  k         !< Running index z-direction - fine-grid     
     6177       INTEGER(iwp) ::  kcb = 0   !< Bottom boundary index for anterpolation along z
    56786178       INTEGER(iwp) ::  kk        !< Running index z-direction - coarse grid
    5679        INTEGER(iwp) ::  kcb = 0   !< Bottom boundary index for anterpolation along z
    56806179       INTEGER(iwp) ::  var_flag  !< bit number used to flag topography on respective grid
    56816180
     
    56866185       INTEGER(iwp), DIMENSION(jcs:jcn), INTENT(IN) ::  jfl !< Indicates start index of child cells belonging to certain parent cell - y direction
    56876186       INTEGER(iwp), DIMENSION(jcs:jcn), INTENT(IN) ::  jfu !< Indicates start index of child cells belonging to certain parent cell - y direction
    5688        INTEGER(iwp), DIMENSION(0:kct), INTENT(IN)   ::  kfl !< Indicates start index of child cells belonging to certain parent cell - z direction
    5689        INTEGER(iwp), DIMENSION(0:kct), INTENT(IN)   ::  kfu !< Indicates start index of child cells belonging to certain parent cell - z direction
    5690 
    5691        INTEGER(iwp), DIMENSION(0:kct,jcs:jcn,icl:icr), INTENT(IN) :: ijkfc !< number of child grid points contributing to a parent grid box
     6187!AH       INTEGER(iwp), DIMENSION(0:kct), INTENT(IN)   ::  kfl !< Indicates start index of child cells belonging to certain parent cell - z direction
     6188!AH       INTEGER(iwp), DIMENSION(0:kct), INTENT(IN)   ::  kfu !< Indicates start index of child cells belonging to certain parent cell - z direction
     6189       INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN)   ::  kfl !< Indicates start index of child cells belonging to certain parent cell - z direction
     6190       INTEGER(iwp), DIMENSION(0:cg%nz+1), INTENT(IN)   ::  kfu !< Indicates start index of child cells belonging to certain parent cell - z direction
    56926191
    56936192       REAL(wp) ::  cellsum   !< sum of respective child cells belonging to parent cell
     
    56986197 
    56996198!
    5700 !--    Initialize the index bounds for anterpolation
    5701        iclp = icl
    5702        icrm = icr
    5703        jcsp = jcs
    5704        jcnm = jcn
    5705        kcb  = 0
    5706 !
    5707 !--    Define the index bounds iclp, icrm, jcsp and jcnm.
     6199!--    Define the index bounds icla, icra, jcsa and jcna.
    57086200!--    Note that kcb is simply zero and kct enters here as a parameter and it is
    57096201!--    determined in pmci_init_anterp_tophat.
     
    57146206!--    child domain, leading to increased velocity variances. A more
    57156207!--    comprehensive explanation for this is still pending.
    5716        IF ( nesting_mode == 'vertical' )  THEN
    5717           IF ( bc_dirichlet_l )  THEN
    5718              iclp = icl + nhll
    5719           ENDIF
    5720           IF ( bc_dirichlet_r ) THEN
    5721              icrm = icr - nhlr
    5722           ENDIF
    5723           IF ( bc_dirichlet_s )  THEN
    5724              jcsp = jcs + nhls
    5725           ENDIF
    5726           IF ( bc_dirichlet_n )  THEN
    5727              jcnm = jcn - nhln
    5728           ENDIF
    5729        ELSE
     6208       icla = coarse_bound_anterp(1)
     6209       icra = coarse_bound_anterp(2)
     6210       jcsa = coarse_bound_anterp(3)
     6211       jcna = coarse_bound_anterp(4)
     6212       kcb  = 0
     6213       IF ( nesting_mode /= 'vertical' )  THEN
    57306214          IF ( bc_dirichlet_l )  THEN
    57316215             IF ( var == 'u' )  THEN
    5732                 iclp = icl + nhll + 1 + 1
     6216                icla = coarse_bound_anterp(1) + 2
    57336217             ELSE
    5734                 iclp = icl + nhll + 1
     6218                icla = coarse_bound_anterp(1) + 1
    57356219             ENDIF
    57366220          ENDIF
    57376221          IF ( bc_dirichlet_r )  THEN
    5738              icrm = icr - nhlr - 1
     6222             icra = coarse_bound_anterp(2) - 1
    57396223          ENDIF
    57406224
    57416225          IF ( bc_dirichlet_s )  THEN
    57426226             IF ( var == 'v' )  THEN
    5743                 jcsp = jcs + nhls + 1 + 1
     6227                jcsa = coarse_bound_anterp(3) + 2
    57446228             ELSE
    5745                 jcsp = jcs + nhls + 1
     6229                jcsa = coarse_bound_anterp(3) + 1
    57466230             ENDIF
    57476231          ENDIF
    57486232          IF ( bc_dirichlet_n )  THEN
    5749              jcnm = jcn - nhln - 1
     6233             jcna = coarse_bound_anterp(4) - 1
    57506234          ENDIF
    57516235       ENDIF
     6236
     6237!       write(9,"('pmci_anterp_tophat: ',4(e12.5,2x))")   &
     6238!            cg%coord_x(icla), cg%coord_y(jcsa),  cg%coord_x(icra), cg%coord_y(jcna) 
     6239!       flush(9)
    57526240!
    57536241!--    Set masking bit for topography flags
     
    57616249          var_flag = 0
    57626250       ENDIF 
    5763 
    57646251!
    57656252!--    Note that ii, jj, and kk are coarse-grid indices and i,j, and k
    57666253!--    are fine-grid indices.
    5767        DO  ii = iclp, icrm
    5768           DO  jj = jcsp, jcnm
     6254       DO  ii = icla, icra
     6255          DO  jj = jcsa, jcna
    57696256!
    57706257!--          For simplicity anterpolate within buildings and under elevated
    57716258!--          terrain too
    5772              DO  kk = kcb, kct - 1
    5773 
     6259             DO  kk = kcb, kct - 1               
    57746260                cellsum = 0.0_wp
    57756261                DO  i = ifl(ii), ifu(ii)
     
    57836269!
    57846270!--             Spatial under-relaxation.
    5785                 fra  = frax(ii) * fray(jj) * fraz(kk)
     6271!--             The relaxation buffer zones are no longer needed with
     6272!--             the new reversible interpolation algorithm. 23.19.2018.
     6273!                fra  = frax(ii) * fray(jj) * fraz(kk)               
    57866274!
    57876275!--             In case all child grid points are inside topography, i.e.
     
    57916279!--             zero, keep the parent solution at this point.
    57926280                IF ( ijkfc(kk,jj,ii) /= 0 )  THEN
    5793                    fc(kk,jj,ii) = ( 1.0_wp - fra ) * fc(kk,jj,ii) +            &
    5794                                     fra * cellsum  /                           &
    5795                                     REAL( ijkfc(kk,jj,ii), KIND=wp )
    5796                 ENDIF 
     6281!                   fc(kk,jj,ii) = ( 1.0_wp - fra ) * fc(kk,jj,ii) +         &
     6282!                        fra * cellsum  /                                    &
     6283!                        REAL( ijkfc(kk,jj,ii), KIND=wp )
     6284                   fc(kk,jj,ii) = cellsum / REAL( ijkfc(kk,jj,ii), KIND=wp )
     6285                ENDIF
    57976286
    57986287             ENDDO
  • palm/trunk/SOURCE/time_integration.f90

    r3473 r3484  
    2525! -----------------
    2626! $Id$
     27! pmci_ensure_nest_mass_conservation is premanently removed
     28!
     29! 3473 2018-10-30 20:50:15Z suehring
    2730! new module for virtual measurements introduced
    2831!
     
    517520    USE pmc_interface,                                                         &
    518521        ONLY:  nested_run, nesting_mode, pmci_boundary_conds, pmci_datatrans,  &
    519                pmci_ensure_nest_mass_conservation, pmci_synchronize
     522               pmci_synchronize
    520523
    521524    USE progress_bar,                                                          &
     
    978981!--          Set boundary conditions again after interpolation and anterpolation.
    979982             CALL pmci_boundary_conds
    980 !
    981 !--          Correct the w top-BC in nest domains to ensure mass conservation.
    982 !--          This action must never be done for the root domain. Vertical
    983 !--          Commented out April 18, 2018 as seemingly unnecessary.
    984 !--          Will later be completely removed.
    985 !--             IF ( child_domain )  THEN
    986 !--                CALL pmci_ensure_nest_mass_conservation
    987 !--             ENDIF
    988 
    989983
    990984             CALL cpu_log( log_point(60), 'nesting', 'stop' )
Note: See TracChangeset for help on using the changeset viewer.