Home


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

Changeset 2801 for palm/trunk/SOURCE


Ignore:
Timestamp:
Feb 14, 2018 4:01:55 PM (6 years ago)
Author:
thiele
Message:

Introduce particle transfer in nested models

Location:
palm/trunk/SOURCE
Files:
1 added
13 edited

Legend:

Unmodified
Added
Removed

  • palm/trunk/SOURCE/lpm.f90

    r2718 r2801  
     1MODULE lpm_mod
     2
    13!> @file lpm.f90
    24!------------------------------------------------------------------------------!
    … …  
    2527! -----------------
    2628! $Id$
     29! Changed lpm from subroutine to module.
     30! Introduce particle transfer in nested models.
     31!
     32! 2718 2018-01-02 08:49:38Z maronga
    2733! Corrected "Former revisions" section
    2834!
    … …  
    139145!> Particle advection
    140146!------------------------------------------------------------------------------!
    141  SUBROUTINE lpm
    142147 
    143148
    … …  
    163168        ONLY: lpm_create_particle, PHASE_RELEASE
    164169
    165     USE lpm_pack_and_sort_mod,                                                   &
    166         ONLY:  lpm_sort_in_subboxes, lpm_sort_timeloop_done
     170    USE lpm_pack_and_sort_mod
    167171
    168172    USE particle_attributes,                                                   &
    … …  
    179183    USE pegrid
    180184
     185 USE pmc_particle_interface,                                                &
     186     ONLY: pmcp_c_get_particle_from_parent, pmcp_p_fill_particle_win,       &
     187           pmcp_c_send_particle_to_parent, pmcp_p_empty_particle_win,       &
     188           pmcp_p_delete_particles_in_fine_grid_area
     189
     190    USE pmc_interface,                                                      &
     191       ONLY: nested_run
     192
     193 IMPLICIT NONE
     194 PRIVATE
     195 SAVE
     196
     197 INTERFACE lpm
     198    MODULE PROCEDURE lpm
     199 END INTERFACE lpm
     200
     201 PUBLIC lpm
     202
     203CONTAINS
     204 SUBROUTINE lpm
    181205    IMPLICIT NONE
    182206
    … …  
    424448!--    Horizontal boundary conditions including exchange between subdmains
    425449       CALL lpm_exchange_horiz
    426 !
    427 !--    Pack particles (eliminate those marked for deletion),
    428 !--    determine new number of particles
    429        CALL lpm_sort_in_subboxes
    430 !
    431 !--    Initialize variables for the next (sub-) timestep, i.e., for marking
    432 !--    those particles to be deleted after the timestep
    433        deleted_particles = 0
     450
     451       IF ( .NOT. dt_3d_reached .OR. .NOT. nested_run )   THEN    ! IF .FALSE., lpm_sort_in_subboxes is done inside pcmp
     452!
     453!--       Pack particles (eliminate those marked for deletion),
     454!--       determine new number of particles
     455          CALL lpm_sort_in_subboxes
     456!
     457!--       Initialize variables for the next (sub-) timestep, i.e., for marking
     458!--       those particles to be deleted after the timestep
     459          deleted_particles = 0
     460       ENDIF
    434461
    435462       IF ( dt_3d_reached )  EXIT
    … …  
    437464       first_loop_stride = .FALSE.
    438465    ENDDO   ! timestep loop
     466!   
     467!-- in case of nested runs do the transfer of particles after every full model time step
     468    IF ( nested_run )   THEN
     469       CALL particles_from_parent_to_child
     470       CALL particles_from_child_to_parent
     471       CALL pmcp_p_delete_particles_in_fine_grid_area
     472
     473       CALL lpm_sort_in_subboxes
     474
     475       deleted_particles = 0
     476    ENDIF
    439477
    440478!
    … …  
    469507
    470508 END SUBROUTINE lpm
     509
     510 SUBROUTINE particles_from_parent_to_child
     511    IMPLICIT NONE
     512
     513    CALL pmcp_c_get_particle_from_parent                         ! Child actions
     514    CALL pmcp_p_fill_particle_win                                ! Parent actions
     515
     516    RETURN
     517 END SUBROUTINE particles_from_parent_to_child
     518
     519 SUBROUTINE particles_from_child_to_parent
     520    IMPLICIT NONE
     521
     522    CALL pmcp_c_send_particle_to_parent                         ! Child actions
     523    CALL pmcp_p_empty_particle_win                              ! Parent actions
     524
     525    RETURN
     526 END SUBROUTINE particles_from_child_to_parent
     527
     528
     529END MODULE lpm_mod

  • palm/trunk/SOURCE/lpm_boundary_conds.f90

    r2718 r2801  
    2525! -----------------
    2626! $Id$
     27! Introduce particle transfer in nested models.
     28!
     29! 2718 2018-01-02 08:49:38Z maronga
    2730! Corrected "Former revisions" section
    2831!
    … …  
    230233          ENDIF
    231234
    232           IF ( particles(n)%z >= zu(nz)  .AND.  particles(n)%particle_mask )  THEN
     235          IF ( particles(n)%z >= zw(nz)  .AND.  particles(n)%particle_mask )  THEN
    233236             IF ( ibc_par_t == 1 )  THEN
    234237!
    235238!--             Particle absorption
     239                WRITE(9,*) 'particle absorption'
    236240                particles(n)%particle_mask  = .FALSE.
    237241                deleted_particles = deleted_particles + 1
    … …  
    239243!
    240244!--             Particle reflection
    241                 particles(n)%z       = 2.0_wp * zu(nz) - particles(n)%z
     245                particles(n)%z       = 2.0_wp * zw(nz) - particles(n)%z
    242246                particles(n)%speed_z = -particles(n)%speed_z
    243247                IF ( use_sgs_for_particles  .AND. &

  • palm/trunk/SOURCE/lpm_exchange_horiz.f90

    r2718 r2801  
    2525! -----------------
    2626! $Id$
     27! Introduce particle transfer in nested models.
     28!
     29! 2718 2018-01-02 08:49:38Z maronga
    2730! Corrected "Former revisions" section
    2831!
    … …  
    11751178                      'Particle violated CFL-criterion: particle with id ',    &
    11761179                      particles(n)%id,' will be deleted!'   
    1177                       CALL message( 'lpm_check_cfl', 'PA0475', 0, 1, 0, 6, 0 )
     1180                      CALL message( 'lpm_check_cfl', 'PA0475', 0, 1, -1, 6, 0 )
    11781181                      particles(n)%particle_mask= .FALSE.
    11791182                   ENDIF

  • palm/trunk/SOURCE/lpm_init.f90

    r2718 r2801  
    2525! -----------------
    2626! $Id$
     27! Introduce particle transfer in nested models.
     28!
     29! 2718 2018-01-02 08:49:38Z maronga
    2730! Corrected "Former revisions" section
    2831!
    … …  
    250253        ONLY:  get_topography_top_index_ji, surf_def_h, surf_lsm_h, surf_usm_h
    251254
     255    USE pmc_particle_interface,                                                &
     256        ONLY:  pmcp_g_init
     257
    252258    IMPLICIT NONE
    253259
    … …  
    460466       CASE ( 'reflect' )
    461467          ibc_par_t = 2
     468         
     469       CASE ( 'nested' )
     470          ibc_par_t = 3
    462471
    463472       CASE DEFAULT
    … …  
    477486       CASE ( 'reflect' )
    478487          ibc_par_lr = 2
     488         
     489       CASE ( 'nested' )
     490          ibc_par_lr = 3
    479491
    480492       CASE DEFAULT
    … …  
    494506       CASE ( 'reflect' )
    495507          ibc_par_ns = 2
     508         
     509       CASE ( 'nested' )
     510          ibc_par_ns = 3
    496511
    497512       CASE DEFAULT
    … …  
    621636
    622637    ENDIF
     638
     639    CALL pmcp_g_init
    623640
    624641!

  • palm/trunk/SOURCE/lpm_pack_arrays.f90

    r2718 r2801  
    2525! -----------------
    2626! $Id$
     27! Introduce particle transfer in nested models.
     28!
     29! 2718 2018-01-02 08:49:38Z maronga
    2730! Corrected "Former revisions" section
    2831!
    … …  
    207210       ENDDO
    208211       CALL cpu_log( log_point_s(51), 'lpm_sort_in_subboxes', 'stop' )
    209        RETURN
    210212
    211213    END SUBROUTINE lpm_sort_in_subboxes

  • palm/trunk/SOURCE/lpm_write_exchange_statistics.f90

    r2718 r2801  
    2525! -----------------
    2626! $Id$
     27! Introduce particle transfer in nested models.
     28!
     29! 2718 2018-01-02 08:49:38Z maronga
    2730! Corrected "Former revisions" section
    2831!
    … …  
    6972 SUBROUTINE lpm_write_exchange_statistics
    7073 
     74    USE MPI
    7175
    7276    USE control_parameters,                                                    &
    … …  
    8286               trsp_count_sum, trsp_count_recv_sum
    8387
     88    USE pmc_particle_interface,                                                &
     89        ONLY:  pmcp_g_print_number_of_particles
     90
    8491    USE pegrid
    8592
    … …  
    8996    INTEGER(iwp) :: jp         !<
    9097    INTEGER(iwp) :: kp         !<
     98    INTEGER(iwp) :: tot_number_of_particles
     99
     100
    91101
    92102!
    … …  
    110120                        trsp_count_recv_sum, pnorth, trnp_count_sum,     &
    111121                        trnp_count_recv_sum
    112     CALL close_file( 80 )
    113122#else
    114123    WRITE ( 80, 8000 )  current_timestep_number+1, simulated_time+dt_3d, &
    115124                        number_of_particles
    116125#endif
     126    CALL close_file( 80 )
     127
     128    IF ( number_of_particles > 0 ) THEN
     129        WRITE(9,*) 'number_of_particles ', number_of_particles, current_timestep_number + 1, simulated_time + dt_3d
     130    ENDIF
     131
     132#if defined( __parallel )
     133    CALL MPI_ALLREDUCE( number_of_particles, tot_number_of_particles, 1, MPI_INTEGER,      &
     134                                    MPI_SUM, comm2d, ierr)
     135#else
     136    tot_number_of_particles = number_of_particles
     137#endif
     138
     139    CALL pmcp_g_print_number_of_particles (simulated_time+dt_3d, tot_number_of_particles)
    117140
    118141!

  • palm/trunk/SOURCE/palm.f90

    r2766 r2801  
    2525! -----------------
    2626! $Id$
     27! Changed lpm from subroutine to module.
     28! Introduce particle transfer in nested models.
     29!
     30! 2766 2018-01-22 17:17:47Z kanani
    2731! Removed preprocessor directive __chem
    2832!
    … …  
    250254               pmci_modelconfiguration, pmci_parent_initialize,                &
    251255               pmci_ensure_nest_mass_conservation
     256
     257    USE pmc_particle_interface,                                                 &
     258        ONLY: pmcp_g_alloc_win
    252259
    253260    USE radiation_model_mod,                                                   &
    … …  
    431438       ENDIF
    432439
     440       CALL pmcp_g_alloc_win                    ! Must be called after pmci_child_initialize and pmci_parent_initialize
    433441    ENDIF
    434442

  • palm/trunk/SOURCE/pmc_child_mod.f90

    r2718 r2801  
    2626! -----------------
    2727! $Id$
     28! Introduce particle transfer in nested models.
     29!
     30! 2718 2018-01-02 08:49:38Z maronga
    2831! Corrected "Former revisions" section
    2932!
    … …  
    8487!
    8588! Child part of Palm Model Coupler
    86 !-------------------------------------------------------------------------------!
     89!------------------------------------------------------------------------------!
    8790
    8891#if defined( __parallel )
    … …  
    97100
    98101    USE kinds
    99     USE pmc_general,                                                            &
    100         ONLY:  arraydef, childdef, da_desclen, da_namedef, da_namelen, pedef,   &
     102    USE pmc_general,                                                           &
     103        ONLY:  arraydef, childdef, da_desclen, da_namedef, da_namelen, pedef,  &
    101104               pmc_da_name_err,  pmc_g_setname, pmc_max_array, pmc_status_ok
    102105
    103     USE pmc_handle_communicator,                                                &
     106    USE pmc_handle_communicator,                                               &
    104107        ONLY:  m_model_comm, m_model_npes, m_model_rank, m_to_parent_comm
    105108
    106     USE pmc_mpi_wrapper,                                                        &
     109    USE pmc_mpi_wrapper,                                                       &
    107110        ONLY:  pmc_alloc_mem, pmc_bcast, pmc_inter_bcast, pmc_time
    108111
    … …  
    112115    SAVE
    113116
    114     TYPE(childdef) ::  me   !<
    115 
    116     INTEGER ::  myindex = 0         !< counter and unique number for data arrays
    117     INTEGER ::  next_array_in_list = 0   !<
     117    TYPE(childdef), PUBLIC ::  me   !<
     118
     119    INTEGER(iwp) ::  myindex = 0         !< counter and unique number for data arrays
     120    INTEGER(iwp) ::  next_array_in_list = 0   !<
    118121
    119122
    … …  
    149152        MODULE PROCEDURE pmc_c_set_dataarray_2d
    150153        MODULE PROCEDURE pmc_c_set_dataarray_3d
     154        MODULE PROCEDURE pmc_c_set_dataarray_ip2d
    151155    END INTERFACE pmc_c_set_dataarray
    152156
    … …  
    157161
    158162
    159     PUBLIC pmc_childinit, pmc_c_clear_next_array_list, pmc_c_getbuffer,         &
    160            pmc_c_getnextarray, pmc_c_putbuffer, pmc_c_setind_and_allocmem,      &
     163    PUBLIC pmc_childinit, pmc_c_clear_next_array_list, pmc_c_getbuffer,        &
     164           pmc_c_getnextarray, pmc_c_putbuffer, pmc_c_setind_and_allocmem,     &
    161165           pmc_c_set_dataarray, pmc_set_dataarray_name, pmc_c_get_2d_index_list
    162166
    … …  
    169173     IMPLICIT NONE
    170174
    171      INTEGER ::  i        !<
    172      INTEGER ::  istat    !<
     175     INTEGER(iwp) ::  i        !<
     176     INTEGER(iwp) ::  istat    !<
    173177
    174178!
    … …  
    197201
    198202
    199  SUBROUTINE pmc_set_dataarray_name( parentarraydesc, parentarrayname,           &
     203 SUBROUTINE pmc_set_dataarray_name( parentarraydesc, parentarrayname,          &
    200204                                    childarraydesc, childarrayname, istat )
    201205
    … …  
    207211    CHARACTER(LEN=*), INTENT(IN) ::  childarraydesc   !<
    208212
    209     INTEGER, INTENT(OUT) ::  istat  !<
     213    INTEGER(iwp), INTENT(OUT) ::  istat  !<
    210214!
    211215!-- Local variables
    212216    TYPE(da_namedef) ::  myname  !<
    213217
    214     INTEGER ::  mype  !<
    215     INTEGER ::  my_addiarray = 0  !<
     218    INTEGER(iwp) ::  mype  !<
     219    INTEGER(iwp) ::  my_addiarray = 0  !<
    216220
    217221
    … …  
    219223!
    220224!-- Check length of array names
    221     IF ( LEN( TRIM( parentarrayname) ) > da_namelen  .OR.                       &
     225    IF ( LEN( TRIM( parentarrayname) ) > da_namelen  .OR.                      &
    222226         LEN( TRIM( childarrayname) ) > da_namelen )  THEN
    223227       istat = pmc_da_name_err
    … …  
    235239!
    236240!-- Broadcast to all child processes
    237 !-- TODO: describe what is broadcast here and why it is done
     241!
     242!-- The complete description of an transfer names array is broadcasted
     243
    238244    CALL pmc_bcast( myname%couple_index, 0, comm=m_model_comm )
    239245    CALL pmc_bcast( myname%parentdesc,   0, comm=m_model_comm )
    … …  
    243249!
    244250!-- Broadcast to all parent processes
    245 !-- TODO: describe what is broadcast here and why it is done
     251!-- The complete description of an transfer array names is broadcasted als to all parent processe
     252!   Only the root PE of the broadcasts to parent using intra communicator
     253
    246254    IF ( m_model_rank == 0 )  THEN
    247255        mype = MPI_ROOT
    … …  
    290298    IMPLICIT NONE
    291299
    292     INTEGER :: dummy               !<
    293     INTEGER :: i, ierr, i2, j, nr  !<
    294     INTEGER :: indwin              !< MPI window object
    295     INTEGER :: indwin2             !< MPI window object
     300    INTEGER(iwp) :: dummy               !<
     301    INTEGER(iwp) :: i, ierr, i2, j, nr  !<
     302    INTEGER(iwp) :: indwin              !< MPI window object
     303    INTEGER(iwp) :: indwin2             !< MPI window object
    296304
    297305    INTEGER(KIND=MPI_ADDRESS_KIND) :: win_size !< Size of MPI window 1 (in bytes)
    … …  
    307315
    308316    win_size = C_SIZEOF( dummy )
    309     CALL MPI_WIN_CREATE( dummy, win_size, iwp, MPI_INFO_NULL, me%intra_comm,    &
     317    CALL MPI_WIN_CREATE( dummy, win_size, iwp, MPI_INFO_NULL, me%intra_comm,   &
    310318                         indwin, ierr )
    311319!
    312 !-- Open window on parent side
    313 !-- TODO: why is the next MPI routine called twice??
     320!-- Close window on child side and open on parent side
    314321    CALL MPI_WIN_FENCE( 0, indwin, ierr )
    315 !
     322
     323!   Between the two MPI_WIN_FENCE calls, the parent can fill the RMA window
     324
    316325!-- Close window on parent side and open on child side
     326
    317327    CALL MPI_WIN_FENCE( 0, indwin, ierr )
    318328
    319329    DO  i = 1, me%inter_npes
    320330       disp = me%model_rank * 2
    321        CALL MPI_GET( nrele((i-1)*2+1), 2, MPI_INTEGER, i-1, disp, 2,            &
     331       CALL MPI_GET( nrele((i-1)*2+1), 2, MPI_INTEGER, i-1, disp, 2,           &
    322332                     MPI_INTEGER, indwin, ierr )
    323333    ENDDO
    … …  
    347357!-- Here, we use a dummy for the MPI window because the parent processes do
    348358!-- not access the RMA window via MPI_GET or MPI_PUT
    349     CALL MPI_WIN_CREATE( dummy, winsize, iwp, MPI_INFO_NULL, me%intra_comm,     &
     359    CALL MPI_WIN_CREATE( dummy, winsize, iwp, MPI_INFO_NULL, me%intra_comm,    &
    350360                         indwin2, ierr )
    351361!
    352362!-- MPI_GET is non-blocking -> data in nrele is not available until MPI_FENCE is
    353363!-- called
    354 !-- TODO: as before: why is this called twice??
     364
    355365    CALL MPI_WIN_FENCE( 0, indwin2, ierr )
     366
     367!   Between the two MPI_WIN_FENCE calls, the parent can fill the RMA window
     368
    356369    CALL MPI_WIN_FENCE( 0, indwin2, ierr )
    357370
    … …  
    362375          disp = nrele(2*(i-1)+1)
    363376          CALL MPI_WIN_LOCK( MPI_LOCK_SHARED , i-1, 0, indwin2, ierr )
    364           CALL MPI_GET( myind, 2*nr, MPI_INTEGER, i-1, disp, 2*nr,              &
     377          CALL MPI_GET( myind, 2*nr, MPI_INTEGER, i-1, disp, 2*nr,             &
    365378                        MPI_INTEGER, indwin2, ierr )
    366379          CALL MPI_WIN_UNLOCK( i-1, indwin2, ierr )
    … …  
    424437    myname = ar%name
    425438!
    426 !-- Return true if legal array
    427 !-- TODO: the case of a non-legal array does not seem to appear, so why is this
    428 !-- setting required at all?
     439!-- Return true if annother array
     440!-- If all array have been processed, the RETURN statement a couple of lines above is active
     441
    429442    pmc_c_getnextarray = .TRUE.
    430443
    431  END function pmc_c_getnextarray
     444 END FUNCTION pmc_c_getnextarray
    432445
    433446
    … …  
    439452    REAL(wp), INTENT(IN) , DIMENSION(:,:), POINTER ::  array  !<
    440453
    441     INTEGER                 ::  i       !<
    442     INTEGER                 ::  nrdims  !<
    443     INTEGER, DIMENSION(4)  ::  dims    !<
     454    INTEGER(iwp)               ::  i       !<
     455    INTEGER(iwp)               ::  nrdims  !<
     456    INTEGER(iwp), DIMENSION(4) ::  dims    !<
    444457
    445458    TYPE(C_PTR)             ::  array_adr
    … …  
    459472       ar  => ape%array_list(next_array_in_list)
    460473       ar%nrdims = nrdims
     474       ar%dimkey = nrdims
    461475       ar%a_dim  = dims
    462476       ar%data   = array_adr
    … …  
    465479 END SUBROUTINE pmc_c_set_dataarray_2d
    466480
    467 
     481 SUBROUTINE pmc_c_set_dataarray_ip2d( array )
     482
     483    IMPLICIT NONE
     484
     485    INTEGER(idp), INTENT(IN) , DIMENSION(:,:), POINTER ::  array  !<
     486
     487    INTEGER(iwp)               ::  i       !<
     488    INTEGER(iwp)               ::  nrdims  !<
     489    INTEGER(iwp), DIMENSION(4) ::  dims    !<
     490
     491    TYPE(C_PTR)             ::  array_adr
     492    TYPE(arraydef), POINTER ::  ar
     493    TYPE(pedef), POINTER    ::  ape
     494
     495    dims    = 1
     496    nrdims  = 2
     497    dims(1) = SIZE( array, 1 )
     498    dims(2) = SIZE( array, 2 )
     499
     500    array_adr = C_LOC( array )
     501
     502    DO  i = 1, me%inter_npes
     503       ape => me%pes(i)
     504       ar  => ape%array_list(next_array_in_list)
     505       ar%nrdims = nrdims
     506       ar%dimkey = 22
     507       ar%a_dim  = dims
     508       ar%data   = array_adr
     509    ENDDO
     510
     511 END SUBROUTINE pmc_c_set_dataarray_ip2d
    468512
    469513 SUBROUTINE pmc_c_set_dataarray_3d (array)
    … …  
    473517    REAL(wp), INTENT(IN), DIMENSION(:,:,:), POINTER ::  array  !<
    474518
    475     INTEGER                 ::  i
    476     INTEGER                 ::  nrdims
    477     INTEGER, DIMENSION (4)  ::  dims
     519    INTEGER(iwp)                ::  i
     520    INTEGER(iwp)                ::  nrdims
     521    INTEGER(iwp), DIMENSION (4) ::  dims
     522   
    478523    TYPE(C_PTR)             ::  array_adr
    479524    TYPE(pedef), POINTER    ::  ape
    … …  
    493538       ar  => ape%array_list(next_array_in_list)
    494539       ar%nrdims = nrdims
     540       ar%dimkey = nrdims
    495541       ar%a_dim  = dims
    496542       ar%data   = array_adr
    … …  
    512558    CHARACTER(LEN=da_namelen) ::  myname  !<
    513559
    514     INTEGER ::  arlen    !<
    515     INTEGER ::  myindex  !<
    516     INTEGER ::  i        !<
    517     INTEGER ::  ierr     !<
    518     INTEGER ::  istat    !<
    519     INTEGER ::  j        !<
    520     INTEGER ::  rcount   !<
    521     INTEGER ::  tag      !<
    522 
    523     INTEGER, PARAMETER ::  noindex = -1  !<
     560    INTEGER(iwp) ::  arlen    !<
     561    INTEGER(iwp) ::  myindex  !<
     562    INTEGER(iwp) ::  i        !<
     563    INTEGER(iwp) ::  ierr     !<
     564    INTEGER(iwp) ::  istat    !<
     565    INTEGER(iwp) ::  j        !<
     566    INTEGER(iwp) ::  rcount   !<
     567    INTEGER(iwp) ::  tag      !<
     568
     569    INTEGER(iwp), PARAMETER ::  noindex = -1  !<
    524570
    525571    INTEGER(idp)                   ::  bufsize  !< size of MPI data window
    526572    INTEGER(KIND=MPI_ADDRESS_KIND) ::  winsize  !<
    527573
    528     INTEGER,DIMENSION(1024) ::  req  !<
     574    INTEGER(iwp),DIMENSION(1024) ::  req  !<
    529575
    530576    REAL(wp), DIMENSION(:), POINTER, SAVE ::  base_array_pc  !< base array
    … …  
    549595!--       Receive index from child
    550596          tag = tag + 1
    551           CALL MPI_RECV( myindex, 1, MPI_INTEGER, i-1, tag, me%inter_comm,      &
     597          CALL MPI_RECV( myindex, 1, MPI_INTEGER, i-1, tag, me%inter_comm,     &
    552598                         MPI_STATUS_IGNORE, ierr )
    553599          ar%recvindex = myindex
    554600!
    555601!--       Determine max, because child buffer is allocated only once
    556 !--       TODO: give a more meaningful comment
    557           IF( ar%nrdims == 3 )  THEN
     602!--       All 2D and 3d arrays use the same buffer
     603
     604          IF ( ar%nrdims == 3 )  THEN
    558605             bufsize = MAX( bufsize, ar%a_dim(1)*ar%a_dim(2)*ar%a_dim(3) )
    559606          ELSE
    … …  
    588635       DO  j = 1, ape%nr_arrays
    589636          ar => ape%array_list(j)
    590           IF( ar%nrdims == 2 )  THEN
     637          IF ( ar%nrdims == 2 )  THEN
    591638             arlen = ape%nrele
    592639          ELSEIF( ar%nrdims == 3 )  THEN
    … …  
    596643          rcount = rcount + 1
    597644          IF ( ape%nrele > 0 )  THEN
    598              CALL MPI_ISEND( myindex, 1, MPI_INTEGER, i-1, tag, me%inter_comm,  &
     645             CALL MPI_ISEND( myindex, 1, MPI_INTEGER, i-1, tag, me%inter_comm, &
    599646                             req(rcount), ierr )
    600647             ar%sendindex = myindex
    601648          ELSE
    602              CALL MPI_ISEND( noindex, 1, MPI_INTEGER, i-1, tag, me%inter_comm,  &
     649             CALL MPI_ISEND( noindex, 1, MPI_INTEGER, i-1, tag, me%inter_comm, &
    603650                             req(rcount), ierr )
    604651             ar%sendindex = noindex
    605652          ENDIF
    606653!
    607 !--       Maximum of 1024 outstanding requests
    608 !--       TODO: explain where this maximum comes from (arbitrary?).
    609 !--       Outstanding = pending?
     654!--       Maximum of 1024 pending requests
     655!         1024 is an arbitrary value just to make sure the number of pending
     656!         requests is getting too large. It is possible that this value has to
     657!         be adjusted in case of running the model on large number of cores.
     658
    610659          IF ( rcount == 1024 )  THEN
    611660             CALL MPI_WAITALL( rcount, req, MPI_STATUSES_IGNORE, ierr )
    … …  
    640689    winSize = me%totalbuffersize
    641690
    642     CALL MPI_WIN_CREATE( base_array_cp, winsize, wp, MPI_INFO_NULL,             &
     691    CALL MPI_WIN_CREATE( base_array_cp, winsize, wp, MPI_INFO_NULL,            &
    643692                         me%intra_comm, me%win_parent_child, ierr )
    644693    CALL MPI_WIN_FENCE( 0, me%win_parent_child, ierr )
    … …  
    657706!--                the message-routine
    658707             IF ( ar%sendindex+ar%sendsize > bufsize )  THEN
    659                 WRITE( 0,'(a,i4,4i7,1x,a)') 'Child buffer too small ', i,       &
    660                           ar%sendindex, ar%sendsize, ar%sendindex+ar%sendsize,  &
     708                WRITE( 0,'(a,i4,4i7,1x,a)') 'Child buffer too small ', i,      &
     709                          ar%sendindex, ar%sendsize, ar%sendindex+ar%sendsize, &
    661710                          bufsize, TRIM( ar%name )
    662711                CALL MPI_ABORT( MPI_COMM_WORLD, istat, ierr )
    … …  
    670719
    671720
    672  SUBROUTINE pmc_c_getbuffer( waittime )
     721 SUBROUTINE pmc_c_getbuffer( waittime, particle_transfer )
    673722
    674723    IMPLICIT NONE
    675724
    676725    REAL(wp), INTENT(OUT), OPTIONAL ::  waittime  !<
     726    LOGICAL, INTENT(IN), OPTIONAL   ::  particle_transfer  !<
    677727
    678728    CHARACTER(LEN=da_namelen) ::  myname  !<
    679 
    680     INTEGER                        ::  ierr     !<
    681     INTEGER                        ::  ij       !<
    682     INTEGER                        ::  ip       !<
    683     INTEGER                        ::  j        !<
    684     INTEGER                        ::  myindex  !<
    685     INTEGER                        ::  nr       !< number of elements to get
    686                                                 !< from parent
     729   
     730    LOGICAL                        ::  lo_ptrans!<
     731   
     732    INTEGER(iwp)                        ::  ierr    !<
     733    INTEGER(iwp)                        ::  ij      !<
     734    INTEGER(iwp)                        ::  ip      !<
     735    INTEGER(iwp)                        ::  j       !<
     736    INTEGER(iwp)                        ::  myindex !<
     737    INTEGER(iwp)                        ::  nr      !< number of elements to get
     738                                                    !< from parent
    687739    INTEGER(KIND=MPI_ADDRESS_KIND) ::  target_disp
    688740    INTEGER,DIMENSION(1)           ::  buf_shape
    … …  
    696748    TYPE(pedef), POINTER                ::  ape
    697749    TYPE(arraydef), POINTER             ::  ar
     750    INTEGER(idp), POINTER, DIMENSION(:)     ::  ibuf      !<
     751    INTEGER(idp), POINTER, DIMENSION(:,:)   ::  idata_2d  !<
    698752
    699753!
    … …  
    701755!-- Therefore the RMA window can be filled without
    702756!-- sychronization at this point and a barrier is not necessary.
     757
     758!-- In case waittime is present, the following barrier is necessary to
     759!-- insure the same number of barrier calls on parent and child
     760!-- This means, that here on child side two barriers are call successively
     761!-- The parent is filling its buffer between the two barrier calls
     762
    703763!-- Please note that waittime has to be set in pmc_s_fillbuffer AND
    704764!-- pmc_c_getbuffer
    … …  
    709769       waittime = t2 - t1
    710770    ENDIF
     771
     772    lo_ptrans = .FALSE.
     773    IF ( PRESENT( particle_transfer))    lo_ptrans = particle_transfer
     774
    711775!
    712776!-- Wait for buffer is filled.
    713 !-- TODO: explain in more detail what is happening here. The barrier seems to
    714 !-- contradict what is said a few lines before (i.e. that no barrier is necessary)
    715 !-- TODO: In case of PRESENT( waittime ) the barrrier would be calles twice. Why?
    716 !-- Shouldn't it be done the same way as in pmc_putbuffer?
     777!
     778!-- The parent side (in pmc_s_fillbuffer) is filling the buffer in the MPI RMA window
     779!-- When the filling is complet, a MPI_BARRIER is called.
     780!-- The child is not allowd to access the parent-buffer before it is completely filled
     781!-- therefore the following barrier is required.
     782
    717783    CALL MPI_BARRIER( me%intra_comm, ierr )
    718784
    … …  
    721787       DO  j = 1, ape%nr_arrays
    722788          ar => ape%array_list(j)
    723           IF ( ar%nrdims == 2 )  THEN
     789
     790          IF ( ar%dimkey == 2 .AND. .NOT.lo_ptrans)  THEN
    724791             nr = ape%nrele
    725           ELSEIF ( ar%nrdims == 3 )  THEN
     792          ELSEIF ( ar%dimkey == 3 .AND. .NOT.lo_ptrans)  THEN
    726793             nr = ape%nrele * ar%a_dim(1)
     794          ELSE IF ( ar%dimkey == 22 .AND. lo_ptrans)  THEN
     795             nr = ape%nrele
     796          ELSE
     797             CYCLE                    ! Particle array ar not transferd here
    727798          ENDIF
    728799          buf_shape(1) = nr
    729           CALL C_F_POINTER( ar%recvbuf, buf, buf_shape )
     800          IF ( lo_ptrans )   THEN
     801             CALL C_F_POINTER( ar%recvbuf, ibuf, buf_shape )
     802          ELSE
     803             CALL C_F_POINTER( ar%recvbuf, buf, buf_shape )
     804          ENDIF
    730805!
    731806!--       MPI passive target RMA
    732 !--       TODO: explain the above comment
     807!--       One data array is fetcht from MPI RMA window on parent
     808
    733809          IF ( nr > 0 )  THEN
    734810             target_disp = ar%recvindex - 1
    735              CALL MPI_WIN_LOCK( MPI_LOCK_SHARED , ip-1, 0,                      &
     811             CALL MPI_WIN_LOCK( MPI_LOCK_SHARED , ip-1, 0,                     &
    736812                                me%win_parent_child, ierr )
    737              CALL MPI_GET( buf, nr, MPI_REAL, ip-1, target_disp, nr, MPI_REAL,  &
    738                                 me%win_parent_child, ierr )
     813             IF ( lo_ptrans )   THEN
     814                CALL MPI_GET( ibuf, nr*8, MPI_BYTE, ip-1, target_disp, nr*8, MPI_BYTE,  &               !There is no MPI_INTEGER8 datatype
     815                                   me%win_parent_child, ierr )
     816             ELSE
     817                CALL MPI_GET( buf, nr, MPI_REAL, ip-1, target_disp, nr,        &
     818                              MPI_REAL, me%win_parent_child, ierr )
     819             ENDIF
    739820             CALL MPI_WIN_UNLOCK( ip-1, me%win_parent_child, ierr )
    740821          ENDIF
    741822          myindex = 1
    742           IF ( ar%nrdims == 2 )  THEN
     823          IF ( ar%dimkey == 2 .AND. .NOT.lo_ptrans)  THEN
     824
    743825             CALL C_F_POINTER( ar%data, data_2d, ar%a_dim(1:2) )
    744826             DO  ij = 1, ape%nrele
    … …  
    746828                myindex = myindex + 1
    747829             ENDDO
    748           ELSEIF ( ar%nrdims == 3 )  THEN
     830
     831          ELSEIF ( ar%dimkey == 3 .AND. .NOT.lo_ptrans)  THEN
     832
    749833             CALL C_F_POINTER( ar%data, data_3d, ar%a_dim(1:3) )
    750834             DO  ij = 1, ape%nrele
    751                 data_3d(:,ape%locind(ij)%j,ape%locind(ij)%i) =                  &
     835                data_3d(:,ape%locind(ij)%j,ape%locind(ij)%i) =                 &
    752836                                              buf(myindex:myindex+ar%a_dim(1)-1)
    753837                myindex = myindex+ar%a_dim(1)
    754838             ENDDO
     839
     840          ELSEIF ( ar%dimkey == 22 .AND. lo_ptrans)  THEN
     841             CALL C_F_POINTER( ar%data, idata_2d, ar%a_dim(1:2) )
     842
     843             DO  ij = 1, ape%nrele
     844                idata_2d(ape%locind(ij)%j,ape%locind(ij)%i) = ibuf(myindex)
     845                myindex = myindex + 1
     846             ENDDO
     847
    755848          ENDIF
    756849       ENDDO
    … …  
    761854
    762855
    763  SUBROUTINE pmc_c_putbuffer( waittime )
     856 SUBROUTINE pmc_c_putbuffer( waittime , particle_transfer )
    764857
    765858    IMPLICIT NONE
    766859
    767860    REAL(wp), INTENT(OUT), OPTIONAL ::  waittime  !<
     861    LOGICAL, INTENT(IN), OPTIONAL   ::  particle_transfer  !<
    768862
    769863    CHARACTER(LEN=da_namelen) ::  myname  !<
    770 
    771     INTEGER                        ::  ierr         !<
    772     INTEGER                        ::  ij           !<
    773     INTEGER                        ::  ip           !<
    774     INTEGER                        ::  j            !<
    775     INTEGER                        ::  myindex      !<
    776     INTEGER                        ::  nr           !< number of elements to get
    777                                                     !< from parent
     864   
     865    LOGICAL ::  lo_ptrans!<
     866   
     867    INTEGER(iwp) ::  ierr         !<
     868    INTEGER(iwp) ::  ij           !<
     869    INTEGER(iwp) ::  ip           !<
     870    INTEGER(iwp) ::  j            !<
     871    INTEGER(iwp) ::  myindex      !<
     872    INTEGER(iwp) ::  nr           !< number of elements to get from parent
     873   
    778874    INTEGER(KIND=MPI_ADDRESS_KIND) ::  target_disp  !<
    779 
    780     INTEGER, DIMENSION(1)          ::  buf_shape    !<
     875   
     876
     877    INTEGER(iwp), DIMENSION(1) ::  buf_shape    !<
    781878
    782879    REAL(wp) ::  t1  !<
    783880    REAL(wp) ::  t2  !<
    784881
    785     REAL(wp), POINTER, DIMENSION(:)     ::  buf      !<
    786     REAL(wp), POINTER, DIMENSION(:,:)   ::  data_2d  !<
    787     REAL(wp), POINTER, DIMENSION(:,:,:) ::  data_3d  !<
    788 
    789     TYPE(pedef), POINTER               ::  ape  !<
    790     TYPE(arraydef), POINTER            ::  ar   !<
     882    REAL(wp), POINTER, DIMENSION(:)         ::  buf      !<
     883    REAL(wp), POINTER, DIMENSION(:,:)       ::  data_2d  !<
     884    REAL(wp), POINTER, DIMENSION(:,:,:)     ::  data_3d  !<
     885   
     886    INTEGER(idp), POINTER, DIMENSION(:)     ::  ibuf      !<
     887    INTEGER(idp), POINTER, DIMENSION(:,:)   ::  idata_2d  !<
     888
     889    TYPE(pedef), POINTER                    ::  ape  !<
     890    TYPE(arraydef), POINTER                 ::  ar   !<
    791891
    792892!
    793893!-- Wait for empty buffer
    794 !-- TODO: explain what is done here
     894!-- Switch RMA epoche
     895
    795896    t1 = pmc_time()
    796897    CALL MPI_BARRIER( me%intra_comm, ierr )
    797898    t2 = pmc_time()
    798899    IF ( PRESENT( waittime ) )  waittime = t2 - t1
     900
     901    lo_ptrans = .FALSE.
     902    IF ( PRESENT( particle_transfer))    lo_ptrans = particle_transfer
    799903
    800904    DO  ip = 1, me%inter_npes
    … …  
    803907          ar => aPE%array_list(j)
    804908          myindex = 1
    805           IF ( ar%nrdims == 2 )  THEN
     909
     910          IF ( ar%dimkey == 2 .AND. .NOT.lo_ptrans )  THEN
     911
    806912             buf_shape(1) = ape%nrele
    807913             CALL C_F_POINTER( ar%sendbuf, buf,     buf_shape     )
    … …  
    811917                myindex = myindex + 1
    812918             ENDDO
    813           ELSEIF ( ar%nrdims == 3 )  THEN
     919
     920          ELSEIF ( ar%dimkey == 3 .AND. .NOT.lo_ptrans )  THEN
     921
    814922             buf_shape(1) = ape%nrele*ar%a_dim(1)
    815923             CALL C_F_POINTER( ar%sendbuf, buf,     buf_shape     )
    … …  
    820928                myindex = myindex + ar%a_dim(1)
    821929             ENDDO
     930
     931          ELSE IF ( ar%dimkey == 22 .AND. lo_ptrans)  THEN
     932
     933             buf_shape(1) = ape%nrele
     934             CALL C_F_POINTER( ar%sendbuf, ibuf,     buf_shape     )
     935             CALL C_F_POINTER( ar%data,    idata_2d, ar%a_dim(1:2) )
     936
     937             DO  ij = 1, ape%nrele
     938                ibuf(myindex) = idata_2d(ape%locind(ij)%j,ape%locind(ij)%i)
     939                myindex = myindex + 1
     940             ENDDO
     941
    822942          ENDIF
    823943       ENDDO
    824944    ENDDO
    825945!
    826 !-- TODO: Fence might do it, test later
    827 !-- Call MPI_WIN_FENCE( 0, me%win_parent_child, ierr)      !
    828 !
    829946!-- Buffer is filled
    830 !-- TODO: explain in more detail what is happening here
     947!-- Switch RMA epoche
     948
    831949    CALL MPI_Barrier(me%intra_comm, ierr)
    832950

  • palm/trunk/SOURCE/pmc_general_mod.f90

    r2718 r2801  
    2626! -----------------
    2727! $Id$
     28! Introduce particle transfer in nested models.
     29!
     30! 2718 2018-01-02 08:49:38Z maronga
    2831! Corrected "Former revisions" section
    2932!
    … …  
    8891    SAVE
    8992
    90     INTEGER, PARAMETER, PUBLIC :: da_desclen       =  8  !<
    91     INTEGER, PARAMETER, PUBLIC :: da_namelen       = 16  !<
    92     INTEGER, PARAMETER, PUBLIC :: pmc_da_name_err  = 10  !<
    93     INTEGER, PARAMETER, PUBLIC :: pmc_max_array    = 32  !< max # of arrays which can be coupled
    94     INTEGER, PARAMETER, PUBLIC :: pmc_max_models   = 64  !<
    95     INTEGER, PARAMETER, PUBLIC :: pmc_status_ok    =  0  !<
    96     INTEGER, PARAMETER, PUBLIC :: pmc_status_error = -1  !<
     93    INTEGER(iwp), PARAMETER, PUBLIC :: da_desclen       =  8  !<
     94    INTEGER(iwp), PARAMETER, PUBLIC :: da_namelen       = 16  !<
     95    INTEGER(iwp), PARAMETER, PUBLIC :: pmc_da_name_err  = 10  !<
     96    INTEGER(iwp), PARAMETER, PUBLIC :: pmc_max_array    = 32  !< max # of arrays which can be coupled
     97    INTEGER(iwp), PARAMETER, PUBLIC :: pmc_max_models   = 64  !<
     98    INTEGER(iwp), PARAMETER, PUBLIC :: pmc_status_ok    =  0  !<
     99    INTEGER(iwp), PARAMETER, PUBLIC :: pmc_status_error = -1  !<
    97100
    98101
    99102    TYPE, PUBLIC :: xy_ind  !< pair of indices in horizontal plane
    100        INTEGER ::  i
    101        INTEGER ::  j
     103       INTEGER(iwp) ::  i
     104       INTEGER(iwp) ::  j
    102105    END TYPE
    103106
    104107    TYPE, PUBLIC ::  arraydef
    105        INTEGER                   :: coupleindex  !<
    106        INTEGER                   :: nrdims       !< number of dimensions
    107        INTEGER, DIMENSION(4)     :: a_dim        !< size of dimensions
     108       INTEGER(iwp)                   :: coupleindex  !<
     109       INTEGER(iwp)                   :: nrdims       !< number of dimensions
     110       INTEGER(iwp)                   :: dimkey       !< key for NR dimensions and array type
     111       INTEGER(iwp), DIMENSION(4)     :: a_dim        !< size of dimensions
    108112       TYPE(C_PTR)               :: data         !< pointer of data in parent space
    109113       TYPE(C_PTR), DIMENSION(2) :: po_data      !< base pointers,
    … …  
    112116       INTEGER(idp)              :: SendIndex    !< index in send buffer
    113117       INTEGER(idp)              :: RecvIndex    !< index in receive buffer
    114        INTEGER                   :: SendSize     !< size in send buffer
    115        INTEGER                   :: RecvSize     !< size in receive buffer
     118       INTEGER(iwp)              :: SendSize     !< size in send buffer
     119       INTEGER(iwp)              :: RecvSize     !< size in receive buffer
    116120       TYPE(C_PTR)               :: SendBuf      !< data pointer in send buffer
    117121       TYPE(C_PTR)               :: RecvBuf      !< data pointer in receive buffer
    … …  
    123127
    124128    TYPE, PUBLIC ::  pedef
    125        INTEGER :: nr_arrays = 0  !< number of arrays which will be transfered
    126        INTEGER :: nrele          !< number of elements, same for all arrays
     129       INTEGER(iwp) :: nr_arrays = 0  !< number of arrays which will be transfered
     130       INTEGER(iwp) :: nrele          !< number of elements, same for all arrays
    127131       TYPE(xy_ind), POINTER, DIMENSION(:)   ::  locInd      !< xy index local array for remote PE
    128132       TYPE(arraydef), POINTER, DIMENSION(:) ::  array_list  !< list of data arrays to be transfered
    … …  
    131135    TYPE, PUBLIC ::  childdef
    132136       INTEGER(idp) ::  totalbuffersize    !<
    133        INTEGER      ::  model_comm         !< communicator of this model
    134        INTEGER      ::  inter_comm         !< inter communicator model and child
    135        INTEGER      ::  intra_comm         !< intra communicator model and child
    136        INTEGER      ::  model_rank         !< rank of this model
    137        INTEGER      ::  model_npes         !< number of PEs this model
    138        INTEGER      ::  inter_npes         !< number of PEs child model
    139        INTEGER      ::  intra_rank         !< rank within intra_comm
    140        INTEGER      ::  win_parent_child   !< MPI RMA for preparing data on parent AND child side
     137       INTEGER(iwp) ::  model_comm         !< communicator of this model
     138       INTEGER(iwp) ::  inter_comm         !< inter communicator model and child
     139       INTEGER(iwp) ::  intra_comm         !< intra communicator model and child
     140       INTEGER(iwp) ::  model_rank         !< rank of this model
     141       INTEGER(iwp) ::  model_npes         !< number of PEs this model
     142       INTEGER(iwp) ::  inter_npes         !< number of PEs child model
     143       INTEGER(iwp) ::  intra_rank         !< rank within intra_comm
     144       INTEGER(iwp) ::  win_parent_child   !< MPI RMA for preparing data on parent AND child side
    141145       TYPE(pedef), DIMENSION(:), POINTER ::  pes  !< list of all child PEs
    142146    END TYPE childdef
    143147
    144148    TYPE, PUBLIC ::  da_namedef  !< data array name definition
    145        INTEGER                   ::  couple_index  !< unique number of array
     149       INTEGER(iwp)              ::  couple_index  !< unique number of array
    146150       CHARACTER(LEN=da_desclen) ::  parentdesc    !< parent array description
    147151       CHARACTER(LEN=da_namelen) ::  nameonparent  !< name of array within parent
    … …  
    168172    IMPLICIT NONE
    169173
    170     CHARACTER(LEN=*)               ::  aname         !<
    171     INTEGER, INTENT(IN)            ::  couple_index  !<
    172     TYPE(childdef), INTENT(INOUT)  ::  mychild       !<
    173 
    174     INTEGER ::  i  !<
     174    CHARACTER(LEN=*)              ::  aname         !<
     175    INTEGER(iwp), INTENT(IN)      ::  couple_index  !<
     176    TYPE(childdef), INTENT(INOUT) ::  mychild       !<
     177
     178    INTEGER(iwp) ::  i  !<
    175179
    176180    TYPE(arraydef), POINTER ::  ar   !<
    … …  
    195199    IMPLICIT NONE
    196200
    197     INTEGER, INTENT(IN)                    ::  sort_ind
    198     INTEGER, DIMENSION(:,:), INTENT(INOUT) ::  array
    199 
    200     INTEGER ::  i  !<
    201     INTEGER ::  j  !<
    202     INTEGER ::  n  !<
    203 
    204     INTEGER, DIMENSION(SIZE(array,1)) ::  tmp  !<
     201    INTEGER(iwp), INTENT(IN)                    ::  sort_ind
     202    INTEGER(iwp), DIMENSION(:,:), INTENT(INOUT) ::  array
     203
     204    INTEGER(iwp) ::  i  !<
     205    INTEGER(iwp) ::  j  !<
     206    INTEGER(iwp) ::  n  !<
     207
     208    INTEGER(iwp), DIMENSION(SIZE(array,1)) ::  tmp  !<
    205209
    206210    n = SIZE(array,2)

  • palm/trunk/SOURCE/pmc_handle_communicator_mod.f90

    r2718 r2801  
    2525! -----------------
    2626! $Id$
     27! Introduce particle transfer in nested models.
     28!
     29! 2718 2018-01-02 08:49:38Z maronga
    2730! Corrected "Former revisions" section
    2831!
    … …  
    142145
    143146    INTEGER ::  m_world_comm  !< global nesting communicator
    144     INTEGER ::  m_my_cpl_id   !< coupler id of this modelfortran return
     147    INTEGER ::  m_my_cpl_id   !< coupler id of this model
    145148    INTEGER ::  m_parent_id   !< coupler id of parent of this model
    146149    INTEGER ::  m_ncpl        !< number of couplers given in nestpar namelist
    147150
    148     TYPE(pmc_layout), DIMENSION(pmc_max_models) ::  m_couplers  !< information of all couplers
     151    TYPE(pmc_layout), PUBLIC, DIMENSION(pmc_max_models) ::  m_couplers  !< information of all couplers
    149152
    150153    INTEGER, PUBLIC ::  m_model_comm          !< communicator of this model
    … …  
    221224       THEN
    222225!
    223 !--       Determine the first process id of each model
     226!--       Calculate start PE of every model
    224227          start_pe(1) = 0
    225228          DO  i = 2, m_ncpl+1

  • palm/trunk/SOURCE/pmc_interface_mod.f90

    r2795 r2801  
    2525! -----------------
    2626! $Id$
     27! Introduce particle transfer in nested models.
     28!
     29! 2795 2018-02-07 14:48:48Z hellstea
    2730! Bugfix in computation of the anterpolation under-relaxation functions.
    2831!
    … …  
    214217!       routine
    215218! @todo Data transfer of qc and nc is prepared but not activated
    216 !-------------------------------------------------------------------------------!
     219!------------------------------------------------------------------------------!
    217220 MODULE pmc_interface
     221
     222    USE ISO_C_BINDING
     223
    218224
    219225#if defined( __nopointer )
    … …  
    228234#endif
    229235
    230     USE control_parameters,                                                     &
    231         ONLY:  air_chemistry, cloud_physics, coupling_char, dt_3d, dz, humidity,&
    232                message_string, microphysics_morrison, microphysics_seifert,     &
    233                nest_bound_l, nest_bound_r, nest_bound_s, nest_bound_n,          &
    234                nest_domain, neutral, passive_scalar, roughness_length,          &
    235                simulated_time, topography, volume_flow
     236    USE control_parameters,                                                    &
     237        ONLY:  air_chemistry, cloud_physics, coupling_char, dt_3d, dz,         &
     238               humidity, message_string, microphysics_morrison,                &
     239               microphysics_seifert, nest_bound_l, nest_bound_r, nest_bound_s, &
     240               nest_bound_n, nest_domain, neutral, passive_scalar,             &
     241               roughness_length, simulated_time, topography, volume_flow
    236242
    237243    USE chem_modules,                                                          &
    … …  
    250256        ONLY:  nbgp, nx, nxl, nxlg, nxlu, nxr, nxrg, ny, nyn, nyng, nys, nysg, &
    251257               nysv, nz, nzb, nzt, wall_flags_0
     258
     259    USE particle_attributes,                                                   &
     260        ONLY:  particle_advection
    252261
    253262    USE kinds
    … …  
    275284    USE pmc_handle_communicator,                                               &
    276285        ONLY:  pmc_get_model_info, pmc_init_model, pmc_is_rootmodel,           &
    277                pmc_no_namelist_found, pmc_parent_for_child
     286               pmc_no_namelist_found, pmc_parent_for_child, m_couplers
    278287
    279288    USE pmc_mpi_wrapper,                                                       &
    … …  
    297306!
    298307!-- Constants
    299     INTEGER(iwp), PARAMETER ::  child_to_parent = 2   !:
    300     INTEGER(iwp), PARAMETER ::  parent_to_child = 1   !:
     308    INTEGER(iwp), PARAMETER ::  child_to_parent = 2   !<
     309    INTEGER(iwp), PARAMETER ::  parent_to_child = 1   !<
    301310!
    302311!-- Coupler setup
    303     INTEGER(iwp), SAVE      ::  comm_world_nesting     !:
    304     INTEGER(iwp), SAVE      ::  cpl_id  = 1            !:
    305     CHARACTER(LEN=32), SAVE ::  cpl_name               !:
    306     INTEGER(iwp), SAVE      ::  cpl_npe_total          !:
    307     INTEGER(iwp), SAVE      ::  cpl_parent_id          !:
     312    INTEGER(iwp), SAVE      ::  comm_world_nesting    !<
     313    INTEGER(iwp), SAVE      ::  cpl_id  = 1           !<
     314    CHARACTER(LEN=32), SAVE ::  cpl_name              !<
     315    INTEGER(iwp), SAVE      ::  cpl_npe_total         !<
     316    INTEGER(iwp), SAVE      ::  cpl_parent_id         !<
    308317!
    309318!-- Control parameters, will be made input parameters later
    310     CHARACTER(LEN=7), SAVE ::  nesting_datatransfer_mode = 'mixed'  !: steering
    311                                                          !: parameter for data-
    312                                                          !: transfer mode
    313     CHARACTER(LEN=8), SAVE ::  nesting_mode = 'two-way'  !: steering parameter
    314                                                          !: for 1- or 2-way nesting
    315 
    316     LOGICAL, SAVE ::  nested_run = .FALSE.  !: general switch
    317 
    318     REAL(wp), SAVE ::  anterp_relax_length_l = -1.0_wp   !:
    319     REAL(wp), SAVE ::  anterp_relax_length_r = -1.0_wp   !:
    320     REAL(wp), SAVE ::  anterp_relax_length_s = -1.0_wp   !:
    321     REAL(wp), SAVE ::  anterp_relax_length_n = -1.0_wp   !:
    322     REAL(wp), SAVE ::  anterp_relax_length_t = -1.0_wp   !:
     319    CHARACTER(LEN=7), SAVE ::  nesting_datatransfer_mode = 'mixed'  !< steering
     320                                                         !< parameter for data-
     321                                                         !< transfer mode
     322    CHARACTER(LEN=8), SAVE ::  nesting_mode = 'two-way'  !< steering parameter
     323                                                         !< for 1- or 2-way nesting
     324
     325    LOGICAL, SAVE ::  nested_run = .FALSE.  !< general switch
     326
     327    REAL(wp), SAVE ::  anterp_relax_length_l = -1.0_wp   !<
     328    REAL(wp), SAVE ::  anterp_relax_length_r = -1.0_wp   !<
     329    REAL(wp), SAVE ::  anterp_relax_length_s = -1.0_wp   !<
     330    REAL(wp), SAVE ::  anterp_relax_length_n = -1.0_wp   !<
     331    REAL(wp), SAVE ::  anterp_relax_length_t = -1.0_wp   !<
    323332!
    324333!-- Geometry
    325     REAL(wp), SAVE                            ::  area_t               !:
    326     REAL(wp), SAVE, DIMENSION(:), ALLOCATABLE ::  coord_x              !:
    327     REAL(wp), SAVE, DIMENSION(:), ALLOCATABLE ::  coord_y              !:
    328     REAL(wp), SAVE                            ::  lower_left_coord_x   !:
    329     REAL(wp), SAVE                            ::  lower_left_coord_y   !:
     334    REAL(wp), SAVE                                    ::  area_t             !<
     335    REAL(wp), SAVE, DIMENSION(:), ALLOCATABLE, PUBLIC ::  coord_x            !<
     336    REAL(wp), SAVE, DIMENSION(:), ALLOCATABLE, PUBLIC ::  coord_y            !<
     337    REAL(wp), SAVE, PUBLIC                            ::  lower_left_coord_x !<
     338    REAL(wp), SAVE, PUBLIC                            ::  lower_left_coord_y !<
     339
    330340!
    331341!-- Child coarse data arrays
    332     INTEGER(iwp), DIMENSION(5)                  ::  coarse_bound   !:
    333 
    334     REAL(wp), SAVE                              ::  xexl           !:
    335     REAL(wp), SAVE                              ::  xexr           !:
    336     REAL(wp), SAVE                              ::  yexs           !:
    337     REAL(wp), SAVE                              ::  yexn           !:
    338     REAL(wp), SAVE, DIMENSION(:,:), ALLOCATABLE ::  tkefactor_l    !:
    339     REAL(wp), SAVE, DIMENSION(:,:), ALLOCATABLE ::  tkefactor_n    !:
    340     REAL(wp), SAVE, DIMENSION(:,:), ALLOCATABLE ::  tkefactor_r    !:
    341     REAL(wp), SAVE, DIMENSION(:,:), ALLOCATABLE ::  tkefactor_s    !:
    342     REAL(wp), SAVE, DIMENSION(:,:), ALLOCATABLE ::  tkefactor_t    !:
    343 
    344     REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ec   !:
    345     REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ptc  !:
    346     REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  uc   !:
    347     REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  vc   !:
    348     REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  wc   !:
    349     REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  q_c  !:
    350     REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  qcc  !:
    351     REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  qrc  !:
    352     REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  nrc  !:
    353     REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ncc  !:
    354     REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  sc   !:
     342    INTEGER(iwp), DIMENSION(5),PUBLIC           ::  coarse_bound   !<
     343
     344    REAL(wp), SAVE                              ::  xexl           !<
     345    REAL(wp), SAVE                              ::  xexr           !<
     346    REAL(wp), SAVE                              ::  yexs           !<
     347    REAL(wp), SAVE                              ::  yexn           !<
     348    REAL(wp), SAVE, DIMENSION(:,:), ALLOCATABLE ::  tkefactor_l    !<
     349    REAL(wp), SAVE, DIMENSION(:,:), ALLOCATABLE ::  tkefactor_n    !<
     350    REAL(wp), SAVE, DIMENSION(:,:), ALLOCATABLE ::  tkefactor_r    !<
     351    REAL(wp), SAVE, DIMENSION(:,:), ALLOCATABLE ::  tkefactor_s    !<
     352    REAL(wp), SAVE, DIMENSION(:,:), ALLOCATABLE ::  tkefactor_t    !<
     353
     354    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ec   !<
     355    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ptc  !<
     356    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  uc   !<
     357    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  vc   !<
     358    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  wc   !<
     359    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  q_c  !<
     360    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  qcc  !<
     361    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  qrc  !<
     362    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  nrc  !<
     363    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  ncc  !<
     364    REAL(wp), SAVE, DIMENSION(:,:,:), ALLOCATABLE, TARGET ::  sc   !<
     365    INTEGER(idp), SAVE, DIMENSION(:,:), ALLOCATABLE, TARGET, PUBLIC ::  nr_partc    !<
     366    INTEGER(idp), SAVE, DIMENSION(:,:), ALLOCATABLE, TARGET, PUBLIC ::  part_adrc   !<
     367
    355368
    356369    REAL(wp), SAVE, DIMENSION(:,:,:,:), ALLOCATABLE, TARGET ::  chem_spec_c   !< child coarse data array for chemical species
    … …  
    359372!-- Child interpolation coefficients and child-array indices to be
    360373!-- precomputed and stored.
    361     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  ico    !:
    362     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  icu    !:
    363     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  jco    !:
    364     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  jcv    !:
    365     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  kco    !:
    366     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  kcw    !:
    367     REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r1xo   !:
    368     REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r2xo   !:
    369     REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r1xu   !:
    370     REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r2xu   !:
    371     REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r1yo   !:
    372     REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r2yo   !:
    373     REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r1yv   !:
    374     REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r2yv   !:
    375     REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r1zo   !:
    376     REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r2zo   !:
    377     REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r1zw   !:
    378     REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r2zw   !:
     374    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  ico    !<
     375    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  icu    !<
     376    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  jco    !<
     377    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  jcv    !<
     378    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  kco    !<
     379    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  kcw    !<
     380    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r1xo   !<
     381    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r2xo   !<
     382    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r1xu   !<
     383    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r2xu   !<
     384    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r1yo   !<
     385    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r2yo   !<
     386    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r1yv   !<
     387    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r2yv   !<
     388    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r1zo   !<
     389    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r2zo   !<
     390    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r1zw   !<
     391    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:)     ::  r2zw   !<
    379392!
    380393!-- Child index arrays and log-ratio arrays for the log-law near-wall
    381394!-- corrections. These are not truly 3-D arrays but multiple 2-D arrays.
    382     INTEGER(iwp), SAVE :: ncorr  !: 4th dimension of the log_ratio-arrays
    383     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_u_l   !:
    384     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_u_n   !:
    385     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_u_r   !:
    386     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_u_s   !:
    387     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_v_l   !:
    388     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_v_n   !:
    389     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_v_r   !:
    390     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_v_s   !:
    391     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_w_l   !:
    392     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_w_n   !:
    393     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_w_r   !:
    394     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_w_s   !:
    395     REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_u_l   !:
    396     REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_u_n   !:
    397     REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_u_r   !:
    398     REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_u_s   !:
    399     REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_v_l   !:
    400     REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_v_n   !:
    401     REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_v_r   !:
    402     REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_v_s   !:
    403     REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_w_l   !:
    404     REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_w_n   !:
    405     REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_w_r   !:
    406     REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_w_s   !:
     395    INTEGER(iwp), SAVE :: ncorr  !< 4th dimension of the log_ratio-arrays
     396    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_u_l   !<
     397    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_u_n   !<
     398    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_u_r   !<
     399    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_u_s   !<
     400    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_v_l   !<
     401    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_v_n   !<
     402    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_v_r   !<
     403    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_v_s   !<
     404    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_w_l   !<
     405    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_w_n   !<
     406    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_w_r   !<
     407    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:,:) ::  logc_w_s   !<
     408    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_u_l   !<
     409    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_u_n   !<
     410    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_u_r   !<
     411    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_u_s   !<
     412    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_v_l   !<
     413    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_v_n   !<
     414    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_v_r   !<
     415    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_v_s   !<
     416    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_w_l   !<
     417    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_w_n   !<
     418    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_w_r   !<
     419    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:,:,:,:)   ::  logc_ratio_w_s   !<
    407420!
    408421!-- Upper bounds for k in anterpolation.
    409     INTEGER(iwp), SAVE ::  kctu   !:
    410     INTEGER(iwp), SAVE ::  kctw   !:
     422    INTEGER(iwp), SAVE ::  kctu   !<
     423    INTEGER(iwp), SAVE ::  kctw   !<
    411424!
    412425!-- Upper bound for k in log-law correction in interpolation.
    413     INTEGER(iwp), SAVE ::  nzt_topo_nestbc_l   !:
    414     INTEGER(iwp), SAVE ::  nzt_topo_nestbc_n   !:
    415     INTEGER(iwp), SAVE ::  nzt_topo_nestbc_r   !:
    416     INTEGER(iwp), SAVE ::  nzt_topo_nestbc_s   !:
     426    INTEGER(iwp), SAVE ::  nzt_topo_nestbc_l   !<
     427    INTEGER(iwp), SAVE ::  nzt_topo_nestbc_n   !<
     428    INTEGER(iwp), SAVE ::  nzt_topo_nestbc_r   !<
     429    INTEGER(iwp), SAVE ::  nzt_topo_nestbc_s   !<
    417430!
    418431!-- Number of ghost nodes in coarse-grid arrays for i and j in anterpolation.
    419     INTEGER(iwp), SAVE ::  nhll   !:
    420     INTEGER(iwp), SAVE ::  nhlr   !:
    421     INTEGER(iwp), SAVE ::  nhls   !:
    422     INTEGER(iwp), SAVE ::  nhln   !:
     432    INTEGER(iwp), SAVE ::  nhll   !<
     433    INTEGER(iwp), SAVE ::  nhlr   !<
     434    INTEGER(iwp), SAVE ::  nhls   !<
     435    INTEGER(iwp), SAVE ::  nhln   !<
    423436!
    424437!-- Spatial under-relaxation coefficients for anterpolation.
    425     REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) ::  frax   !:
    426     REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) ::  fray   !:
    427     REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) ::  fraz   !:
     438    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) ::  frax   !<
     439    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) ::  fray   !<
     440    REAL(wp), SAVE, ALLOCATABLE, DIMENSION(:) ::  fraz   !<
    428441!
    429442!-- Child-array indices to be precomputed and stored for anterpolation.
    430     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  iflu   !:
    431     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  ifuu   !:
    432     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  iflo   !:
    433     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  ifuo   !:
    434     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  jflv   !:
    435     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  jfuv   !:
    436     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  jflo   !:
    437     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  jfuo   !:
    438     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  kflw   !:
    439     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  kfuw   !:
    440     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  kflo   !:
    441     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  kfuo   !:
     443    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  iflu   !<
     444    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  ifuu   !<
     445    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  iflo   !<
     446    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  ifuo   !<
     447    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  jflv   !<
     448    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  jfuv   !<
     449    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  jflo   !<
     450    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  jfuo   !<
     451    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  kflw   !<
     452    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  kfuw   !<
     453    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  kflo   !<
     454    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  kfuo   !<
    442455!
    443456!-- Number of fine-grid nodes inside coarse-grid ij-faces
    444457!-- to be precomputed for anterpolation.
    445     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:) ::  ijfc_u        !:
    446     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:) ::  ijfc_v        !:
    447     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:) ::  ijfc_s        !:
    448     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:)   ::  kfc_w         !:
    449     INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:)   ::  kfc_s         !:
     458    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:) ::  ijfc_u        !<
     459    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:) ::  ijfc_v        !<
     460    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:,:) ::  ijfc_s        !<
     461    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:)   ::  kfc_w         !<
     462    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:)   ::  kfc_s         !<
    450463   
    451     INTEGER(iwp), DIMENSION(3)          ::  parent_grid_info_int    !:
    452     REAL(wp), DIMENSION(7)              ::  parent_grid_info_real   !:
     464    INTEGER(iwp), DIMENSION(3)          ::  parent_grid_info_int    !<
     465    REAL(wp), DIMENSION(7)              ::  parent_grid_info_real   !<
     466    REAL(wp), DIMENSION(2)              ::  zmax_coarse             !<
    453467
    454468    TYPE coarsegrid_def
    455        INTEGER(iwp)                        ::  nx
    456        INTEGER(iwp)                        ::  ny
    457        INTEGER(iwp)                        ::  nz
    458        REAL(wp)                            ::  dx
    459        REAL(wp)                            ::  dy
    460        REAL(wp)                            ::  dz
    461        REAL(wp)                            ::  lower_left_coord_x
    462        REAL(wp)                            ::  lower_left_coord_y
    463        REAL(wp)                            ::  xend
    464        REAL(wp)                            ::  yend
    465        REAL(wp), DIMENSION(:), ALLOCATABLE ::  coord_x
    466        REAL(wp), DIMENSION(:), ALLOCATABLE ::  coord_y
    467        REAL(wp), DIMENSION(:), ALLOCATABLE ::  dzu       
    468        REAL(wp), DIMENSION(:), ALLOCATABLE ::  dzw       
    469        REAL(wp), DIMENSION(:), ALLOCATABLE ::  zu       
    470        REAL(wp), DIMENSION(:), ALLOCATABLE ::  zw       
     469       INTEGER(iwp)                        ::  nx                 !<
     470       INTEGER(iwp)                        ::  ny                 !<
     471       INTEGER(iwp)                        ::  nz                 !<
     472       REAL(wp)                            ::  dx                 !<
     473       REAL(wp)                            ::  dy                 !<
     474       REAL(wp)                            ::  dz                 !<
     475       REAL(wp)                            ::  lower_left_coord_x !<
     476       REAL(wp)                            ::  lower_left_coord_y !<
     477       REAL(wp)                            ::  xend               !<
     478       REAL(wp)                            ::  yend               !<
     479       REAL(wp), DIMENSION(:), ALLOCATABLE ::  coord_x            !<
     480       REAL(wp), DIMENSION(:), ALLOCATABLE ::  coord_y            !<
     481       REAL(wp), DIMENSION(:), ALLOCATABLE ::  dzu                !<
     482       REAL(wp), DIMENSION(:), ALLOCATABLE ::  dzw                !<
     483       REAL(wp), DIMENSION(:), ALLOCATABLE ::  zu                 !<
     484       REAL(wp), DIMENSION(:), ALLOCATABLE ::  zw                 !<
    471485    END TYPE coarsegrid_def
    472                                          
    473     TYPE(coarsegrid_def), SAVE ::  cg   !:
    474 
     486
     487    TYPE(coarsegrid_def), SAVE, PUBLIC     ::  cg   !<
     488
     489!-  Variables for particle coupling
     490
     491    TYPE, PUBLIC :: childgrid_def
     492       INTEGER(iwp)                        ::  nx                   !<
     493       INTEGER(iwp)                        ::  ny                   !<
     494       INTEGER(iwp)                        ::  nz                   !<
     495       REAL(wp)                            ::  dx                   !<
     496       REAL(wp)                            ::  dy                   !<
     497       REAL(wp)                            ::  dz                   !<
     498       REAL(wp)                            ::  lx_coord, lx_coord_b !<
     499       REAL(wp)                            ::  rx_coord, rx_coord_b !<
     500       REAL(wp)                            ::  sy_coord, sy_coord_b !<
     501       REAL(wp)                            ::  ny_coord, ny_coord_b !<
     502       REAL(wp)                            ::  uz_coord, uz_coord_b !<
     503    END TYPE childgrid_def
     504
     505    TYPE(childgrid_def), SAVE, ALLOCATABLE, DIMENSION(:), PUBLIC :: childgrid !<
     506
     507    INTEGER(idp),ALLOCATABLE,DIMENSION(:,:),PUBLIC,TARGET    :: nr_part  !<
     508    INTEGER(idp),ALLOCATABLE,DIMENSION(:,:),PUBLIC,TARGET    :: part_adr !<
     509   
    475510    INTERFACE pmci_boundary_conds
    476511       MODULE PROCEDURE pmci_boundary_conds
    477512    END INTERFACE pmci_boundary_conds
    478 
     513   
    479514    INTERFACE pmci_check_setting_mismatches
    480515       MODULE PROCEDURE pmci_check_setting_mismatches
    … …  
    509544    END INTERFACE
    510545
     546    INTERFACE get_number_of_childs
     547       MODULE PROCEDURE get_number_of_childs
     548    END  INTERFACE get_number_of_childs
     549
     550    INTERFACE get_childid
     551       MODULE PROCEDURE get_childid
     552    END  INTERFACE get_childid
     553
     554    INTERFACE get_child_edges
     555       MODULE PROCEDURE get_child_edges
     556    END  INTERFACE get_child_edges
     557
     558    INTERFACE get_child_gridspacing
     559       MODULE PROCEDURE get_child_gridspacing
     560    END  INTERFACE get_child_gridspacing
     561
     562
    511563    INTERFACE pmci_set_swaplevel
    512564       MODULE PROCEDURE pmci_set_swaplevel
    513565    END INTERFACE pmci_set_swaplevel
    514566
    515     PUBLIC anterp_relax_length_l, anterp_relax_length_r,                        &
    516            anterp_relax_length_s, anterp_relax_length_n,                        &
    517            anterp_relax_length_t, child_to_parent, comm_world_nesting,          &
    518            cpl_id, nested_run, nesting_datatransfer_mode, nesting_mode,         &
     567    PUBLIC anterp_relax_length_l, anterp_relax_length_r,                       &
     568           anterp_relax_length_s, anterp_relax_length_n,                       &
     569           anterp_relax_length_t, child_to_parent, comm_world_nesting,         &
     570           cpl_id, nested_run, nesting_datatransfer_mode, nesting_mode,        &
    519571           parent_to_child
    520572
    … …  
    528580    PUBLIC pmci_synchronize
    529581    PUBLIC pmci_set_swaplevel
     582    PUBLIC get_number_of_childs, get_childid, get_child_edges, get_child_gridspacing
     583
    530584
    531585
    … …  
    535589 SUBROUTINE pmci_init( world_comm )
    536590
    537     USE control_parameters,                                                     &
     591    USE control_parameters,                                                    &
    538592        ONLY:  message_string
    539593
    540594    IMPLICIT NONE
    541595
    542     INTEGER, INTENT(OUT) ::  world_comm   !:
     596    INTEGER(iwp), INTENT(OUT) ::  world_comm   !<
    543597
    544598#if defined( __parallel )
    545599
    546     INTEGER(iwp)         ::  ierr         !:
    547     INTEGER(iwp)         ::  istat        !:
    548     INTEGER(iwp)         ::  pmc_status   !:
    549 
    550 
    551     CALL pmc_init_model( world_comm, nesting_datatransfer_mode, nesting_mode,   &
     600    INTEGER(iwp)         ::  ierr         !<
     601    INTEGER(iwp)         ::  istat        !<
     602    INTEGER(iwp)         ::  pmc_status   !<
     603
     604
     605    CALL pmc_init_model( world_comm, nesting_datatransfer_mode, nesting_mode,  &
    552606                         pmc_status )
    553607
    … …  
    564618!
    565619!-- Check steering parameter values
    566     IF ( TRIM( nesting_mode ) /= 'one-way'  .AND.                               &
    567          TRIM( nesting_mode ) /= 'two-way'  .AND.                               &
    568          TRIM( nesting_mode ) /= 'vertical' )                                   &                 
     620    IF ( TRIM( nesting_mode ) /= 'one-way'  .AND.                              &
     621         TRIM( nesting_mode ) /= 'two-way'  .AND.                              &
     622         TRIM( nesting_mode ) /= 'vertical' )                                  &                 
    569623    THEN
    570624       message_string = 'illegal nesting mode: ' // TRIM( nesting_mode )
    … …  
    572626    ENDIF
    573627
    574     IF ( TRIM( nesting_datatransfer_mode ) /= 'cascade'  .AND.                  &
    575          TRIM( nesting_datatransfer_mode ) /= 'mixed'    .AND.                  &
    576          TRIM( nesting_datatransfer_mode ) /= 'overlap' )                       &
     628    IF ( TRIM( nesting_datatransfer_mode ) /= 'cascade'  .AND.                 &
     629         TRIM( nesting_datatransfer_mode ) /= 'mixed'    .AND.                 &
     630         TRIM( nesting_datatransfer_mode ) /= 'overlap' )                      &
    577631    THEN
    578        message_string = 'illegal nesting datatransfer mode: '                   &
     632       message_string = 'illegal nesting datatransfer mode: '                  &
    579633                        // TRIM( nesting_datatransfer_mode )
    580634       CALL message( 'pmci_init', 'PA0418', 3, 2, 0, 6, 0 )
    … …  
    586640!-- Get some variables required by the pmc-interface (and in some cases in the
    587641!-- PALM code out of the pmci) out of the pmc-core
    588     CALL pmc_get_model_info( comm_world_nesting = comm_world_nesting,           &
    589                              cpl_id = cpl_id, cpl_parent_id = cpl_parent_id,    &
    590                              cpl_name = cpl_name, npe_total = cpl_npe_total,    &
    591                              lower_left_x = lower_left_coord_x,                 &
     642    CALL pmc_get_model_info( comm_world_nesting = comm_world_nesting,          &
     643                             cpl_id = cpl_id, cpl_parent_id = cpl_parent_id,   &
     644                             cpl_name = cpl_name, npe_total = cpl_npe_total,   &
     645                             lower_left_x = lower_left_coord_x,                &
    592646                             lower_left_y = lower_left_coord_y )
    593647!
    … …  
    661715
    662716    CHARACTER(LEN=32) ::  myname
    663 
    664     INTEGER(iwp) ::  child_id         !:
    665     INTEGER(iwp) ::  ierr             !:
    666     INTEGER(iwp) ::  i                !:
    667     INTEGER(iwp) ::  j                !:
    668     INTEGER(iwp) ::  k                !:
    669     INTEGER(iwp) ::  m                !:
    670     INTEGER(iwp) ::  mm               !:
     717   
     718    INTEGER(iwp) ::  child_id         !<
     719    INTEGER(iwp) ::  ierr             !<
     720    INTEGER(iwp) ::  i                !<
     721    INTEGER(iwp) ::  j                !<
     722    INTEGER(iwp) ::  k                !<
     723    INTEGER(iwp) ::  m                !<
     724    INTEGER(iwp) ::  mid              !<
     725    INTEGER(iwp) ::  mm               !<
    671726    INTEGER(iwp) ::  n = 1            !< running index for chemical species
    672     INTEGER(iwp) ::  nest_overlap     !:
    673     INTEGER(iwp) ::  nomatch          !:
    674     INTEGER(iwp) ::  nx_cl            !:
    675     INTEGER(iwp) ::  ny_cl            !:
    676     INTEGER(iwp) ::  nz_cl            !:
    677 
    678     INTEGER(iwp), DIMENSION(5) ::  val    !:
    679 
    680 
    681     REAL(wp), DIMENSION(:), ALLOCATABLE ::  ch_xl   !:
    682     REAL(wp), DIMENSION(:), ALLOCATABLE ::  ch_xr   !:   
    683     REAL(wp), DIMENSION(:), ALLOCATABLE ::  ch_ys   !:
    684     REAL(wp), DIMENSION(:), ALLOCATABLE ::  ch_yn   !:
    685     REAL(wp) ::  cl_height        !:
    686     REAL(wp) ::  dx_cl            !:
    687     REAL(wp) ::  dy_cl            !:
    688     REAL(wp) ::  left_limit       !:
    689     REAL(wp) ::  north_limit      !:
    690     REAL(wp) ::  right_limit      !:
    691     REAL(wp) ::  south_limit      !:
    692     REAL(wp) ::  xez              !:
    693     REAL(wp) ::  yez              !:
    694 
    695     REAL(wp), DIMENSION(1) ::  fval             !:
    696 
    697     REAL(wp), DIMENSION(:), ALLOCATABLE ::  cl_coord_x   !:
    698     REAL(wp), DIMENSION(:), ALLOCATABLE ::  cl_coord_y   !:
     727    INTEGER(iwp) ::  nest_overlap     !<
     728    INTEGER(iwp) ::  nomatch          !<
     729    INTEGER(iwp) ::  nx_cl            !<
     730    INTEGER(iwp) ::  ny_cl            !<
     731    INTEGER(iwp) ::  nz_cl            !<
     732
     733    INTEGER(iwp), DIMENSION(5) ::  val    !<
     734
     735
     736    REAL(wp), DIMENSION(:), ALLOCATABLE ::  ch_xl   !<
     737    REAL(wp), DIMENSION(:), ALLOCATABLE ::  ch_xr   !<   
     738    REAL(wp), DIMENSION(:), ALLOCATABLE ::  ch_ys   !<
     739    REAL(wp), DIMENSION(:), ALLOCATABLE ::  ch_yn   !<
     740    REAL(wp) ::  cl_height        !<
     741    REAL(wp) ::  dx_cl            !<
     742    REAL(wp) ::  dy_cl            !<
     743    REAL(wp) ::  dz_cl            !<
     744    REAL(wp) ::  left_limit       !<
     745    REAL(wp) ::  north_limit      !<
     746    REAL(wp) ::  right_limit      !<
     747    REAL(wp) ::  south_limit      !<
     748    REAL(wp) ::  xez              !<
     749    REAL(wp) ::  yez              !<
     750
     751    REAL(wp), DIMENSION(5) ::  fval             !<
     752
     753    REAL(wp), DIMENSION(:), ALLOCATABLE ::  cl_coord_x   !<
     754    REAL(wp), DIMENSION(:), ALLOCATABLE ::  cl_coord_y   !<
    699755
    700756!
    … …  
    709765       ALLOCATE( ch_yn(1:SIZE( pmc_parent_for_child ) - 1) )
    710766    ENDIF
     767    IF ( ( SIZE( pmc_parent_for_child ) - 1 > 0 ) )  THEN
     768       ALLOCATE( childgrid(1:SIZE( pmc_parent_for_child ) - 1) )
     769    ENDIF
     770
    711771!
    712772!-- Get coordinates from all children
    … …  
    719779          CALL pmc_recv_from_child( child_id, fval, size(fval), 0, 124, ierr )
    720780         
    721           nx_cl = val(1)
    722           ny_cl = val(2)
    723           dx_cl = val(4)
    724           dy_cl = val(5)
     781          nx_cl     = val(1)
     782          ny_cl     = val(2)
     783          dx_cl     = fval(3)
     784          dy_cl     = fval(4)
     785          dz_cl     = fval(5)
    725786          cl_height = fval(1)
     787
    726788          nz_cl = nz
    727789!
    … …  
    734796             ENDIF
    735797          ENDDO
     798
     799          zmax_coarse = fval(1:2)
     800          cl_height   = fval(1)
     801
    736802!   
    737803!--       Get absolute coordinates from the child
    … …  
    739805          ALLOCATE( cl_coord_y(-nbgp:ny_cl+nbgp) )
    740806         
    741           CALL pmc_recv_from_child( child_id, cl_coord_x, SIZE( cl_coord_x ),   &
     807          CALL pmc_recv_from_child( child_id, cl_coord_x, SIZE( cl_coord_x ),  &
    742808               0, 11, ierr )
    743           CALL pmc_recv_from_child( child_id, cl_coord_y, SIZE( cl_coord_y ),   &
     809          CALL pmc_recv_from_child( child_id, cl_coord_y, SIZE( cl_coord_y ),  &
    744810               0, 12, ierr )
    745811         
    … …  
    761827             right_limit = parent_grid_info_real(5)
    762828             north_limit = parent_grid_info_real(6)
    763              IF ( ( cl_coord_x(nx_cl+1) /= right_limit ) .OR.                   &
     829             IF ( ( cl_coord_x(nx_cl+1) /= right_limit ) .OR.                  &
    764830                  ( cl_coord_y(ny_cl+1) /= north_limit ) )  THEN
    765831                nomatch = 1
    … …  
    774840             south_limit = lower_left_coord_y + yez
    775841             north_limit = parent_grid_info_real(6) - yez
    776              IF ( ( cl_coord_x(0) < left_limit )        .OR.                    &
    777                   ( cl_coord_x(nx_cl+1) > right_limit ) .OR.                    &
    778                   ( cl_coord_y(0) < south_limit )       .OR.                    &
     842             IF ( ( cl_coord_x(0) < left_limit )        .OR.                   &
     843                  ( cl_coord_x(nx_cl+1) > right_limit ) .OR.                   &
     844                  ( cl_coord_y(0) < south_limit )       .OR.                   &
    779845                  ( cl_coord_y(ny_cl+1) > north_limit ) )  THEN
    780846                nomatch = 1
    … …  
    785851!--       that the top ghost layer of the child grid does not exceed
    786852!--       the parent domain top boundary.
     853
    787854          IF ( cl_height > zw(nz) ) THEN
    788855             nomatch = 1
    … …  
    798865
    799866             IF ( m > 1 )  THEN
    800                 DO mm = 1, m-1
    801                    IF ( ( ch_xl(m) < ch_xr(mm) .OR.                             &
    802                           ch_xr(m) > ch_xl(mm) )  .AND.                         &
    803                         ( ch_ys(m) < ch_yn(mm) .OR.                             &
    804                           ch_yn(m) > ch_ys(mm) ) )  THEN                       
    805                       nest_overlap = 1
     867                DO mm = 1, m - 1
     868                   mid = pmc_parent_for_child(mm)
     869!
     870!--                Check Only different nest level
     871                   IF (m_couplers(child_id)%parent_id /= m_couplers(mid)%parent_id)  THEN
     872                      IF ( ( ch_xl(m) < ch_xr(mm) .OR.                         &
     873                             ch_xr(m) > ch_xl(mm) )  .AND.                     &
     874                           ( ch_ys(m) < ch_yn(mm) .OR.                         &
     875                             ch_yn(m) > ch_ys(mm) ) )  THEN
     876                         nest_overlap = 1
     877                      ENDIF
    806878                   ENDIF
    807879                ENDDO
    … …  
    809881          ENDIF
    810882
     883          CALL set_child_edge_coords
     884
    811885          DEALLOCATE( cl_coord_x )
    812886          DEALLOCATE( cl_coord_y )
    813887!
    814888!--       Send coarse grid information to child
    815           CALL pmc_send_to_child( child_id, parent_grid_info_real,              &
    816                                    SIZE( parent_grid_info_real ), 0, 21,        &
     889          CALL pmc_send_to_child( child_id, parent_grid_info_real,             &
     890                                   SIZE( parent_grid_info_real ), 0, 21,       &
    817891                                   ierr )
    818           CALL pmc_send_to_child( child_id, parent_grid_info_int,  3, 0,        &
     892          CALL pmc_send_to_child( child_id, parent_grid_info_int,  3, 0,       &
    819893                                   22, ierr )
    820894!
    821895!--       Send local grid to child
    822           CALL pmc_send_to_child( child_id, coord_x, nx+1+2*nbgp, 0, 24,        &
     896          CALL pmc_send_to_child( child_id, coord_x, nx+1+2*nbgp, 0, 24,       &
    823897                                   ierr )
    824           CALL pmc_send_to_child( child_id, coord_y, ny+1+2*nbgp, 0, 25,        &
     898          CALL pmc_send_to_child( child_id, coord_y, ny+1+2*nbgp, 0, 25,       &
    825899                                   ierr )
    826900!
    … …  
    835909       CALL MPI_BCAST( nomatch, 1, MPI_INTEGER, 0, comm2d, ierr )
    836910       IF ( nomatch /= 0 )  THEN
    837           WRITE ( message_string, * )  'nested child domain does ',             &
     911          WRITE ( message_string, * )  'nested child domain does ',            &
    838912                                       'not fit into its parent domain'
    839913          CALL message( 'pmci_setup_parent', 'PA0425', 3, 2, 0, 6, 0 )
    … …  
    847921     
    848922       CALL MPI_BCAST( nz_cl, 1, MPI_INTEGER, 0, comm2d, ierr )
     923       CALL MPI_BCAST( childgrid(m), c_sizeof(childgrid(1)), MPI_BYTE, 0, comm2d, ierr )
     924
    849925!
    850926!--    TO_DO: Klaus: please give a comment what is done here
    … …  
    852928!
    853929!--    Include couple arrays into parent content
    854 !--    TO_DO: Klaus: please give a more meaningful comment
     930!--    The adresses of the PALM 2D or 3D array (here server coarse grid) which are candidates
     931!--    for coupling are stored once into the pmc context. While data transfer, the array do not
     932!--    have to be specified again
     933
    855934       CALL pmc_s_clear_next_array_list
    856935       DO  WHILE ( pmc_s_getnextarray( child_id, myname ) )
    … …  
    881960       IMPLICIT NONE
    882961
    883        INTEGER(iwp) ::  i                  !:
    884        INTEGER(iwp) ::  ic                 !:
    885        INTEGER(iwp) ::  ierr               !:
    886        INTEGER(iwp) ::  j                  !:
    887        INTEGER(iwp) ::  k                  !:
    888        INTEGER(iwp) ::  m                  !:
    889        INTEGER(iwp) ::  n                  !:
    890        INTEGER(iwp) ::  npx                !:
    891        INTEGER(iwp) ::  npy                !:
    892        INTEGER(iwp) ::  nrx                !:
    893        INTEGER(iwp) ::  nry                !:
    894        INTEGER(iwp) ::  px                 !:
    895        INTEGER(iwp) ::  py                 !:
    896        INTEGER(iwp) ::  parent_pe          !:
    897 
    898        INTEGER(iwp), DIMENSION(2) ::  scoord             !:
    899        INTEGER(iwp), DIMENSION(2) ::  size_of_array      !:
    900 
    901        INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE  ::  coarse_bound_all   !:
    902        INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE  ::  index_list         !:
     962       INTEGER(iwp) ::  i                  !<
     963       INTEGER(iwp) ::  ic                 !<
     964       INTEGER(iwp) ::  ierr               !<
     965       INTEGER(iwp) ::  j                  !<
     966       INTEGER(iwp) ::  k                  !<
     967       INTEGER(iwp) ::  m                  !<
     968       INTEGER(iwp) ::  n                  !<
     969       INTEGER(iwp) ::  npx                !<
     970       INTEGER(iwp) ::  npy                !<
     971       INTEGER(iwp) ::  nrx                !<
     972       INTEGER(iwp) ::  nry                !<
     973       INTEGER(iwp) ::  px                 !<
     974       INTEGER(iwp) ::  py                 !<
     975       INTEGER(iwp) ::  parent_pe          !<
     976
     977       INTEGER(iwp), DIMENSION(2) ::  scoord             !<
     978       INTEGER(iwp), DIMENSION(2) ::  size_of_array      !<
     979
     980       INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE  ::  coarse_bound_all   !<
     981       INTEGER(iwp), DIMENSION(:,:), ALLOCATABLE  ::  index_list         !<
    903982
    904983       IF ( myid == 0 )  THEN
    … …  
    907986          CALL pmc_recv_from_child( child_id, size_of_array, 2, 0, 40, ierr )
    908987          ALLOCATE( coarse_bound_all(size_of_array(1),size_of_array(2)) )
    909           CALL pmc_recv_from_child( child_id, coarse_bound_all,                 &
     988          CALL pmc_recv_from_child( child_id, coarse_bound_all,                &
    910989                                    SIZE( coarse_bound_all ), 0, 41, ierr )
    911990!
    … …  
    9831062     END SUBROUTINE pmci_create_index_list
    9841063
     1064     SUBROUTINE set_child_edge_coords
     1065        IMPLICIT  NONE
     1066
     1067        INTEGER(iwp) :: nbgp_lpm = 1
     1068
     1069        nbgp_lpm = min(nbgp_lpm, nbgp)
     1070
     1071        childgrid(m)%nx = nx_cl
     1072        childgrid(m)%ny = ny_cl
     1073        childgrid(m)%nz = nz_cl
     1074        childgrid(m)%dx = dx_cl
     1075        childgrid(m)%dy = dy_cl
     1076        childgrid(m)%dz = dz_cl
     1077
     1078        childgrid(m)%lx_coord   = cl_coord_x(0)
     1079        childgrid(m)%lx_coord_b = cl_coord_x(-nbgp_lpm)
     1080        childgrid(m)%rx_coord   = cl_coord_x(nx_cl)+dx_cl
     1081        childgrid(m)%rx_coord_b = cl_coord_x(nx_cl+nbgp_lpm)+dx_cl
     1082        childgrid(m)%sy_coord   = cl_coord_y(0)
     1083        childgrid(m)%sy_coord_b = cl_coord_y(-nbgp_lpm)
     1084        childgrid(m)%ny_coord   = cl_coord_y(ny_cl)+dy_cl
     1085        childgrid(m)%ny_coord_b = cl_coord_y(ny_cl+nbgp_lpm)+dy_cl
     1086        childgrid(m)%uz_coord   = zmax_coarse(2)
     1087        childgrid(m)%uz_coord_b = zmax_coarse(1)
     1088
     1089        WRITE(9,*)                 'edge coordinates for child id ',child_id,m
     1090        WRITE(9,*)                 'Number of Boundray cells lpm  ',nbgp_lpm
     1091        WRITE(9,'(a,3i7,2f10.2)') ' model size                    ', nx_cl, ny_cl, nz_cl, dx_cl, dy_cl
     1092        WRITE(9,'(a,5f10.2)')     ' model edge                    ', childgrid(m)%lx_coord, childgrid(m)%rx_coord, childgrid(m)%sy_coord, childgrid(m)%ny_coord,childgrid(m)%uz_coord
     1093        WRITE(9,'(a,4f10.2)')     ' model edge with Boundary      ', childgrid(m)%lx_coord_b, childgrid(m)%rx_coord_b, childgrid(m)%sy_coord_b, childgrid(m)%ny_coord_b
     1094
     1095     END SUBROUTINE set_child_edge_coords
     1096
    9851097#endif
    9861098 END SUBROUTINE pmci_setup_parent
    … …  
    10051117    INTEGER(iwp) ::  n          !< running index for number of chemical species
    10061118
    1007     INTEGER(iwp), DIMENSION(5) ::  val        !:
     1119    INTEGER(iwp), DIMENSION(5) ::  val        !<
    10081120   
    1009     REAL(wp) ::  xcs        !:
    1010     REAL(wp) ::  xce        !:
    1011     REAL(wp) ::  ycs        !:
    1012     REAL(wp) ::  yce        !:
    1013 
    1014     REAL(wp), DIMENSION(1) ::  fval       !:
     1121    REAL(wp) ::  xcs        !<
     1122    REAL(wp) ::  xce        !<
     1123    REAL(wp) ::  ycs        !<
     1124    REAL(wp) ::  yce        !<
     1125
     1126    REAL(wp), DIMENSION(5) ::  fval       !<
    10151127                                             
    10161128!
    1017 !-- TO_DO: describe what is happening in this if-clause
    1018 !-- Root model does not have a parent and is not a child
     1129!-- Child setup
     1130!-- Root model does not have a parent and is not a child, therefore no child setup on root model
     1131
    10191132    IF ( .NOT. pmc_is_rootmodel() )  THEN
    10201133
    … …  
    10571170       ENDIF
    10581171
     1172       IF( particle_advection )  THEN
     1173          CALL pmc_set_dataarray_name( 'coarse', 'nr_part'  ,'fine', 'nr_part',  ierr )
     1174          CALL pmc_set_dataarray_name( 'coarse', 'part_adr'  ,'fine', 'part_adr',  ierr )
     1175       ENDIF
     1176       
    10591177       IF ( air_chemistry )  THEN
    10601178          DO  n = 1, nspec
    … …  
    10781196       val(5)  = dy
    10791197       fval(1) = zw(nzt+1)
     1198       fval(2) = zw(nzt)
     1199       fval(3) = dx
     1200       fval(4) = dy
     1201       fval(5) = dz
    10801202
    10811203       IF ( myid == 0 )  THEN
    … …  
    10871209!
    10881210!--       Receive Coarse grid information.
    1089           CALL pmc_recv_from_parent( parent_grid_info_real,                     &
     1211          CALL pmc_recv_from_parent( parent_grid_info_real,                    &
    10901212                                     SIZE(parent_grid_info_real), 0, 21, ierr )
    10911213          CALL pmc_recv_from_parent( parent_grid_info_int,  3, 0, 22, ierr )
    10921214!
    10931215!--        Debug-printouts - keep them
    1094 !          WRITE(0,*) 'Coarse grid from parent '
    1095 !          WRITE(0,*) 'startx_tot    = ',parent_grid_info_real(1)
    1096 !          WRITE(0,*) 'starty_tot    = ',parent_grid_info_real(2)
    1097 !          WRITE(0,*) 'endx_tot      = ',parent_grid_info_real(5)
    1098 !          WRITE(0,*) 'endy_tot      = ',parent_grid_info_real(6)
    1099 !          WRITE(0,*) 'dx            = ',parent_grid_info_real(3)
    1100 !          WRITE(0,*) 'dy            = ',parent_grid_info_real(4)
    1101 !          WRITE(0,*) 'dz            = ',parent_grid_info_real(7)
    1102 !          WRITE(0,*) 'nx_coarse     = ',parent_grid_info_int(1)
    1103 !          WRITE(0,*) 'ny_coarse     = ',parent_grid_info_int(2)
    1104 !          WRITE(0,*) 'nz_coarse     = ',parent_grid_info_int(3)
    1105        ENDIF
    1106 
    1107        CALL MPI_BCAST( parent_grid_info_real, SIZE(parent_grid_info_real),      &
     1216!           WRITE(0,*) 'Coarse grid from parent '
     1217!           WRITE(0,*) 'startx_tot    = ',parent_grid_info_real(1)
     1218!           WRITE(0,*) 'starty_tot    = ',parent_grid_info_real(2)
     1219!           WRITE(0,*) 'endx_tot      = ',parent_grid_info_real(5)
     1220!           WRITE(0,*) 'endy_tot      = ',parent_grid_info_real(6)
     1221!           WRITE(0,*) 'dx            = ',parent_grid_info_real(3)
     1222!           WRITE(0,*) 'dy            = ',parent_grid_info_real(4)
     1223!           WRITE(0,*) 'dz            = ',parent_grid_info_real(7)
     1224!           WRITE(0,*) 'nx_coarse     = ',parent_grid_info_int(1)
     1225!           WRITE(0,*) 'ny_coarse     = ',parent_grid_info_int(2)
     1226!           WRITE(0,*) 'nz_coarse     = ',parent_grid_info_int(3)
     1227       ENDIF
     1228
     1229       CALL MPI_BCAST( parent_grid_info_real, SIZE(parent_grid_info_real),     &
    11081230                       MPI_REAL, 0, comm2d, ierr )
    11091231       CALL MPI_BCAST( parent_grid_info_int, 3, MPI_INTEGER, 0, comm2d, ierr )
    … …  
    11581280       n = 1
    11591281       DO  WHILE ( pmc_c_getnextarray( myname ) )
    1160 !--       Note that cg%nz is not th eoriginal nz of parent, but the highest
     1282!--       Note that cg%nz is not the original nz of parent, but the highest
    11611283!--       parent-grid level needed for nesting.
    11621284!--       Please note, in case of chemical species an additional parameter
    … …  
    11861308!--    Precompute the index arrays and relaxation functions for the
    11871309!--    anterpolation
    1188        IF ( TRIM( nesting_mode ) == 'two-way' .OR.                              &
     1310       IF ( TRIM( nesting_mode ) == 'two-way' .OR.                             &
    11891311                  nesting_mode == 'vertical' )  THEN
    11901312          CALL pmci_init_anterp_tophat
    … …  
    12061328       IMPLICIT NONE
    12071329
    1208        INTEGER(iwp), DIMENSION(5,numprocs) ::  coarse_bound_all   !:
    1209        INTEGER(iwp), DIMENSION(2)          ::  size_of_array      !:
     1330       INTEGER(iwp), DIMENSION(5,numprocs) ::  coarse_bound_all   !<
     1331       INTEGER(iwp), DIMENSION(2)          ::  size_of_array      !<
    12101332                                             
    1211        REAL(wp) ::  loffset     !:
    1212        REAL(wp) ::  noffset     !:
    1213        REAL(wp) ::  roffset     !:
    1214        REAL(wp) ::  soffset     !:
     1333       REAL(wp) ::  loffset     !<
     1334       REAL(wp) ::  noffset     !<
     1335       REAL(wp) ::  roffset     !<
     1336       REAL(wp) ::  soffset     !<
    12151337
    12161338!
    … …  
    12831405!--    Note that MPI_Gather receives data from all processes in the rank order
    12841406!--    TO_DO: refer to the line where this fact becomes important
    1285        CALL MPI_GATHER( coarse_bound, 5, MPI_INTEGER, coarse_bound_all, 5,      &
     1407       CALL MPI_GATHER( coarse_bound, 5, MPI_INTEGER, coarse_bound_all, 5,     &
    12861408                        MPI_INTEGER, 0, comm2d, ierr )
    12871409
    … …  
    12901412          size_of_array(2) = SIZE( coarse_bound_all, 2 )
    12911413          CALL pmc_send_to_parent( size_of_array, 2, 0, 40, ierr )
    1292           CALL pmc_send_to_parent( coarse_bound_all, SIZE( coarse_bound_all ),  &
     1414          CALL pmc_send_to_parent( coarse_bound_all, SIZE( coarse_bound_all ), &
    12931415                                   0, 41, ierr )
    12941416       ENDIF
    … …  
    13061428       IMPLICIT NONE
    13071429
    1308        INTEGER(iwp) ::  i       !:
    1309        INTEGER(iwp) ::  i1      !:
    1310        INTEGER(iwp) ::  j       !:
    1311        INTEGER(iwp) ::  j1      !:
    1312        INTEGER(iwp) ::  k       !:
    1313        INTEGER(iwp) ::  kc      !:
    1314        INTEGER(iwp) ::  kdzo    !:
    1315        INTEGER(iwp) ::  kdzw    !:       
    1316 
    1317        REAL(wp) ::  xb          !:
    1318        REAL(wp) ::  xcsu        !:
    1319        REAL(wp) ::  xfso        !:
    1320        REAL(wp) ::  xcso        !:
    1321        REAL(wp) ::  xfsu        !:
    1322        REAL(wp) ::  yb          !:
    1323        REAL(wp) ::  ycso        !:
    1324        REAL(wp) ::  ycsv        !:
    1325        REAL(wp) ::  yfso        !:
    1326        REAL(wp) ::  yfsv        !:
    1327        REAL(wp) ::  zcso        !:
    1328        REAL(wp) ::  zcsw        !:
    1329        REAL(wp) ::  zfso        !:
    1330        REAL(wp) ::  zfsw        !:
     1430       INTEGER(iwp) ::  i       !<
     1431       INTEGER(iwp) ::  i1      !<
     1432       INTEGER(iwp) ::  j       !<
     1433       INTEGER(iwp) ::  j1      !<
     1434       INTEGER(iwp) ::  k       !<
     1435       INTEGER(iwp) ::  kc      !<
     1436       INTEGER(iwp) ::  kdzo    !<
     1437       INTEGER(iwp) ::  kdzw    !<       
     1438
     1439       REAL(wp) ::  xb          !<
     1440       REAL(wp) ::  xcsu        !<
     1441       REAL(wp) ::  xfso        !<
     1442       REAL(wp) ::  xcso        !<
     1443       REAL(wp) ::  xfsu        !<
     1444       REAL(wp) ::  yb          !<
     1445       REAL(wp) ::  ycso        !<
     1446       REAL(wp) ::  ycsv        !<
     1447       REAL(wp) ::  yfso        !<
     1448       REAL(wp) ::  yfsv        !<
     1449       REAL(wp) ::  zcso        !<
     1450       REAL(wp) ::  zcsw        !<
     1451       REAL(wp) ::  zfso        !<
     1452       REAL(wp) ::  zfsw        !<
    13311453     
    13321454
    … …  
    13911513          kcw(k) = kc - 1
    13921514         
    1393           !if ( myid == 0 .and. nx==191 )  then
    1394           !   write(162,*)nx, nzt+1, k, zw(k), cg%nz+1, kcw(k), cg%zw(kcw(k))
    1395           !endif
    1396           !if ( myid == 0 .and. nx==383 )  then
    1397           !   write(163,*)nx, nzt+1, k, zw(k), cg%nz+1, kcw(k), cg%zw(kcw(k))
    1398           !endif
    1399 
    14001515          DO kc = 0, cg%nz+1
    14011516             IF ( cg%zu(kc) > zfso )  EXIT
    … …  
    19452060                      inc        = 1
    19462061                      wall_index = j
    1947                       CALL pmci_define_loglaw_correction_parameters( lc, lcr,   &
     2062                      CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
    19482063                          k, j, inc, wall_index, z0_topo, kb, direction, ncorr )
    19492064!
    … …  
    21882303       IMPLICIT NONE
    21892304
    2190        INTEGER(iwp), INTENT(IN)  ::  direction                 !:
    2191        INTEGER(iwp), INTENT(IN)  ::  ij                        !:
    2192        INTEGER(iwp), INTENT(IN)  ::  inc                       !:
    2193        INTEGER(iwp), INTENT(IN)  ::  k                         !:
    2194        INTEGER(iwp), INTENT(IN)  ::  kb                        !:
    2195        INTEGER(iwp), INTENT(OUT) ::  lc                        !:
    2196        INTEGER(iwp), INTENT(IN)  ::  ncorr                     !:
    2197        INTEGER(iwp), INTENT(IN)  ::  wall_index                !:
    2198 
    2199        INTEGER(iwp) ::  alcorr       !:
    2200        INTEGER(iwp) ::  corr_index   !:
    2201        INTEGER(iwp) ::  lcorr        !:
    2202 
    2203        LOGICAL      ::  more         !:
    2204 
    2205        REAL(wp), DIMENSION(0:ncorr-1), INTENT(OUT) ::  lcr     !:
    2206        REAL(wp), INTENT(IN)      ::  z0_l                      !:
     2305       INTEGER(iwp), INTENT(IN)  ::  direction  !<
     2306       INTEGER(iwp), INTENT(IN)  ::  ij         !<
     2307       INTEGER(iwp), INTENT(IN)  ::  inc        !<
     2308       INTEGER(iwp), INTENT(IN)  ::  k          !<
     2309       INTEGER(iwp), INTENT(IN)  ::  kb         !<
     2310       INTEGER(iwp), INTENT(OUT) ::  lc         !<
     2311       INTEGER(iwp), INTENT(IN)  ::  ncorr      !<
     2312       INTEGER(iwp), INTENT(IN)  ::  wall_index !<
     2313
     2314       INTEGER(iwp) ::  alcorr       !<
     2315       INTEGER(iwp) ::  corr_index   !<
     2316       INTEGER(iwp) ::  lcorr        !<
     2317
     2318       LOGICAL      ::  more         !<
     2319
     2320       REAL(wp), DIMENSION(0:ncorr-1), INTENT(OUT) ::  lcr     !<
     2321       REAL(wp), INTENT(IN)      ::  z0_l                      !<
    22072322     
    2208        REAL(wp)     ::  logvelc1     !:
     2323       REAL(wp)     ::  logvelc1     !<
    22092324     
    22102325
    … …  
    22962411       IMPLICIT NONE
    22972412
    2298        INTEGER(iwp), INTENT(IN)  ::  kb   !:
    2299        INTEGER(iwp), INTENT(OUT) ::  lc   !:
    2300 
    2301        INTEGER(iwp) ::  kbc    !:
    2302        INTEGER(iwp) ::  k1     !:
    2303 
    2304        REAL(wp), INTENT(OUT) ::  logzc1     !:
    2305        REAL(wp), INTENT(IN) ::  z0_l       !:
    2306 
    2307        REAL(wp) ::  zuc1   !:
     2413       INTEGER(iwp), INTENT(IN)  ::  kb   !<
     2414       INTEGER(iwp), INTENT(OUT) ::  lc   !<
     2415
     2416       INTEGER(iwp) ::  kbc    !<
     2417       INTEGER(iwp) ::  k1     !<
     2418
     2419       REAL(wp), INTENT(OUT) ::  logzc1     !<
     2420       REAL(wp), INTENT(IN) ::  z0_l       !<
     2421
     2422       REAL(wp) ::  zuc1   !<
    23082423
    23092424
    … …  
    23352450       IMPLICIT NONE
    23362451
    2337        INTEGER(iwp), INTENT(IN)  ::  inc    !:  increment must be 1 or -1.
    2338        INTEGER(iwp), INTENT(IN)  ::  j      !:
    2339        INTEGER(iwp), INTENT(IN)  ::  jw     !:
    2340        INTEGER(iwp), INTENT(OUT) ::  lc     !:
    2341 
    2342        INTEGER(iwp) ::  j1       !:
    2343 
    2344        REAL(wp), INTENT(IN) ::  z0_l   !:
    2345 
    2346        REAL(wp) ::  logyc1   !:
    2347        REAL(wp) ::  yc1      !:
     2452       INTEGER(iwp), INTENT(IN)  ::  inc    !<  increment must be 1 or -1.
     2453       INTEGER(iwp), INTENT(IN)  ::  j      !<
     2454       INTEGER(iwp), INTENT(IN)  ::  jw     !<
     2455       INTEGER(iwp), INTENT(OUT) ::  lc     !<
     2456
     2457       INTEGER(iwp) ::  j1       !<
     2458
     2459       REAL(wp), INTENT(IN) ::  z0_l   !<
     2460
     2461       REAL(wp) ::  logyc1   !<
     2462       REAL(wp) ::  yc1      !<
    23482463       
    23492464!
    … …  
    23762491       IMPLICIT NONE
    23772492
    2378        INTEGER(iwp), INTENT(IN)  ::  i      !:
    2379        INTEGER(iwp), INTENT(IN)  ::  inc    !: increment must be 1 or -1.
    2380        INTEGER(iwp), INTENT(IN)  ::  iw     !:
    2381        INTEGER(iwp), INTENT(OUT) ::  lc     !:
    2382 
    2383        INTEGER(iwp) ::  i1       !:
    2384 
    2385        REAL(wp), INTENT(IN) ::  z0_l   !:
    2386 
    2387        REAL(wp) ::  logxc1   !:
    2388        REAL(wp) ::  xc1      !:
     2493       INTEGER(iwp), INTENT(IN)  ::  i      !<
     2494       INTEGER(iwp), INTENT(IN)  ::  inc    !< increment must be 1 or -1.
     2495       INTEGER(iwp), INTENT(IN)  ::  iw     !<
     2496       INTEGER(iwp), INTENT(OUT) ::  lc     !<
     2497
     2498       INTEGER(iwp) ::  i1       !<
     2499
     2500       REAL(wp), INTENT(IN) ::  z0_l   !<
     2501
     2502       REAL(wp) ::  logxc1   !<
     2503       REAL(wp) ::  xc1      !<
    23892504
    23902505!
    … …  
    24172532       IMPLICIT NONE
    24182533
    2419        INTEGER(iwp) ::  i        !: Fine-grid index
    2420        INTEGER(iwp) ::  ifc_o    !:
    2421        INTEGER(iwp) ::  ifc_u    !:
    2422        INTEGER(iwp) ::  ii       !: Coarse-grid index
    2423        INTEGER(iwp) ::  istart   !:
    2424        INTEGER(iwp) ::  ir       !:
    2425        INTEGER(iwp) ::  j        !: Fine-grid index
    2426        INTEGER(iwp) ::  jj       !: Coarse-grid index
    2427        INTEGER(iwp) ::  jstart   !:
    2428        INTEGER(iwp) ::  jr       !:
    2429        INTEGER(iwp) ::  k        !: Fine-grid index
    2430        INTEGER(iwp) ::  kk       !: Coarse-grid index
    2431        INTEGER(iwp) ::  kstart   !:
    2432        REAL(wp)     ::  xi       !:
    2433        REAL(wp)     ::  eta      !:
    2434        REAL(wp)     ::  zeta     !:
     2534       INTEGER(iwp) ::  i        !< Fine-grid index
     2535       INTEGER(iwp) ::  ifc_o    !<
     2536       INTEGER(iwp) ::  ifc_u    !<
     2537       INTEGER(iwp) ::  ii       !< Coarse-grid index
     2538       INTEGER(iwp) ::  istart   !<
     2539       INTEGER(iwp) ::  ir       !<
     2540       INTEGER(iwp) ::  j        !< Fine-grid index
     2541       INTEGER(iwp) ::  jj       !< Coarse-grid index
     2542       INTEGER(iwp) ::  jstart   !<
     2543       INTEGER(iwp) ::  jr       !<
     2544       INTEGER(iwp) ::  k        !< Fine-grid index
     2545       INTEGER(iwp) ::  kk       !< Coarse-grid index
     2546       INTEGER(iwp) ::  kstart   !<
     2547       REAL(wp)     ::  xi       !<
     2548       REAL(wp)     ::  eta      !<
     2549       REAL(wp)     ::  zeta     !<
    24352550     
    24362551!
    … …  
    24902605       DO  ii = icl, icr-1
    24912606          i = istart
    2492           DO  WHILE ( ( coord_x(i) < cg%coord_x(ii) - 0.5_wp * cg%dx )  .AND.   &
     2607          DO  WHILE ( ( coord_x(i) < cg%coord_x(ii) - 0.5_wp * cg%dx )  .AND.  &
    24932608                      ( i < nxrg ) )
    24942609             i  = i + 1
    … …  
    24962611          iflu(ii) = MIN( MAX( i, nxlg ), nxrg )
    24972612          ir = i
    2498           DO  WHILE ( ( coord_x(ir) <= cg%coord_x(ii) + 0.5_wp * cg%dx )  .AND. &
     2613          DO  WHILE ( ( coord_x(ir) <= cg%coord_x(ii) + 0.5_wp * cg%dx )  .AND.&
    24992614                      ( i < nxrg+1 ) )
    25002615             i  = i + 1
    … …  
    25122627       DO  ii = icl, icr-1
    25132628          i = istart
    2514           DO  WHILE ( ( coord_x(i) + 0.5_wp * dx < cg%coord_x(ii) )  .AND.      &
     2629          DO  WHILE ( ( coord_x(i) + 0.5_wp * dx < cg%coord_x(ii) )  .AND.     &
    25152630                      ( i < nxrg ) )
    25162631             i  = i + 1
    … …  
    25182633          iflo(ii) = MIN( MAX( i, nxlg ), nxrg )
    25192634          ir = i
    2520           DO  WHILE ( ( coord_x(ir) + 0.5_wp * dx <= cg%coord_x(ii) + cg%dx )   &
     2635          DO  WHILE ( ( coord_x(ir) + 0.5_wp * dx <= cg%coord_x(ii) + cg%dx )  &
    25212636                      .AND.  ( i < nxrg+1 ) )
    25222637             i  = i + 1
    … …  
    25342649       DO  jj = jcs, jcn-1
    25352650          j = jstart
    2536           DO  WHILE ( ( coord_y(j) < cg%coord_y(jj) - 0.5_wp * cg%dy )  .AND.   &
     2651          DO  WHILE ( ( coord_y(j) < cg%coord_y(jj) - 0.5_wp * cg%dy )  .AND.  &
    25372652                      ( j < nyng ) )
    25382653             j  = j + 1
    … …  
    25402655          jflv(jj) = MIN( MAX( j, nysg ), nyng )
    25412656          jr = j
    2542           DO  WHILE ( ( coord_y(jr) <= cg%coord_y(jj) + 0.5_wp * cg%dy )  .AND. &
     2657          DO  WHILE ( ( coord_y(jr) <= cg%coord_y(jj) + 0.5_wp * cg%dy )  .AND.&
    25432658                      ( j < nyng+1 ) )
    25442659             j  = j + 1
    … …  
    25562671       DO  jj = jcs, jcn-1
    25572672          j = jstart
    2558           DO  WHILE ( ( coord_y(j) + 0.5_wp * dy < cg%coord_y(jj) )  .AND.      &
     2673          DO  WHILE ( ( coord_y(j) + 0.5_wp * dy < cg%coord_y(jj) )  .AND.     &
    25592674                      ( j < nyng ) )
    25602675             j  = j + 1
    … …  
    25622677          jflo(jj) = MIN( MAX( j, nysg ), nyng )
    25632678          jr = j
    2564           DO  WHILE ( ( coord_y(jr) + 0.5_wp * dy <= cg%coord_y(jj) + cg%dy )   &
     2679          DO  WHILE ( ( coord_y(jr) + 0.5_wp * dy <= cg%coord_y(jj) + cg%dy )  &
    25652680                      .AND.  ( j < nyng+1 ) )
    25662681             j  = j + 1
    … …  
    26362751          DO  ii = icl, icr
    26372752             IF ( ifuu(ii) < ( nx + 1 ) / 2 )  THEN   
    2638                 xi = ( MAX( 0.0_wp, ( cg%coord_x(ii) -                          &
     2753                xi = ( MAX( 0.0_wp, ( cg%coord_x(ii) -                         &
    26392754                     lower_left_coord_x ) ) / anterp_relax_length_l )**4
    26402755                frax(ii) = xi / ( 1.0_wp + xi )
    26412756             ELSE
    2642                 xi = ( MAX( 0.0_wp, ( lower_left_coord_x + ( nx + 1 ) * dx -    &
    2643                                       cg%coord_x(ii) ) ) /                      &
     2757                xi = ( MAX( 0.0_wp, ( lower_left_coord_x + ( nx + 1 ) * dx -   &
     2758                                      cg%coord_x(ii) ) ) /                     &
    26442759                       anterp_relax_length_r )**4
    26452760                frax(ii) = xi / ( 1.0_wp + xi )               
    … …  
    26502765          DO  jj = jcs, jcn
    26512766             IF ( jfuv(jj) < ( ny + 1 ) / 2 )  THEN
    2652                 eta = ( MAX( 0.0_wp, ( cg%coord_y(jj) -                         &
     2767                eta = ( MAX( 0.0_wp, ( cg%coord_y(jj) -                        &
    26532768                     lower_left_coord_y ) ) / anterp_relax_length_s )**4
    26542769                fray(jj) = eta / ( 1.0_wp + eta )
    26552770             ELSE
    2656                 eta = ( MAX( 0.0_wp, ( lower_left_coord_y + ( ny + 1 ) * dy -   &
    2657                                        cg%coord_y(jj)) ) /                      &
     2771                eta = ( MAX( 0.0_wp, ( lower_left_coord_y + ( ny + 1 ) * dy -  &
     2772                                       cg%coord_y(jj)) ) /                     &
    26582773                        anterp_relax_length_n )**4
    26592774                fray(jj) = eta / ( 1.0_wp + eta )
    … …  
    26832798       IMPLICIT NONE
    26842799
    2685        INTEGER(iwp)        ::  k                     !: index variable along z
    2686        INTEGER(iwp)        ::  k_wall                !: topography-top index along z
    2687        INTEGER(iwp)        ::  kc                    !:
    2688 
    2689        REAL(wp), PARAMETER ::  cfw = 0.2_wp          !:
    2690        REAL(wp), PARAMETER ::  c_tkef = 0.6_wp       !:
    2691        REAL(wp)            ::  fw                    !:
    2692        REAL(wp), PARAMETER ::  fw0 = 0.9_wp          !:
    2693        REAL(wp)            ::  glsf                  !:
    2694        REAL(wp)            ::  glsc                  !:
    2695        REAL(wp)            ::  height                !:
    2696        REAL(wp), PARAMETER ::  p13 = 1.0_wp/3.0_wp   !:
    2697        REAL(wp), PARAMETER ::  p23 = 2.0_wp/3.0_wp   !:       
     2800       INTEGER(iwp)        ::  k                     !< index variable along z
     2801       INTEGER(iwp)        ::  k_wall                !< topography-top index along z
     2802       INTEGER(iwp)        ::  kc                    !<
     2803
     2804       REAL(wp), PARAMETER ::  cfw = 0.2_wp          !<
     2805       REAL(wp), PARAMETER ::  c_tkef = 0.6_wp       !<
     2806       REAL(wp)            ::  fw                    !<
     2807       REAL(wp), PARAMETER ::  fw0 = 0.9_wp          !<
     2808       REAL(wp)            ::  glsf                  !<
     2809       REAL(wp)            ::  glsc                  !<
     2810       REAL(wp)            ::  height                !<
     2811       REAL(wp), PARAMETER ::  p13 = 1.0_wp/3.0_wp   !<
     2812       REAL(wp), PARAMETER ::  p23 = 2.0_wp/3.0_wp   !<       
    26982813
    26992814       IF ( nest_bound_l )  THEN
    … …  
    27112826                height = zu(k) - zu(k_wall)
    27122827                fw     = EXP( -cfw * height / glsf )
    2713                 tkefactor_l(k,j) = c_tkef * ( fw0 * fw + ( 1.0_wp - fw ) *      &
     2828                tkefactor_l(k,j) = c_tkef * ( fw0 * fw + ( 1.0_wp - fw ) *     &
    27142829                                              ( glsf / glsc )**p23 )
    27152830             ENDDO
    … …  
    27322847                height = zu(k) - zu(k_wall)
    27332848                fw     = EXP( -cfw * height / glsf )
    2734                 tkefactor_r(k,j) = c_tkef * ( fw0 * fw + ( 1.0_wp - fw ) *      &
     2849                tkefactor_r(k,j) = c_tkef * ( fw0 * fw + ( 1.0_wp - fw ) *     &
    27352850                                              ( glsf / glsc )**p23 )
    27362851             ENDDO
    … …  
    27532868                height = zu(k) - zu(k_wall)
    27542869                fw     = EXP( -cfw*height / glsf )
    2755                 tkefactor_s(k,i) = c_tkef * ( fw0 * fw + ( 1.0_wp - fw ) *      &
     2870                tkefactor_s(k,i) = c_tkef * ( fw0 * fw + ( 1.0_wp - fw ) *     &
    27562871                     ( glsf / glsc )**p23 )
    27572872             ENDDO
    … …  
    28122927    IMPLICIT NONE
    28132928
    2814     INTEGER(iwp) ::  i   !:
    2815     INTEGER(iwp) ::  j   !:
     2929    INTEGER(iwp) ::  i   !<
     2930    INTEGER(iwp) ::  j   !<
    28162931
    28172932!
    … …  
    28382953    IMPLICIT NONE
    28392954
    2840     INTEGER, INTENT(IN)          ::  child_id    !:
    2841     INTEGER, INTENT(IN)          ::  nz_cl       !:
    2842     INTEGER, INTENT(IN),OPTIONAL ::  n           !< index of chemical species
    2843 
    2844     CHARACTER(LEN=*), INTENT(IN) ::  name        !:
     2955    INTEGER(iwp), INTENT(IN)          ::  child_id    !<
     2956    INTEGER(iwp), INTENT(IN)          ::  nz_cl       !<
     2957    INTEGER(iwp), INTENT(IN),OPTIONAL ::  n           !< index of chemical species
     2958
     2959    CHARACTER(LEN=*), INTENT(IN) ::  name        !<
    28452960
    28462961#if defined( __parallel )
    2847     INTEGER(iwp) ::  ierr        !:
    2848     INTEGER(iwp) ::  istat       !:
    2849 
    2850     REAL(wp), POINTER, DIMENSION(:,:)   ::  p_2d        !:
    2851     REAL(wp), POINTER, DIMENSION(:,:)   ::  p_2d_sec    !:
    2852     REAL(wp), POINTER, DIMENSION(:,:,:) ::  p_3d        !:
    2853     REAL(wp), POINTER, DIMENSION(:,:,:) ::  p_3d_sec    !:
     2962    INTEGER(iwp) ::  ierr        !<
     2963    INTEGER(iwp) ::  istat       !<
     2964
     2965    REAL(wp), POINTER, DIMENSION(:,:)     ::  p_2d        !<
     2966    REAL(wp), POINTER, DIMENSION(:,:)     ::  p_2d_sec    !<
     2967    REAL(wp), POINTER, DIMENSION(:,:,:)   ::  p_3d        !<
     2968    REAL(wp), POINTER, DIMENSION(:,:,:)   ::  p_3d_sec    !<
     2969    INTEGER(idp), POINTER, DIMENSION(:,:) ::  i_2d        !<
    28542970
    28552971
    28562972    NULLIFY( p_3d )
    28572973    NULLIFY( p_2d )
     2974    NULLIFY( i_2d )
     2975
    28582976!
    28592977!-- List of array names, which can be coupled.
    … …  
    28702988    IF ( TRIM(name) == "nc" )  p_3d => nc
    28712989    IF ( TRIM(name) == "s"  )  p_3d => s
     2990    IF ( TRIM(name) == "nr_part"  )   i_2d => nr_part
     2991    IF ( TRIM(name) == "part_adr"  )  i_2d => part_adr
    28722992    IF ( INDEX( TRIM(name), "chem_" ) /= 0 )  p_3d => chem_species(n)%conc
    28732993
    … …  
    28823002    ELSEIF ( ASSOCIATED( p_2d ) )  THEN
    28833003       CALL pmc_s_set_dataarray( child_id, p_2d )
     3004    ELSEIF ( ASSOCIATED( i_2d ) )  THEN
     3005       CALL pmc_s_set_dataarray( child_id, i_2d )
    28843006    ELSE
    28853007!
    … …  
    28873009       IF ( myid == 0  .AND.  cpl_id == 1 )  THEN
    28883010
    2889           message_string = 'pointer for array "' // TRIM( name ) //             &
     3011          message_string = 'pointer for array "' // TRIM( name ) //            &
    28903012                           '" can''t be associated'
    28913013          CALL message( 'pmci_set_array_pointer', 'PA0117', 3, 2, 0, 6, 0 )
    … …  
    29113033
    29123034    IF ( ASSOCIATED( p_3d ) )  THEN
    2913        CALL pmc_s_set_dataarray( child_id, p_3d, nz_cl, nz,                     &
     3035       CALL pmc_s_set_dataarray( child_id, p_3d, nz_cl, nz,                    &
    29143036                                 array_2 = p_3d_sec )
    29153037    ELSEIF ( ASSOCIATED( p_2d ) )  THEN
    29163038       CALL pmc_s_set_dataarray( child_id, p_2d )
     3039    ELSEIF ( ASSOCIATED( i_2d ) )  THEN
     3040       CALL pmc_s_set_dataarray( child_id, i_2d )
    29173041    ELSE
    29183042!
    … …  
    29203044       IF ( myid == 0  .AND.  cpl_id == 1 )  THEN
    29213045
    2922           message_string = 'pointer for array "' // TRIM( name ) //             &
     3046          message_string = 'pointer for array "' // TRIM( name ) //            &
    29233047                           '" can''t be associated'
    29243048          CALL message( 'pmci_set_array_pointer', 'PA0117', 3, 2, 0, 6, 0 )
    … …  
    29333057
    29343058#endif
    2935  END SUBROUTINE pmci_set_array_pointer
    2936 
    2937 
    2938 
    2939  SUBROUTINE pmci_create_child_arrays( name, is, ie, js, je, nzc, n )
     3059END SUBROUTINE pmci_set_array_pointer
     3060
     3061INTEGER FUNCTION get_number_of_childs ()
     3062   IMPLICIT NONE
     3063
     3064   get_number_of_childs = SIZE( pmc_parent_for_child ) - 1
     3065
     3066   RETURN
     3067END FUNCTION get_number_of_childs
     3068
     3069INTEGER FUNCTION get_childid (id_index)
     3070   IMPLICIT NONE
     3071
     3072   INTEGER,INTENT(IN)                 :: id_index
     3073
     3074   get_childid = pmc_parent_for_child(id_index)
     3075
     3076   RETURN
     3077END FUNCTION get_childid
     3078
     3079SUBROUTINE  get_child_edges (m, lx_coord, lx_coord_b, rx_coord, rx_coord_b,    &
     3080                               sy_coord, sy_coord_b, ny_coord, ny_coord_b,     &
     3081                               uz_coord, uz_coord_b)
     3082   IMPLICIT NONE
     3083   INTEGER,INTENT(IN)             ::  m
     3084   REAL(wp),INTENT(OUT)           ::  lx_coord, lx_coord_b
     3085   REAL(wp),INTENT(OUT)           ::  rx_coord, rx_coord_b
     3086   REAL(wp),INTENT(OUT)           ::  sy_coord, sy_coord_b
     3087   REAL(wp),INTENT(OUT)           ::  ny_coord, ny_coord_b
     3088   REAL(wp),INTENT(OUT)           ::  uz_coord, uz_coord_b
     3089
     3090   lx_coord = childgrid(m)%lx_coord
     3091   rx_coord = childgrid(m)%rx_coord
     3092   sy_coord = childgrid(m)%sy_coord
     3093   ny_coord = childgrid(m)%ny_coord
     3094   uz_coord = childgrid(m)%uz_coord
     3095
     3096   lx_coord_b = childgrid(m)%lx_coord_b
     3097   rx_coord_b = childgrid(m)%rx_coord_b
     3098   sy_coord_b = childgrid(m)%sy_coord_b
     3099   ny_coord_b = childgrid(m)%ny_coord_b
     3100   uz_coord_b = childgrid(m)%uz_coord_b
     3101
     3102END SUBROUTINE get_child_edges
     3103
     3104SUBROUTINE  get_child_gridspacing (m, dx,dy,dz)
     3105
     3106   IMPLICIT NONE
     3107   INTEGER,INTENT(IN)             ::  m
     3108   REAL(wp),INTENT(OUT)           ::  dx,dy
     3109   REAL(wp),INTENT(OUT),OPTIONAL  ::  dz
     3110
     3111   dx = childgrid(m)%dx
     3112   dy = childgrid(m)%dy
     3113   IF(PRESENT(dz))   THEN
     3114      dz = childgrid(m)%dz
     3115   ENDIF
     3116
     3117END SUBROUTINE get_child_gridspacing
     3118
     3119SUBROUTINE pmci_create_child_arrays( name, is, ie, js, je, nzc,n  )
    29403120
    29413121    IMPLICIT NONE
    29423122
    2943     CHARACTER(LEN=*), INTENT(IN) ::  name    !:
    2944 
    2945     INTEGER(iwp), INTENT(IN) ::  ie      !:
    2946     INTEGER(iwp), INTENT(IN) ::  is      !:
    2947     INTEGER(iwp), INTENT(IN) ::  je      !:
    2948     INTEGER(iwp), INTENT(IN) ::  js      !:
    2949     INTEGER(iwp), INTENT(IN) ::  nzc     !:  Note that nzc is cg%nz
     3123    CHARACTER(LEN=*), INTENT(IN) ::  name    !<
     3124
     3125    INTEGER(iwp), INTENT(IN) ::  ie      !<
     3126    INTEGER(iwp), INTENT(IN) ::  is      !<
     3127    INTEGER(iwp), INTENT(IN) ::  je      !<
     3128    INTEGER(iwp), INTENT(IN) ::  js      !<
     3129    INTEGER(iwp), INTENT(IN) ::  nzc     !<  Note that nzc is cg%nz
    29503130
    29513131    INTEGER(iwp), INTENT(IN), OPTIONAL ::  n  !< number of chemical species
    29523132
    29533133#if defined( __parallel )
    2954     INTEGER(iwp) ::  ierr    !:
    2955     INTEGER(iwp) ::  istat   !:
    2956 
    2957     REAL(wp), POINTER,DIMENSION(:,:)   ::  p_2d    !:
    2958     REAL(wp), POINTER,DIMENSION(:,:,:) ::  p_3d    !:
     3134    INTEGER(iwp) ::  ierr    !<
     3135    INTEGER(iwp) ::  istat   !<
     3136
     3137    REAL(wp), POINTER,DIMENSION(:,:)       ::  p_2d    !<
     3138    REAL(wp), POINTER,DIMENSION(:,:,:)     ::  p_3d    !<
     3139    INTEGER(idp), POINTER,DIMENSION(:,:)   ::  i_2d    !<
    29593140
    29603141
    29613142    NULLIFY( p_3d )
    29623143    NULLIFY( p_2d )
     3144    NULLIFY( i_2d )
     3145
    29633146!
    29643147!-- List of array names, which can be coupled
    … …  
    29963179       IF ( .NOT. ALLOCATED( sc ) )  ALLOCATE( sc(0:nzc+1,js:je,is:ie) )
    29973180       p_3d => sc
     3181    ELSEIF (trim(name) == "nr_part") then
     3182       IF (.not.allocated(nr_partc))  allocate(nr_partc(js:je, is:ie))
     3183       i_2d => nr_partc
     3184    ELSEIF (trim(name) == "part_adr") then
     3185       IF (.not.allocated(part_adrc))  allocate(part_adrc(js:je, is:ie))
     3186       i_2d => part_adrc
    29983187    ELSEIF ( TRIM( name(1:5) ) == "chem_" )  THEN
    29993188       IF ( .NOT. ALLOCATED( chem_spec_c ) )                                   &
    … …  
    30093198    ELSEIF ( ASSOCIATED( p_2d ) )  THEN
    30103199       CALL pmc_c_set_dataarray( p_2d )
     3200    ELSEIF ( ASSOCIATED( i_2d ) )  THEN
     3201       CALL pmc_c_set_dataarray( i_2d )
    30113202    ELSE
    30123203!
    … …  
    30143205       IF ( myid == 0  .AND.  cpl_id == 2 )  THEN
    30153206
    3016           message_string = 'pointer for array "' // TRIM( name ) //             &
     3207          message_string = 'pointer for array "' // TRIM( name ) //            &
    30173208                           '" can''t be associated'
    30183209          CALL message( 'pmci_create_child_arrays', 'PA0170', 3, 2, 0, 6, 0 )
    … …  
    30373228    IMPLICIT NONE
    30383229
    3039     INTEGER(iwp) ::  child_id    !:
    3040     INTEGER(iwp) ::  m           !:
    3041 
    3042     REAL(wp) ::  waittime        !:
     3230    INTEGER(iwp) ::  child_id    !<
     3231    INTEGER(iwp) ::  m           !<
     3232
     3233    REAL(wp) ::  waittime        !<
    30433234
    30443235
    … …  
    30863277!
    30873278!--    The interpolation.
    3088        CALL pmci_interp_tril_all ( u,  uc,  icu, jco, kco, r1xu, r2xu, r1yo,    &
     3279       CALL pmci_interp_tril_all ( u,  uc,  icu, jco, kco, r1xu, r2xu, r1yo,   &
    30893280                                   r2yo, r1zo, r2zo, 'u' )
    3090        CALL pmci_interp_tril_all ( v,  vc,  ico, jcv, kco, r1xo, r2xo, r1yv,    &
     3281       CALL pmci_interp_tril_all ( v,  vc,  ico, jcv, kco, r1xo, r2xo, r1yv,   &
    30913282                                   r2yv, r1zo, r2zo, 'v' )
    3092        CALL pmci_interp_tril_all ( w,  wc,  ico, jco, kcw, r1xo, r2xo, r1yo,    &
     3283       CALL pmci_interp_tril_all ( w,  wc,  ico, jco, kcw, r1xo, r2xo, r1yo,   &
    30933284                                   r2yo, r1zw, r2zw, 'w' )
    3094        CALL pmci_interp_tril_all ( e,  ec,  ico, jco, kco, r1xo, r2xo, r1yo,    &
     3285       CALL pmci_interp_tril_all ( e,  ec,  ico, jco, kco, r1xo, r2xo, r1yo,   &
    30953286                                   r2yo, r1zo, r2zo, 'e' )
    30963287
    30973288       IF ( .NOT. neutral )  THEN
    3098           CALL pmci_interp_tril_all ( pt, ptc, ico, jco, kco, r1xo, r2xo,       &
     3289          CALL pmci_interp_tril_all ( pt, ptc, ico, jco, kco, r1xo, r2xo,      &
    30993290                                      r1yo, r2yo, r1zo, r2zo, 's' )
    31003291       ENDIF
    … …  
    31023293       IF ( humidity )  THEN
    31033294
    3104           CALL pmci_interp_tril_all ( q, q_c, ico, jco, kco, r1xo, r2xo, r1yo,   &
     3295          CALL pmci_interp_tril_all ( q, q_c, ico, jco, kco, r1xo, r2xo, r1yo, &
    31053296                                      r2yo, r1zo, r2zo, 's' )
    31063297
    31073298          IF ( cloud_physics  .AND.  microphysics_morrison )  THEN
    3108              CALL pmci_interp_tril_all ( qc, qcc, ico, jco, kco, r1xo, r2xo,    &
     3299             CALL pmci_interp_tril_all ( qc, qcc, ico, jco, kco, r1xo, r2xo,   &
    31093300                                          r1yo, r2yo, r1zo, r2zo, 's' )
    3110              CALL pmci_interp_tril_all ( nc, ncc, ico, jco, kco, r1xo, r2xo,    &
     3301             CALL pmci_interp_tril_all ( nc, ncc, ico, jco, kco, r1xo, r2xo,   &
    31113302                                         r1yo, r2yo, r1zo, r2zo, 's' )   
    31123303          ENDIF
    31133304
    31143305          IF ( cloud_physics  .AND.  microphysics_seifert )  THEN
    3115              CALL pmci_interp_tril_all ( qr, qrc, ico, jco, kco, r1xo, r2xo,    &
     3306             CALL pmci_interp_tril_all ( qr, qrc, ico, jco, kco, r1xo, r2xo,   &
    31163307                                         r1yo, r2yo, r1zo, r2zo, 's' )
    3117              CALL pmci_interp_tril_all ( nr, nrc, ico, jco, kco, r1xo, r2xo,    &
     3308             CALL pmci_interp_tril_all ( nr, nrc, ico, jco, kco, r1xo, r2xo,   &
    31183309                                         r1yo, r2yo, r1zo, r2zo, 's' )
    31193310          ENDIF
    … …  
    31223313
    31233314       IF ( passive_scalar )  THEN
    3124           CALL pmci_interp_tril_all ( s, sc, ico, jco, kco, r1xo, r2xo, r1yo,   &
     3315          CALL pmci_interp_tril_all ( s, sc, ico, jco, kco, r1xo, r2xo, r1yo,  &
    31253316                                      r2yo, r1zo, r2zo, 's' )
    31263317       ENDIF
    … …  
    31693360
    31703361
    3171     SUBROUTINE pmci_interp_tril_all( f, fc, ic, jc, kc, r1x, r2x, r1y, r2y,     &
     3362    SUBROUTINE pmci_interp_tril_all( f, fc, ic, jc, kc, r1x, r2x, r1y, r2y,    &
    31723363                                     r1z, r2z, var )
    31733364!
    … …  
    31773368       IMPLICIT NONE
    31783369
    3179        CHARACTER(LEN=1), INTENT(IN) :: var  !:
    3180 
    3181        INTEGER(iwp), DIMENSION(nxlg:nxrg), INTENT(IN)           ::  ic    !:
    3182        INTEGER(iwp), DIMENSION(nysg:nyng), INTENT(IN)           ::  jc    !:
    3183        INTEGER(iwp), DIMENSION(nzb:nzt+1), INTENT(IN)           ::  kc    !:
    3184 
    3185        INTEGER(iwp) ::  i        !:
    3186        INTEGER(iwp) ::  ib       !:
    3187        INTEGER(iwp) ::  ie       !:
    3188        INTEGER(iwp) ::  j        !:
    3189        INTEGER(iwp) ::  jb       !:
    3190        INTEGER(iwp) ::  je       !:
    3191        INTEGER(iwp) ::  k        !:
    3192        INTEGER(iwp) ::  k_wall   !:
    3193        INTEGER(iwp) ::  k1       !:
    3194        INTEGER(iwp) ::  kbc      !:
    3195        INTEGER(iwp) ::  l        !:
    3196        INTEGER(iwp) ::  m        !:
    3197        INTEGER(iwp) ::  n        !:
    3198 
    3199        REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(INOUT) :: f !:
    3200        REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr), INTENT(IN) :: fc       !:
    3201        REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN) :: r1x   !:
    3202        REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN) :: r2x   !:
    3203        REAL(wp), DIMENSION(nysg:nyng), INTENT(IN) :: r1y   !:
    3204        REAL(wp), DIMENSION(nysg:nyng), INTENT(IN) :: r2y   !:
    3205        REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN) :: r1z   !:
    3206        REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN) :: r2z   !:
    3207 
    3208        REAL(wp) ::  fk         !:
    3209        REAL(wp) ::  fkj        !:
    3210        REAL(wp) ::  fkjp       !:
    3211        REAL(wp) ::  fkp        !:
    3212        REAL(wp) ::  fkpj       !:
    3213        REAL(wp) ::  fkpjp      !:
    3214        REAL(wp) ::  logratio   !:
    3215        REAL(wp) ::  logzuc1    !:
    3216        REAL(wp) ::  zuc1       !:
    3217        REAL(wp) ::  z0_topo    !:  roughness at vertical walls
     3370       CHARACTER(LEN=1), INTENT(IN) :: var  !<
     3371
     3372       INTEGER(iwp), DIMENSION(nxlg:nxrg), INTENT(IN)           ::  ic    !<
     3373       INTEGER(iwp), DIMENSION(nysg:nyng), INTENT(IN)           ::  jc    !<
     3374       INTEGER(iwp), DIMENSION(nzb:nzt+1), INTENT(IN)           ::  kc    !<
     3375
     3376       INTEGER(iwp) ::  i        !<
     3377       INTEGER(iwp) ::  ib       !<
     3378       INTEGER(iwp) ::  ie       !<
     3379       INTEGER(iwp) ::  j        !<
     3380       INTEGER(iwp) ::  jb       !<
     3381       INTEGER(iwp) ::  je       !<
     3382       INTEGER(iwp) ::  k        !<
     3383       INTEGER(iwp) ::  k_wall   !<
     3384       INTEGER(iwp) ::  k1       !<
     3385       INTEGER(iwp) ::  kbc      !<
     3386       INTEGER(iwp) ::  l        !<
     3387       INTEGER(iwp) ::  m        !<
     3388       INTEGER(iwp) ::  n        !<
     3389
     3390       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(INOUT) :: f !<
     3391       REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr), INTENT(IN) :: fc       !<
     3392       REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN) :: r1x   !<
     3393       REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN) :: r2x   !<
     3394       REAL(wp), DIMENSION(nysg:nyng), INTENT(IN) :: r1y   !<
     3395       REAL(wp), DIMENSION(nysg:nyng), INTENT(IN) :: r2y   !<
     3396       REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN) :: r1z   !<
     3397       REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN) :: r2z   !<
     3398
     3399       REAL(wp) ::  fk         !<
     3400       REAL(wp) ::  fkj        !<
     3401       REAL(wp) ::  fkjp       !<
     3402       REAL(wp) ::  fkp        !<
     3403       REAL(wp) ::  fkpj       !<
     3404       REAL(wp) ::  fkpjp      !<
     3405       REAL(wp) ::  logratio   !<
     3406       REAL(wp) ::  logzuc1    !<
     3407       REAL(wp) ::  zuc1       !<
     3408       REAL(wp) ::  z0_topo    !<  roughness at vertical walls
    32183409
    32193410
    … …  
    32923483                k = k_wall + 1
    32933484                DO  WHILE ( zu(k) < zuc1 )
    3294                    logratio = ( LOG( ( zu(k) - zu(k_wall) ) / z0_topo ) ) /     &
     3485                   logratio = ( LOG( ( zu(k) - zu(k_wall) ) / z0_topo ) ) /    &
    32953486                                logzuc1
    32963487                   f(k,j,i) = logratio * f(k1,j,i)
    … …  
    33313522#if defined( __parallel )
    33323523
    3333     USE control_parameters,                                                     &
     3524    USE control_parameters,                                                    &
    33343525        ONLY:  dt_restart, end_time, message_string, restart_time, time_restart
    33353526
    … …  
    33533544    IF ( .NOT. pmc_is_rootmodel() )  THEN
    33543545       IF ( end_time /= end_time_root )  THEN
    3355           WRITE( message_string, * )  'mismatch between root model and ',       &
    3356                'child settings &   end_time(root) = ', end_time_root,           &
    3357                ' &   end_time(child) = ', end_time, ' & child value is set',    &
     3546          WRITE( message_string, * )  'mismatch between root model and ',      &
     3547               'child settings &   end_time(root) = ', end_time_root,          &
     3548               ' &   end_time(child) = ', end_time, ' & child value is set',   &
    33583549               ' to root value'
    3359           CALL message( 'pmci_check_setting_mismatches', 'PA0419', 0, 1, 0, 6,  &
     3550          CALL message( 'pmci_check_setting_mismatches', 'PA0419', 0, 1, 0, 6, &
    33603551                        0 )
    33613552          end_time = end_time_root
    … …  
    33693560    IF ( .NOT. pmc_is_rootmodel() )  THEN
    33703561       IF ( restart_time /= restart_time_root )  THEN
    3371           WRITE( message_string, * )  'mismatch between root model and ',       &
    3372                'child settings &   restart_time(root) = ', restart_time_root,   &
    3373                ' &   restart_time(child) = ', restart_time, ' & child ',        &
     3562          WRITE( message_string, * )  'mismatch between root model and ',      &
     3563               'child settings &   restart_time(root) = ', restart_time_root,  &
     3564               ' &   restart_time(child) = ', restart_time, ' & child ',       &
    33743565               'value is set to root value'
    3375           CALL message( 'pmci_check_setting_mismatches', 'PA0419', 0, 1, 0, 6,  &
     3566          CALL message( 'pmci_check_setting_mismatches', 'PA0419', 0, 1, 0, 6, &
    33763567                        0 )
    33773568          restart_time = restart_time_root
    … …  
    33853576    IF ( .NOT. pmc_is_rootmodel() )  THEN
    33863577       IF ( dt_restart /= dt_restart_root )  THEN
    3387           WRITE( message_string, * )  'mismatch between root model and ',       &
    3388                'child settings &   dt_restart(root) = ', dt_restart_root,       &
    3389                ' &   dt_restart(child) = ', dt_restart, ' & child ',            &
     3578          WRITE( message_string, * )  'mismatch between root model and ',      &
     3579               'child settings &   dt_restart(root) = ', dt_restart_root,      &
     3580               ' &   dt_restart(child) = ', dt_restart, ' & child ',           &
    33903581               'value is set to root value'
    3391           CALL message( 'pmci_check_setting_mismatches', 'PA0419', 0, 1, 0, 6,  &
     3582          CALL message( 'pmci_check_setting_mismatches', 'PA0419', 0, 1, 0, 6, &
    33923583                        0 )
    33933584          dt_restart = dt_restart_root
    … …  
    34013592    IF ( .NOT. pmc_is_rootmodel() )  THEN
    34023593       IF ( time_restart /= time_restart_root )  THEN
    3403           WRITE( message_string, * )  'mismatch between root model and ',       &
    3404                'child settings &   time_restart(root) = ', time_restart_root,   &
    3405                ' &   time_restart(child) = ', time_restart, ' & child ',        &
     3594          WRITE( message_string, * )  'mismatch between root model and ',      &
     3595               'child settings &   time_restart(root) = ', time_restart_root,  &
     3596               ' &   time_restart(child) = ', time_restart, ' & child ',       &
    34063597               'value is set to root value'
    3407           CALL message( 'pmci_check_setting_mismatches', 'PA0419', 0, 1, 0, 6,  &
     3598          CALL message( 'pmci_check_setting_mismatches', 'PA0419', 0, 1, 0, 6, &
    34083599                        0 )
    34093600          time_restart = time_restart_root
    … …  
    34243615    IMPLICIT NONE
    34253616
    3426     INTEGER(iwp) ::  i                           !:
    3427     INTEGER(iwp) ::  ierr                        !:
    3428     INTEGER(iwp) ::  j                           !:
    3429     INTEGER(iwp) ::  k                           !:
    3430 
    3431     REAL(wp) ::  dxdy                            !:
    3432     REAL(wp) ::  innor                           !:
    3433     REAL(wp) ::  w_lt                            !:
    3434     REAL(wp), DIMENSION(1:3) ::  volume_flow_l   !:
     3617    INTEGER(iwp) ::  i                           !<
     3618    INTEGER(iwp) ::  ierr                        !<
     3619    INTEGER(iwp) ::  j                           !<
     3620    INTEGER(iwp) ::  k                           !<
     3621
     3622    REAL(wp) ::  dxdy                            !<
     3623    REAL(wp) ::  innor                           !<
     3624    REAL(wp) ::  w_lt                            !<
     3625    REAL(wp), DIMENSION(1:3) ::  volume_flow_l   !<
    34353626
    34363627!
    … …  
    34653656#if defined( __parallel )
    34663657    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
    3467     CALL MPI_ALLREDUCE( volume_flow_l(1), volume_flow(1), 1, MPI_REAL,          &
     3658    CALL MPI_ALLREDUCE( volume_flow_l(1), volume_flow(1), 1, MPI_REAL,         &
    34683659                        MPI_SUM, comm2d, ierr )
    34693660#else
    … …  
    35023693#if defined( __parallel )
    35033694    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
    3504     CALL MPI_ALLREDUCE( volume_flow_l(2), volume_flow(2), 1, MPI_REAL,          &
     3695    CALL MPI_ALLREDUCE( volume_flow_l(2), volume_flow(2), 1, MPI_REAL,         &
    35053696                        MPI_SUM, comm2d, ierr )
    35063697#else
    … …  
    35223713#if defined( __parallel )
    35233714    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
    3524     CALL MPI_ALLREDUCE( volume_flow_l(3), volume_flow(3), 1, MPI_REAL,          &
     3715    CALL MPI_ALLREDUCE( volume_flow_l(3), volume_flow(3), 1, MPI_REAL,         &
    35253716                        MPI_SUM, comm2d, ierr )
    35263717#else
    … …  
    35533744   IMPLICIT NONE
    35543745
    3555    INTEGER(iwp)           :: ierr  !:
    3556    REAL(wp), DIMENSION(1) :: dtl   !:
    3557    REAL(wp), DIMENSION(1) :: dtg   !:
     3746   INTEGER(iwp)           :: ierr  !<
     3747   REAL(wp), DIMENSION(1) :: dtl   !<
     3748   REAL(wp), DIMENSION(1) :: dtg   !<
    35583749
    35593750   
    … …  
    35753766    IMPLICIT NONE
    35763767
    3577     INTEGER(iwp), INTENT(IN) ::  swaplevel  !: swaplevel (1 or 2) of PALM's
    3578                                             !: timestep
    3579 
    3580     INTEGER(iwp)            ::  child_id    !:
    3581     INTEGER(iwp)            ::  m           !:
     3768    INTEGER(iwp), INTENT(IN) ::  swaplevel  !< swaplevel (1 or 2) of PALM's
     3769                                            !< timestep
     3770
     3771    INTEGER(iwp)            ::  child_id    !<
     3772    INTEGER(iwp)            ::  m           !<
    35823773
    35833774#if defined( __parallel )
    … …  
    36033794    IMPLICIT NONE
    36043795
    3605     INTEGER(iwp)           ::  ierr   !:
    3606     INTEGER(iwp)           ::  istat  !:
     3796    INTEGER(iwp)           ::  ierr   !<
     3797    INTEGER(iwp)           ::  istat  !<
    36073798
    36083799    CHARACTER(LEN=*), INTENT(IN) ::  local_nesting_mode
    … …  
    36513842    IMPLICIT NONE
    36523843
    3653     INTEGER(iwp), INTENT(IN) ::  direction   !:
     3844    INTEGER(iwp), INTENT(IN) ::  direction   !<
    36543845
    36553846#if defined( __parallel )
    3656     INTEGER(iwp) ::  child_id    !:
    3657     INTEGER(iwp) ::  i           !:
    3658     INTEGER(iwp) ::  ierr        !:
    3659     INTEGER(iwp) ::  j           !:
    3660     INTEGER(iwp) ::  k           !:
    3661     INTEGER(iwp) ::  m           !:
    3662 
    3663     REAL(wp)               ::  waittime    !:
    3664     REAL(wp), DIMENSION(1) ::  dtc         !:
    3665     REAL(wp), DIMENSION(1) ::  dtl         !:
     3847    INTEGER(iwp) ::  child_id    !<
     3848    INTEGER(iwp) ::  i           !<
     3849    INTEGER(iwp) ::  ierr        !<
     3850    INTEGER(iwp) ::  j           !<
     3851    INTEGER(iwp) ::  k           !<
     3852    INTEGER(iwp) ::  m           !<
     3853
     3854    REAL(wp)               ::  waittime    !<
     3855    REAL(wp), DIMENSION(1) ::  dtc         !<
     3856    REAL(wp), DIMENSION(1) ::  dtl         !<
    36663857
    36673858
    … …  
    37223913    IMPLICIT NONE
    37233914
    3724     INTEGER(iwp), INTENT(IN) ::  direction   !:
     3915    INTEGER(iwp), INTENT(IN) ::  direction   !<
    37253916
    37263917#if defined( __parallel )
    3727     INTEGER(iwp) ::  ierr        !:
    3728     INTEGER(iwp) ::  icl         !:
    3729     INTEGER(iwp) ::  icr         !:
    3730     INTEGER(iwp) ::  jcs         !:
    3731     INTEGER(iwp) ::  jcn         !:
     3918    INTEGER(iwp) ::  ierr        !<
     3919    INTEGER(iwp) ::  icl         !<
     3920    INTEGER(iwp) ::  icr         !<
     3921    INTEGER(iwp) ::  jcs         !<
     3922    INTEGER(iwp) ::  jcn         !<
    37323923   
    3733     REAL(wp), DIMENSION(1) ::  dtl         !:
    3734     REAL(wp), DIMENSION(1) ::  dts         !:
     3924    REAL(wp), DIMENSION(1) ::  dtl         !<
     3925    REAL(wp), DIMENSION(1) ::  dts         !<
    37353926
    37363927
    … …  
    37883979!--       Left border pe:
    37893980          IF ( nest_bound_l )  THEN
    3790              CALL pmci_interp_tril_lr( u,  uc,  icu, jco, kco, r1xu, r2xu,      &
    3791                                        r1yo, r2yo, r1zo, r2zo,                  &
    3792                                        logc_u_l, logc_ratio_u_l,                &
     3981             CALL pmci_interp_tril_lr( u,  uc,  icu, jco, kco, r1xu, r2xu,     &
     3982                                       r1yo, r2yo, r1zo, r2zo,                 &
     3983                                       logc_u_l, logc_ratio_u_l,               &
    37933984                                       nzt_topo_nestbc_l, 'l', 'u' )
    37943985
    3795              CALL pmci_interp_tril_lr( v,  vc,  ico, jcv, kco, r1xo, r2xo,      &
    3796                                        r1yv, r2yv, r1zo, r2zo,                  &
    3797                                        logc_v_l, logc_ratio_v_l,                &
     3986             CALL pmci_interp_tril_lr( v,  vc,  ico, jcv, kco, r1xo, r2xo,     &
     3987                                       r1yv, r2yv, r1zo, r2zo,                 &
     3988                                       logc_v_l, logc_ratio_v_l,               &
    37983989                                       nzt_topo_nestbc_l, 'l', 'v' )
    37993990
    3800              CALL pmci_interp_tril_lr( w,  wc,  ico, jco, kcw, r1xo, r2xo,      &
    3801                                        r1yo, r2yo, r1zw, r2zw,                  &
    3802                                        logc_w_l, logc_ratio_w_l,                &
     3991             CALL pmci_interp_tril_lr( w,  wc,  ico, jco, kcw, r1xo, r2xo,     &
     3992                                       r1yo, r2yo, r1zw, r2zw,                 &
     3993                                       logc_w_l, logc_ratio_w_l,               &
    38033994                                       nzt_topo_nestbc_l, 'l', 'w' )
    38043995
    3805              CALL pmci_interp_tril_lr( e,  ec,  ico, jco, kco, r1xo, r2xo,      &
    3806                                        r1yo, r2yo, r1zo, r2zo,                  &
    3807                                        logc_u_l, logc_ratio_u_l,                &
     3996             CALL pmci_interp_tril_lr( e,  ec,  ico, jco, kco, r1xo, r2xo,     &
     3997                                       r1yo, r2yo, r1zo, r2zo,                 &
     3998                                       logc_u_l, logc_ratio_u_l,               &
    38083999                                       nzt_topo_nestbc_l, 'l', 'e' )
    38094000
    38104001             IF ( .NOT. neutral )  THEN
    3811                 CALL pmci_interp_tril_lr( pt, ptc, ico, jco, kco, r1xo, r2xo,   &
    3812                                           r1yo, r2yo, r1zo, r2zo,               &
    3813                                           logc_u_l, logc_ratio_u_l,             &
     4002                CALL pmci_interp_tril_lr( pt, ptc, ico, jco, kco, r1xo, r2xo,  &
     4003                                          r1yo, r2yo, r1zo, r2zo,              &
     4004                                          logc_u_l, logc_ratio_u_l,            &
    38144005                                          nzt_topo_nestbc_l, 'l', 's' )
    38154006             ENDIF
    … …  
    38174008             IF ( humidity )  THEN
    38184009
    3819                 CALL pmci_interp_tril_lr( q, q_c, ico, jco, kco, r1xo, r2xo,    &
    3820                                           r1yo, r2yo, r1zo, r2zo,               &
    3821                                           logc_u_l, logc_ratio_u_l,             &
     4010                CALL pmci_interp_tril_lr( q, q_c, ico, jco, kco, r1xo, r2xo,   &
     4011                                          r1yo, r2yo, r1zo, r2zo,              &
     4012                                          logc_u_l, logc_ratio_u_l,            &
    38224013                                          nzt_topo_nestbc_l, 'l', 's' )
    38234014
    … …  
    38534044
    38544045             IF ( passive_scalar )  THEN
    3855                 CALL pmci_interp_tril_lr( s, sc, ico, jco, kco, r1xo, r2xo,     &
    3856                                           r1yo, r2yo, r1zo, r2zo,               &
    3857                                           logc_u_l, logc_ratio_u_l,             &
     4046                CALL pmci_interp_tril_lr( s, sc, ico, jco, kco, r1xo, r2xo,    &
     4047                                          r1yo, r2yo, r1zo, r2zo,              &
     4048                                          logc_u_l, logc_ratio_u_l,            &
    38584049                                          nzt_topo_nestbc_l, 'l', 's' )
    38594050             ENDIF
    … …  
    39164107!--       Right border pe
    39174108          IF ( nest_bound_r )  THEN
    3918              CALL pmci_interp_tril_lr( u,  uc,  icu, jco, kco, r1xu, r2xu,      &
    3919                                        r1yo, r2yo, r1zo, r2zo,                  &
    3920                                        logc_u_r, logc_ratio_u_r,                &
     4109             CALL pmci_interp_tril_lr( u,  uc,  icu, jco, kco, r1xu, r2xu,     &
     4110                                       r1yo, r2yo, r1zo, r2zo,                 &
     4111                                       logc_u_r, logc_ratio_u_r,               &
    39214112                                       nzt_topo_nestbc_r, 'r', 'u' )
    39224113
    3923              CALL pmci_interp_tril_lr( v,  vc,  ico, jcv, kco, r1xo, r2xo,      &
    3924                                        r1yv, r2yv, r1zo, r2zo,                  &
    3925                                        logc_v_r, logc_ratio_v_r,                &
     4114             CALL pmci_interp_tril_lr( v,  vc,  ico, jcv, kco, r1xo, r2xo,     &
     4115                                       r1yv, r2yv, r1zo, r2zo,                 &
     4116                                       logc_v_r, logc_ratio_v_r,               &
    39264117                                       nzt_topo_nestbc_r, 'r', 'v' )
    39274118
    3928              CALL pmci_interp_tril_lr( w,  wc,  ico, jco, kcw, r1xo, r2xo,      &
    3929                                        r1yo, r2yo, r1zw, r2zw,                  &
    3930                                        logc_w_r, logc_ratio_w_r,                &
     4119             CALL pmci_interp_tril_lr( w,  wc,  ico, jco, kcw, r1xo, r2xo,     &
     4120                                       r1yo, r2yo, r1zw, r2zw,                 &
     4121                                       logc_w_r, logc_ratio_w_r,               &
    39314122                                       nzt_topo_nestbc_r, 'r', 'w' )
    39324123
    3933              CALL pmci_interp_tril_lr( e,  ec,  ico, jco, kco, r1xo, r2xo,      &
    3934                                        r1yo,r2yo, r1zo, r2zo,                   &
    3935                                        logc_u_r, logc_ratio_u_r,                &
     4124             CALL pmci_interp_tril_lr( e,  ec,  ico, jco, kco, r1xo, r2xo,     &
     4125                                       r1yo,r2yo, r1zo, r2zo,                  &
     4126                                       logc_u_r, logc_ratio_u_r,               &
    39364127                                       nzt_topo_nestbc_r, 'r', 'e' )
    39374128
    39384129
    39394130             IF ( .NOT. neutral )  THEN
    3940                 CALL pmci_interp_tril_lr( pt, ptc, ico, jco, kco, r1xo, r2xo,   &
    3941                                           r1yo, r2yo, r1zo, r2zo,               &
    3942                                           logc_u_r, logc_ratio_u_r,             &
     4131                CALL pmci_interp_tril_lr( pt, ptc, ico, jco, kco, r1xo, r2xo,  &
     4132                                          r1yo, r2yo, r1zo, r2zo,              &
     4133                                          logc_u_r, logc_ratio_u_r,            &
    39434134                                          nzt_topo_nestbc_r, 'r', 's' )
    39444135
    … …  
    39464137
    39474138             IF ( humidity )  THEN
    3948                 CALL pmci_interp_tril_lr( q, q_c, ico, jco, kco, r1xo, r2xo,    &
    3949                                           r1yo, r2yo, r1zo, r2zo,               &
    3950                                           logc_u_r, logc_ratio_u_r,             &
     4139                CALL pmci_interp_tril_lr( q, q_c, ico, jco, kco, r1xo, r2xo,   &
     4140                                          r1yo, r2yo, r1zo, r2zo,              &
     4141                                          logc_u_r, logc_ratio_u_r,            &
    39514142                                          nzt_topo_nestbc_r, 'r', 's' )
    39524143
    … …  
    40474238!--       South border pe
    40484239          IF ( nest_bound_s )  THEN
    4049              CALL pmci_interp_tril_sn( u,  uc,  icu, jco, kco, r1xu, r2xu,      &
    4050                                        r1yo, r2yo, r1zo, r2zo,                  &
    4051                                        logc_u_s, logc_ratio_u_s,                &
     4240             CALL pmci_interp_tril_sn( u,  uc,  icu, jco, kco, r1xu, r2xu,     &
     4241                                       r1yo, r2yo, r1zo, r2zo,                 &
     4242                                       logc_u_s, logc_ratio_u_s,               &
    40524243                                       nzt_topo_nestbc_s, 's', 'u' )
    4053              CALL pmci_interp_tril_sn( v,  vc,  ico, jcv, kco, r1xo, r2xo,      &
    4054                                        r1yv, r2yv, r1zo, r2zo,                  &
    4055                                        logc_v_s, logc_ratio_v_s,                &
     4244             CALL pmci_interp_tril_sn( v,  vc,  ico, jcv, kco, r1xo, r2xo,     &
     4245                                       r1yv, r2yv, r1zo, r2zo,                 &
     4246                                       logc_v_s, logc_ratio_v_s,               &
    40564247                                       nzt_topo_nestbc_s, 's', 'v' )
    4057              CALL pmci_interp_tril_sn( w,  wc,  ico, jco, kcw, r1xo, r2xo,      &
    4058                                        r1yo, r2yo, r1zw, r2zw,                  &
    4059                                        logc_w_s, logc_ratio_w_s,                &
     4248             CALL pmci_interp_tril_sn( w,  wc,  ico, jco, kcw, r1xo, r2xo,     &
     4249                                       r1yo, r2yo, r1zw, r2zw,                 &
     4250                                       logc_w_s, logc_ratio_w_s,               &
    40604251                                       nzt_topo_nestbc_s, 's','w' )
    4061              CALL pmci_interp_tril_sn( e,  ec,  ico, jco, kco, r1xo, r2xo,      &
    4062                                        r1yo, r2yo, r1zo, r2zo,                  &
    4063                                        logc_u_s, logc_ratio_u_s,                &
     4252             CALL pmci_interp_tril_sn( e,  ec,  ico, jco, kco, r1xo, r2xo,     &
     4253                                       r1yo, r2yo, r1zo, r2zo,                 &
     4254                                       logc_u_s, logc_ratio_u_s,               &
    40644255                                       nzt_topo_nestbc_s, 's', 'e' )
    40654256
    40664257             IF ( .NOT. neutral )  THEN
    4067                 CALL pmci_interp_tril_sn( pt, ptc, ico, jco, kco, r1xo, r2xo,   &
    4068                                           r1yo, r2yo, r1zo, r2zo,               &
    4069                                           logc_u_s, logc_ratio_u_s,             &
     4258                CALL pmci_interp_tril_sn( pt, ptc, ico, jco, kco, r1xo, r2xo,  &
     4259                                          r1yo, r2yo, r1zo, r2zo,              &
     4260                                          logc_u_s, logc_ratio_u_s,            &
    40704261                                          nzt_topo_nestbc_s, 's', 's' )
    40714262             ENDIF
    40724263
    40734264             IF ( humidity )  THEN
    4074                 CALL pmci_interp_tril_sn( q, q_c, ico, jco, kco, r1xo, r2xo,    &
    4075                                           r1yo,r2yo, r1zo, r2zo,                &
    4076                                           logc_u_s, logc_ratio_u_s,             &
     4265                CALL pmci_interp_tril_sn( q, q_c, ico, jco, kco, r1xo, r2xo,   &
     4266                                          r1yo,r2yo, r1zo, r2zo,               &
     4267                                          logc_u_s, logc_ratio_u_s,            &
    40774268                                          nzt_topo_nestbc_s, 's', 's' )
    40784269
    … …  
    41124303
    41134304             IF ( passive_scalar )  THEN
    4114                 CALL pmci_interp_tril_sn( s, sc, ico, jco, kco, r1xo, r2xo,     &
    4115                                           r1yo,r2yo, r1zo, r2zo,                &
    4116                                           logc_u_s, logc_ratio_u_s,             &
     4305                CALL pmci_interp_tril_sn( s, sc, ico, jco, kco, r1xo, r2xo,    &
     4306                                          r1yo,r2yo, r1zo, r2zo,               &
     4307                                          logc_u_s, logc_ratio_u_s,            &
    41174308                                          nzt_topo_nestbc_s, 's', 's' )
    41184309             ENDIF
    … …  
    41204311             IF ( air_chemistry )  THEN
    41214312                DO  n = 1, nspec
    4122                    CALL pmci_interp_tril_sn( chem_species(n)%conc,              &
    4123                                              chem_spec_c(:,:,:,n),              &
    4124                                              ico, jco, kco, r1xo, r2xo,         &
    4125                                              r1yo, r2yo, r1zo, r2zo,            &
    4126                                              logc_u_s, logc_ratio_u_s,          &
     4313                   CALL pmci_interp_tril_sn( chem_species(n)%conc,             &
     4314                                             chem_spec_c(:,:,:,n),             &
     4315                                             ico, jco, kco, r1xo, r2xo,        &
     4316                                             r1yo, r2yo, r1zo, r2zo,           &
     4317                                             logc_u_s, logc_ratio_u_s,         &
    41274318                                             nzt_topo_nestbc_s, 's', 's' )
    41284319                ENDDO
    … …  
    41724363!--       North border pe
    41734364          IF ( nest_bound_n )  THEN
    4174              CALL pmci_interp_tril_sn( u,  uc,  icu, jco, kco, r1xu, r2xu,      &
    4175                                        r1yo, r2yo, r1zo, r2zo,                  &
    4176                                        logc_u_n, logc_ratio_u_n,                &
     4365             CALL pmci_interp_tril_sn( u,  uc,  icu, jco, kco, r1xu, r2xu,     &
     4366                                       r1yo, r2yo, r1zo, r2zo,                 &
     4367                                       logc_u_n, logc_ratio_u_n,               &
    41774368                                       nzt_topo_nestbc_n, 'n', 'u' )
    41784369
    4179              CALL pmci_interp_tril_sn( v,  vc,  ico, jcv, kco, r1xo, r2xo,      &
    4180                                        r1yv, r2yv, r1zo, r2zo,                  &
    4181                                        logc_v_n, logc_ratio_v_n,                &
     4370             CALL pmci_interp_tril_sn( v,  vc,  ico, jcv, kco, r1xo, r2xo,     &
     4371                                       r1yv, r2yv, r1zo, r2zo,                 &
     4372                                       logc_v_n, logc_ratio_v_n,               &
    41824373                                       nzt_topo_nestbc_n, 'n', 'v' )
    41834374
    4184              CALL pmci_interp_tril_sn( w,  wc,  ico, jco, kcw, r1xo, r2xo,      &
    4185                                        r1yo, r2yo, r1zw, r2zw,                  &
    4186                                        logc_w_n, logc_ratio_w_n,                &
     4375             CALL pmci_interp_tril_sn( w,  wc,  ico, jco, kcw, r1xo, r2xo,     &
     4376                                       r1yo, r2yo, r1zw, r2zw,                 &
     4377                                       logc_w_n, logc_ratio_w_n,               &
    41874378                                       nzt_topo_nestbc_n, 'n', 'w' )
    41884379
    4189              CALL pmci_interp_tril_sn( e,  ec,  ico, jco, kco, r1xo, r2xo,      &
    4190                                        r1yo, r2yo, r1zo, r2zo,                  &
    4191                                        logc_u_n, logc_ratio_u_n,                &
     4380             CALL pmci_interp_tril_sn( e,  ec,  ico, jco, kco, r1xo, r2xo,     &
     4381                                       r1yo, r2yo, r1zo, r2zo,                 &
     4382                                       logc_u_n, logc_ratio_u_n,               &
    41924383                                       nzt_topo_nestbc_n, 'n', 'e' )
    41934384
    41944385             IF ( .NOT. neutral )  THEN
    4195                 CALL pmci_interp_tril_sn( pt, ptc, ico, jco, kco, r1xo, r2xo,   &
    4196                                           r1yo, r2yo, r1zo, r2zo,               &
    4197                                           logc_u_n, logc_ratio_u_n,             &
     4386                CALL pmci_interp_tril_sn( pt, ptc, ico, jco, kco, r1xo, r2xo,  &
     4387                                          r1yo, r2yo, r1zo, r2zo,              &
     4388                                          logc_u_n, logc_ratio_u_n,            &
    41984389                                          nzt_topo_nestbc_n, 'n', 's' )
    41994390             ENDIF
    42004391
    42014392             IF ( humidity )  THEN
    4202                 CALL pmci_interp_tril_sn( q, q_c, ico, jco, kco, r1xo, r2xo,    &
    4203                                           r1yo, r2yo, r1zo, r2zo,               &
    4204                                           logc_u_n, logc_ratio_u_n,             &
     4393                CALL pmci_interp_tril_sn( q, q_c, ico, jco, kco, r1xo, r2xo,   &
     4394                                          r1yo, r2yo, r1zo, r2zo,              &
     4395                                          logc_u_n, logc_ratio_u_n,            &
    42054396                                          nzt_topo_nestbc_n, 'n', 's' )
    42064397
    … …  
    42404431
    42414432             IF ( passive_scalar )  THEN
    4242                 CALL pmci_interp_tril_sn( s, sc, ico, jco, kco, r1xo, r2xo,     &
    4243                                           r1yo, r2yo, r1zo, r2zo,               &
    4244                                           logc_u_n, logc_ratio_u_n,             &
     4433                CALL pmci_interp_tril_sn( s, sc, ico, jco, kco, r1xo, r2xo,    &
     4434                                          r1yo, r2yo, r1zo, r2zo,              &
     4435                                          logc_u_n, logc_ratio_u_n,            &
    42454436                                          nzt_topo_nestbc_n, 'n', 's' )
    42464437             ENDIF
    … …  
    44794670      IMPLICIT NONE
    44804671
    4481       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                       &
    4482                                       INTENT(INOUT) ::  f       !:
    4483       REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr),                           &
    4484                                       INTENT(IN)    ::  fc      !:
    4485       REAL(wp), DIMENSION(1:2,0:ncorr-1,nzb:nzt_topo_nestbc,nys:nyn),           &
    4486                                       INTENT(IN)    ::  logc_ratio   !:
    4487       REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN)    ::  r1x     !:
    4488       REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN)    ::  r2x     !:
    4489       REAL(wp), DIMENSION(nysg:nyng), INTENT(IN)    ::  r1y     !:
    4490       REAL(wp), DIMENSION(nysg:nyng), INTENT(IN)    ::  r2y     !:
    4491       REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN)    ::  r1z     !:
    4492       REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN)    ::  r2z     !:
     4672      REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                      &
     4673                                      INTENT(INOUT) ::  f       !<
     4674      REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr),                          &
     4675                                      INTENT(IN)    ::  fc      !<
     4676      REAL(wp), DIMENSION(1:2,0:ncorr-1,nzb:nzt_topo_nestbc,nys:nyn),          &
     4677                                      INTENT(IN)    ::  logc_ratio   !<
     4678      REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN)    ::  r1x     !<
     4679      REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN)    ::  r2x     !<
     4680      REAL(wp), DIMENSION(nysg:nyng), INTENT(IN)    ::  r1y     !<
     4681      REAL(wp), DIMENSION(nysg:nyng), INTENT(IN)    ::  r2y     !<
     4682      REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN)    ::  r1z     !<
     4683      REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN)    ::  r2z     !<
    44934684     
    4494       INTEGER(iwp), DIMENSION(nxlg:nxrg), INTENT(IN)           ::  ic     !:
    4495       INTEGER(iwp), DIMENSION(nysg:nyng), INTENT(IN)           ::  jc     !:
    4496       INTEGER(iwp), DIMENSION(nzb:nzt+1), INTENT(IN)           ::  kc     !:
    4497       INTEGER(iwp), DIMENSION(1:2,nzb:nzt_topo_nestbc,nys:nyn),                 &
    4498                                           INTENT(IN)           ::  logc   !:
    4499       INTEGER(iwp) ::  nzt_topo_nestbc   !:
    4500 
    4501       CHARACTER(LEN=1), INTENT(IN) ::  edge   !:
    4502       CHARACTER(LEN=1), INTENT(IN) ::  var    !:
    4503 
    4504       INTEGER(iwp) ::  i        !:
    4505       INTEGER(iwp) ::  ib       !:
    4506       INTEGER(iwp) ::  ibgp     !:
    4507       INTEGER(iwp) ::  iw       !:
    4508       INTEGER(iwp) ::  j        !:
    4509       INTEGER(iwp) ::  jco      !:
    4510       INTEGER(iwp) ::  jcorr    !:
    4511       INTEGER(iwp) ::  jinc     !:
    4512       INTEGER(iwp) ::  jw       !:
    4513       INTEGER(iwp) ::  j1       !:
    4514       INTEGER(iwp) ::  k        !:
    4515       INTEGER(iwp) ::  k_wall   !: vertical index of topography top
    4516       INTEGER(iwp) ::  kco      !:
    4517       INTEGER(iwp) ::  kcorr    !:
    4518       INTEGER(iwp) ::  k1       !:
    4519       INTEGER(iwp) ::  l        !:
    4520       INTEGER(iwp) ::  m        !:
    4521       INTEGER(iwp) ::  n        !:
    4522       INTEGER(iwp) ::  kbc      !:
     4685      INTEGER(iwp), DIMENSION(nxlg:nxrg), INTENT(IN)           ::  ic     !<
     4686      INTEGER(iwp), DIMENSION(nysg:nyng), INTENT(IN)           ::  jc     !<
     4687      INTEGER(iwp), DIMENSION(nzb:nzt+1), INTENT(IN)           ::  kc     !<
     4688      INTEGER(iwp), DIMENSION(1:2,nzb:nzt_topo_nestbc,nys:nyn),                &
     4689                                          INTENT(IN)           ::  logc   !<
     4690      INTEGER(iwp) ::  nzt_topo_nestbc   !<
     4691
     4692      CHARACTER(LEN=1), INTENT(IN) ::  edge   !<
     4693      CHARACTER(LEN=1), INTENT(IN) ::  var    !<
     4694
     4695      INTEGER(iwp) ::  i        !<
     4696      INTEGER(iwp) ::  ib       !<
     4697      INTEGER(iwp) ::  ibgp     !<
     4698      INTEGER(iwp) ::  iw       !<
     4699      INTEGER(iwp) ::  j        !<
     4700      INTEGER(iwp) ::  jco      !<
     4701      INTEGER(iwp) ::  jcorr    !<
     4702      INTEGER(iwp) ::  jinc     !<
     4703      INTEGER(iwp) ::  jw       !<
     4704      INTEGER(iwp) ::  j1       !<
     4705      INTEGER(iwp) ::  k        !<
     4706      INTEGER(iwp) ::  k_wall   !< vertical index of topography top
     4707      INTEGER(iwp) ::  kco      !<
     4708      INTEGER(iwp) ::  kcorr    !<
     4709      INTEGER(iwp) ::  k1       !<
     4710      INTEGER(iwp) ::  l        !<
     4711      INTEGER(iwp) ::  m        !<
     4712      INTEGER(iwp) ::  n        !<
     4713      INTEGER(iwp) ::  kbc      !<
    45234714     
    4524       REAL(wp) ::  coarse_dx   !:
    4525       REAL(wp) ::  coarse_dy   !:
    4526       REAL(wp) ::  coarse_dz   !:
    4527       REAL(wp) ::  fkj         !:
    4528       REAL(wp) ::  fkjp        !:
    4529       REAL(wp) ::  fkpj        !:
    4530       REAL(wp) ::  fkpjp       !:
    4531       REAL(wp) ::  fk          !:
    4532       REAL(wp) ::  fkp         !:
     4715      REAL(wp) ::  coarse_dx   !<
     4716      REAL(wp) ::  coarse_dy   !<
     4717      REAL(wp) ::  coarse_dz   !<
     4718      REAL(wp) ::  fkj         !<
     4719      REAL(wp) ::  fkjp        !<
     4720      REAL(wp) ::  fkpj        !<
     4721      REAL(wp) ::  fkpjp       !<
     4722      REAL(wp) ::  fk          !<
     4723      REAL(wp) ::  fkp         !<
    45334724     
    45344725!
    … …  
    46404831                        DO  kcorr = 0, ncorr-1
    46414832                           kco = k + kcorr
    4642                            f(kco,jco,i) = 0.5_wp * ( logc_ratio(1,kcorr,k,j) *  &
    4643                                                      f(k1,j,i)                  &
    4644                                                    + logc_ratio(2,jcorr,k,j) *  &
     4833                           f(kco,jco,i) = 0.5_wp * ( logc_ratio(1,kcorr,k,j) * &
     4834                                                     f(k1,j,i)                 &
     4835                                                   + logc_ratio(2,jcorr,k,j) * &
    46454836                                                     f(k,j1,i) )
    46464837                        ENDDO
    … …  
    46954886
    46964887
    4697    SUBROUTINE pmci_interp_tril_sn( f, fc, ic, jc, kc, r1x, r2x, r1y, r2y, r1z,  &
     4888   SUBROUTINE pmci_interp_tril_sn( f, fc, ic, jc, kc, r1x, r2x, r1y, r2y, r1z, &
    46984889                                   r2z, logc, logc_ratio,                   &
    46994890                                   nzt_topo_nestbc, edge, var )
    … …  
    47064897      IMPLICIT NONE
    47074898
    4708       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                       &
    4709                                       INTENT(INOUT) ::  f             !:
    4710       REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr),                           &
    4711                                       INTENT(IN)    ::  fc            !:
    4712       REAL(wp), DIMENSION(1:2,0:ncorr-1,nzb:nzt_topo_nestbc,nxl:nxr),           &
    4713                                       INTENT(IN)    ::  logc_ratio    !:
    4714       REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN)    ::  r1x           !:
    4715       REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN)    ::  r2x           !:
    4716       REAL(wp), DIMENSION(nysg:nyng), INTENT(IN)    ::  r1y           !:
    4717       REAL(wp), DIMENSION(nysg:nyng), INTENT(IN)    ::  r2y           !:
    4718       REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN)    ::  r1z           !:
    4719       REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN)    ::  r2z           !:
     4899      REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                      &
     4900                                      INTENT(INOUT) ::  f             !<
     4901      REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr),                          &
     4902                                      INTENT(IN)    ::  fc            !<
     4903      REAL(wp), DIMENSION(1:2,0:ncorr-1,nzb:nzt_topo_nestbc,nxl:nxr),          &
     4904                                      INTENT(IN)    ::  logc_ratio    !<
     4905      REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN)    ::  r1x           !<
     4906      REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN)    ::  r2x           !<
     4907      REAL(wp), DIMENSION(nysg:nyng), INTENT(IN)    ::  r1y           !<
     4908      REAL(wp), DIMENSION(nysg:nyng), INTENT(IN)    ::  r2y           !<
     4909      REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN)    ::  r1z           !<
     4910      REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN)    ::  r2z           !<
    47204911     
    4721       INTEGER(iwp), DIMENSION(nxlg:nxrg), INTENT(IN)           ::  ic    !:
    4722       INTEGER(iwp), DIMENSION(nysg:nyng), INTENT(IN)           ::  jc    !:
    4723       INTEGER(iwp), DIMENSION(nzb:nzt+1), INTENT(IN)           ::  kc    !:
    4724       INTEGER(iwp), DIMENSION(1:2,nzb:nzt_topo_nestbc,nxl:nxr),                 &
    4725                                           INTENT(IN)           ::  logc  !:
    4726       INTEGER(iwp) ::  nzt_topo_nestbc   !:
    4727 
    4728       CHARACTER(LEN=1), INTENT(IN) ::  edge   !:
    4729       CHARACTER(LEN=1), INTENT(IN) ::  var    !:
     4912      INTEGER(iwp), DIMENSION(nxlg:nxrg), INTENT(IN)           ::  ic    !<
     4913      INTEGER(iwp), DIMENSION(nysg:nyng), INTENT(IN)           ::  jc    !<
     4914      INTEGER(iwp), DIMENSION(nzb:nzt+1), INTENT(IN)           ::  kc    !<
     4915      INTEGER(iwp), DIMENSION(1:2,nzb:nzt_topo_nestbc,nxl:nxr),                &
     4916                                          INTENT(IN)           ::  logc  !<
     4917      INTEGER(iwp) ::  nzt_topo_nestbc   !<
     4918
     4919      CHARACTER(LEN=1), INTENT(IN) ::  edge   !<
     4920      CHARACTER(LEN=1), INTENT(IN) ::  var    !<
    47304921     
    4731       INTEGER(iwp) ::  i       !:
    4732       INTEGER(iwp) ::  iinc    !:
    4733       INTEGER(iwp) ::  icorr   !:
    4734       INTEGER(iwp) ::  ico     !:
    4735       INTEGER(iwp) ::  i1      !:
    4736       INTEGER(iwp) ::  j       !:
    4737       INTEGER(iwp) ::  jb      !:
    4738       INTEGER(iwp) ::  jbgp    !:
    4739       INTEGER(iwp) ::  k       !:
    4740       INTEGER(iwp) ::  k_wall   !: vertical index of topography top
    4741       INTEGER(iwp) ::  kcorr   !:
    4742       INTEGER(iwp) ::  kco     !:
    4743       INTEGER(iwp) ::  k1      !:
    4744       INTEGER(iwp) ::  l       !:
    4745       INTEGER(iwp) ::  m       !:
    4746       INTEGER(iwp) ::  n       !:
     4922      INTEGER(iwp) ::  i       !<
     4923      INTEGER(iwp) ::  iinc    !<
     4924      INTEGER(iwp) ::  icorr   !<
     4925      INTEGER(iwp) ::  ico     !<
     4926      INTEGER(iwp) ::  i1      !<
     4927      INTEGER(iwp) ::  j       !<
     4928      INTEGER(iwp) ::  jb      !<
     4929      INTEGER(iwp) ::  jbgp    !<
     4930      INTEGER(iwp) ::  k       !<
     4931      INTEGER(iwp) ::  k_wall   !< vertical index of topography top
     4932      INTEGER(iwp) ::  kcorr   !<
     4933      INTEGER(iwp) ::  kco     !<
     4934      INTEGER(iwp) ::  k1      !<
     4935      INTEGER(iwp) ::  l       !<
     4936      INTEGER(iwp) ::  m       !<
     4937      INTEGER(iwp) ::  n       !<
    47474938                           
    4748       REAL(wp) ::  coarse_dx   !:
    4749       REAL(wp) ::  coarse_dy   !:
    4750       REAL(wp) ::  coarse_dz   !:
    4751       REAL(wp) ::  fk          !:
    4752       REAL(wp) ::  fkj         !:
    4753       REAL(wp) ::  fkjp        !:
    4754       REAL(wp) ::  fkpj        !:
    4755       REAL(wp) ::  fkpjp       !:
    4756       REAL(wp) ::  fkp         !:
     4939      REAL(wp) ::  coarse_dx   !<
     4940      REAL(wp) ::  coarse_dy   !<
     4941      REAL(wp) ::  coarse_dz   !<
     4942      REAL(wp) ::  fk          !<
     4943      REAL(wp) ::  fkj         !<
     4944      REAL(wp) ::  fkjp        !<
     4945      REAL(wp) ::  fkpj        !<
     4946      REAL(wp) ::  fkpjp       !<
     4947      REAL(wp) ::  fkp         !<
    47574948     
    47584949!
    … …  
    48655056                        DO  kcorr = 0, ncorr-1
    48665057                           kco = k + kcorr
    4867                            f(kco,j,ico) = 0.5_wp * ( logc_ratio(1,kcorr,k,i) *  &
    4868                                                      f(k1,j,i)                  &
    4869                                                    + logc_ratio(2,icorr,k,i) *  &
     5058                           f(kco,j,ico) = 0.5_wp * ( logc_ratio(1,kcorr,k,i) * &
     5059                                                     f(k1,j,i)                 &
     5060                                                   + logc_ratio(2,icorr,k,i) * &
    48705061                                                     f(k,j,i1) )
    48715062                        ENDDO
    … …  
    49185109 
    49195110
    4920    SUBROUTINE pmci_interp_tril_t( f, fc, ic, jc, kc, r1x, r2x, r1y, r2y, r1z,   &
     5111   SUBROUTINE pmci_interp_tril_t( f, fc, ic, jc, kc, r1x, r2x, r1y, r2y, r1z,  &
    49215112                                  r2z, var )
    49225113
    … …  
    49285119      IMPLICIT NONE
    49295120
    4930       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                       &
    4931                                       INTENT(INOUT) ::  f     !:
    4932       REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr),                           &
    4933                                       INTENT(IN)    ::  fc    !:
    4934       REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN)    ::  r1x   !:
    4935       REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN)    ::  r2x   !:
    4936       REAL(wp), DIMENSION(nysg:nyng), INTENT(IN)    ::  r1y   !:
    4937       REAL(wp), DIMENSION(nysg:nyng), INTENT(IN)    ::  r2y   !:
    4938       REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN)    ::  r1z   !:
    4939       REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN)    ::  r2z   !:
     5121      REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                      &
     5122                                      INTENT(INOUT) ::  f     !<
     5123      REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr),                          &
     5124                                      INTENT(IN)    ::  fc    !<
     5125      REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN)    ::  r1x   !<
     5126      REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN)    ::  r2x   !<
     5127      REAL(wp), DIMENSION(nysg:nyng), INTENT(IN)    ::  r1y   !<
     5128      REAL(wp), DIMENSION(nysg:nyng), INTENT(IN)    ::  r2y   !<
     5129      REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN)    ::  r1z   !<
     5130      REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN)    ::  r2z   !<
    49405131     
    4941       INTEGER(iwp), DIMENSION(nxlg:nxrg), INTENT(IN) ::  ic    !:
    4942       INTEGER(iwp), DIMENSION(nysg:nyng), INTENT(IN) ::  jc    !:
    4943       INTEGER(iwp), DIMENSION(nzb:nzt+1), INTENT(IN) ::  kc    !:
     5132      INTEGER(iwp), DIMENSION(nxlg:nxrg), INTENT(IN) ::  ic    !<
     5133      INTEGER(iwp), DIMENSION(nysg:nyng), INTENT(IN) ::  jc    !<
     5134      INTEGER(iwp), DIMENSION(nzb:nzt+1), INTENT(IN) ::  kc    !<
    49445135     
    4945       CHARACTER(LEN=1), INTENT(IN) :: var   !:
    4946 
    4947       INTEGER(iwp) ::  i   !:
    4948       INTEGER(iwp) ::  ib  !:
    4949       INTEGER(iwp) ::  ie  !:
    4950       INTEGER(iwp) ::  j   !:
    4951       INTEGER(iwp) ::  jb   !:
    4952       INTEGER(iwp) ::  je   !:     
    4953       INTEGER(iwp) ::  k   !:
    4954       INTEGER(iwp) ::  l   !:
    4955       INTEGER(iwp) ::  m   !:
    4956       INTEGER(iwp) ::  n   !:
     5136      CHARACTER(LEN=1), INTENT(IN) :: var   !<
     5137
     5138      INTEGER(iwp) ::  i   !<
     5139      INTEGER(iwp) ::  ib  !<
     5140      INTEGER(iwp) ::  ie  !<
     5141      INTEGER(iwp) ::  j   !<
     5142      INTEGER(iwp) ::  jb   !<
     5143      INTEGER(iwp) ::  je   !<     
     5144      INTEGER(iwp) ::  k   !<
     5145      INTEGER(iwp) ::  l   !<
     5146      INTEGER(iwp) ::  m   !<
     5147      INTEGER(iwp) ::  n   !<
    49575148     
    4958       REAL(wp) ::  coarse_dx   !:
    4959       REAL(wp) ::  coarse_dy   !:
    4960       REAL(wp) ::  coarse_dz   !:
    4961       REAL(wp) ::  fk          !:
    4962       REAL(wp) ::  fkj         !:
    4963       REAL(wp) ::  fkjp        !:
    4964       REAL(wp) ::  fkpj        !:
    4965       REAL(wp) ::  fkpjp       !:
    4966       REAL(wp) ::  fkp         !:
     5149      REAL(wp) ::  coarse_dx   !<
     5150      REAL(wp) ::  coarse_dy   !<
     5151      REAL(wp) ::  coarse_dz   !<
     5152      REAL(wp) ::  fk          !<
     5153      REAL(wp) ::  fkj         !<
     5154      REAL(wp) ::  fkjp        !<
     5155      REAL(wp) ::  fkpj        !<
     5156      REAL(wp) ::  fkpjp       !<
     5157      REAL(wp) ::  fkp         !<
    49675158
    49685159     
    … …  
    50365227       IMPLICIT NONE
    50375228
    5038        CHARACTER(LEN=1), INTENT(IN) ::  edge   !:
    5039        CHARACTER(LEN=1), INTENT(IN) ::  var    !:
    5040 
    5041        INTEGER(iwp) ::  i       !:
    5042        INTEGER(iwp) ::  ib      !:
    5043        INTEGER(iwp) ::  ibgp    !:
    5044        INTEGER(iwp) ::  ied     !:
    5045        INTEGER(iwp) ::  j       !:
    5046        INTEGER(iwp) ::  k       !:
    5047        INTEGER(iwp) ::  k_wall  !:
    5048 
    5049        REAL(wp) ::  outnor    !:
    5050        REAL(wp) ::  vdotnor   !:
    5051 
    5052        REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(INOUT) :: f !:
     5229       CHARACTER(LEN=1), INTENT(IN) ::  edge   !<
     5230       CHARACTER(LEN=1), INTENT(IN) ::  var    !<
     5231
     5232       INTEGER(iwp) ::  i       !<
     5233       INTEGER(iwp) ::  ib      !<
     5234       INTEGER(iwp) ::  ibgp    !<
     5235       INTEGER(iwp) ::  ied     !<
     5236       INTEGER(iwp) ::  j       !<
     5237       INTEGER(iwp) ::  k       !<
     5238       INTEGER(iwp) ::  k_wall  !<
     5239
     5240       REAL(wp) ::  outnor    !<
     5241       REAL(wp) ::  vdotnor   !<
     5242
     5243       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(INOUT) :: f !<
    50535244!
    50545245!--    Check which edge is to be handled: left or right
    … …  
    51145305       IMPLICIT NONE
    51155306
    5116        CHARACTER(LEN=1), INTENT(IN) ::  edge   !:
    5117        CHARACTER(LEN=1), INTENT(IN) ::  var    !:
     5307       CHARACTER(LEN=1), INTENT(IN) ::  edge   !<
     5308       CHARACTER(LEN=1), INTENT(IN) ::  var    !<
    51185309     
    5119        INTEGER(iwp) ::  i         !:
    5120        INTEGER(iwp) ::  j         !:
    5121        INTEGER(iwp) ::  jb        !:
    5122        INTEGER(iwp) ::  jbgp      !:
    5123        INTEGER(iwp) ::  jed       !:
    5124        INTEGER(iwp) ::  k         !:
    5125        INTEGER(iwp) ::  k_wall    !:
    5126 
    5127        REAL(wp)     ::  outnor    !:
    5128        REAL(wp)     ::  vdotnor   !:
    5129 
    5130        REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(INOUT) :: f !:
     5310       INTEGER(iwp) ::  i         !<
     5311       INTEGER(iwp) ::  j         !<
     5312       INTEGER(iwp) ::  jb        !<
     5313       INTEGER(iwp) ::  jbgp      !<
     5314       INTEGER(iwp) ::  jed       !<
     5315       INTEGER(iwp) ::  k         !<
     5316       INTEGER(iwp) ::  k_wall    !<
     5317
     5318       REAL(wp)     ::  outnor    !<
     5319       REAL(wp)     ::  vdotnor   !<
     5320
     5321       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(INOUT) :: f !<
    51315322
    51325323!
    … …  
    51915382       IMPLICIT NONE
    51925383
    5193        CHARACTER(LEN=1), INTENT(IN) ::  var   !:
     5384       CHARACTER(LEN=1), INTENT(IN) ::  var   !<
    51945385     
    5195        INTEGER(iwp) ::  i     !:
    5196        INTEGER(iwp) ::  j     !:
    5197        INTEGER(iwp) ::  k     !:
    5198        INTEGER(iwp) ::  ked   !:
    5199 
    5200        REAL(wp) ::  vdotnor   !:
    5201 
    5202        REAL(wp), DIMENSION(nzb:nzt+1,nys-nbgp:nyn+nbgp,nxl-nbgp:nxr+nbgp),      &
    5203                  INTENT(INOUT) ::  f   !:
     5386       INTEGER(iwp) ::  i     !<
     5387       INTEGER(iwp) ::  j     !<
     5388       INTEGER(iwp) ::  k     !<
     5389       INTEGER(iwp) ::  ked   !<
     5390
     5391       REAL(wp) ::  vdotnor   !<
     5392
     5393       REAL(wp), DIMENSION(nzb:nzt+1,nys-nbgp:nyn+nbgp,nxl-nbgp:nxr+nbgp),     &
     5394                 INTENT(INOUT) ::  f   !<
    52045395     
    52055396
    … …  
    52325423
    52335424
    5234     SUBROUTINE pmci_anterp_tophat( f, fc, kct, ifl, ifu, jfl, jfu, kfl, kfu,    &
     5425    SUBROUTINE pmci_anterp_tophat( f, fc, kct, ifl, ifu, jfl, jfu, kfl, kfu,   &
    52355426                                   ijfc, kfc, var )
    52365427!
    … …  
    53515542!--             Spatial under-relaxation.
    53525543                fra  = frax(ii) * fray(jj) * fraz(kk)
    5353                 fc(kk,jj,ii) = ( 1.0_wp - fra ) * fc(kk,jj,ii) +                &
     5544                fc(kk,jj,ii) = ( 1.0_wp - fra ) * fc(kk,jj,ii) +               &
    53545545                               fra * cellsum / REAL( nfc, KIND = wp )
    53555546

  • palm/trunk/SOURCE/pmc_parent_mod.f90

    r2718 r2801  
    2626! -----------------
    2727! $Id$
     28! Introduce particle transfer in nested models.
     29!
     30! 2718 2018-01-02 08:49:38Z maronga
    2831! Corrected "Former revisions" section
    2932!
    … …  
    8891!
    8992! Parent part of Palm Model Coupler
    90 !-------------------------------------------------------------------------------!
     93!------------------------------------------------------------------------------!
    9194
    9295#if defined( __parallel )
    … …  
    99102#endif
    100103    USE kinds
    101     USE pmc_general,                                                            &
    102         ONLY: arraydef, childdef, da_namedef, da_namelen, pedef,                &
     104    USE pmc_general,                                                           &
     105        ONLY: arraydef, childdef, da_namedef, da_namelen, pedef,               &
    103106              pmc_g_setname, pmc_max_array, pmc_max_models, pmc_sort
    104107
    105     USE pmc_handle_communicator,                                                &
    106         ONLY: m_model_comm,m_model_rank,m_model_npes, m_to_child_comm,          &
     108    USE pmc_handle_communicator,                                               &
     109        ONLY: m_model_comm,m_model_rank,m_model_npes, m_to_child_comm,         &
    107110              m_world_rank, pmc_parent_for_child
    108111
    109     USE pmc_mpi_wrapper,                                                        &
     112    USE pmc_mpi_wrapper,                                                       &
    110113        ONLY: pmc_alloc_mem, pmc_bcast, pmc_time
    111114
    … …  
    120123   END TYPE childindexdef
    121124
    122    TYPE(childdef), DIMENSION(pmc_max_models)       ::  children     !<
    123    TYPE(childindexdef), DIMENSION(pmc_max_models)  ::  indchildren  !<
     125   TYPE(childdef), DIMENSION(pmc_max_models),PUBLIC   ::  children     !<
     126   TYPE(childindexdef), DIMENSION(pmc_max_models)     ::  indchildren  !<
    124127
    125128   INTEGER ::  next_array_in_list = 0  !<
    … …  
    148151        MODULE PROCEDURE pmc_s_set_dataarray_2d
    149152        MODULE PROCEDURE pmc_s_set_dataarray_3d
     153        MODULE PROCEDURE pmc_s_set_dataarray_ip2d
    150154    END INTERFACE pmc_s_set_dataarray
    151155
    … …  
    166170    END INTERFACE pmc_s_set_active_data_array
    167171
    168     PUBLIC pmc_parentinit, pmc_s_clear_next_array_list, pmc_s_fillbuffer,       &
    169            pmc_s_getdata_from_buffer, pmc_s_getnextarray,                       &
    170            pmc_s_setind_and_allocmem, pmc_s_set_active_data_array,              &
    171            pmc_s_set_dataarray, pmc_s_set_2d_index_list
     172    INTERFACE pmc_s_get_child_npes
     173        MODULE PROCEDURE pmc_s_get_child_npes
     174    END INTERFACE pmc_s_get_child_npes
     175
     176    PUBLIC pmc_parentinit, pmc_s_clear_next_array_list, pmc_s_fillbuffer,      &
     177           pmc_s_getdata_from_buffer, pmc_s_getnextarray,                      &
     178           pmc_s_setind_and_allocmem, pmc_s_set_active_data_array,             &
     179           pmc_s_set_dataarray, pmc_s_set_2d_index_list,                       &
     180           pmc_s_get_child_npes
    172181
    173182 CONTAINS
    … …  
    178187    IMPLICIT NONE
    179188
    180     INTEGER ::  childid   !<
    181     INTEGER ::  i         !<
    182     INTEGER ::  j         !<
    183     INTEGER ::  istat     !<
     189    INTEGER(iwp) ::  childid   !<
     190    INTEGER(iwp) ::  i         !<
     191    INTEGER(iwp) ::  j         !<
     192    INTEGER(iwp) ::  istat     !<
    184193
    185194
    … …  
    193202!
    194203!--    Get rank and size
    195        CALL MPI_COMM_RANK( children(childid)%model_comm,                        &
     204       CALL MPI_COMM_RANK( children(childid)%model_comm,                       &
    196205                           children(childid)%model_rank, istat )
    197        CALL MPI_COMM_SIZE( children(childid)%model_comm,                        &
     206       CALL MPI_COMM_SIZE( children(childid)%model_comm,                       &
    198207                           children(childid)%model_npes, istat )
    199        CALL MPI_COMM_REMOTE_SIZE( children(childid)%inter_comm,                 &
     208       CALL MPI_COMM_REMOTE_SIZE( children(childid)%inter_comm,                &
    200209                                  children(childid)%inter_npes, istat )
    201210
    202211!
    203212!--    Intra communicator is used for MPI_GET
    204        CALL MPI_INTERCOMM_MERGE( children(childid)%inter_comm, .FALSE.,         &
     213       CALL MPI_INTERCOMM_MERGE( children(childid)%inter_comm, .FALSE.,        &
    205214                                 children(childid)%intra_comm, istat )
    206        CALL MPI_COMM_RANK( children(childid)%intra_comm,                        &
     215       CALL MPI_COMM_RANK( children(childid)%intra_comm,                       &
    207216                           children(childid)%intra_rank, istat )
    208217
    … …  
    228237     IMPLICIT NONE
    229238
    230      INTEGER, INTENT(IN)                    :: childid     !<
    231      INTEGER, DIMENSION(:,:), INTENT(INOUT) :: index_list  !<
    232 
    233      INTEGER ::  ian    !<
    234      INTEGER ::  ic     !<
    235      INTEGER ::  ie     !<
    236      INTEGER ::  ip     !<
    237      INTEGER ::  is     !<
    238      INTEGER ::  istat  !<
    239      INTEGER ::  n      !<
     239     INTEGER(iwp), INTENT(IN)                    :: childid     !<
     240     INTEGER(iwp), DIMENSION(:,:), INTENT(INOUT) :: index_list  !<
     241
     242     INTEGER(iwp) ::  ian    !<
     243     INTEGER(iwp) ::  ic     !<
     244     INTEGER(iwp) ::  ie     !<
     245     INTEGER(iwp) ::  ip     !<
     246     INTEGER(iwp) ::  is     !<
     247     INTEGER(iwp) ::  istat  !<
     248     INTEGER(iwp) ::  n,i    !<
    240249
    241250
    … …  
    268277              IF ( ian > 0)  THEN
    269278                  ALLOCATE( indchildren(childid)%index_list_2d(6,ian) )
    270                   indchildren(childid)%index_list_2d(:,1:ian) =                 &
     279                  indchildren(childid)%index_list_2d(:,1:ian) =                &
    271280                                                             index_list(:,is:ie)
    272281              ENDIF
    273282           ELSE
    274               CALL MPI_SEND( ian, 1, MPI_INTEGER, ip, 1000, m_model_comm,       &
     283              CALL MPI_SEND( ian, 1, MPI_INTEGER, ip, 1000, m_model_comm,      &
    275284                             istat )
    276285              IF ( ian > 0)  THEN
    277                   CALL MPI_SEND( index_list(1,is), 6*ian, MPI_INTEGER, ip,      &
     286                  CALL MPI_SEND( index_list(1,is), 6*ian, MPI_INTEGER, ip,     &
    278287                                 1001, m_model_comm, istat )
    279288              ENDIF
    … …  
    282291        ENDDO
    283292     ELSE
    284         CALL MPI_RECV( indchildren(childid)%nrpoints, 1, MPI_INTEGER, 0, 1000,  &
     293        CALL MPI_RECV( indchildren(childid)%nrpoints, 1, MPI_INTEGER, 0, 1000, &
    285294                       m_model_comm, MPI_STATUS_IGNORE, istat )
    286295        ian = indchildren(childid)%nrpoints
    287296        IF ( ian > 0 )  THEN
    288297           ALLOCATE( indchildren(childid)%index_list_2d(6,ian) )
    289            CALL MPI_RECV( indchildren(childid)%index_list_2d, 6*ian,            &
    290                           MPI_INTEGER, 0, 1001, m_model_comm,                   &
     298           CALL MPI_RECV( indchildren(childid)%index_list_2d, 6*ian,           &
     299                          MPI_INTEGER, 0, 1001, m_model_comm,                  &
    291300                          MPI_STATUS_IGNORE, istat)
    292301        ENDIF
    293302     ENDIF
    294      CALL set_pe_index_list( childid, children(childid),                        &
    295                              indchildren(childid)%index_list_2d,                &
     303     CALL set_pe_index_list( childid, children(childid),                       &
     304                             indchildren(childid)%index_list_2d,               &
    296305                             indchildren(childid)%nrpoints )
    297306
    … …  
    313322
    314323!
    315 !-- List handling is still required to get minimal interaction with
    316 !-- pmc_interface
    317 !-- TODO: what does "still" mean? Is there a chance to change this!
     324!-- Althoug there are no linked lists any more in PMC, this call still looks like working with a list
     325
    318326    CHARACTER(LEN=*), INTENT(OUT) ::  myname    !<
    319327    INTEGER(iwp), INTENT(IN)      ::  childid   !<
    … …  
    338346    myname = ar%name
    339347!
    340 !-- Return true if legal array
    341 !-- TODO: what does this comment mean? Can there be non-legal arrays??
     348!-- Return true if there is still an array in the list
     349
    342350    pmc_s_getnextarray = .TRUE.
    343351
    … …  
    350358    IMPLICIT NONE
    351359
    352     INTEGER,INTENT(IN) ::  childid   !<
     360    INTEGER(iwp), INTENT(IN) ::  childid   !<
    353361
    354362    REAL(wp), INTENT(IN), DIMENSION(:,:), POINTER           ::  array    !<
    355363    REAL(wp), INTENT(IN), DIMENSION(:,:), POINTER, OPTIONAL ::  array_2  !<
    356364
    357     INTEGER               ::  nrdims      !<
    358     INTEGER, DIMENSION(4) ::  dims        !<
     365    INTEGER(iwp)               ::  nrdims      !<
     366    INTEGER(iwp), DIMENSION(4) ::  dims        !<
    359367    TYPE(C_PTR)           ::  array_adr   !<
    360368    TYPE(C_PTR)           ::  second_adr  !<
    … …  
    369377    IF ( PRESENT( array_2 ) )  THEN
    370378       second_adr = C_LOC(array_2)
    371        CALL pmc_s_setarray( childid, nrdims, dims, array_adr,                   &
     379       CALL pmc_s_setarray( childid, nrdims, dims, array_adr,                  &
    372380                            second_adr = second_adr)
    373381    ELSE
    … …  
    377385 END SUBROUTINE pmc_s_set_dataarray_2d
    378386
     387 SUBROUTINE pmc_s_set_dataarray_ip2d( childid, array )
     388
     389    IMPLICIT NONE
     390
     391    INTEGER(iwp),INTENT(IN) ::  childid   !<
     392
     393    INTEGER(idp), INTENT(IN), DIMENSION(:,:), POINTER           ::  array    !<
     394
     395    INTEGER(iwp)               ::  nrdims      !<
     396    INTEGER(iwp), DIMENSION(4) ::  dims        !<
     397    TYPE(C_PTR)           ::  array_adr   !<
     398
     399
     400    dims      = 1
     401    nrdims    = 2
     402    dims(1)   = SIZE( array,1 )
     403    dims(2)   = SIZE( array,2 )
     404    array_adr = C_LOC( array )
     405
     406    CALL pmc_s_setarray( childid, nrdims, dims, array_adr , dimkey=22)
     407
     408 END SUBROUTINE pmc_s_set_dataarray_ip2d
    379409
    380410
    … …  
    383413    IMPLICIT NONE
    384414
    385     INTEGER, INTENT(IN) ::  childid   !<
    386     INTEGER, INTENT(IN) ::  nz        !<
    387     INTEGER, INTENT(IN) ::  nz_cl     !<
     415    INTEGER(iwp), INTENT(IN) ::  childid   !<
     416    INTEGER(iwp), INTENT(IN) ::  nz        !<
     417    INTEGER(iwp), INTENT(IN) ::  nz_cl     !<
    388418
    389419    REAL(wp), INTENT(IN), DIMENSION(:,:,:), POINTER           ::  array    !<
    390420    REAL(wp), INTENT(IN), DIMENSION(:,:,:), POINTER, OPTIONAL ::  array_2  !<
    391421
    392     INTEGER               ::  nrdims      !<
    393     INTEGER, DIMENSION(4) ::  dims        !<
     422    INTEGER(iwp)               ::  nrdims      !<
     423    INTEGER(iwp), DIMENSION(4) ::  dims        !<
    394424    TYPE(C_PTR)           ::  array_adr   !<
    395425    TYPE(C_PTR)           ::  second_adr  !<
    396426
    397 !
    398 !-- TODO: the next assignment seems to be obsolete. Please check!
    399     dims      = 1
    400     dims      = 0
    401427    nrdims    = 3
    402428    dims(1)   = SIZE( array,1 )
    … …  
    411437    IF ( PRESENT( array_2 ) )  THEN
    412438      second_adr = C_LOC( array_2 )
    413       CALL pmc_s_setarray( childid, nrdims, dims, array_adr,                    &
     439      CALL pmc_s_setarray( childid, nrdims, dims, array_adr,                   &
    414440                           second_adr = second_adr)
    415441    ELSE
    … …  
    423449 SUBROUTINE pmc_s_setind_and_allocmem( childid )
    424450
    425     USE control_parameters,                                                     &
     451    USE control_parameters,                                                    &
    426452        ONLY:  message_string
    427453
    … …  
    433459!--                                     send -> parent to child transfer
    434460!--                                     recv -> child to parent transfer
    435     INTEGER, INTENT(IN) ::  childid   !<
    436 
    437     INTEGER                        ::  arlen    !<
    438     INTEGER                        ::  i        !<
    439     INTEGER                        ::  ierr     !<
    440     INTEGER                        ::  istat    !<
    441     INTEGER                        ::  j        !<
    442     INTEGER                        ::  myindex  !<
    443     INTEGER                        ::  rcount   !< count MPI requests
    444     INTEGER                        ::  tag      !<
     461    INTEGER(iwp), INTENT(IN) ::  childid   !<
     462
     463    INTEGER(iwp)                   ::  arlen    !<
     464    INTEGER(iwp)                   ::  i        !<
     465    INTEGER(iwp)                   ::  ierr     !<
     466    INTEGER(iwp)                   ::  istat    !<
     467    INTEGER(iwp)                   ::  j        !<
     468    INTEGER(iwp)                   ::  myindex  !<
     469    INTEGER(iwp)                   ::  rcount   !< count MPI requests
     470    INTEGER(iwp)                   ::  tag      !<
    445471
    446472    INTEGER(idp)                   ::  bufsize  !< size of MPI data window
    447473    INTEGER(KIND=MPI_ADDRESS_KIND) ::  winsize  !<
    448474
    449     INTEGER, DIMENSION(1024)       ::  req      !<
     475    INTEGER(iwp), DIMENSION(1024)       ::  req      !<
    450476
    451477    TYPE(C_PTR)             ::  base_ptr  !<
    … …  
    482508          tag    = tag + 1
    483509          rcount = rcount + 1
    484           CALL MPI_ISEND( myindex, 1, MPI_INTEGER, i-1, tag,                    &
     510          CALL MPI_ISEND( myindex, 1, MPI_INTEGER, i-1, tag,                   &
    485511                          children(childid)%inter_comm, req(rcount), ierr )
    486512!
    487 !--       Maximum of 1024 outstanding requests
    488 !--       TODO: what does this limit mean? Does outstanding mean pending?
     513!--       Maximum of 1024 pending requests
     514
    489515          IF ( rcount == 1024 )  THEN
    490516             CALL MPI_WAITALL( rcount, req, MPI_STATUSES_IGNORE, ierr )
    … …  
    515541
    516542    winsize = bufsize * wp
    517     CALL MPI_WIN_CREATE( base_array_pc, winsize, wp, MPI_INFO_NULL,             &
    518                          children(childid)%intra_comm,                          &
     543    CALL MPI_WIN_CREATE( base_array_pc, winsize, wp, MPI_INFO_NULL,            &
     544                         children(childid)%intra_comm,                         &
    519545                         children(childid)%win_parent_child, ierr )
    520546!
    … …  
    533559
    534560          IF ( ar%sendindex + ar%sendsize > bufsize )  THEN             
    535              WRITE( message_string, '(a,i4,4i7,1x,a)' )                         &
    536                     'parent buffer too small ',i,                               &
    537                     ar%sendindex,ar%sendsize,ar%sendindex+ar%sendsize,          &
     561             WRITE( message_string, '(a,i4,4i7,1x,a)' )                        &
     562                    'parent buffer too small ',i,                              &
     563                    ar%sendindex,ar%sendsize,ar%sendindex+ar%sendsize,         &
    538564                    bufsize,trim(ar%name)
    539565             CALL message( 'pmc_s_setind_and_allocmem', 'PA0429', 3, 2, 0, 6, 0 )
    … …  
    554580!--       Receive index from child
    555581          tag = tag + 1
    556           CALL MPI_RECV( myindex, 1, MPI_INTEGER, i-1, tag,                     &
     582          CALL MPI_RECV( myindex, 1, MPI_INTEGER, i-1, tag,                    &
    557583                         children(childid)%inter_comm, MPI_STATUS_IGNORE, ierr )
    558584          IF ( ar%nrdims == 3 )  THEN
    … …  
    586612
    587613
    588  SUBROUTINE pmc_s_fillbuffer( childid, waittime )
    589 
    590     IMPLICIT NONE
    591 
    592     INTEGER, INTENT(IN)             ::  childid   !<
     614 SUBROUTINE pmc_s_fillbuffer( childid, waittime, particle_transfer )
     615
     616    IMPLICIT NONE
     617
     618    INTEGER(iwp), INTENT(IN)             ::  childid   !<
    593619
    594620    REAL(wp), INTENT(OUT), OPTIONAL ::  waittime  !<
    595 
    596     INTEGER               ::  ierr     !<
    597     INTEGER               ::  ij       !<
    598     INTEGER               ::  ip       !<
    599     INTEGER               ::  istat    !<
    600     INTEGER               ::  j        !<
    601     INTEGER               ::  myindex  !<
    602 
    603     INTEGER, DIMENSION(1) ::  buf_shape
     621    LOGICAL, INTENT(IN), OPTIONAL   ::  particle_transfer  !<
     622
     623
     624    INTEGER(iwp)               ::  ierr     !<
     625    INTEGER(iwp)               ::  ij       !<
     626    INTEGER(iwp)               ::  ip       !<
     627    INTEGER(iwp)               ::  istat    !<
     628    INTEGER(iwp)               ::  j        !<
     629    INTEGER(iwp)               ::  myindex  !<
     630   
     631    LOGICAL                    ::  lo_ptrans
     632
     633    INTEGER(iwp), DIMENSION(1) ::  buf_shape
    604634
    605635    REAL(wp)                            ::  t1       !<
    … …  
    608638    REAL(wp), POINTER, DIMENSION(:,:)   ::  data_2d  !<
    609639    REAL(wp), POINTER, DIMENSION(:,:,:) ::  data_3d  !<
     640    INTEGER(idp), POINTER, DIMENSION(:)     ::  ibuf      !<
     641    INTEGER(idp), POINTER, DIMENSION(:,:)   ::  idata_2d  !<
    610642
    611643    TYPE(pedef), POINTER    ::  ape  !<
    … …  
    625657    ENDIF
    626658
     659    lo_ptrans = .FALSE.
     660    IF ( PRESENT( particle_transfer))    lo_ptrans = particle_transfer
     661
    627662    DO  ip = 1, children(childid)%inter_npes
    628663       ape => children(childid)%pes(ip)
    … …  
    630665          ar => ape%array_list(j)
    631666          myindex = 1
    632           IF ( ar%nrdims == 2 )  THEN
     667
     668          IF ( ar%dimkey == 2 .AND. .NOT.lo_ptrans  )  THEN                            ! PALM 2D REAL*8 Array
     669
    633670             buf_shape(1) = ape%nrele
    634671             CALL C_F_POINTER( ar%sendbuf, buf, buf_shape )
    … …  
    638675                myindex = myindex + 1
    639676             ENDDO
    640           ELSEIF ( ar%nrdims == 3 )  THEN
     677
     678          ELSEIF ( ar%dimkey == 3  .AND. .NOT.lo_ptrans  )  THEN                       ! PALM 3D REAL*8 Array
     679
    641680             buf_shape(1) = ape%nrele*ar%a_dim(4)
    642681             CALL C_F_POINTER( ar%sendbuf, buf, buf_shape )
    … …  
    647686                myindex = myindex + ar%a_dim(4)
    648687             ENDDO
     688          ELSEIF ( ar%dimkey == 22 .AND. lo_ptrans  )  THEN                           ! 2D INTEGER*8 Array for particle Transfer
     689
     690             buf_shape(1) = ape%nrele
     691             CALL C_F_POINTER( ar%sendbuf, ibuf, buf_shape )
     692             CALL C_F_POINTER( ar%data, idata_2d, ar%a_dim(1:2) )
     693             DO  ij = 1, ape%nrele
     694                ibuf(myindex) = idata_2d(ape%locind(ij)%j,ape%locind(ij)%i)
     695                myindex = myindex + 1
     696             ENDDO
    649697          ENDIF
    650698        ENDDO
    … …  
    658706
    659707
    660  SUBROUTINE pmc_s_getdata_from_buffer( childid, waittime )
    661 
    662     IMPLICIT NONE
    663 
    664     INTEGER, INTENT(IN)             ::  childid      !<
     708 SUBROUTINE pmc_s_getdata_from_buffer( childid, waittime , particle_transfer, child_process_nr )
     709
     710    IMPLICIT NONE
     711
     712    INTEGER(iwp), INTENT(IN)             ::  childid      !<
    665713    REAL(wp), INTENT(OUT), OPTIONAL ::  waittime     !<
    666 
    667     INTEGER                        ::  ierr          !<
    668     INTEGER                        ::  ij            !<
    669     INTEGER                        ::  ip            !<
    670     INTEGER                        ::  istat         !<
    671     INTEGER                        ::  j             !<
    672     INTEGER                        ::  myindex       !<
    673     INTEGER                        ::  nr            !<
    674     INTEGER                        ::  target_pe     !<
     714    LOGICAL, INTENT(IN), OPTIONAL   ::  particle_transfer     !<
     715    INTEGER(iwp), INTENT(IN), OPTIONAL   ::  child_process_nr      !<
     716
     717    INTEGER(iwp)                        ::  ierr          !<
     718    INTEGER(iwp)                   ::  ij            !<
     719    INTEGER(iwp)                   ::  ip            !<
     720    INTEGER(iwp)                   ::  ip_start      !<
     721    INTEGER(iwp)                   ::  ip_end        !<
     722    INTEGER(iwp)                   ::  istat         !<
     723    INTEGER(iwp)                   ::  j             !<
     724    INTEGER(iwp)                   ::  myindex       !<
     725    INTEGER(iwp)                   ::  nr            !<
     726    INTEGER(iwp)                   ::  target_pe     !<
    675727    INTEGER(kind=MPI_ADDRESS_KIND) ::  target_disp   !<
    676 
    677     INTEGER, DIMENSION(1)          ::  buf_shape     !<
    678 
    679     REAL(wp)                            ::  t1       !<
    680     REAL(wp)                            ::  t2       !<
    681     REAL(wp), POINTER, DIMENSION(:)     ::  buf      !<
    682     REAL(wp), POINTER, DIMENSION(:,:)   ::  data_2d  !<
    683     REAL(wp), POINTER, DIMENSION(:,:,:) ::  data_3d  !<
    684 
    685     TYPE(pedef), POINTER    ::  ape  !<
    686     TYPE(arraydef), POINTER ::  ar   !<
     728   
     729    LOGICAL                        ::  lo_ptrans
     730
     731    INTEGER(iwp), DIMENSION(1)          ::  buf_shape     !<
     732
     733    REAL(wp)                                ::  t1       !<
     734    REAL(wp)                                ::  t2       !<
     735    REAL(wp), POINTER, DIMENSION(:)         ::  buf      !<
     736    REAL(wp), POINTER, DIMENSION(:,:)       ::  data_2d  !<
     737    REAL(wp), POINTER, DIMENSION(:,:,:)     ::  data_3d  !<
     738    INTEGER(idp), POINTER, DIMENSION(:)     ::  ibuf      !<
     739    INTEGER(idp), POINTER, DIMENSION(:,:)   ::  idata_2d  !<
     740
     741    TYPE(pedef), POINTER                    ::  ape  !<
     742    TYPE(arraydef), POINTER                 ::  ar   !<
    687743
    688744
    689745    t1 = pmc_time()
    690 !
    691 !-- Wait for child to fill buffer
    692     CALL MPI_BARRIER( children(childid)%intra_comm, ierr )
    693     t2 = pmc_time() - t1
    694     IF ( PRESENT( waittime ) )  waittime = t2
    695 !
    696 !-- TODO: check next statement
    697 !-- Fence might do it, test later
    698 !-- CALL MPI_WIN_FENCE( 0, children(childid)%win_parent_child, ierr)
    699     CALL MPI_BARRIER( children(childid)%intra_comm, ierr )
    700 
    701     DO  ip = 1, children(childid)%inter_npes
     746
     747    IF(PRESENT(child_process_nr)) then
     748       ip_start = child_process_nr
     749       ip_end   = child_process_nr
     750    ELSE
     751       ip_start = 1
     752       ip_end   = children(childid)%inter_npes
     753    END IF
     754
     755    lo_ptrans = .FALSE.
     756    IF ( PRESENT( particle_transfer))    lo_ptrans = particle_transfer
     757
     758    IF(ip_start == 1)   THEN
     759!
     760!--    Wait for child to fill buffer
     761       CALL MPI_BARRIER( children(childid)%intra_comm, ierr )
     762       t2 = pmc_time() - t1
     763       IF ( PRESENT( waittime ) )  waittime = t2
     764
     765       CALL MPI_BARRIER( children(childid)%intra_comm, ierr )
     766    ENDIF
     767
     768    DO  ip = ip_start,ip_end
    702769       ape => children(childid)%pes(ip)
    703770       DO  j = 1, ape%nr_arrays
    … …  
    706773          IF ( ar%recvindex < 0 )  CYCLE
    707774
    708           IF ( ar%nrdims == 2 )  THEN
     775          IF ( ar%dimkey == 2  .AND. .NOT.lo_ptrans )  THEN
    709776             nr = ape%nrele
    710           ELSEIF ( ar%nrdims == 3 )  THEN
     777          ELSEIF ( ar%dimkey == 3  .AND. .NOT.lo_ptrans )  THEN
    711778             nr = ape%nrele * ar%a_dim(4)
     779          ELSE IF ( ar%dimkey == 22 .AND. lo_ptrans)  THEN
     780             nr = ape%nrele
     781          ELSE
     782             CYCLE                                        !particle array are not transfered here
    712783          ENDIF
    713784          buf_shape(1) = nr
    714           CALL C_F_POINTER( ar%recvbuf, buf, buf_shape )
     785          IF(lo_ptrans)   THEN
     786             CALL C_F_POINTER( ar%recvbuf, ibuf, buf_shape )
     787          ELSE
     788             CALL C_F_POINTER( ar%recvbuf, buf, buf_shape )
     789          ENDIF
     790
    715791!
    716792!--       MPI passive target RMA
    … …  
    720796!--          Child processes are located behind parent process
    721797             target_pe = ip - 1 + m_model_npes
    722              CALL MPI_WIN_LOCK( MPI_LOCK_SHARED, target_pe, 0,                  &
     798             CALL MPI_WIN_LOCK( MPI_LOCK_SHARED, target_pe, 0,                      &
    723799                                children(childid)%win_parent_child, ierr )
    724              CALL MPI_GET( buf, nr, MPI_REAL, target_pe, target_disp, nr,       &
    725                            MPI_REAL, children(childid)%win_parent_child, ierr )
    726              CALL MPI_WIN_UNLOCK( target_pe,                                    &
     800             IF(lo_ptrans)   THEN
     801                CALL MPI_GET( ibuf, nr*8, MPI_BYTE, target_pe, target_disp, nr*8,    &              !There is no MPI_INTEGER8 datatype
     802                              MPI_BYTE, children(childid)%win_parent_child, ierr )
     803             ELSE
     804                CALL MPI_GET( buf, nr, MPI_REAL, target_pe, target_disp, nr,        &
     805                              MPI_REAL, children(childid)%win_parent_child, ierr )
     806             ENDIF
     807             CALL MPI_WIN_UNLOCK( target_pe,                                        &
    727808                                  children(childid)%win_parent_child, ierr )
    728809          ENDIF
    729810          myindex = 1
    730           IF ( ar%nrdims == 2 )  THEN
     811          IF ( ar%dimkey == 2  .AND. .NOT.lo_ptrans  )  THEN
     812
    731813             CALL C_F_POINTER( ar%data, data_2d, ar%a_dim(1:2) )
    732814             DO  ij = 1, ape%nrele
    … …  
    734816                myindex = myindex + 1
    735817             ENDDO
    736           ELSEIF ( ar%nrdims == 3 )  THEN
     818
     819          ELSEIF ( ar%dimkey == 3  .AND. .NOT.lo_ptrans  )  THEN
     820
    737821             CALL C_F_POINTER( ar%data, data_3d, ar%a_dim(1:3))
    738822             DO  ij = 1, ape%nrele
    739                 data_3d(1:ar%a_dim(4),ape%locind(ij)%j,ape%locind(ij)%i) =      &
     823                data_3d(1:ar%a_dim(4),ape%locind(ij)%j,ape%locind(ij)%i) =     &
    740824                                              buf(myindex:myindex+ar%a_dim(4)-1)
    741825                myindex = myindex + ar%a_dim(4)
    742826             ENDDO
     827
     828          ELSE IF ( ar%dimkey == 22 .AND. lo_ptrans)  THEN
     829
     830             CALL C_F_POINTER( ar%data, idata_2d, ar%a_dim(1:2) )
     831             DO  ij = 1, ape%nrele
     832                idata_2d(ape%locind(ij)%j,ape%locind(ij)%i) = ibuf(myindex)
     833                myindex = myindex + 1
     834             ENDDO
     835
    743836          ENDIF
    744837       ENDDO
    … …  
    755848    IMPLICIT NONE
    756849
    757     INTEGER, INTENT(IN) ::  childid  !<
     850    INTEGER(iwp), INTENT(IN) ::  childid  !<
    758851
    759852    TYPE(da_namedef) ::  myname  !<
    … …  
    767860       CALL pmc_bcast( myname%nameonchild,  0, comm=m_to_child_comm(childid) )
    768861
    769        CALL pmc_g_setname( children(childid), myname%couple_index,              &
     862       CALL pmc_g_setname( children(childid), myname%couple_index,             &
    770863                           myname%nameonparent )
    771864   ENDDO
    … …  
    775868
    776869
    777  SUBROUTINE pmc_s_setarray(childid, nrdims, dims, array_adr, second_adr )
     870 SUBROUTINE pmc_s_setarray(childid, nrdims, dims, array_adr, second_adr, dimkey )
    778871
    779872!
    … …  
    781874    IMPLICIT NONE
    782875
    783     INTEGER, INTENT(IN)               ::  childid    !<
    784     INTEGER, INTENT(IN)               ::  nrdims     !<
    785     INTEGER, INTENT(IN), DIMENSION(:) ::  dims       !<
    786 
    787     TYPE(C_PTR), INTENT(IN)           :: array_adr   !<
    788     TYPE(C_PTR), INTENT(IN), OPTIONAL :: second_adr  !<
    789 
    790     INTEGER ::  i  !< local counter
     876    INTEGER(iwp), INTENT(IN)               :: childid    !<
     877    INTEGER(iwp), INTENT(IN)               :: nrdims     !<
     878    INTEGER(iwp), INTENT(IN), DIMENSION(:) :: dims       !<
     879
     880    TYPE(C_PTR), INTENT(IN)           :: array_adr  !<
     881    TYPE(C_PTR), INTENT(IN), OPTIONAL :: second_adr !<
     882    INTEGER(iwp), INTENT(IN), OPTIONAL     :: dimkey     !<
     883
     884    INTEGER(iwp) ::  i  !< local counter
    791885
    792886    TYPE(pedef), POINTER    ::  ape  !<
    … …  
    798892       ar  => ape%array_list(next_array_in_list)
    799893       ar%nrdims = nrdims
     894       ar%dimkey = nrdims
     895       IF(PRESENT(dimkey)) ar%dimkey = dimkey
    800896       ar%a_dim  = dims
    801897       ar%data   = array_adr
    … …  
    817913    IMPLICIT NONE
    818914
    819     INTEGER, INTENT(IN) ::  childid   !<
    820     INTEGER, INTENT(IN) ::  iactive   !<
    821 
    822     INTEGER :: i   !<
    823     INTEGER :: ip  !<
    824     INTEGER :: j   !<
     915    INTEGER(iwp), INTENT(IN) ::  childid   !<
     916    INTEGER(iwp), INTENT(IN) ::  iactive   !<
     917
     918    INTEGER(iwp) :: i   !<
     919    INTEGER(iwp) :: ip  !<
     920    INTEGER(iwp) :: j   !<
    825921
    826922    TYPE(pedef), POINTER    ::  ape  !<
    … …  
    831927       DO  j = 1, ape%nr_arrays
    832928          ar => ape%array_list(j)
     929          if(mod(ar%dimkey,10) == 2) CYCLE           !Not for 2D array
    833930          IF ( iactive == 1  .OR.  iactive == 2 )  THEN
    834931             ar%data = ar%po_data(iactive)
    … …  
    839936 END SUBROUTINE pmc_s_set_active_data_array
    840937
     938 INTEGER FUNCTION pmc_s_get_child_npes (child_id)
     939   IMPLICIT NONE
     940
     941   INTEGER(iwp),INTENT(IN)                 :: child_id
     942
     943   pmc_s_get_child_npes = children(child_id)%inter_npes
     944
     945   RETURN
     946 END FUNCTION pmc_s_get_child_npes
    841947
    842948
    … …  
    845951    IMPLICIT NONE
    846952
    847     INTEGER, INTENT(IN)                 ::  childid     !<
    848     INTEGER, INTENT(IN), DIMENSION(:,:) ::  index_list  !<
    849     INTEGER, INTENT(IN)                 ::  nrp         !<
     953    INTEGER(iwp), INTENT(IN)                 ::  childid     !<
     954    INTEGER(iwp), INTENT(IN), DIMENSION(:,:) ::  index_list  !<
     955    INTEGER(iwp), INTENT(IN)                 ::  nrp         !<
    850956
    851957    TYPE(childdef), INTENT(INOUT)       ::  mychild     !<
    852958
    853     INTEGER                                 :: i        !<
    854     INTEGER                                 :: ierr     !<
    855     INTEGER                                 :: ind      !<
    856     INTEGER                                 :: indwin   !<
    857     INTEGER                                 :: indwin2  !<
    858     INTEGER                                 :: i2       !<
    859     INTEGER                                 :: j        !<
    860     INTEGER                                 :: rempe    !<
     959    INTEGER(iwp)                            :: i        !<
     960    INTEGER(iwp)                            :: ierr     !<
     961    INTEGER(iwp)                            :: ind      !<
     962    INTEGER(iwp)                            :: indwin   !<
     963    INTEGER(iwp)                            :: indwin2  !<
     964    INTEGER(iwp)                            :: i2       !<
     965    INTEGER(iwp)                            :: j        !<
     966    INTEGER(iwp)                            :: rempe    !<
    861967    INTEGER(KIND=MPI_ADDRESS_KIND)          :: winsize  !<
    862968
    863     INTEGER, DIMENSION(mychild%inter_npes)  :: remind   !<
    864 
    865     INTEGER, DIMENSION(:), POINTER          :: remindw  !<
    866     INTEGER, DIMENSION(:), POINTER          :: rldef    !<
     969    INTEGER(iwp), DIMENSION(mychild%inter_npes)  :: remind   !<
     970
     971    INTEGER(iwp), DIMENSION(:), POINTER          :: remindw  !<
     972    INTEGER(iwp), DIMENSION(:), POINTER          :: rldef    !<
    867973
    868974    TYPE(pedef), POINTER                    :: ape      !<
    … …  
    9061012    winsize = mychild%inter_npes*c_sizeof(i)*2
    9071013
    908     CALL MPI_WIN_CREATE( rldef, winsize, iwp, MPI_INFO_NULL,                    &
     1014    CALL MPI_WIN_CREATE( rldef, winsize, iwp, MPI_INFO_NULL,                   &
    9091015                         mychild%intra_comm, indwin, ierr )
    9101016!
    … …  
    9371043
    9381044    CALL MPI_BARRIER( m_model_comm, ierr )
    939     CALL MPI_WIN_CREATE( remindw, winsize*c_sizeof(i), iwp, MPI_INFO_NULL,      &
     1045    CALL MPI_WIN_CREATE( remindw, winsize*c_sizeof(i), iwp, MPI_INFO_NULL,     &
    9401046                         mychild%intra_comm, indwin2, ierr )
    9411047!

  • palm/trunk/SOURCE/time_integration.f90

    r2776 r2801  
    2525! -----------------
    2626! $Id$
     27! Changed lpm from subroutine to module.
     28! Introduce particle transfer in nested models.
     29!
     30! 2776 2018-01-31 10:44:42Z Giersch
    2731! Variable use_synthetic_turbulence_generator has been abbreviated
    2832!
    … …  
    452456        ONLY:  wtm_forces
    453457
     458    USE lpm_mod,                                                               &
     459        ONLY:  lpm
     460
    454461    USE vertical_nesting_mod,                                                  &
    455462        ONLY:  vnested, vnest_anterpolate, vnest_anterpolate_e,                &
Note: See TracChangeset for help on using the changeset viewer.
                                                                                                                                                                                                                                                                                                                                                                               
  | Impressum | ©Leibniz Universität Hannover |