Home


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

Changeset 1933


Ignore:
Timestamp:
Jun 13, 2016 7:12:51 AM (8 years ago)
Author:
hellstea
Message:

last commit documented

Location:
palm/trunk/SOURCE
Files:
13 edited
2 moved

Legend:

Unmodified
Added
Removed

  • palm/trunk/SOURCE/Makefile

    r1932 r1933  
    312312        mod_particle_attributes.f90 netcdf_interface_mod.f90 nudging_mod.f90 \
    313313        package_parin.f90 palm.f90 parin.f90 plant_canopy_model_mod.f90 pmc_interface_mod.f90 \
    314         pmc_client_mod.f90 pmc_general_mod.f90 pmc_handle_communicator_mod.f90 \
    315         pmc_mpi_wrapper_mod.f90 pmc_server_mod.f90 poisfft_mod.f90 poismg_mod.f90 \
    316         poismg_noopt.f90 pres.f90 print_1d.f90 production_e.f90 \
     314        pmc_child_mod.f90 pmc_general_mod.f90 pmc_handle_communicator_mod.f90 \
     315        pmc_mpi_wrapper_mod.f90 pmc_parent_mod.f90 poisfft_mod.f90 poismg.f90 \
     316        poismg_fast_mod.f90 pres.f90 print_1d.f90 production_e.f90 \
    317317        prognostic_equations.f90 progress_bar_mod.f90 radiation_model_mod.f90 \
    318318        random_function_mod.f90 random_gauss.f90 random_generator_parallel_mod.f90 \
    … …  
    495495   radiation_model_mod.o microphysics_mod.o wind_turbine_model_mod.o
    496496plant_canopy_model_mod.o: modules.o mod_kinds.o
    497 pmc_interface_mod.o: modules.o mod_kinds.o pmc_client_mod.o pmc_general_mod.o\
    498         pmc_handle_communicator_mod.o pmc_mpi_wrapper_mod.o pmc_server_mod.o
    499 pmc_client_mod.o: mod_kinds.o pmc_general_mod.o pmc_handle_communicator_mod.o\
     497pmc_interface_mod.o: modules.o mod_kinds.o pmc_child_mod.o pmc_general_mod.o\
     498        pmc_handle_communicator_mod.o pmc_mpi_wrapper_mod.o pmc_parent_mod.o
     499pmc_child_mod.o: mod_kinds.o pmc_general_mod.o pmc_handle_communicator_mod.o\
    500500   pmc_mpi_wrapper_mod.o
    501501pmc_general_mod.o: mod_kinds.o
    502502pmc_handle_communicator_mod.o: modules.o mod_kinds.o pmc_general_mod.o
    503503pmc_mpi_wrapper_mod.o: pmc_handle_communicator_mod.o
    504 pmc_server_mod.o: pmc_general_mod.o pmc_handle_communicator_mod.o pmc_mpi_wrapper_mod.o
     504pmc_parent_mod.o: pmc_general_mod.o pmc_handle_communicator_mod.o pmc_mpi_wrapper_mod.o
    505505poisfft_mod.o: modules.o cpulog_mod.o fft_xy_mod.o mod_kinds.o tridia_solver_mod.o
    506506poismg_mod.o: modules.o cpulog_mod.o mod_kinds.o

  • palm/trunk/SOURCE/boundary_conds.f90

    r1823 r1933  
    1919! Current revisions:
    2020! -----------------
    21 !
    22 !
     21! 
     22! 
    2323! Former revisions:
    2424! -----------------
    2525! $Id$
     26!
     27! 1823 2016-04-07 08:57:52Z hoffmann
     28! Initial version of purely vertical nesting introduced.
    2629!
    2730! 1822 2016-04-07 07:49:42Z hoffmann
    … …  
    159162    USE pegrid
    160163
     164    USE pmc_interface,                                                         &
     165        ONLY : nesting_mode
     166
    161167
    162168    IMPLICIT NONE
    … …  
    359365!
    360366!-- The same restoration for u at i=nxl and v at j=nys as above must be made
    361 !-- in case of nest boundaries. Note however, that the above ELSEIF-structure is
    362 !-- not appropriate here as there may be more than one nest boundary on a
    363 !-- PE-domain. Furthermore Neumann conditions for SGS-TKE are not required here.
    364     IF ( nest_bound_s )  THEN
    365        v_p(:,nys,:) = v_p(:,nys-1,:)
    366     ENDIF
    367     IF ( nest_bound_l )  THEN
    368        u_p(:,:,nxl) = u_p(:,:,nxl-1)
     367!-- in case of nest boundaries. This must not be done in case of vertical nesting
     368!-- mode as in that case the lateral boundaries are actually cyclic.
     369    IF ( nesting_mode /= 'vertical' )  THEN
     370       IF ( nest_bound_s )  THEN
     371          v_p(:,nys,:) = v_p(:,nys-1,:)
     372       ENDIF
     373       IF ( nest_bound_l )  THEN
     374          u_p(:,:,nxl) = u_p(:,:,nxl-1)
     375       ENDIF
    369376    ENDIF
    370377

  • palm/trunk/SOURCE/exchange_horiz.f90

    r1818 r1933  
    277277                DO  k = nzb, nzt+1
    278278                   ar(k,nys-nbgp_local+j,i) = ar(k,nyn-nbgp_local+1+j,i)
    279                      ar(k,nyn+1+j,i)          = ar(k,nys+j,i)
     279                   ar(k,nyn+1+j,i)          = ar(k,nys+j,i)
    280280                ENDDO
    281281             ENDDO

  • palm/trunk/SOURCE/exchange_horiz_2d.f90

    r1818 r1933  
    2525! $Id$
    2626!
     27! 1818 2016-04-06 15:53:27Z maronga
     28! Initial version of purely vertical nesting introduced.
     29!
    2730! 1804 2016-04-05 16:30:18Z maronga
    2831! Removed code for parameter file check (__check)
    … …  
    8184    USE pegrid
    8285
     86    USE pmc_interface,                                                         &
     87        ONLY : nesting_mode
     88
     89
    8390    IMPLICIT NONE
    8491
    … …  
    160167!
    161168!-- Neumann-conditions at inflow/outflow/nested boundaries
    162     IF ( inflow_l .OR. outflow_l .OR. nest_bound_l )  THEN
    163        DO  i = nbgp, 1, -1
    164          ar(:,nxl-i) = ar(:,nxl)
    165        ENDDO
    166     ENDIF
    167     IF ( inflow_r .OR. outflow_r .OR. nest_bound_r )  THEN
    168        DO  i = 1, nbgp
    169           ar(:,nxr+i) = ar(:,nxr)
    170        ENDDO
    171     ENDIF
    172     IF ( inflow_s .OR. outflow_s .OR. nest_bound_s )  THEN
    173        DO  i = nbgp, 1, -1
    174          ar(nys-i,:) = ar(nys,:)
    175        ENDDO
    176     ENDIF
    177     IF ( inflow_n .OR. outflow_n .OR. nest_bound_n )  THEN
    178        DO  i = 1, nbgp
    179          ar(nyn+i,:) = ar(nyn,:)
    180        ENDDO
     169    IF ( nesting_mode /= 'vertical' )  THEN
     170       IF ( inflow_l .OR. outflow_l .OR. nest_bound_l )  THEN
     171          DO  i = nbgp, 1, -1
     172             ar(:,nxl-i) = ar(:,nxl)
     173          ENDDO
     174       ENDIF
     175       IF ( inflow_r .OR. outflow_r .OR. nest_bound_r )  THEN
     176          DO  i = 1, nbgp
     177             ar(:,nxr+i) = ar(:,nxr)
     178          ENDDO
     179       ENDIF
     180       IF ( inflow_s .OR. outflow_s .OR. nest_bound_s )  THEN
     181          DO  i = nbgp, 1, -1
     182             ar(nys-i,:) = ar(nys,:)
     183          ENDDO
     184       ENDIF
     185       IF ( inflow_n .OR. outflow_n .OR. nest_bound_n )  THEN
     186          DO  i = 1, nbgp
     187             ar(nyn+i,:) = ar(nyn,:)
     188          ENDDO
     189       ENDIF
    181190    ENDIF
    182191

  • palm/trunk/SOURCE/init_pegrid.f90

    r1923 r1933  
    2525! $Id$
    2626!
     27! 1923 2016-05-31 16:37:07Z boeske
     28! Initial version of purely vertical nesting introduced.
     29!
    2730! 1922 2016-05-31 16:36:08Z boeske
    2831! Bugfix: array transposition checks restricted to cases if a fourier
    … …  
    153156               maximum_parallel_io_streams, message_string,                    &
    154157               mg_switch_to_pe0_level, momentum_advec, nest_bound_l,           &
    155                nest_bound_n, nest_bound_r, nest_bound_s, neutral, psolver,    &
    156                outflow_l, outflow_n, outflow_r, outflow_s, recycling_width,    &
    157                scalar_advec, subdomain_size
     158               nest_bound_n, nest_bound_r, nest_bound_s, nest_domain, neutral, &
     159               psolver, outflow_l, outflow_n, outflow_r, outflow_s,            &
     160               recycling_width, scalar_advec, subdomain_size
    158161
    159162    USE grid_variables,                                                        &
    … …  
    170173     
    171174    USE pegrid
    172 
     175   
     176    USE pmc_interface,                                                         &   
     177        ONLY:  nesting_mode
     178   
    173179    USE spectra_mod,                                                           &
    174180        ONLY:  calculate_spectra, dt_dosp
    … …  
    10921098#if defined( __parallel )
    10931099!
    1094 !-- Setting of flags for inflow/outflow/nesting conditions in case of non-cyclic
    1095 !-- horizontal boundary conditions.
    1096     IF ( pleft == MPI_PROC_NULL )  THEN
    1097        IF ( bc_lr == 'dirichlet/radiation' )  THEN
    1098           inflow_l  = .TRUE.
    1099        ELSEIF ( bc_lr == 'radiation/dirichlet' )  THEN
    1100           outflow_l = .TRUE.
    1101        ELSEIF ( bc_lr == 'nested' )  THEN
     1100!-- Setting of flags for inflow/outflow/nesting conditions.
     1101    IF ( nesting_mode == 'vertical' .AND. nest_domain )  THEN
     1102       IF ( nxl == 0 )  THEN
    11021103          nest_bound_l = .TRUE.
    11031104       ENDIF
    1104     ENDIF
    1105 
    1106     IF ( pright == MPI_PROC_NULL )  THEN
    1107        IF ( bc_lr == 'dirichlet/radiation' )  THEN
    1108           outflow_r = .TRUE.
    1109        ELSEIF ( bc_lr == 'radiation/dirichlet' )  THEN
    1110           inflow_r  = .TRUE.
    1111        ELSEIF ( bc_lr == 'nested' )  THEN
     1105    ELSE
     1106       IF ( pleft == MPI_PROC_NULL )  THEN
     1107          IF ( bc_lr == 'dirichlet/radiation' )  THEN
     1108             inflow_l  = .TRUE.
     1109          ELSEIF ( bc_lr == 'radiation/dirichlet' )  THEN
     1110             outflow_l = .TRUE.
     1111          ELSEIF ( bc_lr == 'nested' )  THEN
     1112             nest_bound_l = .TRUE.
     1113          ENDIF
     1114       ENDIF
     1115    ENDIF
     1116 
     1117    IF ( nesting_mode == 'vertical' .AND. nest_domain )  THEN
     1118       IF ( nxr == nx )  THEN
    11121119          nest_bound_r = .TRUE.
    11131120       ENDIF
    1114     ENDIF
    1115 
    1116     IF ( psouth == MPI_PROC_NULL )  THEN
    1117        IF ( bc_ns == 'dirichlet/radiation' )  THEN
    1118           outflow_s = .TRUE.
    1119        ELSEIF ( bc_ns == 'radiation/dirichlet' )  THEN
    1120           inflow_s  = .TRUE.
    1121        ELSEIF ( bc_ns == 'nested' )  THEN
     1121    ELSE
     1122       IF ( pright == MPI_PROC_NULL )  THEN
     1123          IF ( bc_lr == 'dirichlet/radiation' )  THEN
     1124             outflow_r = .TRUE.
     1125          ELSEIF ( bc_lr == 'radiation/dirichlet' )  THEN
     1126             inflow_r  = .TRUE.
     1127          ELSEIF ( bc_lr == 'nested' )  THEN
     1128             nest_bound_r = .TRUE.
     1129          ENDIF
     1130       ENDIF
     1131    ENDIF
     1132
     1133    IF ( nesting_mode == 'vertical' .AND. nest_domain )  THEN
     1134       IF ( nys == 0 )  THEN
    11221135          nest_bound_s = .TRUE.
    11231136       ENDIF
    1124     ENDIF
    1125 
    1126     IF ( pnorth == MPI_PROC_NULL )  THEN
    1127        IF ( bc_ns == 'dirichlet/radiation' )  THEN
    1128           inflow_n  = .TRUE.
    1129        ELSEIF ( bc_ns == 'radiation/dirichlet' )  THEN
    1130           outflow_n = .TRUE.
    1131        ELSEIF ( bc_ns == 'nested' )  THEN
     1137    ELSE
     1138       IF ( psouth == MPI_PROC_NULL )  THEN
     1139          IF ( bc_ns == 'dirichlet/radiation' )  THEN
     1140             outflow_s = .TRUE.
     1141          ELSEIF ( bc_ns == 'radiation/dirichlet' )  THEN
     1142             inflow_s  = .TRUE.
     1143          ELSEIF ( bc_ns == 'nested' )  THEN
     1144             nest_bound_s = .TRUE.
     1145          ENDIF
     1146       ENDIF
     1147    ENDIF
     1148
     1149    IF ( nesting_mode == 'vertical' .AND. nest_domain )  THEN
     1150       IF ( nyn == ny )  THEN
    11321151          nest_bound_n = .TRUE.
    11331152       ENDIF
    1134     ENDIF
    1135 
     1153    ELSE
     1154       IF ( pnorth == MPI_PROC_NULL )  THEN
     1155          IF ( bc_ns == 'dirichlet/radiation' )  THEN
     1156             inflow_n  = .TRUE.
     1157          ELSEIF ( bc_ns == 'radiation/dirichlet' )  THEN
     1158             outflow_n = .TRUE.
     1159          ELSEIF ( bc_ns == 'nested' )  THEN
     1160             nest_bound_n = .TRUE.
     1161          ENDIF
     1162       ENDIF
     1163    ENDIF
     1164       
    11361165!
    11371166!-- Broadcast the id of the inflow PE

  • palm/trunk/SOURCE/palm.f90

    r1834 r1933  
    2525! $Id$
    2626!
     27! 1834 2016-04-07 14:34:20Z raasch
     28! Initial version of purely vertical nesting introduced.
     29!
    2730! 1833 2016-04-07 14:23:03Z raasch
    2831! required user interface version changed
    … …  
    134137        ONLY:  constant_diffusion, coupling_char, coupling_mode,               &
    135138               do2d_at_begin, do3d_at_begin, humidity, io_blocks, io_group,    &
    136                large_scale_forcing, message_string, nest_domain, nudging,      &
    137                passive_scalar, simulated_time, simulated_time_chr,             &
     139               large_scale_forcing, message_string, nest_domain, neutral,      &
     140               nudging, passive_scalar, simulated_time, simulated_time_chr,    &
    138141               user_interface_current_revision,                                &
    139142               user_interface_required_revision, version, wall_heatflux,       &
    … …  
    168171
    169172    USE pmc_interface,                                                         &
    170         ONLY:  cpl_id, nested_run, pmci_client_initialize, pmci_init,          &
    171                pmci_modelconfiguration, pmci_server_initialize
     173        ONLY:  cpl_id, nested_run, pmci_child_initialize, pmci_init,           &
     174               pmci_modelconfiguration, pmci_parent_initialize
    172175
    173176    USE statistics,                                                            &
    … …  
    341344       CALL pmci_modelconfiguration
    342345!
    343 !--    Receive and interpolate initial data on client.
    344 !--    Client initialization must be made first if the model is both client and
    345 !--    server
    346        CALL pmci_client_initialize
    347 !
    348 !--    Send initial condition data from server to client
    349        CALL pmci_server_initialize
     346!--    Receive and interpolate initial data on children.
     347!--    Child initialization must be made first if the model is both child and
     348!--    parent
     349       CALL pmci_child_initialize
     350!
     351!--    Send initial condition data from parent to children
     352       CALL pmci_parent_initialize
    350353!
    351354!--    Exchange_horiz is needed after the nest initialization
    … …  
    354357          CALL exchange_horiz( v, nbgp )
    355358          CALL exchange_horiz( w, nbgp )
    356           CALL exchange_horiz( pt, nbgp )
     359          IF ( .NOT. neutral )  THEN
     360             CALL exchange_horiz( pt, nbgp )
     361          ENDIF
    357362          IF ( .NOT. constant_diffusion )  CALL exchange_horiz( e, nbgp )
    358363          IF (humidity  .OR.  passive_scalar)  THEN

  • palm/trunk/SOURCE/parin.f90

    r1917 r1933  
    1919! Current revisions:
    2020! -----------------
    21 !
     21! 
    2222!
    2323! Former revisions:
    … …  
    2525! $Id$
    2626!
     27! 1917 2016-05-27 14:28:12Z witha
     28! Initial version of purely vertical nesting introduced.
     29!
    2730! 1914 2016-05-26 14:44:07Z witha
    2831! Added call to wind turbine model for reading of &wind_turbine_par
    … …  
    245248
    246249    USE pmc_interface,                                                         &
    247         ONLY:  nested_run
     250        ONLY:  nested_run, nesting_mode
    248251
    249252    USE profil_parameter,                                                      &
    … …  
    429432
    430433!
    431 !--       In case of nested runs, explicitly set nesting boundary conditions
    432 !--       except for the root domain. This will overwrite the user settings.
    433           IF ( nest_domain )  THEN
    434              bc_lr   = 'nested'
    435              bc_ns   = 'nested'
    436              bc_uv_t = 'nested'
    437              bc_pt_t = 'nested'
    438              bc_q_t  = 'nested'
    439              bc_p_t  = 'neumann'
     434!--       In case of nested runs, explicitly set nesting boundary conditions.
     435!--       This will overwrite the user settings. bc_lr and bc_ns always need
     436!--       to be cyclic for vertical nesting.
     437          IF ( nesting_mode == 'vertical' )  THEN
     438             IF (bc_lr /= 'cyclic' .OR. bc_ns /= 'cyclic' )  THEN
     439                WRITE ( message_string, *)  'bc_lr and bc_ns were set to ,',   &
     440                                      'cyclic for vertical nesting'
     441                CALL message( 'parin', 'PA0428', 0, 0, 0, 6, 0 )
     442                bc_lr   = 'cyclic'
     443                bc_ns   = 'cyclic'
     444             ENDIF
     445             IF ( nest_domain )  THEN
     446                bc_uv_t = 'nested'
     447                bc_pt_t = 'nested'
     448                bc_q_t  = 'nested'
     449                bc_p_t  = 'neumann'
     450             ENDIF
     451          ELSE
     452         
     453!
     454!--       For other nesting modes only set boundary conditions for
     455!--       nested domains.
     456             IF ( nest_domain )  THEN
     457                bc_lr   = 'nested'
     458                bc_ns   = 'nested'
     459                bc_uv_t = 'nested'
     460                bc_pt_t = 'nested'
     461                bc_q_t  = 'nested'
     462                bc_p_t  = 'neumann'
     463             ENDIF
    440464          ENDIF
     465           
    441466!
    442467!--       Check validity of lateral boundary conditions. This has to be done

  • palm/trunk/SOURCE/pmc_child_mod.f90

    r1932 r1933  
    1 MODULE pmc_client
    2 
    3 !--------------------------------------------------------------------------------!
     1MODULE pmc_child
     2
     3!-------------------------------------------------------------------------------!
    44! This file is part of PALM.
    55!
    … …  
    1616!
    1717! Copyright 1997-2016 Leibniz Universitaet Hannover
    18 !--------------------------------------------------------------------------------!
     18!-------------------------------------------------------------------------------!
    1919!
    2020! Current revisions:
    2121! ------------------
    2222!
    23 !
     23! 
    2424! Former revisions:
    2525! -----------------
    2626! $Id$
     27!
     28! 1897 2016-05-03 08:10:23Z raasch
     29! Module renamed. Code clean up. The words server/client changed to parent/child.
    2730!
    2831! 1896 2016-05-03 08:06:41Z raasch
    … …  
    4750!
    4851! 1786 2016-03-08 05:49:27Z raasch
    49 ! change in client-server data transfer: server now gets data from client
    50 ! instead that client put's it to the server
     52! change in child-parent data transfer: parent now gets data from child
     53! instead of that child puts it to the parent
    5154!
    5255! 1783 2016-03-06 18:36:17Z raasch
    … …  
    6770! ------------
    6871!
    69 ! Client part of Palm Model Coupler
    70 !------------------------------------------------------------------------------!
     72! Child part of Palm Model Coupler
     73!-------------------------------------------------------------------------------!
    7174
    7275#if defined( __parallel )
    … …  
    8184
    8285    USE kinds
    83     USE pmc_general,                                                           &
    84         ONLY:  arraydef, clientdef, da_desclen, da_namedef, da_namelen, pedef, &
     86    USE pmc_general,                                                            &
     87        ONLY:  arraydef, childdef, da_desclen, da_namedef, da_namelen, pedef,  &
    8588               pmc_da_name_err,  pmc_g_setname, pmc_max_array, pmc_status_ok
    8689
    87     USE pmc_handle_communicator,                                               &
    88         ONLY:  m_model_comm, m_model_npes, m_model_rank, m_to_server_comm
    89 
    90     USE pmc_mpi_wrapper,                                                       &
    91         ONLY:  pmc_alloc_mem, pmc_bcast, pmc_inter_bcast,                      &
    92                pmc_recv_from_server, pmc_send_to_server, pmc_time
     90    USE pmc_handle_communicator,                                                &
     91        ONLY:  m_model_comm, m_model_npes, m_model_rank, m_to_parent_comm
     92
     93    USE pmc_mpi_wrapper,                                                        &
     94        ONLY:  pmc_alloc_mem, pmc_bcast, pmc_inter_bcast, pmc_time
    9395
    9496    IMPLICIT NONE
    … …  
    9799    SAVE
    98100
    99     TYPE(clientdef) ::  me   !<
     101    TYPE(childdef) ::  me   !<
    100102
    101103    INTEGER ::  myindex = 0         !< counter and unique number for data arrays
    … …  
    103105
    104106
    105     INTERFACE pmc_clientinit
    106         MODULE PROCEDURE pmc_clientinit
    107     END INTERFACE PMC_ClientInit
     107    INTERFACE pmc_childinit
     108        MODULE PROCEDURE pmc_childinit
     109    END INTERFACE pmc_childinit
    108110
    109111    INTERFACE pmc_c_clear_next_array_list
    … …  
    142144
    143145
    144     PUBLIC pmc_clientinit, pmc_c_clear_next_array_list, pmc_c_getbuffer,       &
    145            pmc_c_getnextarray, pmc_c_putbuffer, pmc_c_setind_and_allocmem,     &
     146    PUBLIC pmc_childinit, pmc_c_clear_next_array_list, pmc_c_getbuffer,         &
     147           pmc_c_getnextarray, pmc_c_putbuffer, pmc_c_setind_and_allocmem,      &
    146148           pmc_c_set_dataarray, pmc_set_dataarray_name, pmc_c_get_2d_index_list
    147149
    … …  
    150152
    151153
    152  SUBROUTINE pmc_clientinit
     154 SUBROUTINE pmc_childinit
    153155
    154156     IMPLICIT NONE
    … …  
    160162!--  Get / define the MPI environment
    161163     me%model_comm = m_model_comm
    162      me%inter_comm = m_to_server_comm
     164     me%inter_comm = m_to_parent_comm
    163165
    164166     CALL MPI_COMM_RANK( me%model_comm, me%model_rank, istat )
    165167     CALL MPI_COMM_SIZE( me%model_comm, me%model_npes, istat )
    166168     CALL MPI_COMM_REMOTE_SIZE( me%inter_comm, me%inter_npes, istat )
     169
    167170!
    168171!--  Intra-communicater is used for MPI_GET
    … …  
    173176
    174177!
    175 !--  Allocate an array of type arraydef for all server PEs to store information
     178!--  Allocate an array of type arraydef for all parent PEs to store information
    176179!--  of then transfer array
    177180     DO  i = 1, me%inter_npes
    … …  
    179182     ENDDO
    180183
    181  END SUBROUTINE pmc_clientinit
    182 
    183 
    184 
    185  SUBROUTINE pmc_set_dataarray_name( serverarraydesc, serverarrayname,          &
    186                                     clientarraydesc, clientarrayname, istat )
    187 
    188     IMPLICIT NONE
    189 
    190     CHARACTER(LEN=*), INTENT(IN) ::  serverarrayname  !<
    191     CHARACTER(LEN=*), INTENT(IN) ::  serverarraydesc  !<
    192     CHARACTER(LEN=*), INTENT(IN) ::  clientarrayname  !<
    193     CHARACTER(LEN=*), INTENT(IN) ::  clientarraydesc  !<
     184 END SUBROUTINE pmc_childinit
     185
     186
     187
     188 SUBROUTINE pmc_set_dataarray_name( parentarraydesc, parentarrayname,           &
     189                                    childarraydesc, childarrayname, istat )
     190
     191    IMPLICIT NONE
     192
     193    CHARACTER(LEN=*), INTENT(IN) ::  parentarrayname  !<
     194    CHARACTER(LEN=*), INTENT(IN) ::  parentarraydesc  !<
     195    CHARACTER(LEN=*), INTENT(IN) ::  childarrayname   !<
     196    CHARACTER(LEN=*), INTENT(IN) ::  childarraydesc   !<
    194197
    195198    INTEGER, INTENT(OUT) ::  istat  !<
    … …  
    204207
    205208    istat = pmc_status_ok
     209
    206210!
    207211!-- Check length of array names
    208     IF ( LEN( TRIM( serverarrayname) ) > da_namelen  .OR.                     &
    209          LEN( TRIM( clientarrayname) ) > da_namelen )  THEN
     212    IF ( LEN( TRIM( parentarrayname) ) > da_namelen  .OR.                       &
     213         LEN( TRIM( childarrayname) ) > da_namelen )  THEN
    210214       istat = pmc_da_name_err
    211215    ENDIF
    … …  
    214218       myindex = myindex + 1
    215219       myname%couple_index = myIndex
    216        myname%serverdesc   = TRIM( serverarraydesc )
    217        myname%nameonserver = TRIM( serverarrayname )
    218        myname%clientdesc   = TRIM( clientarraydesc )
    219        myname%nameonclient = TRIM( clientarrayname )
     220       myname%parentdesc   = TRIM( parentarraydesc )
     221       myname%nameonparent = TRIM( parentarrayname )
     222       myname%childdesc    = TRIM( childarraydesc )
     223       myname%nameonchild  = TRIM( childarrayname )
    220224    ENDIF
    221225
    222226!
    223 !-- Broadcat to all client PEs
     227!-- Broadcat to all child PEs
    224228!-- TODO: describe what is broadcast here and why it is done
    225229    CALL pmc_bcast( myname%couple_index, 0, comm=m_model_comm )
    226     CALL pmc_bcast( myname%serverdesc,   0, comm=m_model_comm )
    227     CALL pmc_bcast( myname%nameonserver, 0, comm=m_model_comm )
    228     CALL pmc_bcast( myname%clientdesc,   0, comm=m_model_comm )
    229     CALL pmc_bcast( myname%nameonclient, 0, comm=m_model_comm )
    230 
    231 !
    232 !-- Broadcat to all server PEs
     230    CALL pmc_bcast( myname%parentdesc,   0, comm=m_model_comm )
     231    CALL pmc_bcast( myname%nameonparent, 0, comm=m_model_comm )
     232    CALL pmc_bcast( myname%childdesc,    0, comm=m_model_comm )
     233    CALL pmc_bcast( myname%nameonchild, 0, comm=m_model_comm )
     234
     235!
     236!-- Broadcat to all parent PEs
    233237!-- TODO: describe what is broadcast here and why it is done
    234238    IF ( m_model_rank == 0 )  THEN
    … …  
    238242    ENDIF
    239243
    240     CALL pmc_bcast( myname%couple_index, mype, comm=m_to_server_comm )
    241     CALL pmc_bcast( myname%serverdesc,   mype, comm=m_to_server_comm )
    242     CALL pmc_bcast( myname%nameonserver, mype, comm=m_to_server_comm )
    243     CALL pmc_bcast( myname%clientdesc,   mype, comm=m_to_server_comm )
    244     CALL pmc_bcast( myname%nameonclient, mype, comm=m_to_server_comm )
    245 
    246     CALL pmc_g_setname( me, myname%couple_index, myname%nameonclient )
     244    CALL pmc_bcast( myname%couple_index, mype, comm=m_to_parent_comm )
     245    CALL pmc_bcast( myname%parentdesc,   mype, comm=m_to_parent_comm )
     246    CALL pmc_bcast( myname%nameonparent, mype, comm=m_to_parent_comm )
     247    CALL pmc_bcast( myname%childdesc,    mype, comm=m_to_parent_comm )
     248    CALL pmc_bcast( myname%nameonchild,  mype, comm=m_to_parent_comm )
     249
     250    CALL pmc_g_setname( me, myname%couple_index, myname%nameonchild )
    247251
    248252 END SUBROUTINE pmc_set_dataarray_name
    … …  
    269273    ENDIF
    270274
    271     CALL pmc_bcast( myname%couple_index, mype, comm=m_to_server_comm )
     275    CALL pmc_bcast( myname%couple_index, mype, comm=m_to_parent_comm )
    272276
    273277 END SUBROUTINE pmc_set_dataarray_name_lastentry
    … …  
    296300
    297301    win_size = C_SIZEOF( dummy )
    298     CALL MPI_WIN_CREATE( dummy, win_size, iwp, MPI_INFO_NULL, me%intra_comm,   &
     302    CALL MPI_WIN_CREATE( dummy, win_size, iwp, MPI_INFO_NULL, me%intra_comm,    &
    299303                         indwin, ierr )
    300 !
    301 !-- Open window on server side
     304
     305!
     306!-- Open window on parent side
    302307!-- TODO: why is the next MPI routine called twice??
    303308    CALL MPI_WIN_FENCE( 0, indwin, ierr )
    304 !
    305 !-- Close window on server side and open on client side
     309
     310!
     311!-- Close window on parent side and open on child side
    306312    CALL MPI_WIN_FENCE( 0, indwin, ierr )
    307313
    308314    DO  i = 1, me%inter_npes
    309315       disp = me%model_rank * 2
    310        CALL MPI_GET( nrele((i-1)*2+1), 2, MPI_INTEGER, i-1, disp, 2,           &
     316       CALL MPI_GET( nrele((i-1)*2+1), 2, MPI_INTEGER, i-1, disp, 2,            &
    311317                     MPI_INTEGER, indwin, ierr )
    312318    ENDDO
     319
    313320!
    314321!-- MPI_GET is non-blocking -> data in nrele is not available until MPI_FENCE is
    … …  
    336343!
    337344!-- Local buffer used in MPI_GET can but must not be inside the MPI Window.
    338 !-- Here, we use a dummy for the MPI window because the server PEs do not access
     345!-- Here, we use a dummy for the MPI window because the parent PEs do not access
    339346!-- the RMA window via MPI_GET or MPI_PUT
    340     CALL MPI_WIN_CREATE( dummy, winsize, iwp, MPI_INFO_NULL, me%intra_comm,    &
     347    CALL MPI_WIN_CREATE( dummy, winsize, iwp, MPI_INFO_NULL, me%intra_comm,     &
    341348                         indwin2, ierr )
     349
    342350!
    343351!-- MPI_GET is non-blocking -> data in nrele is not available until MPI_FENCE is
    … …  
    353361          disp = nrele(2*(i-1)+1)
    354362          CALL MPI_WIN_LOCK( MPI_LOCK_SHARED , i-1, 0, indwin2, ierr )
    355           CALL MPI_GET( myind, 2*nr, MPI_INTEGER, i-1, disp, 2*nr,             &
     363          CALL MPI_GET( myind, 2*nr, MPI_INTEGER, i-1, disp, 2*nr,              &
    356364                        MPI_INTEGER, indwin2, ierr )
    357365          CALL MPI_WIN_UNLOCK( i-1, indwin2, ierr )
    … …  
    389397
    390398 LOGICAL FUNCTION pmc_c_getnextarray( myname )
     399
    391400!
    392401!--  List handling is still required to get minimal interaction with
    … …  
    403412
    404413!
    405 !-- Array names are the same on all client PEs, so take first PE to get the name
     414!-- Array names are the same on all child PEs, so take first PE to get the name
    406415    ape => me%pes(1)
     416
    407417!
    408418!-- Check if all arrays have been processed
    … …  
    497507
    498508    IMPLICIT NONE
    499 !
    500 !-- Naming convention for appendices:  _sc  -> server to client transfer
    501 !--                                    _cs  -> client to server transfer
    502 !--                                    recv -> server to client transfer
    503 !--                                    send -> client to server transfer
     509
     510!
     511!-- Naming convention for appendices:  _pc  -> parent to child transfer
     512!--                                    _cp  -> child to parent transfer
     513!--                                    recv -> parent to child transfer
     514!--                                    send -> child to parent transfer
    504515    CHARACTER(LEN=da_namelen) ::  myname  !<
    505516
    … …  
    520531    INTEGER,DIMENSION(1024) ::  req  !<
    521532
    522     REAL(wp), DIMENSION(:), POINTER, SAVE ::  base_array_sc  !< base array
    523     REAL(wp), DIMENSION(:), POINTER, SAVE ::  base_array_cs  !< base array
     533    REAL(wp), DIMENSION(:), POINTER, SAVE ::  base_array_pc  !< base array
     534    REAL(wp), DIMENSION(:), POINTER, SAVE ::  base_array_cp  !< base array
    524535
    525536    TYPE(pedef), POINTER    ::  ape       !<
    … …  
    532543
    533544!
    534 !-- Server to client direction.
     545!-- Parent to child direction.
    535546!-- First stride: compute size and set index
    536547    DO  i = 1, me%inter_npes
    … …  
    542553
    543554          ar => ape%array_list(j)
    544 !
    545 !--       Receive index from client
     555
     556!
     557!--       Receive index from child
    546558          tag = tag + 1
    547           CALL MPI_RECV( myindex, 1, MPI_INTEGER, i-1, tag, me%inter_comm,     &
     559          CALL MPI_RECV( myindex, 1, MPI_INTEGER, i-1, tag, me%inter_comm,      &
    548560                         MPI_STATUS_IGNORE, ierr )
    549561          ar%recvindex = myindex
    550 !
    551 !--       Determine max, because client buffer is allocated only once
     562
     563!
     564!--       Determine max, because child buffer is allocated only once
    552565!--       TODO: give a more meaningful comment
    553566          IF( ar%nrdims == 3 )  THEN
    … …  
    565578!-- The buffer for MPI_GET can be PE local, i.e. it can but must not be part of
    566579!-- the MPI RMA window
    567     CALL pmc_alloc_mem( base_array_sc, bufsize, base_ptr )
     580    CALL pmc_alloc_mem( base_array_pc, bufsize, base_ptr )
    568581    me%totalbuffersize = bufsize*wp  ! total buffer size in byte
    569582
    … …  
    582595
    583596!
    584 !-- Client to server direction
     597!-- Child to parent direction
    585598    myindex = 1
    586599    rcount  = 0
    … …  
    604617          rcount = rcount + 1
    605618          IF ( ape%nrele > 0 )  THEN
    606              CALL MPI_ISEND( myindex, 1, MPI_INTEGER, i-1, tag, me%inter_comm, &
     619             CALL MPI_ISEND( myindex, 1, MPI_INTEGER, i-1, tag, me%inter_comm,  &
    607620                             req(rcount), ierr )
    608621             ar%sendindex = myindex
    609622          ELSE
    610              CALL MPI_ISEND( noindex, 1, MPI_INTEGER, i-1, tag, me%inter_comm, &
     623             CALL MPI_ISEND( noindex, 1, MPI_INTEGER, i-1, tag, me%inter_comm,  &
    611624                             req(rcount), ierr )
    612625             ar%sendindex = noindex
    613626          ENDIF
     627
    614628!
    615629!--       Maximum of 1024 outstanding requests
    … …  
    635649
    636650!
    637 !-- Create RMA (one sided communication) window for data buffer client to server
     651!-- Create RMA (one sided communication) window for data buffer child to parent
    638652!-- transfer.
    639653!-- The buffer of MPI_GET (counter part of transfer) can be PE-local, i.e. it
    640654!-- can but must not be part of the MPI RMA window. Only one RMA window is
    641655!-- required to prepare the data
    642 !--        for server -> client transfer on the server side
     656!--        for parent -> child transfer on the parent side
    643657!-- and
    644 !--        for client -> server transfer on the client side
    645 
    646     CALL pmc_alloc_mem( base_array_cs, bufsize )
     658!--        for child -> parent transfer on the child side
     659    CALL pmc_alloc_mem( base_array_cp, bufsize )
    647660    me%totalbuffersize = bufsize * wp  ! total buffer size in byte
    648661
    649662    winSize = me%totalbuffersize
    650663
    651     CALL MPI_WIN_CREATE( base_array_cs, winsize, wp, MPI_INFO_NULL,            &
    652                          me%intra_comm, me%win_server_client, ierr )
    653     CALL MPI_WIN_FENCE( 0, me%win_server_client, ierr )
     664    CALL MPI_WIN_CREATE( base_array_cp, winsize, wp, MPI_INFO_NULL,             &
     665                         me%intra_comm, me%win_parent_child, ierr )
     666    CALL MPI_WIN_FENCE( 0, me%win_parent_child, ierr )
    654667    CALL MPI_BARRIER( me%intra_comm, ierr )
    655668
    … …  
    665678
    666679          IF ( ape%nrele > 0 )  THEN
    667              ar%sendbuf = C_LOC( base_array_cs(ar%sendindex) )
     680             ar%sendbuf = C_LOC( base_array_cp(ar%sendindex) )
     681
     682!
    668683!--          TODO: if this is an error to be really expected, replace the
    669684!--                following message by a meaningful standard PALM message using
    670685!--                the message-routine
    671686             IF ( ar%sendindex+ar%sendsize > bufsize )  THEN
    672                 WRITE( 0,'(a,i4,4i7,1x,a)') 'Client Buffer too small ', i,     &
    673                           ar%sendindex, ar%sendsize, ar%sendindex+ar%sendsize, &
     687                WRITE( 0,'(a,i4,4i7,1x,a)') 'Child buffer too small ', i,       &
     688                          ar%sendindex, ar%sendsize, ar%sendindex+ar%sendsize,  &
    674689                          bufsize, TRIM( ar%name )
    675690                CALL MPI_ABORT( MPI_COMM_WORLD, istat, ierr )
    … …  
    699714    INTEGER                        ::  myindex  !<
    700715    INTEGER                        ::  nr       !< number of elements to get
    701                                                 !< from server
     716                                                !< from parent
    702717    INTEGER(KIND=MPI_ADDRESS_KIND) ::  target_disp
    703718    INTEGER,DIMENSION(1)           ::  buf_shape
    … …  
    713728
    714729!
    715 !-- Synchronization of the model is done in pmci_client_synchronize and
    716 !-- pmci_server_synchronize. Therefor the RMA window can be filled without
     730!-- Synchronization of the model is done in pmci_synchronize.
     731!-- Therefore the RMA window can be filled without
    717732!-- sychronization at this point and a barrier is not necessary.
    718733!-- Please note that waittime has to be set in pmc_s_fillbuffer AND
    … …  
    724739       waittime = t2 - t1
    725740    ENDIF
    726 !
    727 !-- Wait for buffer is filled
     741
     742!
     743!-- Wait for buffer is filled.
    728744!-- TODO: explain in more detail what is happening here. The barrier seems to
    729 !-- contradict what is said a few lines beforer (i.e. that no barrier is necessary)
     745!-- contradict what is said a few lines before (i.e. that no barrier is necessary)
    730746!-- TODO: In case of PRESENT( waittime ) the barrrier would be calles twice. Why?
    731747!-- Shouldn't it be done the same way as in pmc_putbuffer?
    … …  
    748764          buf_shape(1) = nr
    749765          CALL C_F_POINTER( ar%recvbuf, buf, buf_shape )
     766
    750767!
    751768!--       MPI passive target RMA
    … …  
    753770          IF ( nr > 0 )  THEN
    754771             target_disp = ar%recvindex - 1
    755              CALL MPI_WIN_LOCK( MPI_LOCK_SHARED , ip-1, 0,                     &
    756                                 me%win_server_client, ierr )
    757              CALL MPI_GET( buf, nr, MPI_REAL, ip-1, target_disp, nr, MPI_REAL, &
    758                                 me%win_server_client, ierr )
    759              CALL MPI_WIN_UNLOCK( ip-1, me%win_server_client, ierr )
     772             CALL MPI_WIN_LOCK( MPI_LOCK_SHARED , ip-1, 0,                      &
     773                                me%win_parent_child, ierr )
     774             CALL MPI_GET( buf, nr, MPI_REAL, ip-1, target_disp, nr, MPI_REAL,  &
     775                                me%win_parent_child, ierr )
     776             CALL MPI_WIN_UNLOCK( ip-1, me%win_parent_child, ierr )
    760777          ENDIF
    761778
    … …  
    775792
    776793             DO  ij = 1, ape%nrele
    777                 data_3d(:,ape%locind(ij)%j,ape%locind(ij)%i) =                 &
     794                data_3d(:,ape%locind(ij)%j,ape%locind(ij)%i) =                  &
    778795                                              buf(myindex:myindex+ar%a_dim(1)-1)
    779796                myindex = myindex+ar%a_dim(1)
    … …  
    804821    INTEGER                        ::  myindex      !<
    805822    INTEGER                        ::  nr           !< number of elements to get
    806                                                     !< from server
     823                                                    !< from parent
    807824    INTEGER(KIND=MPI_ADDRESS_KIND) ::  target_disp  !<
    808825
    … …  
    854871
    855872             DO  ij = 1, ape%nrele
    856                 buf(myindex:myindex+ar%a_dim(1)-1) =                           &
     873                buf(myindex:myindex+ar%a_dim(1)-1) =                            &
    857874                                    data_3d(:,ape%locind(ij)%j,ape%locind(ij)%i)
    858875                myindex = myindex + ar%a_dim(1)
    … …  
    864881
    865882    ENDDO
     883
    866884!
    867885!-- TODO: Fence might do it, test later
    868 !-- Call MPI_WIN_FENCE( 0, me%win_server_client, ierr)      !
     886!-- Call MPI_WIN_FENCE( 0, me%win_parent_child, ierr)      !
    869887!
    870888!-- Buffer is filled
    … …  
    875893
    876894#endif
    877  END MODULE pmc_client
     895 END MODULE pmc_child

  • palm/trunk/SOURCE/pmc_general_mod.f90

    r1901 r1933  
    11 MODULE pmc_general
    22
    3 !--------------------------------------------------------------------------------!
     3!-------------------------------------------------------------------------------!
    44! This file is part of PALM.
    55!
    … …  
    1616!
    1717! Copyright 1997-2016 Leibniz Universitaet Hannover
    18 !--------------------------------------------------------------------------------!
     18!-------------------------------------------------------------------------------!
    1919!
    2020! Current revisions:
    2121! ------------------
    22 !
    23 !
     22! 
     23! 
    2424! Former revisions:
    2525! -----------------
    2626! $Id$
    2727!
     28! 1901 2016-05-04 15:39:38Z raasch
     29! Code clean up. The words server/client changed to parent/child.
     30!
    2831! 1900 2016-05-04 15:27:53Z raasch
    2932! re-formatted to match PALM style, file renamed again
    … …  
    3336!
    3437! 1786 2016-03-08 05:49:27Z raasch
    35 ! change in client-server data transfer: server now gets data from client
    36 ! instead that client put's it to the server
     38! change in child-parent data transfer: parent now gets data from child
     39! instead of that child puts it to the parent
    3740!
    3841! 1779 2016-03-03 08:01:28Z raasch
    … …  
    9093       INTEGER                   :: nrdims       !< number of dimensions
    9194       INTEGER, DIMENSION(4)     :: a_dim        !< size of dimensions
    92        TYPE(C_PTR)               :: data         !< pointer of data in server space
     95       TYPE(C_PTR)               :: data         !< pointer of data in parent space
    9396       TYPE(C_PTR), DIMENSION(2) :: po_data      !< base pointers,
    9497                                                 !< pmc_s_set_active_data_array
    … …  
    113116    END TYPE pedef
    114117
    115     TYPE, PUBLIC ::  clientdef
     118    TYPE, PUBLIC ::  childdef
    116119       INTEGER(idp) ::  totalbuffersize    !<
    117120       INTEGER      ::  model_comm         !< communicator of this model
    118        INTEGER      ::  inter_comm         !< inter communicator model and client
    119        INTEGER      ::  intra_comm         !< intra communicator model and client
     121       INTEGER      ::  inter_comm         !< inter communicator model and child
     122       INTEGER      ::  intra_comm         !< intra communicator model and child
    120123       INTEGER      ::  model_rank         !< rank of this model
    121124       INTEGER      ::  model_npes         !< number of PEs this model
    122        INTEGER      ::  inter_npes         !< number of PEs client model
     125       INTEGER      ::  inter_npes         !< number of PEs child model
    123126       INTEGER      ::  intra_rank         !< rank within intra_comm
    124        INTEGER      ::  win_server_client  !< MPI RMA for preparing data on server AND client side
    125        TYPE(pedef), DIMENSION(:), POINTER ::  pes  !< list of all client PEs
    126     END TYPE clientdef
     127       INTEGER      ::  win_parent_child   !< MPI RMA for preparing data on parent AND child side
     128       TYPE(pedef), DIMENSION(:), POINTER ::  pes  !< list of all child PEs
     129    END TYPE childdef
    127130
    128131    TYPE, PUBLIC ::  da_namedef  !< data array name definition
    129132       INTEGER                   ::  couple_index  !< unique number of array
    130        CHARACTER(LEN=da_desclen) ::  serverdesc    !< server array description
    131        CHARACTER(LEN=da_namelen) ::  nameonserver  !< name of array within server
    132        CHARACTER(LEN=da_desclen) ::  clientdesc    !< client array description
    133        CHARACTER(LEN=da_namelen) ::  nameonclient  !< name of array within client
     133       CHARACTER(LEN=da_desclen) ::  parentdesc    !< parent array description
     134       CHARACTER(LEN=da_namelen) ::  nameonparent  !< name of array within parent
     135       CHARACTER(LEN=da_desclen) ::  childdesc     !< child array description
     136       CHARACTER(LEN=da_namelen) ::  nameonchild   !< name of array within child
    134137    END TYPE da_namedef
    135138
    … …  
    146149 CONTAINS
    147150
    148  SUBROUTINE pmc_g_setname( myclient, couple_index, aname )
     151 SUBROUTINE pmc_g_setname( mychild, couple_index, aname )
    149152
    150153    IMPLICIT NONE
    … …  
    152155    CHARACTER(LEN=*)               ::  aname         !<
    153156    INTEGER, INTENT(IN)            ::  couple_index  !<
    154     TYPE(clientdef), INTENT(INOUT) ::  myclient      !<
     157    TYPE(childdef), INTENT(INOUT)  ::  mychild       !<
    155158
    156159    INTEGER ::  i  !<
    … …  
    162165!-- Assign array to next free index in array list.
    163166!-- Set name of array in arraydef structure
    164     DO  i = 1, myclient%inter_npes
    165 
    166        ape => myclient%pes(i)
     167    DO  i = 1, mychild%inter_npes
     168
     169       ape => mychild%pes(i)
    167170       ape%nr_arrays = ape%nr_arrays + 1
    168171       ape%array_list(ape%nr_arrays)%name        = aname

  • palm/trunk/SOURCE/pmc_handle_communicator_mod.f90

    r1925 r1933  
    11 MODULE PMC_handle_communicator
    22
    3 !--------------------------------------------------------------------------------!
     3!-------------------------------------------------------------------------------!
    44! This file is part of PALM.
    55!
    … …  
    1616!
    1717! Copyright 1997-2016 Leibniz Universitaet Hannover
    18 !--------------------------------------------------------------------------------!
     18!-------------------------------------------------------------------------------!
    1919!
    2020! Current revisions:
    2121! ------------------
    2222!
    23 !
     23! 
    2424! Former revisions:
    2525! -----------------
    2626! $Id$
     27!
     28! 1901 2016-05-04 15:39:38Z raasch
     29! Initial version of purely vertical nesting introduced.
     30! Code clean up. The words server/client changed to parent/child.
    2731!
    2832! 1900 2016-05-04 15:27:53Z raasch
    … …  
    7074! ------------
    7175! Handle MPI communicator in PALM model coupler
    72 !------------------------------------------------------------------------------!
     76!-------------------------------------------------------------------------------!
    7377
    7478#if defined( __parallel )
    … …  
    8185#endif
    8286
    83     USE pmc_general,                                                           &
     87    USE pmc_general,                                                            &
    8488        ONLY: pmc_status_ok, pmc_status_error, pmc_max_models
     89    USE control_parameters,                                                     &
     90        ONLY: message_string
    8591
    8692    IMPLICIT NONE
    … …  
    113119
    114120    INTEGER, PUBLIC ::  m_model_comm          !< communicator of this model
    115     INTEGER, PUBLIC ::  m_to_server_comm      !< communicator to the server
     121    INTEGER, PUBLIC ::  m_to_parent_comm      !< communicator to the parent
    116122    INTEGER, PUBLIC ::  m_world_rank          !<
    117123    INTEGER         ::  m_world_npes          !<
    118124    INTEGER, PUBLIC ::  m_model_rank          !<
    119125    INTEGER, PUBLIC ::  m_model_npes          !<
    120     INTEGER         ::  m_server_remote_size  !< number of server PEs
    121 
    122     INTEGER, DIMENSION(pmc_max_models), PUBLIC ::  m_to_client_comm   !< communicator to the client(s)
    123     INTEGER, DIMENSION(:), POINTER, PUBLIC ::  pmc_server_for_client  !<
     126    INTEGER         ::  m_parent_remote_size  !< number of parent PEs
     127
     128    INTEGER, DIMENSION(pmc_max_models), PUBLIC ::  m_to_child_comm    !< communicator to the child(ren)
     129    INTEGER, DIMENSION(:), POINTER, PUBLIC ::  pmc_parent_for_child   !<
    124130
    125131
    … …  
    136142 CONTAINS
    137143
    138  SUBROUTINE pmc_init_model( comm, nesting_datatransfer_mode, nesting_mode,     &
     144 SUBROUTINE pmc_init_model( comm, nesting_datatransfer_mode, nesting_mode,      &
    139145                              pmc_status )
    140146
    141     USE control_parameters,                                                    &
     147    USE control_parameters,                                                     &
    142148        ONLY:  message_string
    143149
    144     USE pegrid,                                                                &
     150    USE pegrid,                                                                 &
    145151        ONLY:  myid
    146152
    147153      IMPLICIT NONE
    148154
    149     CHARACTER(LEN=7), INTENT(OUT) ::  nesting_mode               !<
     155    CHARACTER(LEN=8), INTENT(OUT) ::  nesting_mode               !<
    150156    CHARACTER(LEN=7), INTENT(OUT) ::  nesting_datatransfer_mode  !<
    151157
    … …  
    153159    INTEGER, INTENT(OUT) ::  pmc_status  !<
    154160
    155     INTEGER ::  clientcount    !<
     161    INTEGER ::  childcount     !<
    156162    INTEGER ::  i              !<
    157163    INTEGER ::  ierr           !<
    … …  
    160166    INTEGER ::  tag            !<
    161167
    162     INTEGER, DIMENSION(pmc_max_models)   ::  activeserver  ! I am active server for this client ID
     168    INTEGER, DIMENSION(pmc_max_models)   ::  activeparent  ! I am active parent for this child ID
    163169    INTEGER, DIMENSION(pmc_max_models+1) ::  start_pe
    164170
    … …  
    167173    m_world_comm = MPI_COMM_WORLD
    168174    m_my_cpl_id  = -1
    169     clientcount  =  0
    170     activeserver = -1
     175    childcount   =  0
     176    activeparent = -1
    171177    start_pe(:)  =  0
    172178
    … …  
    177183    IF ( m_world_rank == 0 )  THEN
    178184
    179        CALL read_coupling_layout( nesting_datatransfer_mode, nesting_mode,     &
     185       CALL read_coupling_layout( nesting_datatransfer_mode, nesting_mode,      &
    180186                                  pmc_status )
    181187
    182        IF ( pmc_status /= pmc_no_namelist_found  .AND.                         &
    183             pmc_status /= pmc_namelist_error )                                 &
     188       IF ( pmc_status /= pmc_no_namelist_found  .AND.                          &
     189            pmc_status /= pmc_namelist_error )                                  &
    184190       THEN
    185191!
    … …  
    194200!--       total sum of cores required by all nest domains
    195201          IF ( start_pe(m_ncpl+1) /= m_world_npes )  THEN
    196              WRITE ( message_string, '(A,I6,A,I6,A)' )                         &
    197                              'nesting-setup requires more MPI procs (',        &
    198                              start_pe(m_ncpl+1), ') than provided (',          &
    199                              m_world_npes,')'
     202             WRITE ( message_string, '(A,I6,A,I6,A)' )                          &
     203                             'nesting-setup requires different number of ',     &
     204                             'MPI procs (', start_pe(m_ncpl+1), ') than ',      &
     205                             'provided (', m_world_npes,')'
    200206             CALL message( 'pmc_init_model', 'PA0229', 3, 2, 0, 6, 0 )
    201207          ENDIF
    … …  
    234240!-- Broadcast coupling layout
    235241    DO  i = 1, m_ncpl
    236        CALL MPI_BCAST( m_couplers(i)%name, LEN( m_couplers(i)%name ),          &
     242       CALL MPI_BCAST( m_couplers(i)%name, LEN( m_couplers(i)%name ),           &
    237243                       MPI_CHARACTER, 0, MPI_COMM_WORLD, istat )
    238        CALL MPI_BCAST( m_couplers(i)%id,           1, MPI_INTEGER, 0,          &
    239                        MPI_COMM_WORLD, istat )
    240        CALL MPI_BCAST( m_couplers(i)%Parent_id,    1, MPI_INTEGER, 0,          &
    241                        MPI_COMM_WORLD, istat )
    242        CALL MPI_BCAST( m_couplers(i)%npe_total,    1, MPI_INTEGER, 0,          &
    243                        MPI_COMM_WORLD, istat )
    244        CALL MPI_BCAST( m_couplers(i)%lower_left_x, 1, MPI_REAL,    0,          &
    245                        MPI_COMM_WORLD, istat )
    246        CALL MPI_BCAST( m_couplers(i)%lower_left_y, 1, MPI_REAL,    0,          &
     244       CALL MPI_BCAST( m_couplers(i)%id,           1, MPI_INTEGER, 0,           &
     245                       MPI_COMM_WORLD, istat )
     246       CALL MPI_BCAST( m_couplers(i)%Parent_id,    1, MPI_INTEGER, 0,           &
     247                       MPI_COMM_WORLD, istat )
     248       CALL MPI_BCAST( m_couplers(i)%npe_total,    1, MPI_INTEGER, 0,           &
     249                       MPI_COMM_WORLD, istat )
     250       CALL MPI_BCAST( m_couplers(i)%lower_left_x, 1, MPI_REAL,    0,           &
     251                       MPI_COMM_WORLD, istat )
     252       CALL MPI_BCAST( m_couplers(i)%lower_left_y, 1, MPI_REAL,    0,           &
    247253                       MPI_COMM_WORLD, istat )
    248254    ENDDO
    249     CALL MPI_BCAST( nesting_mode, LEN( nesting_mode ), MPI_CHARACTER, 0,       &
     255    CALL MPI_BCAST( nesting_mode, LEN( nesting_mode ), MPI_CHARACTER, 0,        &
    250256                    MPI_COMM_WORLD, istat )
    251     CALL MPI_BCAST( nesting_datatransfer_mode, LEN(nesting_datatransfer_mode), &
     257    CALL MPI_BCAST( nesting_datatransfer_mode, LEN(nesting_datatransfer_mode),  &
    252258                    MPI_CHARACTER, 0, MPI_COMM_WORLD, istat )
    253259
    … …  
    255261!-- Assign global MPI processes to individual models by setting the couple id
    256262    DO  i = 1, m_ncpl
    257        IF ( m_world_rank >= start_pe(i)  .AND.  m_world_rank < start_pe(i+1) ) &
     263       IF ( m_world_rank >= start_pe(i)  .AND.  m_world_rank < start_pe(i+1) )  &
    258264       THEN
    259265          m_my_cpl_id = i
    … …  
    267273!-- The communictors for the individual models as created by MPI_COMM_SPLIT.
    268274!-- The color of the model is represented by the coupler id
    269     CALL MPI_COMM_SPLIT( MPI_COMM_WORLD, m_my_cpl_id, m_my_cpl_rank, comm,     &
     275    CALL MPI_COMM_SPLIT( MPI_COMM_WORLD, m_my_cpl_id, m_my_cpl_rank, comm,      &
    270276                         istat )
    271277!
    … …  
    277283!-- Broadcast (from PE 0) the parent id and id of every model
    278284    DO  i = 1, m_ncpl
    279        CALL MPI_BCAST( m_couplers(i)%parent_id, 1, MPI_INTEGER, 0,             &
    280                        MPI_COMM_WORLD, istat )
    281        CALL MPI_BCAST( m_couplers(i)%id,        1, MPI_INTEGER, 0,             &
     285       CALL MPI_BCAST( m_couplers(i)%parent_id, 1, MPI_INTEGER, 0,              &
     286                       MPI_COMM_WORLD, istat )
     287       CALL MPI_BCAST( m_couplers(i)%id,        1, MPI_INTEGER, 0,              &
    282288                       MPI_COMM_WORLD, istat )
    283289    ENDDO
    … …  
    288294
    289295!
    290 !-- Create intercommunicator between server and clients.
     296!-- Create intercommunicator between parent and children.
    291297!-- MPI_INTERCOMM_CREATE creates an intercommunicator between 2 groups of
    292298!-- different colors.
    … …  
    296302       IF ( m_couplers(i)%parent_id == m_my_cpl_id )  THEN
    297303!
    298 !--       Collect server PEs.
     304!--       Collect parent PEs.
    299305!--       Every model exept the root model has a parent model which acts as
    300 !--       server model. Create an intercommunicator to connect current PE to
    301 !--       all client PEs
     306!--       parent model. Create an intercommunicator to connect current PE to
     307!--       all children PEs
    302308          tag = 500 + i
    303           CALL MPI_INTERCOMM_CREATE( comm, 0, MPI_COMM_WORLD, start_pe(i),     &
    304                                      tag, m_to_client_comm(i), istat)
    305           clientcount = clientcount + 1
    306           activeserver(i) = 1
     309          CALL MPI_INTERCOMM_CREATE( comm, 0, MPI_COMM_WORLD, start_pe(i),      &
     310                                     tag, m_to_child_comm(i), istat)
     311          childcount = childcount + 1
     312          activeparent(i) = 1
    307313
    308314       ELSEIF ( i == m_my_cpl_id)  THEN
    309315!
    310 !--       Collect client PEs.
    311 !--       Every model exept the root model has a paremt model which acts as
    312 !--       server model. Create an intercommunicator to connect current PE to
    313 !--       all server PEs
     316!--       Collect children PEs.
     317!--       Every model except the root model has a parent model.
     318!--       Create an intercommunicator to connect current PE to all parent PEs
    314319          tag = 500 + i
    315           CALL MPI_INTERCOMM_CREATE( comm, 0, MPI_COMM_WORLD,                  &
    316                                      start_pe(m_couplers(i)%parent_id),        &
    317                                      tag, m_to_server_comm, istat )
     320          CALL MPI_INTERCOMM_CREATE( comm, 0, MPI_COMM_WORLD,                   &
     321                                     start_pe(m_couplers(i)%parent_id),         &
     322                                     tag, m_to_parent_comm, istat )
    318323       ENDIF
    319324
    … …  
    321326
    322327!
    323 !-- If I am server, count the number of clients that I have
    324 !-- Although this loop is symmetric on all processes, the "activeserver" flag
     328!-- If I am parent, count the number of children that I have
     329!-- Although this loop is symmetric on all processes, the "activeparent" flag
    325330!-- is true (==1) on the respective individual PE only.
    326     ALLOCATE( pmc_server_for_client(clientcount+1) )
    327 
    328     clientcount = 0
     331    ALLOCATE( pmc_parent_for_child(childcount+1) )
     332
     333    childcount = 0
    329334    DO  i = 2, m_ncpl
    330        IF ( activeserver(i) == 1 )  THEN
    331           clientcount = clientcount + 1
    332           pmc_server_for_client(clientcount) = i
     335       IF ( activeparent(i) == 1 )  THEN
     336          childcount = childcount + 1
     337          pmc_parent_for_child(childcount) = i
    333338       ENDIF
    334339    ENDDO
    335340!
    336 !-- Get the size of the server model
     341!-- Get the size of the parent model
    337342    IF ( m_my_cpl_id > 1 )  THEN
    338        CALL MPI_COMM_REMOTE_SIZE( m_to_server_comm, m_server_remote_size,      &
     343       CALL MPI_COMM_REMOTE_SIZE( m_to_parent_comm, m_parent_remote_size,       &
    339344                                  istat)
    340345    ELSE
    341346!
    342 !--    The root model does not have a server
    343        m_server_remote_size = -1
     347!--    The root model does not have a parent
     348       m_parent_remote_size = -1
    344349    ENDIF
    345350!
    … …  
    356361
    357362
    358  SUBROUTINE pmc_get_model_info( comm_world_nesting, cpl_id, cpl_name,          &
    359                                 cpl_parent_id, lower_left_x, lower_left_y,     &
     363 SUBROUTINE pmc_get_model_info( comm_world_nesting, cpl_id, cpl_name,           &
     364                                cpl_parent_id, lower_left_x, lower_left_y,      &
    360365                                ncpl, npe_total, request_for_cpl_id )
    361366!
    … …  
    366371    IMPLICIT NONE
    367372
    368     CHARACTER(LEN=*), INTENT(OUT), OPTIONAL ::  cpl_name  !<
    369 
    370     INTEGER, INTENT(IN), OPTIONAL ::  request_for_cpl_id  !<
     373    CHARACTER(LEN=*), INTENT(OUT), OPTIONAL ::  cpl_name   !<
     374
     375    INTEGER, INTENT(IN), OPTIONAL ::  request_for_cpl_id   !<
    371376
    372377    INTEGER, INTENT(OUT), OPTIONAL ::  comm_world_nesting  !<
    … …  
    433438
    434439
    435  SUBROUTINE read_coupling_layout( nesting_datatransfer_mode, nesting_mode,     &
     440 SUBROUTINE read_coupling_layout( nesting_datatransfer_mode, nesting_mode,      &
    436441                                  pmc_status )
    437442
    438443    IMPLICIT NONE
    439444
    440     CHARACTER(LEN=7), INTENT(INOUT) ::  nesting_mode
     445    CHARACTER(LEN=8), INTENT(INOUT) ::  nesting_mode
    441446    CHARACTER(LEN=7), INTENT(INOUT) ::  nesting_datatransfer_mode
    442447
    443     INTEGER, INTENT(INOUT) ::  pmc_status
    444     INTEGER                ::  i, istat
     448    INTEGER(iwp), INTENT(INOUT) ::  pmc_status
     449    INTEGER(iwp)                ::  bad_llcorner
     450    INTEGER(iwp)                ::  i
     451    INTEGER(iwp)                ::  istat
    445452
    446453    TYPE(pmc_layout), DIMENSION(pmc_max_models) ::  domain_layouts
    … …  
    461468
    462469    IF ( istat < 0 )  THEN
     470
    463471!
    464472!--    No nestpar-NAMELIST found
    465473       pmc_status = pmc_no_namelist_found
     474
    466475!
    467476!--    Set filepointer to the beginning of the file. Otherwise PE0 will later
    … …  
    471480
    472481    ELSEIF ( istat > 0 )  THEN
     482
    473483!
    474484!--    Errors in reading nestpar-NAMELIST
    … …  
    481491!-- Output location message
    482492    CALL location_message( 'initialize communicators for nesting', .FALSE. )
     493
    483494!
    484495!-- Assign the layout to the internally used variable
    … …  
    490501!
    491502!--    When id=-1 is found for the first time, the list of domains is finished
    492        IF ( m_couplers(i)%id == -1  .OR.  i == pmc_max_models )  THEN
     503        IF ( m_couplers(i)%id == -1  .OR.  i == pmc_max_models )  THEN
    493504          IF ( m_couplers(i)%id == -1 )  THEN
    494505             m_ncpl = i - 1
    … …  
    501512    ENDDO
    502513
     514!
     515!-- Make sure that all domains have equal lower left corner in case of vertical
     516!-- nesting
     517    IF ( nesting_mode == 'vertical' )  THEN
     518       bad_llcorner = 0
     519       DO  i = 1, m_ncpl
     520          IF ( domain_layouts(i)%lower_left_x /= 0.0_wp .OR.                    &
     521               domain_layouts(i)%lower_left_y /= 0.0_wp )  THEN
     522             bad_llcorner = bad_llcorner + 1
     523             domain_layouts(i)%lower_left_x = 0.0_wp
     524             domain_layouts(i)%lower_left_y = 0.0_wp
     525          ENDIF
     526       ENDDO
     527       IF ( bad_llcorner /= 0)  THEN
     528          WRITE ( message_string, *)  'Lower left corners do not match,',       &
     529                                      'they were set to (0, 0)'
     530          CALL message( 'read_coupling_layout', 'PA0427', 0, 0, 0, 6, 0 )
     531       ENDIF
     532    ENDIF
     533
    503534 END SUBROUTINE read_coupling_layout
    504535

  • palm/trunk/SOURCE/pmc_interface_mod.f90

    r1928 r1933  
    11MODULE pmc_interface
    22
    3 !------------------------------------------------------------------------------!
     3!-------------------------------------------------------------------------------!
    44! This file is part of PALM.
    55!
    … …  
    1616!
    1717! Copyright 1997-2016 Leibniz Universitaet Hannover
    18 !------------------------------------------------------------------------------!
     18!-------------------------------------------------------------------------------!
    1919!
    2020! Current revisions:
    … …  
    2626! $Id$
    2727!
    28 ! 1927 2016-06-07 11:56:53Z hellstea
    29 ! Error check for overlapping parallel nests added
     28! 1901 2016-05-04 15:39:38Z raasch
     29! Initial version of purely vertical nesting introduced.
     30! Code clean up. The words server/client changed to parent/child.
    3031!
    3132! 1900 2016-05-04 15:27:53Z raasch
    … …  
    6263! introduction of different datatransfer modes,
    6364! further formatting cleanup, parameter checks added (including mismatches
    64 ! between root and client model settings),
     65! between root and nest model settings),
    6566! +routine pmci_check_setting_mismatches
    6667! comm_world_nesting introduced
    … …  
    106107! Domain nesting interface routines. The low-level inter-domain communication   
    107108! is conducted by the PMC-library routines.
    108 !------------------------------------------------------------------------------!
     109!-------------------------------------------------------------------------------!
    109110
    110111#if defined( __nopointer )
    111     USE arrays_3d,                                                             &
    112         ONLY:  dzu, dzw, e, e_p, pt, pt_p, q, q_p, u, u_p, v, v_p, w, w_p, zu, &
     112    USE arrays_3d,                                                              &
     113        ONLY:  dzu, dzw, e, e_p, pt, pt_p, q, q_p, u, u_p, v, v_p, w, w_p, zu,  &
    113114               zw, z0
    114115#else
    115    USE arrays_3d,                                                              &
    116         ONLY:  dzu, dzw, e, e_p, e_1, e_2, pt, pt_p, pt_1, pt_2, q, q_p, q_1,  &
    117                q_2, u, u_p, u_1, u_2, v, v_p, v_1, v_2, w, w_p, w_1, w_2, zu,  &
     116   USE arrays_3d,                                                               &
     117        ONLY:  dzu, dzw, e, e_p, e_1, e_2, pt, pt_p, pt_1, pt_2, q, q_p, q_1,   &
     118               q_2, u, u_p, u_1, u_2, v, v_p, v_1, v_2, w, w_p, w_1, w_2, zu,   &
    118119               zw, z0
    119120#endif
    120121
    121     USE control_parameters,                                                    &
    122         ONLY:  coupling_char, dt_3d, dz, humidity, message_string,             &
    123                nest_bound_l, nest_bound_r, nest_bound_s, nest_bound_n,         &
    124                nest_domain, neutral, passive_scalar, simulated_time,           &
     122    USE control_parameters,                                                     &
     123        ONLY:  coupling_char, dt_3d, dz, humidity, message_string,              &
     124               nest_bound_l, nest_bound_r, nest_bound_s, nest_bound_n,          &
     125               nest_domain, neutral, passive_scalar, simulated_time,            &
    125126               topography, volume_flow
    126127
    127     USE cpulog,                                                                &
     128    USE cpulog,                                                                 &
    128129        ONLY:  cpu_log, log_point_s
    129130
    130     USE grid_variables,                                                        &
     131    USE grid_variables,                                                         &
    131132        ONLY:  dx, dy
    132133
    133     USE indices,                                                               &
    134         ONLY:  nbgp, nx, nxl, nxlg, nxlu, nxr, nxrg, ny, nyn, nyng, nys, nysg, &
    135                nysv, nz, nzb, nzb_s_inner, nzb_u_inner, nzb_u_outer,           &
     134    USE indices,                                                                &
     135        ONLY:  nbgp, nx, nxl, nxlg, nxlu, nxr, nxrg, ny, nyn, nyng, nys, nysg,  &
     136               nysv, nz, nzb, nzb_s_inner, nzb_u_inner, nzb_u_outer,            &
    136137               nzb_v_inner, nzb_v_outer, nzb_w_inner, nzb_w_outer, nzt
    137138
    … …  
    145146#endif
    146147
    147     USE pegrid,                                                                &
    148         ONLY:  collective_wait, comm1dx, comm1dy, comm2d, myid, myidx, myidy,  &
     148    USE pegrid,                                                                 &
     149        ONLY:  collective_wait, comm1dx, comm1dy, comm2d, myid, myidx, myidy,   &
    149150               numprocs
    150151
    151     USE pmc_client,                                                            &
    152         ONLY:  pmc_clientinit, pmc_c_clear_next_array_list,                    &
    153                pmc_c_getnextarray, pmc_c_get_2d_index_list, pmc_c_getbuffer,   &
    154                pmc_c_putbuffer, pmc_c_setind_and_allocmem,                     &
     152    USE pmc_child,                                                              &
     153        ONLY:  pmc_childinit, pmc_c_clear_next_array_list,                      &
     154               pmc_c_getnextarray, pmc_c_get_2d_index_list, pmc_c_getbuffer,    &
     155               pmc_c_putbuffer, pmc_c_setind_and_allocmem,                      &
    155156               pmc_c_set_dataarray, pmc_set_dataarray_name
    156157
    157     USE pmc_general,                                                           &
     158    USE pmc_general,                                                            &
    158159        ONLY:  da_namelen
    159160
    160     USE pmc_handle_communicator,                                               &
    161         ONLY:  pmc_get_model_info, pmc_init_model, pmc_is_rootmodel,           &
    162                pmc_no_namelist_found, pmc_server_for_client
    163 
    164     USE pmc_mpi_wrapper,                                                       &
    165         ONLY:  pmc_bcast, pmc_recv_from_client, pmc_recv_from_server,          &
    166                pmc_send_to_client, pmc_send_to_server
    167 
    168     USE pmc_server,                                                            &
    169         ONLY:  pmc_serverinit, pmc_s_clear_next_array_list, pmc_s_fillbuffer,  &
    170                pmc_s_getdata_from_buffer, pmc_s_getnextarray,                  &
    171                pmc_s_setind_and_allocmem, pmc_s_set_active_data_array,         &
     161    USE pmc_handle_communicator,                                                &
     162        ONLY:  pmc_get_model_info, pmc_init_model, pmc_is_rootmodel,            &
     163               pmc_no_namelist_found, pmc_parent_for_child
     164
     165    USE pmc_mpi_wrapper,                                                        &
     166        ONLY:  pmc_bcast, pmc_recv_from_child, pmc_recv_from_parent,            &
     167               pmc_send_to_child, pmc_send_to_parent
     168
     169    USE pmc_parent,                                                             &
     170        ONLY:  pmc_parentinit, pmc_s_clear_next_array_list, pmc_s_fillbuffer,   &
     171               pmc_s_getdata_from_buffer, pmc_s_getnextarray,                   &
     172               pmc_s_setind_and_allocmem, pmc_s_set_active_data_array,          &
    172173               pmc_s_set_dataarray, pmc_s_set_2d_index_list
    173174
    … …  
    180181!
    181182!-- Constants
    182     INTEGER(iwp), PARAMETER ::  client_to_server = 2   !:
    183     INTEGER(iwp), PARAMETER ::  server_to_client = 1   !:
     183    INTEGER(iwp), PARAMETER ::  child_to_parent = 2   !:
     184    INTEGER(iwp), PARAMETER ::  parent_to_child = 1   !:
    184185
    185186!
    … …  
    196197                                                         !: parameter for data-
    197198                                                         !: transfer mode
    198     CHARACTER(LEN=7), SAVE ::  nesting_mode = 'two-way'  !: steering parameter
     199    CHARACTER(LEN=8), SAVE ::  nesting_mode = 'two-way'  !: steering parameter
    199200                                                         !: for 1- or 2-way nesting
    200201
    … …  
    216217
    217218!
    218 !-- Client coarse data arrays
     219!-- Child coarse data arrays
    219220    INTEGER(iwp), DIMENSION(5)                  ::  coarse_bound   !:
    220221
    … …  
    237238
    238239!
    239 !-- Client interpolation coefficients and client-array indices to be precomputed
    240 !-- and stored.
     240!-- Child interpolation coefficients and child-array indices to be
     241!-- precomputed and stored.
    241242    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  ico    !:
    242243    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  icu    !:
    … …  
    259260
    260261!
    261 !-- Client index arrays and log-ratio arrays for the log-law near-wall
     262!-- Child index arrays and log-ratio arrays for the log-law near-wall
    262263!-- corrections. These are not truly 3-D arrays but multiple 2-D arrays.
    263264    INTEGER(iwp), SAVE :: ncorr  !: 4th dimension of the log_ratio-arrays
    … …  
    313314
    314315!
    315 !-- Client-array indices to be precomputed and stored for anterpolation.
     316!-- Child-array indices to be precomputed and stored for anterpolation.
    316317    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  iflu   !:
    317318    INTEGER(iwp), SAVE, ALLOCATABLE, DIMENSION(:) ::  ifuu   !:
    … …  
    363364    END INTERFACE
    364365
    365     INTERFACE pmci_client_initialize
    366        MODULE PROCEDURE pmci_client_initialize
     366    INTERFACE pmci_child_initialize
     367       MODULE PROCEDURE pmci_child_initialize
    367368    END INTERFACE
    368369
    … …  
    387388    END INTERFACE
    388389
    389     INTERFACE pmci_server_initialize
    390        MODULE PROCEDURE pmci_server_initialize
     390    INTERFACE pmci_parent_initialize
     391       MODULE PROCEDURE pmci_parent_initialize
    391392    END INTERFACE
    392393
    … …  
    395396    END INTERFACE pmci_set_swaplevel
    396397
    397     PUBLIC anterp_relax_length_l, anterp_relax_length_r,                       &
    398            anterp_relax_length_s, anterp_relax_length_n,                       &
    399            anterp_relax_length_t, client_to_server, comm_world_nesting,        &
    400            cpl_id, nested_run, nesting_datatransfer_mode, nesting_mode,        &
    401            server_to_client
    402     PUBLIC pmci_client_initialize
     398    PUBLIC anterp_relax_length_l, anterp_relax_length_r,                        &
     399           anterp_relax_length_s, anterp_relax_length_n,                        &
     400           anterp_relax_length_t, child_to_parent, comm_world_nesting,          &
     401           cpl_id, nested_run, nesting_datatransfer_mode, nesting_mode,         &
     402           parent_to_child
     403    PUBLIC pmci_child_initialize
    403404    PUBLIC pmci_datatrans
    404405    PUBLIC pmci_ensure_nest_mass_conservation
    405406    PUBLIC pmci_init
    406407    PUBLIC pmci_modelconfiguration
    407     PUBLIC pmci_server_initialize
     408    PUBLIC pmci_parent_initialize
    408409    PUBLIC pmci_synchronize
    409410    PUBLIC pmci_set_swaplevel
    … …  
    415416 SUBROUTINE pmci_init( world_comm )
    416417
    417     USE control_parameters,                                                  &
     418    USE control_parameters,                                                     &
    418419        ONLY:  message_string
    419420
    … …  
    429430
    430431
    431     CALL pmc_init_model( world_comm, nesting_datatransfer_mode, nesting_mode,  &
     432    CALL pmc_init_model( world_comm, nesting_datatransfer_mode, nesting_mode,   &
    432433                         pmc_status )
    433434
    … …  
    445446!
    446447!-- Check steering parameter values
    447     IF ( TRIM( nesting_mode ) /= 'one-way'  .AND.                              &
    448          TRIM( nesting_mode ) /= 'two-way' )                                   &
     448    IF ( TRIM( nesting_mode ) /= 'one-way'  .AND.                               &
     449         TRIM( nesting_mode ) /= 'two-way'  .AND.                               &
     450         TRIM( nesting_mode ) /= 'vertical' )                                   &                 
    449451    THEN
    450452       message_string = 'illegal nesting mode: ' // TRIM( nesting_mode )
    … …  
    452454    ENDIF
    453455
    454     IF ( TRIM( nesting_datatransfer_mode ) /= 'cascade'  .AND.                 &
    455          TRIM( nesting_datatransfer_mode ) /= 'mixed'    .AND.                 &
    456          TRIM( nesting_datatransfer_mode ) /= 'overlap' )                      &
     456    IF ( TRIM( nesting_datatransfer_mode ) /= 'cascade'  .AND.                  &
     457         TRIM( nesting_datatransfer_mode ) /= 'mixed'    .AND.                  &
     458         TRIM( nesting_datatransfer_mode ) /= 'overlap' )                       &
    457459    THEN
    458        message_string = 'illegal nesting datatransfer mode: '                  &
     460       message_string = 'illegal nesting datatransfer mode: '                   &
    459461                        // TRIM( nesting_datatransfer_mode )
    460462       CALL message( 'pmci_init', 'PA0418', 3, 2, 0, 6, 0 )
    … …  
    468470!-- Get some variables required by the pmc-interface (and in some cases in the
    469471!-- PALM code out of the pmci) out of the pmc-core
    470     CALL pmc_get_model_info( comm_world_nesting = comm_world_nesting,          &
    471                              cpl_id = cpl_id, cpl_parent_id = cpl_parent_id,   &
    472                              cpl_name = cpl_name, npe_total = cpl_npe_total,   &
    473                              lower_left_x = lower_left_coord_x,                &
     472    CALL pmc_get_model_info( comm_world_nesting = comm_world_nesting,           &
     473                             cpl_id = cpl_id, cpl_parent_id = cpl_parent_id,    &
     474                             cpl_name = cpl_name, npe_total = cpl_npe_total,    &
     475                             lower_left_x = lower_left_coord_x,                 &
    474476                             lower_left_y = lower_left_coord_y )
    475477!
    … …  
    513515    CALL pmci_setup_coordinates
    514516!
    515 !-- Initialize the client (must be called before pmc_setup_server)
    516     CALL pmci_setup_client
    517 !
    518 !-- Initialize PMC Server
    519     CALL pmci_setup_server
    520 !
    521 !-- Check for mismatches between settings of master and client variables
    522 !-- (e.g., all clients have to follow the end_time settings of the root master)
     517!-- Initialize the child (must be called before pmc_setup_parent)
     518    CALL pmci_setup_child
     519!
     520!-- Initialize PMC parent
     521    CALL pmci_setup_parent
     522!
     523!-- Check for mismatches between settings of master and child variables
     524!-- (e.g., all children have to follow the end_time settings of the root master)
    523525    CALL pmci_check_setting_mismatches
    524526
    … …  
    529531
    530532
    531  SUBROUTINE pmci_setup_server
     533 SUBROUTINE pmci_setup_parent
    532534
    533535#if defined( __parallel )
    … …  
    536538    CHARACTER(LEN=32) ::  myname
    537539
    538     INTEGER(iwp) ::  client_id        !:
     540    INTEGER(iwp) ::  child_id         !:
    539541    INTEGER(iwp) ::  ierr             !:
    540542    INTEGER(iwp) ::  i                !:
    … …  
    558560    REAL(wp) ::  dx_cl            !:
    559561    REAL(wp) ::  dy_cl            !:
     562    REAL(wp) ::  left_limit       !:
     563    REAL(wp) ::  north_limit      !:
     564    REAL(wp) ::  right_limit      !:
     565    REAL(wp) ::  south_limit      !:
    560566    REAL(wp) ::  xez              !:
    561567    REAL(wp) ::  yez              !:
    … …  
    568574
    569575!
    570 !   Initialize the pmc server
    571     CALL pmc_serverinit
     576!   Initialize the pmc parent
     577    CALL pmc_parentinit
    572578
    573579!
    574580!-- Corners of all children of the present parent
    575     IF ( ( SIZE( pmc_server_for_client ) - 1 > 0 ) .AND. myid == 0 )  THEN
    576        ALLOCATE( ch_xl(1:SIZE( pmc_server_for_client ) - 1) )
    577        ALLOCATE( ch_xr(1:SIZE( pmc_server_for_client ) - 1) )
    578        ALLOCATE( ch_ys(1:SIZE( pmc_server_for_client ) - 1) )
    579        ALLOCATE( ch_yn(1:SIZE( pmc_server_for_client ) - 1) )
     581    IF ( ( SIZE( pmc_parent_for_child ) - 1 > 0 ) .AND. myid == 0 )  THEN
     582       ALLOCATE( ch_xl(1:SIZE( pmc_parent_for_child ) - 1) )
     583       ALLOCATE( ch_xr(1:SIZE( pmc_parent_for_child ) - 1) )
     584       ALLOCATE( ch_ys(1:SIZE( pmc_parent_for_child ) - 1) )
     585       ALLOCATE( ch_yn(1:SIZE( pmc_parent_for_child ) - 1) )
    580586    ENDIF
    581587
    582588!
    583589!-- Get coordinates from all children
    584     DO  m = 1, SIZE( pmc_server_for_client ) - 1
    585 
    586        client_id = pmc_server_for_client(m)
     590    DO  m = 1, SIZE( pmc_parent_for_child ) - 1
     591
     592       child_id = pmc_parent_for_child(m)
    587593       IF ( myid == 0 )  THEN       
    588594
    589           CALL pmc_recv_from_client( client_id, val,  size(val),  0, 123, ierr )
    590           CALL pmc_recv_from_client( client_id, fval, size(fval), 0, 124, ierr )
     595          CALL pmc_recv_from_child( child_id, val,  size(val),  0, 123, ierr )
     596          CALL pmc_recv_from_child( child_id, fval, size(fval), 0, 124, ierr )
    591597         
    592598          nx_cl = val(1)
    … …  
    598604
    599605!
    600 !--       Find the highest client level in the coarse grid for the reduced z
     606!--       Find the highest nest level in the coarse grid for the reduced z
    601607!--       transfer
    602608          DO  k = 1, nz                 
    … …  
    612618          ALLOCATE( cl_coord_y(-nbgp:ny_cl+nbgp) )
    613619         
    614           CALL pmc_recv_from_client( client_id, cl_coord_x, SIZE( cl_coord_x ),&
     620          CALL pmc_recv_from_child( child_id, cl_coord_x, SIZE( cl_coord_x ),   &
    615621                                     0, 11, ierr )
    616           CALL pmc_recv_from_client( client_id, cl_coord_y, SIZE( cl_coord_y ),&
     622          CALL pmc_recv_from_child( child_id, cl_coord_y, SIZE( cl_coord_y ),   &
    617623                                     0, 12, ierr )
    618 !          WRITE ( 0, * )  'receive from pmc Client ', client_id, nx_cl, ny_cl
     624!          WRITE ( 0, * )  'receive from pmc child ', child_id, nx_cl, ny_cl
    619625         
    620626          define_coarse_grid_real(1) = lower_left_coord_x
    … …  
    631637
    632638!
    633 !--       Check that the client domain is completely inside the server domain.
     639!--       Check that the child domain matches parent domain.
    634640          nomatch = 0
    635           xez = ( nbgp + 1 ) * dx
    636           yez = ( nbgp + 1 ) * dy
    637           IF ( ( cl_coord_x(0) < define_coarse_grid_real(1) + xez )       .OR. &
    638                ( cl_coord_x(nx_cl+1) > define_coarse_grid_real(5) - xez ) .OR. &
    639                ( cl_coord_y(0) < define_coarse_grid_real(2) + yez )       .OR. &
    640                ( cl_coord_y(ny_cl+1) > define_coarse_grid_real(6) - yez ) )    &
    641           THEN
    642              nomatch = 1
     641          IF ( nesting_mode == 'vertical' )  THEN
     642             right_limit = define_coarse_grid_real(5)
     643             north_limit = define_coarse_grid_real(6)
     644             IF ( ( cl_coord_x(nx_cl+1) /= right_limit ) .OR.                   &
     645                  ( cl_coord_y(ny_cl+1) /= north_limit ) )  THEN
     646                nomatch = 1
     647             ENDIF
     648          ELSE
     649         
     650!
     651!--       Check that the children domain is completely inside the parent domain.
     652             xez = ( nbgp + 1 ) * dx
     653             yez = ( nbgp + 1 ) * dy
     654             left_limit  = lower_left_coord_x + xez
     655             right_limit = define_coarse_grid_real(5) - xez
     656             south_limit = lower_left_coord_y + yez
     657             north_limit = define_coarse_grid_real(6) - yez
     658             IF ( ( cl_coord_x(0) < left_limit )        .OR.                    &
     659                  ( cl_coord_x(nx_cl+1) > right_limit ) .OR.                    &
     660                  ( cl_coord_y(0) < south_limit )       .OR.                    &
     661                  ( cl_coord_y(ny_cl+1) > north_limit ) )  THEN
     662                nomatch = 1
     663             ENDIF
    643664          ENDIF
    644665
    … …  
    646667!--       Check that parallel nest domains, if any, do not overlap.
    647668          nest_overlap = 0
    648           IF ( SIZE( pmc_server_for_client ) - 1 > 0 )  THEN
     669          IF ( SIZE( pmc_parent_for_child ) - 1 > 0 )  THEN
    649670             ch_xl(m) = cl_coord_x(-nbgp)
    650671             ch_xr(m) = cl_coord_x(nx_cl+nbgp)
    … …  
    654675             IF ( m > 1 )  THEN
    655676                DO mm = 1, m-1
    656                    IF ( ( ch_xl(m) < ch_xr(mm) .OR. ch_xr(m) > ch_xl(mm) ) .AND.  &
    657                         ( ch_ys(m) < ch_yn(mm) .OR. ch_yn(m) > ch_ys(mm) ) )  THEN                       
     677                   IF ( ( ch_xl(m) < ch_xr(mm) .OR.                             &
     678                          ch_xr(m) > ch_xl(mm) )  .AND.                         &
     679                        ( ch_ys(m) < ch_yn(mm) .OR.                             &
     680                          ch_yn(m) > ch_ys(mm) ) )  THEN                       
    658681                      nest_overlap = 1
    659682                   ENDIF
    … …  
    667690!
    668691!--       Send coarse grid information to child
    669           CALL pmc_send_to_client( client_id, define_coarse_grid_real,         &
    670                                    SIZE( define_coarse_grid_real ), 0, 21,     &
     692          CALL pmc_send_to_child( child_id, define_coarse_grid_real,            &
     693                                   SIZE( define_coarse_grid_real ), 0, 21,      &
    671694                                   ierr )
    672           CALL pmc_send_to_client( client_id, define_coarse_grid_int,  3, 0,   &
     695          CALL pmc_send_to_child( child_id, define_coarse_grid_int,  3, 0,      &
    673696                                   22, ierr )
    674697
    675698!
    676699!--       Send local grid to child
    677           CALL pmc_send_to_client( client_id, coord_x, nx+1+2*nbgp, 0, 24,     &
     700          CALL pmc_send_to_child( child_id, coord_x, nx+1+2*nbgp, 0, 24,        &
    678701                                   ierr )
    679           CALL pmc_send_to_client( client_id, coord_y, ny+1+2*nbgp, 0, 25,     &
     702          CALL pmc_send_to_child( child_id, coord_y, ny+1+2*nbgp, 0, 25,        &
    680703                                   ierr )
    681704
    682705!
    683706!--       Also send the dzu-, dzw-, zu- and zw-arrays here
    684           CALL pmc_send_to_client( client_id, dzu, nz_cl+1, 0, 26, ierr )
    685           CALL pmc_send_to_client( client_id, dzw, nz_cl+1, 0, 27, ierr )
    686           CALL pmc_send_to_client( client_id, zu,  nz_cl+2, 0, 28, ierr )
    687           CALL pmc_send_to_client( client_id, zw,  nz_cl+2, 0, 29, ierr )
     707          CALL pmc_send_to_child( child_id, dzu, nz_cl+1, 0, 26, ierr )
     708          CALL pmc_send_to_child( child_id, dzw, nz_cl+1, 0, 27, ierr )
     709          CALL pmc_send_to_child( child_id, zu,  nz_cl+2, 0, 28, ierr )
     710          CALL pmc_send_to_child( child_id, zw,  nz_cl+2, 0, 29, ierr )
    688711
    689712       ENDIF
    … …  
    691714       CALL MPI_BCAST( nomatch, 1, MPI_INTEGER, 0, comm2d, ierr )
    692715       IF ( nomatch /= 0 ) THEN
    693           WRITE ( message_string, * )  'Error: nested child domain does ',    &
     716          WRITE ( message_string, * )  'Error: nested child domain does ',      &
    694717                                       'not fit into its parent domain'
    695           CALL message( 'pmc_palm_setup_server', 'PA0425', 3, 2, 0, 6, 0 )
     718          CALL message( 'pmci_setup_parent', 'PA0425', 3, 2, 0, 6, 0 )
    696719       ENDIF
    697720 
    … …  
    700723          WRITE ( message_string, * )  'Nested parallel child ',    &
    701724                                       'domains overlap'
    702           CALL message( 'pmc_palm_setup_server', 'PA0426', 3, 2, 0, 6, 0 )
     725          CALL message( 'pmci_setup_parent', 'PA0426', 3, 2, 0, 6, 0 )
    703726       ENDIF
    704727     
    … …  
    710733
    711734!
    712 !--    Include couple arrays into server content
     735!--    Include couple arrays into parent content
    713736!--    TO_DO: Klaus: please give a more meaningful comment
    714737       CALL pmc_s_clear_next_array_list
    715        DO  WHILE ( pmc_s_getnextarray( client_id, myname ) )
    716           CALL pmci_set_array_pointer( myname, client_id = client_id,          &
     738       DO  WHILE ( pmc_s_getnextarray( child_id, myname ) )
     739          CALL pmci_set_array_pointer( myname, child_id = child_id,             &
    717740                                       nz_cl = nz_cl )
    718741       ENDDO
    719        CALL pmc_s_setind_and_allocmem( client_id )
     742       CALL pmc_s_setind_and_allocmem( child_id )
    720743    ENDDO
    721744
    722     IF ( ( SIZE( pmc_server_for_client ) - 1 > 0 ) .AND. myid == 0 )  THEN
     745    IF ( ( SIZE( pmc_parent_for_child ) - 1 > 0 ) .AND. myid == 0 )  THEN
    723746       DEALLOCATE( ch_xl )
    724747       DEALLOCATE( ch_xr )
    … …  
    747770       INTEGER(iwp) ::  px                 !:
    748771       INTEGER(iwp) ::  py                 !:
    749        INTEGER(iwp) ::  server_pe          !:
     772       INTEGER(iwp) ::  parent_pe          !:
    750773
    751774       INTEGER(iwp), DIMENSION(2) ::  scoord             !:
    … …  
    757780       IF ( myid == 0 )  THEN
    758781!--       TO_DO: Klaus: give more specific comment what size_of_array stands for
    759           CALL pmc_recv_from_client( client_id, size_of_array, 2, 0, 40, ierr )
     782          CALL pmc_recv_from_child( child_id, size_of_array, 2, 0, 40, ierr )
    760783          ALLOCATE( coarse_bound_all(size_of_array(1),size_of_array(2)) )
    761           CALL pmc_recv_from_client( client_id, coarse_bound_all,              &
    762                                      SIZE( coarse_bound_all ), 0, 41, ierr )
     784          CALL pmc_recv_from_child( child_id, coarse_bound_all,                 &
     785                                    SIZE( coarse_bound_all ), 0, 41, ierr )
    763786
    764787!
    … …  
    783806          ic  = 0
    784807!
    785 !--       Loop over all client PEs
     808!--       Loop over all children PEs
    786809          DO  k = 1, size_of_array(2)
    787810!
    788 !--          Area along y required by actual client PE
     811!--          Area along y required by actual child PE
    789812             DO  j = coarse_bound_all(3,k), coarse_bound_all(4,k)
    790813!
    791 !--             Area along x required by actual client PE
     814!--             Area along x required by actual child PE
    792815                DO  i = coarse_bound_all(1,k), coarse_bound_all(2,k)
    793816
    … …  
    796819                   scoord(1) = px
    797820                   scoord(2) = py
    798                    CALL MPI_CART_RANK( comm2d, scoord, server_pe, ierr )
     821                   CALL MPI_CART_RANK( comm2d, scoord, parent_pe, ierr )
    799822                 
    800823                   ic = ic + 1
    801824!
    802 !--                First index in server array
     825!--                First index in parent array
    803826                   index_list(1,ic) = i - ( px * nrx ) + 1 + nbgp
    804827!
    805 !--                Second index in server array
     828!--                Second index in parent array
    806829                   index_list(2,ic) = j - ( py * nry ) + 1 + nbgp
    807830!
    808 !--                x index of client coarse grid
     831!--                x index of child coarse grid
    809832                   index_list(3,ic) = i - coarse_bound_all(1,k) + 1
    810833!
    811 !--                y index of client coarse grid
     834!--                y index of child coarse grid
    812835                   index_list(4,ic) = j - coarse_bound_all(3,k) + 1
    813836!
    814 !--                PE number of client
     837!--                PE number of child
    815838                   index_list(5,ic) = k - 1
    816839!
    817 !--                PE number of server
    818                    index_list(6,ic) = server_pe
     840!--                PE number of parent
     841                   index_list(6,ic) = parent_pe
    819842
    820843                ENDDO
    … …  
    823846!
    824847!--       TO_DO: Klaus: comment what is done here
    825           CALL pmc_s_set_2d_index_list( client_id, index_list(:,1:ic) )
     848          CALL pmc_s_set_2d_index_list( child_id, index_list(:,1:ic) )
    826849
    827850       ELSE
    … …  
    829852!--       TO_DO: Klaus: comment why this dummy allocation is required
    830853          ALLOCATE( index_list(6,1) )
    831           CALL pmc_s_set_2d_index_list( client_id, index_list )
     854          CALL pmc_s_set_2d_index_list( child_id, index_list )
    832855       ENDIF
    833856
    … …  
    837860
    838861#endif
    839  END SUBROUTINE pmci_setup_server
    840 
    841 
    842 
    843  SUBROUTINE pmci_setup_client
     862 END SUBROUTINE pmci_setup_parent
     863
     864
     865
     866 SUBROUTINE pmci_setup_child
    844867
    845868#if defined( __parallel )
    … …  
    867890!
    868891!-- TO_DO: describe what is happening in this if-clause
    869 !-- Root Model does not have Server and is not a client
     892!-- Root model does not have a parent and is not a child
    870893    IF ( .NOT. pmc_is_rootmodel() )  THEN
    871894
    872        CALL pmc_clientinit
     895       CALL pmc_childinit
    873896!
    874897!--    Here AND ONLY HERE the arrays are defined, which actualy will be
    875 !--    exchanged between client and server.
     898!--    exchanged between child and parent.
    876899!--    If a variable is removed, it only has to be removed from here.
    877900!--    Please check, if the arrays are in the list of POSSIBLE exchange arrays
    878901!--    in subroutines:
    879 !--    pmci_set_array_pointer (for server arrays)
    880 !--    pmci_create_client_arrays (for client arrays)
     902!--    pmci_set_array_pointer (for parent arrays)
     903!--    pmci_create_child_arrays (for child arrays)
    881904       CALL pmc_set_dataarray_name( 'coarse', 'u'  ,'fine', 'u',  ierr )
    882905       CALL pmc_set_dataarray_name( 'coarse', 'v'  ,'fine', 'v',  ierr )
    … …  
    893916
    894917!
    895 !--    Send grid to server
     918!--    Send grid to parent
    896919       val(1)  = nx
    897920       val(2)  = ny
    … …  
    903926       IF ( myid == 0 )  THEN
    904927
    905           CALL pmc_send_to_server( val, SIZE( val ), 0, 123, ierr )
    906           CALL pmc_send_to_server( fval, SIZE( fval ), 0, 124, ierr )
    907           CALL pmc_send_to_server( coord_x, nx + 1 + 2 * nbgp, 0, 11, ierr )
    908           CALL pmc_send_to_server( coord_y, ny + 1 + 2 * nbgp, 0, 12, ierr )
     928          CALL pmc_send_to_parent( val, SIZE( val ), 0, 123, ierr )
     929          CALL pmc_send_to_parent( fval, SIZE( fval ), 0, 124, ierr )
     930          CALL pmc_send_to_parent( coord_x, nx + 1 + 2 * nbgp, 0, 11, ierr )
     931          CALL pmc_send_to_parent( coord_y, ny + 1 + 2 * nbgp, 0, 12, ierr )
    909932
    910933!
    911934!--       Receive Coarse grid information.
    912935!--       TO_DO: find shorter and more meaningful name for  define_coarse_grid_real
    913           CALL pmc_recv_from_server( define_coarse_grid_real,                  &
     936          CALL pmc_recv_from_parent( define_coarse_grid_real,                  &
    914937                                     SIZE(define_coarse_grid_real), 0, 21, ierr )
    915           CALL pmc_recv_from_server( define_coarse_grid_int,  3, 0, 22, ierr )
     938          CALL pmc_recv_from_parent( define_coarse_grid_int,  3, 0, 22, ierr )
    916939!
    917940!--        Debug-printouts - keep them
    918 !          WRITE(0,*) 'Coarse grid from Server '
     941!          WRITE(0,*) 'Coarse grid from parent '
    919942!          WRITE(0,*) 'startx_tot    = ',define_coarse_grid_real(1)
    920943!          WRITE(0,*) 'starty_tot    = ',define_coarse_grid_real(2)
    … …  
    929952       ENDIF
    930953
    931        CALL MPI_BCAST( define_coarse_grid_real, SIZE(define_coarse_grid_real), &
     954       CALL MPI_BCAST( define_coarse_grid_real, SIZE(define_coarse_grid_real),  &
    932955                       MPI_REAL, 0, comm2d, ierr )
    933956       CALL MPI_BCAST( define_coarse_grid_int, 3, MPI_INTEGER, 0, comm2d, ierr )
    … …  
    941964
    942965!
    943 !--    Get server coordinates on coarse grid
     966!--    Get parent coordinates on coarse grid
    944967       ALLOCATE( cg%coord_x(-nbgp:cg%nx+nbgp) )
    945968       ALLOCATE( cg%coord_y(-nbgp:cg%ny+nbgp) )
    … …  
    951974
    952975!
    953 !--    Get coarse grid coordinates and vales of the z-direction from server
     976!--    Get coarse grid coordinates and values of the z-direction from the parent
    954977       IF ( myid == 0)  THEN
    955978
    956           CALL pmc_recv_from_server( cg%coord_x, cg%nx+1+2*nbgp, 0, 24, ierr )
    957           CALL pmc_recv_from_server( cg%coord_y, cg%ny+1+2*nbgp, 0, 25, ierr )
    958           CALL pmc_recv_from_server( cg%dzu, cg%nz + 1, 0, 26, ierr )
    959           CALL pmc_recv_from_server( cg%dzw, cg%nz + 1, 0, 27, ierr )
    960           CALL pmc_recv_from_server( cg%zu, cg%nz + 2, 0, 28, ierr )
    961           CALL pmc_recv_from_server( cg%zw, cg%nz + 2, 0, 29, ierr )
     979          CALL pmc_recv_from_parent( cg%coord_x, cg%nx+1+2*nbgp, 0, 24, ierr )
     980          CALL pmc_recv_from_parent( cg%coord_y, cg%ny+1+2*nbgp, 0, 25, ierr )
     981          CALL pmc_recv_from_parent( cg%dzu, cg%nz + 1, 0, 26, ierr )
     982          CALL pmc_recv_from_parent( cg%dzw, cg%nz + 1, 0, 27, ierr )
     983          CALL pmc_recv_from_parent( cg%zu, cg%nz + 2, 0, 28, ierr )
     984          CALL pmc_recv_from_parent( cg%zw, cg%nz + 2, 0, 29, ierr )
    962985
    963986       ENDIF
    … …  
    9801003
    9811004!
    982 !--    Include couple arrays into client content
    983 !--    TO_DO: Klaus: better explain the above comment (what is client content?)
     1005!--    Include couple arrays into child content
     1006!--    TO_DO: Klaus: better explain the above comment (what is child content?)
    9841007       CALL  pmc_c_clear_next_array_list
    9851008       DO  WHILE ( pmc_c_getnextarray( myname ) )
    986 !--       TO_DO: Klaus, why the c-arrays are still up to cg%nz??
    987           CALL pmci_create_client_arrays ( myname, icl, icr, jcs, jcn, cg%nz )
     1009!--       TO_DO: Klaus, why the child-arrays are still up to cg%nz??
     1010          CALL pmci_create_child_arrays ( myname, icl, icr, jcs, jcn, cg%nz )
    9881011       ENDDO
    9891012       CALL pmc_c_setind_and_allocmem
    9901013
    9911014!
    992 !--    Precompute interpolation coefficients and client-array indices
     1015!--    Precompute interpolation coefficients and child-array indices
    9931016       CALL pmci_init_interp_tril
    9941017
    … …  
    10021025
    10031026!
    1004 !--    Two-way coupling.
     1027!--    Two-way coupling for general and vertical nesting.
    10051028!--    Precompute the index arrays and relaxation functions for the
    10061029!--    anterpolation
    1007        IF ( nesting_mode == 'two-way' )  THEN
     1030       IF ( TRIM( nesting_mode ) == 'two-way' .OR.                              &
     1031                  nesting_mode == 'vertical' )  THEN
    10081032          CALL pmci_init_anterp_tophat
    10091033       ENDIF
    … …  
    10971121!--    Note that MPI_Gather receives data from all processes in the rank order
    10981122!--    TO_DO: refer to the line where this fact becomes important
    1099        CALL MPI_GATHER( coarse_bound, 5, MPI_INTEGER, coarse_bound_all, 5, &
     1123       CALL MPI_GATHER( coarse_bound, 5, MPI_INTEGER, coarse_bound_all, 5,      &
    11001124                        MPI_INTEGER, 0, comm2d, ierr )
    11011125
    … …  
    11031127          size_of_array(1) = SIZE( coarse_bound_all, 1 )
    11041128          size_of_array(2) = SIZE( coarse_bound_all, 2 )
    1105           CALL pmc_send_to_server( size_of_array, 2, 0, 40, ierr )
    1106           CALL pmc_send_to_server( coarse_bound_all, SIZE( coarse_bound_all ), &
     1129          CALL pmc_send_to_parent( size_of_array, 2, 0, 40, ierr )
     1130          CALL pmc_send_to_parent( coarse_bound_all, SIZE( coarse_bound_all ), &
    11071131                                   0, 41, ierr )
    11081132       ENDIF
    … …  
    11141138    SUBROUTINE pmci_init_interp_tril
    11151139!
    1116 !--    Precomputation of the interpolation coefficients and client-array indices
     1140!--    Precomputation of the interpolation coefficients and child-array indices
    11171141!--    to be used by the interpolation routines interp_tril_lr, interp_tril_ns
    11181142!--    and interp_tril_t.
    … …  
    11671191!
    11681192!--    Note that the node coordinates xfs... and xcs... are relative to the
    1169 !--    lower-left-bottom corner of the fc-array, not the actual client domain
     1193!--    lower-left-bottom corner of the fc-array, not the actual child domain
    11701194!--    corner
    11711195       DO  i = nxlg, nxrg
    … …  
    12621286          DO  i = nxl-1, nxl
    12631287             DO  j = nys, nyn
    1264                 nzt_topo_nestbc_l = MAX( nzt_topo_nestbc_l, nzb_u_inner(j,i),  &
     1288                nzt_topo_nestbc_l = MAX( nzt_topo_nestbc_l, nzb_u_inner(j,i),   &
    12651289                                         nzb_v_inner(j,i), nzb_w_inner(j,i) )
    12661290             ENDDO
    … …  
    12731297          i = nxr + 1
    12741298          DO  j = nys, nyn
    1275              nzt_topo_nestbc_r = MAX( nzt_topo_nestbc_r, nzb_u_inner(j,i),     &
     1299             nzt_topo_nestbc_r = MAX( nzt_topo_nestbc_r, nzb_u_inner(j,i),      &
    12761300                                      nzb_v_inner(j,i), nzb_w_inner(j,i) )
    12771301          ENDDO
    … …  
    12831307          DO  j = nys-1, nys
    12841308             DO  i = nxl, nxr
    1285                 nzt_topo_nestbc_s = MAX( nzt_topo_nestbc_s, nzb_u_inner(j,i),  &
     1309                nzt_topo_nestbc_s = MAX( nzt_topo_nestbc_s, nzb_u_inner(j,i),   &
    12861310                                         nzb_v_inner(j,i), nzb_w_inner(j,i) )
    12871311             ENDDO
    … …  
    12941318          j = nyn + 1
    12951319          DO  i = nxl, nxr
    1296              nzt_topo_nestbc_n = MAX( nzt_topo_nestbc_n, nzb_u_inner(j,i),     &
     1320             nzt_topo_nestbc_n = MAX( nzt_topo_nestbc_n, nzb_u_inner(j,i),      &
    12971321                                      nzb_v_inner(j,i), nzb_w_inner(j,i) )
    12981322          ENDDO
    … …  
    13031327!--    Then determine the maximum number of near-wall nodes per wall point based
    13041328!--    on the grid-spacing ratios.
    1305        nzt_topo_max = MAX( nzt_topo_nestbc_l, nzt_topo_nestbc_r,               &
     1329       nzt_topo_max = MAX( nzt_topo_nestbc_l, nzt_topo_nestbc_r,                &
    13061330                           nzt_topo_nestbc_s, nzt_topo_nestbc_n )
    13071331
    … …  
    13431367             k   = kb + 1
    13441368             wall_index = kb
    1345              CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j,     &
     1369             CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j,      &
    13461370                                inc, wall_index, z0(j,i), kb, direction, ncorr )
    13471371             logc_u_l(1,k,j) = lc
    … …  
    13541378             k   =  kb + 1
    13551379             wall_index = kb
    1356              CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j,     &
     1380             CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j,      &
    13571381                                inc, wall_index, z0(j,i), kb, direction, ncorr )
    13581382             logc_v_l(1,k,j) = lc
    … …  
    13851409             k   = kb + 1
    13861410             wall_index = kb
    1387              CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j,     &
     1411             CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j,      &
    13881412                                inc, wall_index, z0(j,i), kb, direction, ncorr )
    13891413             logc_u_r(1,k,j) = lc
    … …  
    13961420             k   = kb + 1
    13971421             wall_index = kb
    1398              CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j,     &
     1422             CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j,      &
    13991423                                inc, wall_index, z0(j,i), kb, direction, ncorr )
    14001424             logc_v_r(1,k,j) = lc
    … …  
    14281452             k   =  kb + 1
    14291453             wall_index = kb
    1430              CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j,     &
     1454             CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j,      &
    14311455                                inc, wall_index, z0(j,i), kb, direction, ncorr )
    14321456             logc_u_s(1,k,i) = lc
    … …  
    14391463             k   = kb + 1
    14401464             wall_index = kb
    1441              CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j,     &
     1465             CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j,      &
    14421466                                inc, wall_index, z0(j,i), kb, direction, ncorr )
    14431467             logc_v_s(1,k,i) = lc
    … …  
    14711495             k   = kb + 1
    14721496             wall_index = kb
    1473              CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j,     &
     1497             CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j,      &
    14741498                                inc, wall_index, z0(j,i), kb, direction, ncorr )
    14751499             logc_u_n(1,k,i) = lc
    … …  
    14821506             k   = kb + 1
    14831507             wall_index = kb
    1484              CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j,     &
     1508             CALL pmci_define_loglaw_correction_parameters( lc, lcr, k, j,      &
    14851509                                inc, wall_index, z0(j,i), kb, direction, ncorr )
    14861510             logc_v_n(1,k,i) = lc
    … …  
    15021526
    15031527             ALLOCATE( logc_w_l(1:2,nzb:nzt_topo_nestbc_l,nys:nyn) )
    1504              ALLOCATE( logc_ratio_w_l(1:2,0:ncorr-1,nzb:nzt_topo_nestbc_l,     &
     1528             ALLOCATE( logc_ratio_w_l(1:2,0:ncorr-1,nzb:nzt_topo_nestbc_l,      &
    15051529                                      nys:nyn) )
    15061530
    … …  
    15131537!--                Wall for u on the south side, but not on the north side
    15141538                   i  = 0
    1515                    IF ( ( nzb_u_outer(j,i) > nzb_u_outer(j+1,i) ) .AND.        &
    1516                         ( nzb_u_outer(j,i) == nzb_u_outer(j-1,i) ) )           &
     1539                   IF ( ( nzb_u_outer(j,i) > nzb_u_outer(j+1,i) ) .AND.         &
     1540                        ( nzb_u_outer(j,i) == nzb_u_outer(j-1,i) ) )            &
    15171541                   THEN
    15181542                      inc        =  1
    15191543                      wall_index =  j
    1520                       CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
     1544                      CALL pmci_define_loglaw_correction_parameters( lc, lcr,   &
    15211545                          k, j, inc, wall_index, z0(j,i), kb, direction, ncorr )
    15221546!
    … …  
    15311555!--                Wall for u on the north side, but not on the south side
    15321556                   i  = 0
    1533                    IF ( ( nzb_u_outer(j,i) > nzb_u_outer(j-1,i) ) .AND.        &
     1557                   IF ( ( nzb_u_outer(j,i) > nzb_u_outer(j-1,i) ) .AND.         &
    15341558                        ( nzb_u_outer(j,i) == nzb_u_outer(j+1,i) ) )  THEN
    15351559                      inc        = -1
    15361560                      wall_index =  j + 1
    1537                       CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
     1561                      CALL pmci_define_loglaw_correction_parameters( lc, lcr,   &
    15381562                          k, j, inc, wall_index, z0(j,i), kb, direction, ncorr )
    15391563!
    … …  
    15481572!--                Wall for w on the south side, but not on the north side.
    15491573                   i  = -1
    1550                    IF ( ( nzb_w_outer(j,i) > nzb_w_outer(j+1,i) )  .AND.       &
     1574                   IF ( ( nzb_w_outer(j,i) > nzb_w_outer(j+1,i) )  .AND.        &
    15511575                        ( nzb_w_outer(j,i) == nzb_w_outer(j-1,i) ) )  THEN
    15521576                      inc        =  1
    15531577                      wall_index =  j
    1554                       CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
     1578                      CALL pmci_define_loglaw_correction_parameters( lc, lcr,   &
    15551579                          k, j, inc, wall_index, z0(j,i), kb, direction, ncorr )
    15561580!
    … …  
    15651589!--                Wall for w on the north side, but not on the south side.
    15661590                   i  = -1
    1567                    IF ( ( nzb_w_outer(j,i) > nzb_w_outer(j-1,i) )  .AND.       &
     1591                   IF ( ( nzb_w_outer(j,i) > nzb_w_outer(j-1,i) )  .AND.        &
    15681592                        ( nzb_w_outer(j,i) == nzb_w_outer(j+1,i) ) )  THEN
    15691593                      inc        = -1
    15701594                      wall_index =  j+1
    1571                       CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
     1595                      CALL pmci_define_loglaw_correction_parameters( lc, lcr,   &
    15721596                          k, j, inc, wall_index, z0(j,i), kb, direction, ncorr )
    15731597!
    … …  
    15891613
    15901614             ALLOCATE( logc_w_r(1:2,nzb:nzt_topo_nestbc_r,nys:nyn) )
    1591              ALLOCATE( logc_ratio_w_r(1:2,0:ncorr-1,nzb:nzt_topo_nestbc_r,     &
     1615             ALLOCATE( logc_ratio_w_r(1:2,0:ncorr-1,nzb:nzt_topo_nestbc_r,      &
    15921616                                      nys:nyn) )
    15931617             logc_w_r       = 0
    … …  
    16001624!
    16011625!--                Wall for u on the south side, but not on the north side
    1602                    IF ( ( nzb_u_outer(j,i) > nzb_u_outer(j+1,i) )  .AND.       &
     1626                   IF ( ( nzb_u_outer(j,i) > nzb_u_outer(j+1,i) )  .AND.        &
    16031627                        ( nzb_u_outer(j,i) == nzb_u_outer(j-1,i) ) )  THEN
    16041628                      inc        = 1
    16051629                      wall_index = j
    1606                       CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
     1630                      CALL pmci_define_loglaw_correction_parameters( lc, lcr,   &
    16071631                          k, j, inc, wall_index, z0(j,i), kb, direction, ncorr )
    16081632!
    … …  
    16161640!
    16171641!--                Wall for u on the north side, but not on the south side
    1618                    IF ( ( nzb_u_outer(j,i) > nzb_u_outer(j-1,i) )  .AND.       &
     1642                   IF ( ( nzb_u_outer(j,i) > nzb_u_outer(j-1,i) )  .AND.        &
    16191643                        ( nzb_u_outer(j,i) == nzb_u_outer(j+1,i) ) )  THEN
    16201644                      inc        = -1
    16211645                      wall_index =  j+1
    1622                       CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
     1646                      CALL pmci_define_loglaw_correction_parameters( lc, lcr,   &
    16231647                          k, j, inc, wall_index, z0(j,i), kb, direction, ncorr )
    16241648!
    … …  
    16321656!
    16331657!--                Wall for w on the south side, but not on the north side
    1634                    IF ( ( nzb_w_outer(j,i) > nzb_w_outer(j+1,i) )  .AND.       &
     1658                   IF ( ( nzb_w_outer(j,i) > nzb_w_outer(j+1,i) )  .AND.        &
    16351659                        ( nzb_w_outer(j,i) == nzb_w_outer(j-1,i) ) )  THEN
    16361660                      inc        =  1
    16371661                      wall_index =  j
    1638                       CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
     1662                      CALL pmci_define_loglaw_correction_parameters( lc, lcr,   &
    16391663                          k, j, inc, wall_index, z0(j,i), kb, direction, ncorr )
    16401664!
    … …  
    16481672!
    16491673!--                Wall for w on the north side, but not on the south side
    1650                    IF ( ( nzb_w_outer(j,i) > nzb_w_outer(j-1,i) )  .AND.       &
     1674                   IF ( ( nzb_w_outer(j,i) > nzb_w_outer(j-1,i) )  .AND.        &
    16511675                        ( nzb_w_outer(j,i) == nzb_w_outer(j+1,i) ) )  THEN
    16521676                      inc        = -1
    16531677                      wall_index =  j+1
    1654                       CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
     1678                      CALL pmci_define_loglaw_correction_parameters( lc, lcr,   &
    16551679                          k, j, inc, wall_index, z0(j,i), kb, direction, ncorr )
    16561680
    … …  
    16731697
    16741698             ALLOCATE( logc_w_s(1:2,nzb:nzt_topo_nestbc_s,nxl:nxr) )
    1675              ALLOCATE( logc_ratio_w_s(1:2,0:ncorr-1,nzb:nzt_topo_nestbc_s,     &
     1699             ALLOCATE( logc_ratio_w_s(1:2,0:ncorr-1,nzb:nzt_topo_nestbc_s,      &
    16761700                                      nxl:nxr) )
    16771701             logc_w_s       = 0
    … …  
    16841708!--                Wall for v on the left side, but not on the right side
    16851709                   j  = 0
    1686                    IF ( ( nzb_v_outer(j,i) > nzb_v_outer(j,i+1) )  .AND.       &
     1710                   IF ( ( nzb_v_outer(j,i) > nzb_v_outer(j,i+1) )  .AND.        &
    16871711                        ( nzb_v_outer(j,i) == nzb_v_outer(j,i-1) ) )  THEN
    16881712                      inc        =  1
    16891713                      wall_index =  i
    1690                       CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
     1714                      CALL pmci_define_loglaw_correction_parameters( lc, lcr,   &
    16911715                          k, i, inc, wall_index, z0(j,i), kb, direction, ncorr )
    16921716!
    … …  
    17011725!--                Wall for v on the right side, but not on the left side
    17021726                   j  = 0
    1703                    IF ( ( nzb_v_outer(j,i) > nzb_v_outer(j,i-1) )  .AND.       &
     1727                   IF ( ( nzb_v_outer(j,i) > nzb_v_outer(j,i-1) )  .AND.        &
    17041728                        ( nzb_v_outer(j,i) == nzb_v_outer(j,i+1) ) )  THEN
    17051729                      inc        = -1
    17061730                      wall_index =  i+1
    1707                       CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
     1731                      CALL pmci_define_loglaw_correction_parameters( lc, lcr,   &
    17081732                          k, i, inc, wall_index, z0(j,i), kb, direction, ncorr )
    17091733!
    … …  
    17181742!--                Wall for w on the left side, but not on the right side
    17191743                   j  = -1
    1720                    IF ( ( nzb_w_outer(j,i) > nzb_w_outer(j,i+1) )  .AND.       &
     1744                   IF ( ( nzb_w_outer(j,i) > nzb_w_outer(j,i+1) )  .AND.        &
    17211745                        ( nzb_w_outer(j,i) == nzb_w_outer(j,i-1) ) )  THEN
    17221746                      inc        =  1
    17231747                      wall_index =  i
    1724                       CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
     1748                      CALL pmci_define_loglaw_correction_parameters( lc, lcr,   &
    17251749                          k, i, inc, wall_index, z0(j,i), kb, direction, ncorr )
    17261750!
    … …  
    17351759!--                Wall for w on the right side, but not on the left side
    17361760                   j  = -1
    1737                    IF ( ( nzb_w_outer(j,i) > nzb_w_outer(j,i-1) )  .AND.       &
     1761                   IF ( ( nzb_w_outer(j,i) > nzb_w_outer(j,i-1) )  .AND.        &
    17381762                        ( nzb_w_outer(j,i) == nzb_w_outer(j,i+1) ) )  THEN
    17391763                      inc        = -1
    17401764                      wall_index =  i+1
    1741                       CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
     1765                      CALL pmci_define_loglaw_correction_parameters( lc, lcr,   &
    17421766                          k, i, inc, wall_index, z0(j,i), kb, direction, ncorr )
    17431767!
    … …  
    17591783
    17601784             ALLOCATE( logc_w_n(1:2,nzb:nzt_topo_nestbc_n, nxl:nxr) )
    1761              ALLOCATE( logc_ratio_w_n(1:2,0:ncorr-1,nzb:nzt_topo_nestbc_n,     &
     1785             ALLOCATE( logc_ratio_w_n(1:2,0:ncorr-1,nzb:nzt_topo_nestbc_n,      &
    17621786                                      nxl:nxr) )
    17631787             logc_w_n       = 0
    … …  
    17701794!
    17711795!--                Wall for v on the left side, but not on the right side
    1772                    IF ( ( nzb_v_outer(j,i) > nzb_v_outer(j,i+1) )  .AND.       &
     1796                   IF ( ( nzb_v_outer(j,i) > nzb_v_outer(j,i+1) )  .AND.        &
    17731797                        ( nzb_v_outer(j,i) == nzb_v_outer(j,i-1) ) )  THEN
    17741798                      inc        = 1
    17751799                      wall_index = i
    1776                       CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
     1800                      CALL pmci_define_loglaw_correction_parameters( lc, lcr,   &
    17771801                          k, i, inc, wall_index, z0(j,i), kb, direction, ncorr )
    17781802!
    … …  
    17861810!
    17871811!--                Wall for v on the right side, but not on the left side
    1788                    IF ( ( nzb_v_outer(j,i) > nzb_v_outer(j,i-1) )  .AND.       &
     1812                   IF ( ( nzb_v_outer(j,i) > nzb_v_outer(j,i-1) )  .AND.        &
    17891813                        ( nzb_v_outer(j,i) == nzb_v_outer(j,i+1) ) )  THEN
    17901814                      inc        = -1
    17911815                      wall_index =  i + 1
    1792                       CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
     1816                      CALL pmci_define_loglaw_correction_parameters( lc, lcr,   &
    17931817                          k, i, inc, wall_index, z0(j,i), kb, direction, ncorr )
    17941818!
    … …  
    18021826!
    18031827!--                Wall for w on the left side, but not on the right side
    1804                    IF ( ( nzb_w_outer(j,i) > nzb_w_outer(j,i+1) )  .AND.       &
     1828                   IF ( ( nzb_w_outer(j,i) > nzb_w_outer(j,i+1) )  .AND.        &
    18051829                        ( nzb_w_outer(j,i) == nzb_w_outer(j,i-1) ) )  THEN
    18061830                      inc        = 1
    18071831                      wall_index = i
    1808                       CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
     1832                      CALL pmci_define_loglaw_correction_parameters( lc, lcr,   &
    18091833                          k, i, inc, wall_index, z0(j,i), kb, direction, ncorr )
    18101834!
    … …  
    18181842!
    18191843!--                Wall for w on the right side, but not on the left side
    1820                    IF ( ( nzb_w_outer(j,i) > nzb_w_outer(j,i-1) )  .AND.       &
     1844                   IF ( ( nzb_w_outer(j,i) > nzb_w_outer(j,i-1) )  .AND.        &
    18211845                        ( nzb_w_outer(j,i) == nzb_w_outer(j,i+1) ) )  THEN
    18221846                      inc        = -1
    18231847                      wall_index =  i+1
    1824                       CALL pmci_define_loglaw_correction_parameters( lc, lcr,  &
     1848                      CALL pmci_define_loglaw_correction_parameters( lc, lcr,   &
    18251849                          k, i, inc, wall_index, z0(j,i), kb, direction, ncorr )
    18261850!
    … …  
    18431867
    18441868
    1845     SUBROUTINE pmci_define_loglaw_correction_parameters( lc, lcr, k, ij, inc,  &
     1869    SUBROUTINE pmci_define_loglaw_correction_parameters( lc, lcr, k, ij, inc,   &
    18461870                                        wall_index, z0_l, kb, direction, ncorr )
    18471871
    … …  
    18971921                corr_index = ij + lcorr   ! In this case (direction = 2) ij is j
    18981922                IF ( lcorr == 0 )  THEN
    1899                    CALL pmci_find_logc_pivot_j( lc, logvelc1, ij, wall_index,  &
     1923                   CALL pmci_find_logc_pivot_j( lc, logvelc1, ij, wall_index,   &
    19001924                                                z0_l, inc )
    19011925                ENDIF
    … …  
    19051929!--             valid in both directions
    19061930                IF ( inc * corr_index < inc * lc )  THEN
    1907                    lcr(alcorr) = LOG( ABS( coord_y(corr_index) + 0.5_wp * dy   &
    1908                                          - coord_y(wall_index) ) / z0_l )      &
     1931                   lcr(alcorr) = LOG( ABS( coord_y(corr_index) + 0.5_wp * dy    &
     1932                                         - coord_y(wall_index) ) / z0_l )       &
    19091933                                 / logvelc1
    19101934                   more = .TRUE.
    … …  
    19241948                corr_index = ij + lcorr   ! In this case (direction = 3) ij is i
    19251949                IF ( lcorr == 0 )  THEN
    1926                    CALL pmci_find_logc_pivot_i( lc, logvelc1, ij, wall_index,  &
     1950                   CALL pmci_find_logc_pivot_i( lc, logvelc1, ij, wall_index,   &
    19271951                                                z0_l, inc )
    19281952                ENDIF
    … …  
    19311955!--             valid in both directions
    19321956                IF ( inc * corr_index < inc * lc )  THEN
    1933                    lcr(alcorr) = LOG( ABS( coord_x(corr_index) + 0.5_wp * dx   &
    1934                                          - coord_x(wall_index) ) / z0_l )      &
     1957                   lcr(alcorr) = LOG( ABS( coord_x(corr_index) + 0.5_wp * dx    &
     1958                                         - coord_x(wall_index) ) / z0_l )       &
    19351959                                 / logvelc1
    19361960                   more = .TRUE.
    … …  
    19631987       INTEGER(iwp) ::  k1     !:
    19641988
    1965        REAL(wp),INTENT(OUT) ::  logzc1     !:
     1989       REAL(wp), INTENT(OUT) ::  logzc1     !:
    19661990       REAL(wp), INTENT(IN) ::  z0_l       !:
    19671991
    … …  
    20722096    SUBROUTINE pmci_init_anterp_tophat
    20732097!
    2074 !--    Precomputation of the client-array indices for
     2098!--    Precomputation of the child-array indices for
    20752099!--    corresponding coarse-grid array index and the
    20762100!--    Under-relaxation coefficients to be used by anterp_tophat.
    … …  
    21482172       DO  ii = icl, icr
    21492173          i = istart
    2150           DO  WHILE ( ( coord_x(i) < cg%coord_x(ii) - 0.5_wp * cg%dx )  .AND.  &
     2174          DO  WHILE ( ( coord_x(i) < cg%coord_x(ii) - 0.5_wp * cg%dx )  .AND.   &
    21512175                      ( i < nxrg ) )
    21522176             i = i + 1
    21532177          ENDDO
    21542178          iflu(ii) = MIN( MAX( i, nxlg ), nxrg )
    2155           DO  WHILE ( ( coord_x(i) < cg%coord_x(ii) + 0.5_wp * cg%dx )  .AND.  &
     2179          DO  WHILE ( ( coord_x(i) < cg%coord_x(ii) + 0.5_wp * cg%dx )  .AND.   &
    21562180                      ( i < nxrg ) )
    21572181             i = i + 1
    … …  
    21662190       DO  ii = icl, icr
    21672191          i = istart
    2168           DO  WHILE ( ( coord_x(i) + 0.5_wp * dx < cg%coord_x(ii) )  .AND.     &
     2192          DO  WHILE ( ( coord_x(i) + 0.5_wp * dx < cg%coord_x(ii) )  .AND.      &
    21692193                      ( i < nxrg ) )
    21702194             i = i + 1
    21712195          ENDDO
    21722196          iflo(ii) = MIN( MAX( i, nxlg ), nxrg )
    2173           DO  WHILE ( ( coord_x(i) + 0.5_wp * dx < cg%coord_x(ii) + cg%dx )    &
     2197          DO  WHILE ( ( coord_x(i) + 0.5_wp * dx < cg%coord_x(ii) + cg%dx )     &
    21742198                      .AND.  ( i < nxrg ) )
    21752199             i = i + 1
    … …  
    21842208       DO  jj = jcs, jcn
    21852209          j = jstart
    2186           DO  WHILE ( ( coord_y(j) < cg%coord_y(jj) - 0.5_wp * cg%dy )  .AND.  &
     2210          DO  WHILE ( ( coord_y(j) < cg%coord_y(jj) - 0.5_wp * cg%dy )  .AND.   &
    21872211                      ( j < nyng ) )
    21882212             j = j + 1
    21892213          ENDDO
    21902214          jflv(jj) = MIN( MAX( j, nysg ), nyng )
    2191           DO  WHILE ( ( coord_y(j) < cg%coord_y(jj) + 0.5_wp * cg%dy )  .AND.  &
     2215          DO  WHILE ( ( coord_y(j) < cg%coord_y(jj) + 0.5_wp * cg%dy )  .AND.   &
    21922216                      ( j < nyng ) )
    21932217             j = j + 1
    … …  
    22022226       DO  jj = jcs, jcn
    22032227          j = jstart
    2204           DO  WHILE ( ( coord_y(j) + 0.5_wp * dy < cg%coord_y(jj) )  .AND.     &
     2228          DO  WHILE ( ( coord_y(j) + 0.5_wp * dy < cg%coord_y(jj) )  .AND.      &
    22052229                      ( j < nyng ) )
    22062230             j = j + 1
    22072231          ENDDO
    22082232          jflo(jj) = MIN( MAX( j, nysg ), nyng )
    2209           DO  WHILE ( ( coord_y(j) + 0.5_wp * dy < cg%coord_y(jj) + cg%dy )    &
     2233          DO  WHILE ( ( coord_y(j) + 0.5_wp * dy < cg%coord_y(jj) + cg%dy )     &
    22102234                      .AND.  ( j < nyng ) )
    22112235             j = j + 1
    … …  
    22222246       DO  kk = 1, kctw
    22232247          k = kstart
    2224           DO  WHILE ( ( zw(k) < cg%zw(kk) - 0.5_wp * cg%dzw(kk) )  .AND.       &
     2248          DO  WHILE ( ( zw(k) < cg%zw(kk) - 0.5_wp * cg%dzw(kk) )  .AND.        &
    22252249                      ( k < nzt ) )
    22262250             k = k + 1
    22272251          ENDDO
    22282252          kflw(kk) = MIN( MAX( k, 1 ), nzt + 1 )
    2229           DO  WHILE ( ( zw(k) < cg%zw(kk) + 0.5_wp * cg%dzw(kk+1) )  .AND.     &
     2253          DO  WHILE ( ( zw(k) < cg%zw(kk) + 0.5_wp * cg%dzw(kk+1) )  .AND.      &
    22302254                      ( k < nzt ) )
    22312255             k = k + 1
    … …  
    22422266       DO  kk = 1, kctu
    22432267          k = kstart
    2244           DO  WHILE ( ( zu(k) < cg%zu(kk) - 0.5_wp * cg%dzu(kk) )  .AND.       &
     2268          DO  WHILE ( ( zu(k) < cg%zu(kk) - 0.5_wp * cg%dzu(kk) )  .AND.        &
    22452269                      ( k < nzt ) )
    22462270             k = k + 1
    22472271          ENDDO
    22482272          kflo(kk) = MIN( MAX( k, 1 ), nzt + 1 )
    2249           DO  WHILE ( ( zu(k) < cg%zu(kk) + 0.5_wp * cg%dzu(kk+1) )  .AND.     &
     2273          DO  WHILE ( ( zu(k) < cg%zu(kk) + 0.5_wp * cg%dzu(kk+1) )  .AND.      &
    22502274                      ( k < nzt ) )
    22512275             k = k + 1
    … …  
    22722296!--    Spatial under-relaxation coefficients
    22732297       ALLOCATE( frax(icl:icr) )
    2274 
    2275        DO  ii = icl, icr
    2276           IF ( nest_bound_l )  THEN
    2277              xi = ( MAX( 0.0_wp, ( cg%coord_x(ii) - lower_left_coord_x ) ) /   &
    2278                     anterp_relax_length_l )**4
    2279           ELSEIF ( nest_bound_r )  THEN
    2280              xi = ( MAX( 0.0_wp, ( lower_left_coord_x + ( nx + 1 ) * dx -      &
    2281                                    cg%coord_x(ii) ) ) /                        &
    2282                     anterp_relax_length_r )**4
    2283           ELSE
    2284              xi = 999999.9_wp
    2285           ENDIF
    2286           frax(ii) = xi / ( 1.0_wp + xi )
    2287        ENDDO
    2288 
    22892298       ALLOCATE( fray(jcs:jcn) )
    2290 
    2291        DO  jj = jcs, jcn
    2292           IF ( nest_bound_s )  THEN
    2293              eta = ( MAX( 0.0_wp, ( cg%coord_y(jj) - lower_left_coord_y ) ) /  &
    2294                      anterp_relax_length_s )**4
    2295           ELSEIF ( nest_bound_n )  THEN
    2296              eta = ( MAX( 0.0_wp, ( lower_left_coord_y + ( ny + 1 ) * dy -     &
    2297                                     cg%coord_y(jj)) ) /                        &
    2298                      anterp_relax_length_n )**4
    2299           ELSE
    2300              eta = 999999.9_wp
    2301           ENDIF
    2302           fray(jj) = eta / ( 1.0_wp + eta )
    2303        ENDDO
     2299       
     2300       frax(icl:icr) = 1.0_wp
     2301       fray(jcs:jcn) = 1.0_wp
     2302
     2303       IF ( nesting_mode /= 'vertical' )  THEN
     2304          DO  ii = icl, icr
     2305             IF ( nest_bound_l )  THEN
     2306                xi = ( MAX( 0.0_wp, ( cg%coord_x(ii) -                          &
     2307                       lower_left_coord_x ) ) / anterp_relax_length_l )**4
     2308             ELSEIF ( nest_bound_r )  THEN
     2309                xi = ( MAX( 0.0_wp, ( lower_left_coord_x + ( nx + 1 ) * dx -    &
     2310                                      cg%coord_x(ii) ) ) /                      &
     2311                       anterp_relax_length_r )**4
     2312             ELSE
     2313                xi = 999999.9_wp
     2314             ENDIF
     2315             frax(ii) = xi / ( 1.0_wp + xi )
     2316          ENDDO
     2317
     2318
     2319          DO  jj = jcs, jcn
     2320             IF ( nest_bound_s )  THEN
     2321                eta = ( MAX( 0.0_wp, ( cg%coord_y(jj) -                         &
     2322                        lower_left_coord_y ) ) / anterp_relax_length_s )**4
     2323             ELSEIF ( nest_bound_n )  THEN
     2324                eta = ( MAX( 0.0_wp, ( lower_left_coord_y + ( ny + 1 ) * dy -   &
     2325                                       cg%coord_y(jj)) ) /                      &
     2326                        anterp_relax_length_n )**4
     2327             ELSE
     2328                eta = 999999.9_wp
     2329             ENDIF
     2330             fray(jj) = eta / ( 1.0_wp + eta )
     2331          ENDDO
     2332       ENDIF
    23042333     
    23052334       ALLOCATE( fraz(0:kctu) )
    … …  
    23472376                height = zu(k) - zu(nzb_s_inner(j,i))
    23482377                fw     = EXP( -cfw * height / glsf )
    2349                 tkefactor_l(k,j) = c_tkef * ( fw0 * fw + ( 1.0_wp - fw ) *     &
     2378                tkefactor_l(k,j) = c_tkef * ( fw0 * fw + ( 1.0_wp - fw ) *      &
    23502379                                              ( glsf / glsc )**p23 )
    23512380             ENDDO
    … …  
    23652394                height = zu(k) - zu(nzb_s_inner(j,i))
    23662395                fw     = EXP( -cfw * height / glsf )
    2367                 tkefactor_r(k,j) = c_tkef * ( fw0 * fw + ( 1.0_wp - fw ) *     &
     2396                tkefactor_r(k,j) = c_tkef * ( fw0 * fw + ( 1.0_wp - fw ) *      &
    23682397                                              ( glsf / glsc )**p23 )
    23692398             ENDDO
    … …  
    23832412                height = zu(k) - zu(nzb_s_inner(j,i))
    23842413                fw     = EXP( -cfw*height / glsf )
    2385                 tkefactor_s(k,i) = c_tkef * ( fw0 * fw + ( 1.0_wp - fw ) *     &
     2414                tkefactor_s(k,i) = c_tkef * ( fw0 * fw + ( 1.0_wp - fw ) *      &
    23862415                                              ( glsf / glsc )**p23 )
    23872416             ENDDO
    … …  
    24012430                height = zu(k) - zu(nzb_s_inner(j,i))
    24022431                fw     = EXP( -cfw * height / glsf )
    2403                 tkefactor_n(k,i) = c_tkef * ( fw0 * fw + ( 1.0_wp - fw ) *     &
     2432                tkefactor_n(k,i) = c_tkef * ( fw0 * fw + ( 1.0_wp - fw ) *      &
    24042433                                              ( glsf / glsc )**p23 )
    24052434             ENDDO
    … …  
    24172446             height = zu(k) - zu(nzb_s_inner(j,i))
    24182447             fw     = EXP( -cfw * height / glsf )
    2419              tkefactor_t(j,i) = c_tkef * ( fw0 * fw + ( 1.0_wp - fw ) *        &
     2448             tkefactor_t(j,i) = c_tkef * ( fw0 * fw + ( 1.0_wp - fw ) *         &
    24202449                                           ( glsf / glsc )**p23 )
    24212450          ENDDO
    … …  
    24252454
    24262455#endif
    2427  END SUBROUTINE pmci_setup_client
     2456 END SUBROUTINE pmci_setup_child
    24282457
    24292458
    … …  
    24562485
    24572486
    2458  SUBROUTINE pmci_set_array_pointer( name, client_id, nz_cl )
     2487 SUBROUTINE pmci_set_array_pointer( name, child_id, nz_cl )
    24592488
    24602489    IMPLICIT NONE
    24612490
    2462     INTEGER, INTENT(IN)          ::  client_id   !:
     2491    INTEGER, INTENT(IN)          ::  child_id    !:
    24632492    INTEGER, INTENT(IN)          ::  nz_cl       !:
    24642493    CHARACTER(LEN=*), INTENT(IN) ::  name        !:
    … …  
    24932522#if defined( __nopointer )
    24942523    IF ( ASSOCIATED( p_3d ) )  THEN
    2495        CALL pmc_s_set_dataarray( client_id, p_3d, nz_cl, nz )
     2524       CALL pmc_s_set_dataarray( child_id, p_3d, nz_cl, nz )
    24962525    ELSEIF ( ASSOCIATED( p_2d ) )  THEN
    2497        CALL pmc_s_set_dataarray( client_id, p_2d )
     2526       CALL pmc_s_set_dataarray( child_id, p_2d )
    24982527    ELSE
    24992528!
    … …  
    25012530       IF ( myid == 0  .AND.  cpl_id == 1 )  THEN
    25022531
    2503           message_string = 'pointer for array "' // TRIM( name ) //            &
     2532          message_string = 'pointer for array "' // TRIM( name ) //             &
    25042533                           '" can''t be associated'
    25052534          CALL message( 'pmci_set_array_pointer', 'PA0117', 3, 2, 0, 6, 0 )
    … …  
    25192548
    25202549    IF ( ASSOCIATED( p_3d ) )  THEN
    2521        CALL pmc_s_set_dataarray( client_id, p_3d, nz_cl, nz, &
     2550       CALL pmc_s_set_dataarray( child_id, p_3d, nz_cl, nz,                    &
    25222551                                 array_2 = p_3d_sec )
    25232552    ELSEIF ( ASSOCIATED( p_2d ) )  THEN
    2524        CALL pmc_s_set_dataarray( client_id, p_2d )
     2553       CALL pmc_s_set_dataarray( child_id, p_2d )
    25252554    ELSE
    25262555!
    … …  
    25282557       IF ( myid == 0  .AND.  cpl_id == 1 )  THEN
    25292558
    2530           message_string = 'pointer for array "' // TRIM( name ) //            &
     2559          message_string = 'pointer for array "' // TRIM( name ) //             &
    25312560                           '" can''t be associated'
    25322561          CALL message( 'pmci_set_array_pointer', 'PA0117', 3, 2, 0, 6, 0 )
    … …  
    25452574
    25462575
    2547  SUBROUTINE pmci_create_client_arrays( name, is, ie, js, je, nzc  )
     2576 SUBROUTINE pmci_create_child_arrays( name, is, ie, js, je, nzc  )
    25482577
    25492578    IMPLICIT NONE
    … …  
    25992628    ELSE
    26002629!
    2601 !--    Give only one message for the first client domain
     2630!--    Give only one message for the first child domain
    26022631       IF ( myid == 0  .AND.  cpl_id == 2 )  THEN
    26032632
    2604           message_string = 'pointer for array "' // TRIM( name ) //            &
     2633          message_string = 'pointer for array "' // TRIM( name ) //             &
    26052634                           '" can''t be associated'
    2606           CALL message( 'pmci_create_client_arrays', 'PA0170', 3, 2, 0, 6, 0 )
     2635          CALL message( 'pmci_create_child_arrays', 'PA0170', 3, 2, 0, 6, 0 )
    26072636       ELSE
    26082637!
    … …  
    26132642
    26142643#endif
    2615  END SUBROUTINE pmci_create_client_arrays
    2616 
    2617 
    2618 
    2619  SUBROUTINE pmci_server_initialize
    2620 !-- TO_DO: add general explanations about what this subroutine does
     2644 END SUBROUTINE pmci_create_child_arrays
     2645
     2646
     2647
     2648 SUBROUTINE pmci_parent_initialize
     2649
     2650!
     2651!-- Send data for the children in order to let them create initial
     2652!-- conditions by interpolating the parent-domain fields.
    26212653#if defined( __parallel )
    26222654    IMPLICIT NONE
    26232655
    2624     INTEGER(iwp) ::  client_id   !:
     2656    INTEGER(iwp) ::  child_id    !:
    26252657    INTEGER(iwp) ::  m           !:
    26262658
    2627     REAL(wp) ::  waittime    !:
    2628 
    2629 
    2630     DO  m = 1, SIZE( pmc_server_for_client ) - 1
    2631        client_id = pmc_server_for_client(m)
    2632        CALL pmc_s_fillbuffer( client_id, waittime=waittime )
     2659    REAL(wp) ::  waittime        !:
     2660
     2661
     2662    DO  m = 1, SIZE( pmc_parent_for_child ) - 1
     2663       child_id = pmc_parent_for_child(m)
     2664       CALL pmc_s_fillbuffer( child_id, waittime=waittime )
    26332665    ENDDO
    26342666
    26352667#endif
    2636  END SUBROUTINE pmci_server_initialize
    2637 
    2638 
    2639 
    2640  SUBROUTINE pmci_client_initialize
    2641 !-- TO_DO: add general explanations about what this subroutine does
     2668 END SUBROUTINE pmci_parent_initialize
     2669
     2670
     2671
     2672 SUBROUTINE pmci_child_initialize
     2673
     2674!
     2675!-- Create initial conditions for the current child domain by interpolating
     2676!-- the parent-domain fields.
    26422677#if defined( __parallel )
    26432678    IMPLICIT NONE
    … …  
    26502685    INTEGER(iwp) ::  jcs        !:
    26512686
    2652     REAL(wp) ::  waittime   !:
    2653 
    2654 !
    2655 !-- Root id is never a client
     2687    REAL(wp) ::  waittime       !:
     2688
     2689!
     2690!-- Root id is never a child
    26562691    IF ( cpl_id > 1 )  THEN
    26572692
    26582693!
    2659 !--    Client domain boundaries in the server index space
     2694!--    Child domain boundaries in the parent index space
    26602695       icl = coarse_bound(1)
    26612696       icr = coarse_bound(2)
    … …  
    26642699
    26652700!
    2666 !--    Get data from server
     2701!--    Get data from the parent
    26672702       CALL pmc_c_getbuffer( waittime = waittime )
    26682703
    26692704!
    26702705!--    The interpolation.
    2671        CALL pmci_interp_tril_all ( u,  uc,  icu, jco, kco, r1xu, r2xu, r1yo,   &
     2706       CALL pmci_interp_tril_all ( u,  uc,  icu, jco, kco, r1xu, r2xu, r1yo,    &
    26722707                                   r2yo, r1zo, r2zo, nzb_u_inner, 'u' )
    2673        CALL pmci_interp_tril_all ( v,  vc,  ico, jcv, kco, r1xo, r2xo, r1yv,   &
     2708       CALL pmci_interp_tril_all ( v,  vc,  ico, jcv, kco, r1xo, r2xo, r1yv,    &
    26742709                                   r2yv, r1zo, r2zo, nzb_v_inner, 'v' )
    2675        CALL pmci_interp_tril_all ( w,  wc,  ico, jco, kcw, r1xo, r2xo, r1yo,   &
     2710       CALL pmci_interp_tril_all ( w,  wc,  ico, jco, kcw, r1xo, r2xo, r1yo,    &
    26762711                                   r2yo, r1zw, r2zw, nzb_w_inner, 'w' )
    2677        CALL pmci_interp_tril_all ( e,  ec,  ico, jco, kco, r1xo, r2xo, r1yo,   &
     2712       CALL pmci_interp_tril_all ( e,  ec,  ico, jco, kco, r1xo, r2xo, r1yo,    &
    26782713                                   r2yo, r1zo, r2zo, nzb_s_inner, 'e' )
    26792714       IF ( .NOT. neutral )  THEN
    2680           CALL pmci_interp_tril_all ( pt, ptc, ico, jco, kco, r1xo, r2xo,      &
     2715          CALL pmci_interp_tril_all ( pt, ptc, ico, jco, kco, r1xo, r2xo,       &
    26812716                                      r1yo, r2yo, r1zo, r2zo, nzb_s_inner, 's' )
    26822717       ENDIF
    26832718       IF ( humidity  .OR.  passive_scalar )  THEN
    2684           CALL pmci_interp_tril_all ( q, qc, ico, jco, kco, r1xo, r2xo, r1yo,  &
     2719          CALL pmci_interp_tril_all ( q, qc, ico, jco, kco, r1xo, r2xo, r1yo,   &
    26852720                                      r2yo, r1zo, r2zo, nzb_s_inner, 's' )
    26862721       ENDIF
    … …  
    27102745
    27112746
    2712     SUBROUTINE pmci_interp_tril_all( f, fc, ic, jc, kc, r1x, r2x, r1y, r2y,    &
     2747    SUBROUTINE pmci_interp_tril_all( f, fc, ic, jc, kc, r1x, r2x, r1y, r2y,     &
    27132748                                     r1z, r2z, kb, var )
    27142749!
    2715 !--    Interpolation of the internal values for the client-domain initialization
     2750!--    Interpolation of the internal values for the child-domain initialization
    27162751!--    This subroutine is based on trilinear interpolation.
    27172752!--    Coding based on interp_tril_lr/sn/t
    … …  
    27392774
    27402775       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg), INTENT(INOUT) :: f !:
    2741        REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr), INTENT(IN) :: fc    !:
     2776       REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr), INTENT(IN) :: fc       !:
    27422777       REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN) :: r1x   !:
    27432778       REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN) :: r2x   !:
    … …  
    27622797       jb = nys
    27632798       je = nyn
    2764        IF ( nest_bound_l )  THEN
    2765           ib = nxl - 1
    2766 !
    2767 !--       For u, nxl is a ghost node, but not for the other variables
    2768           IF ( var == 'u' )  THEN
    2769              ib = nxl
     2799       IF ( nesting_mode /= 'vertical' )  THEN
     2800          IF ( nest_bound_l )  THEN
     2801             ib = nxl - 1
     2802!
     2803!--          For u, nxl is a ghost node, but not for the other variables
     2804             IF ( var == 'u' )  THEN
     2805                ib = nxl
     2806             ENDIF
    27702807          ENDIF
    2771        ENDIF
    2772        IF ( nest_bound_s )  THEN
    2773           jb = nys - 1
    2774 !
    2775 !--       For v, nys is a ghost node, but not for the other variables
    2776           IF ( var == 'v' )  THEN
    2777              jb = nys
     2808          IF ( nest_bound_s )  THEN
     2809             jb = nys - 1
     2810!
     2811!--          For v, nys is a ghost node, but not for the other variables
     2812             IF ( var == 'v' )  THEN
     2813                jb = nys
     2814             ENDIF
    27782815          ENDIF
    2779        ENDIF
    2780        IF ( nest_bound_r )  THEN
    2781           ie = nxr + 1
    2782        ENDIF
    2783        IF ( nest_bound_n )  THEN
    2784           je = nyn + 1
    2785        ENDIF
    2786 
     2816          IF ( nest_bound_r )  THEN
     2817             ie = nxr + 1
     2818          ENDIF
     2819          IF ( nest_bound_n )  THEN
     2820             je = nyn + 1
     2821          ENDIF
     2822       ENDIF
    27872823!
    27882824!--    Trilinear interpolation.
    … …  
    28282864                k = kb(j,i) + 1
    28292865                DO  WHILE ( zu(k) < zuc1 )
    2830                    logratio = ( LOG( ( zu(k) - zu(kb(j,i)) ) / z0(j,i)) ) / logzuc1
     2866                   logratio = ( LOG( ( zu(k) - zu(kb(j,i)) ) / z0(j,i)) ) /     &
     2867                                logzuc1
    28312868                   f(k,j,i) = logratio * f(k1,j,i)
    28322869                   k  = k + 1
    … …  
    28492886
    28502887#endif
    2851  END SUBROUTINE pmci_client_initialize
     2888 END SUBROUTINE pmci_child_initialize
    28522889
    28532890
    … …  
    28552892 SUBROUTINE pmci_check_setting_mismatches
    28562893!
    2857 !-- Check for mismatches between settings of master and client variables
    2858 !-- (e.g., all clients have to follow the end_time settings of the root model).
     2894!-- Check for mismatches between settings of master and child variables
     2895!-- (e.g., all children have to follow the end_time settings of the root model).
    28592896!-- The root model overwrites variables in the other models, so these variables
    28602897!-- only need to be set once in file PARIN.
    … …  
    28622899#if defined( __parallel )
    28632900
    2864     USE control_parameters,                                                    &
     2901    USE control_parameters,                                                     &
    28652902        ONLY:  dt_restart, end_time, message_string, restart_time, time_restart
    28662903
    … …  
    28842921    IF ( .NOT. pmc_is_rootmodel() )  THEN
    28852922       IF ( end_time /= end_time_root )  THEN
    2886           WRITE( message_string, * )  'mismatch between root model and ',      &
    2887                'client settings &   end_time(root) = ', end_time_root,         &
    2888                ' &   end_time(client) = ', end_time, ' & client value is set', &
     2923          WRITE( message_string, * )  'mismatch between root model and ',       &
     2924               'child settings &   end_time(root) = ', end_time_root,           &
     2925               ' &   end_time(child) = ', end_time, ' & child value is set',    &
    28892926               ' to root value'
    2890           CALL message( 'pmci_check_setting_mismatches', 'PA0419', 0, 1, 0, 6, &
     2927          CALL message( 'pmci_check_setting_mismatches', 'PA0419', 0, 1, 0, 6,  &
    28912928                        0 )
    28922929          end_time = end_time_root
    … …  
    29012938    IF ( .NOT. pmc_is_rootmodel() )  THEN
    29022939       IF ( restart_time /= restart_time_root )  THEN
    2903           WRITE( message_string, * )  'mismatch between root model and ',      &
    2904                'client settings &   restart_time(root) = ', restart_time_root, &
    2905                ' &   restart_time(client) = ', restart_time, ' & client ',     &
     2940          WRITE( message_string, * )  'mismatch between root model and ',       &
     2941               'child settings &   restart_time(root) = ', restart_time_root,  &
     2942               ' &   restart_time(child) = ', restart_time, ' & child ',        &
    29062943               'value is set to root value'
    2907           CALL message( 'pmci_check_setting_mismatches', 'PA0419', 0, 1, 0, 6, &
     2944          CALL message( 'pmci_check_setting_mismatches', 'PA0419', 0, 1, 0, 6,  &
    29082945                        0 )
    29092946          restart_time = restart_time_root
    … …  
    29182955    IF ( .NOT. pmc_is_rootmodel() )  THEN
    29192956       IF ( dt_restart /= dt_restart_root )  THEN
    2920           WRITE( message_string, * )  'mismatch between root model and ',      &
    2921                'client settings &   dt_restart(root) = ', dt_restart_root,     &
    2922                ' &   dt_restart(client) = ', dt_restart, ' & client ',         &
     2957          WRITE( message_string, * )  'mismatch between root model and ',       &
     2958               'child settings &   dt_restart(root) = ', dt_restart_root,       &
     2959               ' &   dt_restart(child) = ', dt_restart, ' & child ',            &
    29232960               'value is set to root value'
    2924           CALL message( 'pmci_check_setting_mismatches', 'PA0419', 0, 1, 0, 6, &
     2961          CALL message( 'pmci_check_setting_mismatches', 'PA0419', 0, 1, 0, 6,  &
    29252962                        0 )
    29262963          dt_restart = dt_restart_root
    … …  
    29352972    IF ( .NOT. pmc_is_rootmodel() )  THEN
    29362973       IF ( time_restart /= time_restart_root )  THEN
    2937           WRITE( message_string, * )  'mismatch between root model and ',      &
    2938                'client settings &   time_restart(root) = ', time_restart_root, &
    2939                ' &   time_restart(client) = ', time_restart, ' & client ',     &
     2974          WRITE( message_string, * )  'mismatch between root model and ',       &
     2975               'child settings &   time_restart(root) = ', time_restart_root,  &
     2976               ' &   time_restart(child) = ', time_restart, ' & child ',        &
    29402977               'value is set to root value'
    2941           CALL message( 'pmci_check_setting_mismatches', 'PA0419', 0, 1, 0, 6, &
     2978          CALL message( 'pmci_check_setting_mismatches', 'PA0419', 0, 1, 0, 6,  &
    29422979                        0 )
    29432980          time_restart = time_restart_root
    … …  
    29532990 SUBROUTINE pmci_ensure_nest_mass_conservation
    29542991
    2955 #if defined( __parallel )
    29562992!
    29572993!-- Adjust the volume-flow rate through the top boundary so that the net volume
    … …  
    29592995    IMPLICIT NONE
    29602996
    2961     INTEGER(iwp) ::  i                          !:
    2962     INTEGER(iwp) ::  ierr                       !:
    2963     INTEGER(iwp) ::  j                          !:
    2964     INTEGER(iwp) ::  k                          !:
     2997    INTEGER(iwp) ::  i                           !:
     2998    INTEGER(iwp) ::  ierr                        !:
     2999    INTEGER(iwp) ::  j                           !:
     3000    INTEGER(iwp) ::  k                           !:
    29653001
    29663002    REAL(wp) ::  dxdy                            !:
    … …  
    29963032#if defined( __parallel )
    29973033    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
    2998     CALL MPI_ALLREDUCE( volume_flow_l(1), volume_flow(1), 1, MPI_REAL, &
     3034    CALL MPI_ALLREDUCE( volume_flow_l(1), volume_flow(1), 1, MPI_REAL,          &
    29993035                        MPI_SUM, comm2d, ierr )
    30003036#else
    … …  
    30293065#if defined( __parallel )
    30303066    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
    3031     CALL MPI_ALLREDUCE( volume_flow_l(2), volume_flow(2), 1, MPI_REAL,         &
     3067    CALL MPI_ALLREDUCE( volume_flow_l(2), volume_flow(2), 1, MPI_REAL,          &
    30323068                        MPI_SUM, comm2d, ierr )
    30333069#else
    … …  
    30493085#if defined( __parallel )
    30503086    IF ( collective_wait )  CALL MPI_BARRIER( comm2d, ierr )
    3051     CALL MPI_ALLREDUCE( volume_flow_l(3), volume_flow(3), 1, MPI_REAL,         &
     3087    CALL MPI_ALLREDUCE( volume_flow_l(3), volume_flow(3), 1, MPI_REAL,          &
    30523088                        MPI_SUM, comm2d, ierr )
    30533089#else
    … …  
    30663102    ENDDO
    30673103
    3068 #endif
    30693104 END SUBROUTINE pmci_ensure_nest_mass_conservation
    30703105
    … …  
    31013136    IMPLICIT NONE
    31023137
    3103     INTEGER(iwp),INTENT(IN) ::  swaplevel  !: swaplevel (1 or 2) of PALM's
    3104                                            !: timestep
    3105 
    3106     INTEGER(iwp)            ::  client_id  !:
    3107     INTEGER(iwp)            ::  m          !:
    3108 
    3109     DO  m = 1, SIZE( pmc_server_for_client )-1
    3110        client_id = pmc_server_for_client(m)
    3111        CALL pmc_s_set_active_data_array( client_id, swaplevel )
     3138    INTEGER(iwp), INTENT(IN) ::  swaplevel  !: swaplevel (1 or 2) of PALM's
     3139                                            !: timestep
     3140
     3141    INTEGER(iwp)            ::  child_id    !:
     3142    INTEGER(iwp)            ::  m           !:
     3143
     3144    DO  m = 1, SIZE( pmc_parent_for_child )-1
     3145       child_id = pmc_parent_for_child(m)
     3146       CALL pmc_s_set_active_data_array( child_id, swaplevel )
    31123147    ENDDO
    31133148
    … …  
    31313166    INTEGER(iwp)           ::  istat  !:
    31323167
    3133     CHARACTER(LEN=*),INTENT(IN) ::  local_nesting_mode
    3134 
    3135     IF ( local_nesting_mode == 'one-way' )  THEN
    3136 
    3137        CALL pmci_client_datatrans( server_to_client )
    3138        CALL pmci_server_datatrans( server_to_client )
     3168    CHARACTER(LEN=*), INTENT(IN) ::  local_nesting_mode
     3169
     3170    IF ( TRIM( local_nesting_mode ) == 'one-way' )  THEN
     3171
     3172       CALL pmci_child_datatrans( parent_to_child )
     3173       CALL pmci_parent_datatrans( parent_to_child )
    31393174
    31403175    ELSE
    31413176
    3142        IF ( nesting_datatransfer_mode == 'cascade' )  THEN
    3143 
    3144           CALL pmci_client_datatrans( server_to_client )
    3145           CALL pmci_server_datatrans( server_to_client )
    3146 
    3147           CALL pmci_server_datatrans( client_to_server )
    3148           CALL pmci_client_datatrans( client_to_server )
    3149 
    3150        ELSEIF ( nesting_datatransfer_mode == 'overlap' )  THEN
    3151 
    3152           CALL pmci_server_datatrans( server_to_client )
    3153           CALL pmci_client_datatrans( server_to_client )
    3154 
    3155           CALL pmci_client_datatrans( client_to_server )
    3156           CALL pmci_server_datatrans( client_to_server )
    3157 
    3158        ELSEIF ( TRIM( nesting_datatransfer_mode ) == 'mixed' )  THEN
    3159 
    3160           CALL pmci_server_datatrans( server_to_client )
    3161           CALL pmci_client_datatrans( server_to_client )
    3162 
    3163           CALL pmci_server_datatrans( client_to_server )
    3164           CALL pmci_client_datatrans( client_to_server )
     3177       IF( nesting_datatransfer_mode == 'cascade' )  THEN
     3178
     3179          CALL pmci_child_datatrans( parent_to_child )
     3180          CALL pmci_parent_datatrans( parent_to_child )
     3181
     3182          CALL pmci_parent_datatrans( child_to_parent )
     3183          CALL pmci_child_datatrans( child_to_parent )
     3184
     3185       ELSEIF( nesting_datatransfer_mode == 'overlap')  THEN
     3186
     3187          CALL pmci_parent_datatrans( parent_to_child )
     3188          CALL pmci_child_datatrans( parent_to_child )
     3189
     3190          CALL pmci_child_datatrans( child_to_parent )
     3191          CALL pmci_parent_datatrans( child_to_parent )
     3192
     3193       ELSEIF( TRIM( nesting_datatransfer_mode ) == 'mixed' )  THEN
     3194
     3195          CALL pmci_parent_datatrans( parent_to_child )
     3196          CALL pmci_child_datatrans( parent_to_child )
     3197
     3198          CALL pmci_parent_datatrans( child_to_parent )
     3199          CALL pmci_child_datatrans( child_to_parent )
    31653200
    31663201       ENDIF
    … …  
    31733208
    31743209
    3175  SUBROUTINE pmci_server_datatrans( direction )
     3210 SUBROUTINE pmci_parent_datatrans( direction )
    31763211
    31773212    IMPLICIT NONE
    31783213
    3179     INTEGER(iwp),INTENT(IN) ::  direction   !:
     3214    INTEGER(iwp), INTENT(IN) ::  direction   !:
    31803215
    31813216#if defined( __parallel )
    3182     INTEGER(iwp) ::  client_id   !:
     3217    INTEGER(iwp) ::  child_id    !:
    31833218    INTEGER(iwp) ::  i           !:
    31843219    INTEGER(iwp) ::  j           !:
    … …  
    31913226
    31923227
    3193     DO  m = 1, SIZE( PMC_Server_for_Client )-1
    3194        client_id = PMC_Server_for_Client(m)
     3228    DO  m = 1, SIZE( pmc_parent_for_child ) - 1
     3229       child_id = pmc_parent_for_child(m)
    31953230       
    3196        IF ( direction == server_to_client )  THEN
    3197           CALL cpu_log( log_point_s(71), 'pmc server send', 'start' )
    3198           CALL pmc_s_fillbuffer( client_id )
    3199           CALL cpu_log( log_point_s(71), 'pmc server send', 'stop' )
     3231       IF ( direction == parent_to_child )  THEN
     3232          CALL cpu_log( log_point_s(71), 'pmc parent send', 'start' )
     3233          CALL pmc_s_fillbuffer( child_id )
     3234          CALL cpu_log( log_point_s(71), 'pmc parent send', 'stop' )
    32003235       ELSE
    32013236!
    3202 !--       Communication from client to server
    3203           CALL cpu_log( log_point_s(72), 'pmc server recv', 'start' )
    3204           client_id = pmc_server_for_client(m)
    3205           CALL pmc_s_getdata_from_buffer( client_id )
    3206           CALL cpu_log( log_point_s(72), 'pmc server recv', 'stop' )
     3237!--       Communication from child to parent
     3238          CALL cpu_log( log_point_s(72), 'pmc parent recv', 'start' )
     3239          child_id = pmc_parent_for_child(m)
     3240          CALL pmc_s_getdata_from_buffer( child_id )
     3241          CALL cpu_log( log_point_s(72), 'pmc parent recv', 'stop' )
    32073242
    32083243!
    … …  
    32343269
    32353270#endif
    3236  END SUBROUTINE pmci_server_datatrans
    3237 
    3238 
    3239 
    3240  SUBROUTINE pmci_client_datatrans( direction )
     3271 END SUBROUTINE pmci_parent_datatrans
     3272
     3273
     3274
     3275 SUBROUTINE pmci_child_datatrans( direction )
    32413276
    32423277    IMPLICIT NONE
    … …  
    32583293    IF ( cpl_id > 1 )  THEN
    32593294!
    3260 !--    Client domain boundaries in the server indice space.
     3295!--    Child domain boundaries in the parent indice space.
    32613296       icl = coarse_bound(1)
    32623297       icr = coarse_bound(2)
    … …  
    32643299       jcn = coarse_bound(4)
    32653300
    3266        IF ( direction == server_to_client )  THEN
    3267 
    3268           CALL cpu_log( log_point_s(73), 'pmc client recv', 'start' )
     3301       IF ( direction == parent_to_child )  THEN
     3302
     3303          CALL cpu_log( log_point_s(73), 'pmc child recv', 'start' )
    32693304          CALL pmc_c_getbuffer( )
    3270           CALL cpu_log( log_point_s(73), 'pmc client recv', 'stop' )
     3305          CALL cpu_log( log_point_s(73), 'pmc child recv', 'stop' )
    32713306
    32723307          CALL cpu_log( log_point_s(75), 'pmc interpolation', 'start' )
    … …  
    32763311       ELSE
    32773312!
    3278 !--       direction == client_to_server
     3313!--       direction == child_to_parent
    32793314          CALL cpu_log( log_point_s(76), 'pmc anterpolation', 'start' )
    32803315          CALL pmci_anterpolation
    32813316          CALL cpu_log( log_point_s(76), 'pmc anterpolation', 'stop' )
    32823317
    3283           CALL cpu_log( log_point_s(74), 'pmc client send', 'start' )
     3318          CALL cpu_log( log_point_s(74), 'pmc child send', 'start' )
    32843319          CALL pmc_c_putbuffer( )
    3285           CALL cpu_log( log_point_s(74), 'pmc client send', 'stop' )
     3320          CALL cpu_log( log_point_s(74), 'pmc child send', 'stop' )
    32863321
    32873322       ENDIF
    … …  
    32973332
    32983333!
    3299 !--    Add IF-condition here: IF not vertical nesting
     3334!--    In case of vertical nesting no interpolation is needed for the
     3335!--    horizontal boundaries
     3336       IF ( nesting_mode /= 'vertical' )  THEN
     3337       
     3338!
    33003339!--    Left border pe:
    3301        IF ( nest_bound_l )  THEN
    3302           CALL pmci_interp_tril_lr( u,  uc,  icu, jco, kco, r1xu, r2xu, r1yo,  &
    3303                                     r2yo, r1zo, r2zo, nzb_u_inner, logc_u_l,   &
    3304                                     logc_ratio_u_l, nzt_topo_nestbc_l, 'l',    &
    3305                                     'u' )
    3306           CALL pmci_interp_tril_lr( v,  vc,  ico, jcv, kco, r1xo, r2xo, r1yv,  &
    3307                                     r2yv, r1zo, r2zo, nzb_v_inner, logc_v_l,   &
    3308                                     logc_ratio_v_l, nzt_topo_nestbc_l, 'l',    &
    3309                                     'v' )
    3310           CALL pmci_interp_tril_lr( w,  wc,  ico, jco, kcw, r1xo, r2xo, r1yo,  &
    3311                                     r2yo, r1zw, r2zw, nzb_w_inner, logc_w_l,   &
    3312                                     logc_ratio_w_l, nzt_topo_nestbc_l, 'l',    &
    3313                                     'w' )
    3314           CALL pmci_interp_tril_lr( e,  ec,  ico, jco, kco, r1xo, r2xo, r1yo,  &
    3315                                     r2yo, r1zo, r2zo, nzb_s_inner, logc_u_l,   &
    3316                                     logc_ratio_u_l, nzt_topo_nestbc_l, 'l',    &
    3317                                     'e' )
    3318           IF ( .NOT. neutral )  THEN
    3319              CALL pmci_interp_tril_lr( pt, ptc, ico, jco, kco, r1xo, r2xo,     &
    3320                                        r1yo, r2yo, r1zo, r2zo, nzb_s_inner,    &
    3321                                        logc_u_l, logc_ratio_u_l,               &
    3322                                        nzt_topo_nestbc_l, 'l', 's' )
    3323           ENDIF
    3324           IF ( humidity  .OR.  passive_scalar )  THEN
    3325              CALL pmci_interp_tril_lr( q, qc, ico, jco, kco, r1xo, r2xo, r1yo, &
    3326                                        r2yo, r1zo, r2zo, nzb_s_inner,          &
    3327                                        logc_u_l, logc_ratio_u_l,               &
    3328                                        nzt_topo_nestbc_l, 'l', 's' )
    3329           ENDIF
    3330 
    3331           IF ( nesting_mode == 'one-way' )  THEN
    3332              CALL pmci_extrap_ifoutflow_lr( u, nzb_u_inner, 'l', 'u' )
    3333              CALL pmci_extrap_ifoutflow_lr( v, nzb_v_inner, 'l', 'v' )
    3334              CALL pmci_extrap_ifoutflow_lr( w, nzb_w_inner, 'l', 'w' )
    3335              CALL pmci_extrap_ifoutflow_lr( e, nzb_s_inner, 'l', 'e' )
     3340          IF ( nest_bound_l )  THEN
     3341             CALL pmci_interp_tril_lr( u,  uc,  icu, jco, kco, r1xu, r2xu,      &
     3342                                       r1yo, r2yo, r1zo, r2zo, nzb_u_inner,     &
     3343                                       logc_u_l, logc_ratio_u_l,                &
     3344                                       nzt_topo_nestbc_l, 'l', 'u' )
     3345             CALL pmci_interp_tril_lr( v,  vc,  ico, jcv, kco, r1xo, r2xo,      &
     3346                                       r1yv, r2yv, r1zo, r2zo, nzb_v_inner,     &
     3347                                       logc_v_l, logc_ratio_v_l,                &
     3348                                       nzt_topo_nestbc_l, 'l', 'v' )
     3349             CALL pmci_interp_tril_lr( w,  wc,  ico, jco, kcw, r1xo, r2xo,      &
     3350                                       r1yo, r2yo, r1zw, r2zw, nzb_w_inner,     &
     3351                                       logc_w_l, logc_ratio_w_l,                &
     3352                                       nzt_topo_nestbc_l, 'l', 'w' )
     3353             CALL pmci_interp_tril_lr( e,  ec,  ico, jco, kco, r1xo, r2xo,      &
     3354                                       r1yo, r2yo, r1zo, r2zo, nzb_s_inner,     &
     3355                                       logc_u_l, logc_ratio_u_l,                &
     3356                                       nzt_topo_nestbc_l, 'l', 'e' )
    33363357             IF ( .NOT. neutral )  THEN
    3337                 CALL pmci_extrap_ifoutflow_lr( pt,nzb_s_inner, 'l', 's' )
     3358                CALL pmci_interp_tril_lr( pt, ptc, ico, jco, kco, r1xo, r2xo,   &
     3359                                          r1yo, r2yo, r1zo, r2zo, nzb_s_inner,  &
     3360                                          logc_u_l, logc_ratio_u_l,             &
     3361                                          nzt_topo_nestbc_l, 'l', 's' )
    33383362             ENDIF
    33393363             IF ( humidity  .OR.  passive_scalar )  THEN
    3340                 CALL pmci_extrap_ifoutflow_lr( q, nzb_s_inner, 'l', 's' )
     3364                CALL pmci_interp_tril_lr( q, qc, ico, jco, kco, r1xo, r2xo,     &
     3365                                          r1yo, r2yo, r1zo, r2zo, nzb_s_inner,  &
     3366                                          logc_u_l, logc_ratio_u_l,             &
     3367                                          nzt_topo_nestbc_l, 'l', 's' )
    33413368             ENDIF
     3369
     3370             IF ( TRIM( nesting_mode ) == 'one-way' )  THEN
     3371                CALL pmci_extrap_ifoutflow_lr( u, nzb_u_inner, 'l', 'u' )
     3372                CALL pmci_extrap_ifoutflow_lr( v, nzb_v_inner, 'l', 'v' )
     3373                CALL pmci_extrap_ifoutflow_lr( w, nzb_w_inner, 'l', 'w' )
     3374                CALL pmci_extrap_ifoutflow_lr( e, nzb_s_inner, 'l', 'e' )
     3375                IF ( .NOT. neutral )  THEN
     3376                   CALL pmci_extrap_ifoutflow_lr( pt,nzb_s_inner, 'l', 's' )
     3377                ENDIF
     3378                IF ( humidity  .OR.  passive_scalar )  THEN
     3379                   CALL pmci_extrap_ifoutflow_lr( q, nzb_s_inner, 'l', 's' )
     3380                ENDIF
     3381             ENDIF
     3382
    33423383          ENDIF
    33433384
    3344        ENDIF
    3345 !
    3346 !--    Right border pe
    3347        IF ( nest_bound_r )  THEN
    3348           CALL pmci_interp_tril_lr( u,  uc,  icu, jco, kco, r1xu, r2xu, r1yo,  &
    3349                                     r2yo, r1zo, r2zo, nzb_u_inner, logc_u_r,   &
    3350                                     logc_ratio_u_r, nzt_topo_nestbc_r, 'r',    &
    3351                                     'u' )
    3352           CALL pmci_interp_tril_lr( v,  vc,  ico, jcv, kco, r1xo, r2xo, r1yv,  &
    3353                                     r2yv, r1zo, r2zo, nzb_v_inner, logc_v_r,   &
    3354                                     logc_ratio_v_r, nzt_topo_nestbc_r, 'r',    &
    3355                                     'v' )
    3356           CALL pmci_interp_tril_lr( w,  wc,  ico, jco, kcw, r1xo, r2xo, r1yo,  &
    3357                                     r2yo, r1zw, r2zw, nzb_w_inner, logc_w_r,   &
    3358                                     logc_ratio_w_r, nzt_topo_nestbc_r, 'r',    &
    3359                                     'w' )
    3360           CALL pmci_interp_tril_lr( e,  ec,  ico, jco, kco, r1xo, r2xo, r1yo,  &
    3361                                     r2yo, r1zo, r2zo, nzb_s_inner, logc_u_r,   &
    3362                                     logc_ratio_u_r, nzt_topo_nestbc_r, 'r',    &
    3363                                     'e' )
    3364           IF ( .NOT. neutral )  THEN
    3365              CALL pmci_interp_tril_lr( pt, ptc, ico, jco, kco, r1xo, r2xo,     &
    3366                                        r1yo, r2yo, r1zo, r2zo, nzb_s_inner,    &
    3367                                        logc_u_r, logc_ratio_u_r,               &
    3368                                        nzt_topo_nestbc_r, 'r', 's' )
    3369           ENDIF
    3370           IF ( humidity  .OR.  passive_scalar )  THEN
    3371              CALL pmci_interp_tril_lr( q, qc, ico, jco, kco, r1xo, r2xo, r1yo, &
    3372                                        r2yo, r1zo, r2zo, nzb_s_inner,          &
    3373                                        logc_u_r, logc_ratio_u_r,               &
    3374                                        nzt_topo_nestbc_r, 'r', 's' )
    3375           ENDIF
    3376 
    3377           IF ( nesting_mode == 'one-way' )  THEN
    3378              CALL pmci_extrap_ifoutflow_lr( u, nzb_u_inner, 'r', 'u' )
    3379              CALL pmci_extrap_ifoutflow_lr( v, nzb_v_inner, 'r', 'v' )
    3380              CALL pmci_extrap_ifoutflow_lr( w, nzb_w_inner, 'r', 'w' )
    3381              CALL pmci_extrap_ifoutflow_lr( e, nzb_s_inner, 'r', 'e' )
     3385   !
     3386   !--    Right border pe
     3387          IF ( nest_bound_r )  THEN
     3388             CALL pmci_interp_tril_lr( u,  uc,  icu, jco, kco, r1xu, r2xu,      &
     3389                                       r1yo, r2yo, r1zo, r2zo, nzb_u_inner,     &
     3390                                       logc_u_r, logc_ratio_u_r,                &
     3391                                       nzt_topo_nestbc_r, 'r', 'u' )
     3392             CALL pmci_interp_tril_lr( v,  vc,  ico, jcv, kco, r1xo, r2xo,      &
     3393                                       r1yv, r2yv, r1zo, r2zo, nzb_v_inner,     &
     3394                                       logc_v_r, logc_ratio_v_r,                &
     3395                                       nzt_topo_nestbc_r, 'r', 'v' )
     3396             CALL pmci_interp_tril_lr( w,  wc,  ico, jco, kcw, r1xo, r2xo,      &
     3397                                       r1yo, r2yo, r1zw, r2zw, nzb_w_inner,     &
     3398                                       logc_w_r, logc_ratio_w_r,                &
     3399                                       nzt_topo_nestbc_r, 'r', 'w' )
     3400             CALL pmci_interp_tril_lr( e,  ec,  ico, jco, kco, r1xo, r2xo,      &
     3401                                       r1yo,r2yo, r1zo, r2zo, nzb_s_inner,      &
     3402                                       logc_u_r, logc_ratio_u_r,                &
     3403                                       nzt_topo_nestbc_r, 'r', 'e' )
    33823404             IF ( .NOT. neutral )  THEN
    3383                 CALL pmci_extrap_ifoutflow_lr( pt,nzb_s_inner, 'r', 's' )
     3405                CALL pmci_interp_tril_lr( pt, ptc, ico, jco, kco, r1xo, r2xo,   &
     3406                                          r1yo, r2yo, r1zo, r2zo, nzb_s_inner,  &
     3407                                          logc_u_r, logc_ratio_u_r,             &
     3408                                          nzt_topo_nestbc_r, 'r', 's' )
    33843409             ENDIF
    33853410             IF ( humidity  .OR.  passive_scalar )  THEN
    3386                 CALL pmci_extrap_ifoutflow_lr( q, nzb_s_inner, 'r', 's' )
     3411                CALL pmci_interp_tril_lr( q, qc, ico, jco, kco, r1xo, r2xo,     &
     3412                                          r1yo, r2yo, r1zo, r2zo, nzb_s_inner,  &
     3413                                          logc_u_r, logc_ratio_u_r,             &
     3414                                          nzt_topo_nestbc_r, 'r', 's' )
    33873415             ENDIF
     3416
     3417             IF ( TRIM( nesting_mode ) == 'one-way' )  THEN
     3418                CALL pmci_extrap_ifoutflow_lr( u, nzb_u_inner, 'r', 'u' )
     3419                CALL pmci_extrap_ifoutflow_lr( v, nzb_v_inner, 'r', 'v' )
     3420                CALL pmci_extrap_ifoutflow_lr( w, nzb_w_inner, 'r', 'w' )
     3421                CALL pmci_extrap_ifoutflow_lr( e, nzb_s_inner, 'r', 'e' )
     3422                IF ( .NOT. neutral )  THEN
     3423                   CALL pmci_extrap_ifoutflow_lr( pt,nzb_s_inner, 'r', 's' )
     3424                ENDIF
     3425                IF ( humidity  .OR.  passive_scalar )  THEN
     3426                   CALL pmci_extrap_ifoutflow_lr( q, nzb_s_inner, 'r', 's' )
     3427                ENDIF
     3428             ENDIF
     3429
    33883430          ENDIF
    33893431
    3390        ENDIF
    3391 !
    3392 !--    South border pe
    3393        IF ( nest_bound_s )  THEN
    3394           CALL pmci_interp_tril_sn( u,  uc,  icu, jco, kco, r1xu, r2xu, r1yo,  &
    3395                                     r2yo, r1zo, r2zo, nzb_u_inner, logc_u_s,   &
    3396                                     logc_ratio_u_s, nzt_topo_nestbc_s, 's',    &
    3397                                     'u' )
    3398           CALL pmci_interp_tril_sn( v,  vc,  ico, jcv, kco, r1xo, r2xo, r1yv,  &
    3399                                     r2yv, r1zo, r2zo, nzb_v_inner, logc_v_s,   &
    3400                                     logc_ratio_v_s, nzt_topo_nestbc_s, 's',    &
    3401                                     'v' )
    3402           CALL pmci_interp_tril_sn( w,  wc,  ico, jco, kcw, r1xo, r2xo, r1yo,  &
    3403                                     r2yo, r1zw, r2zw, nzb_w_inner, logc_w_s,   &
    3404                                     logc_ratio_w_s, nzt_topo_nestbc_s, 's',    &
    3405                                     'w' )
    3406           CALL pmci_interp_tril_sn( e,  ec,  ico, jco, kco, r1xo, r2xo, r1yo,  &
    3407                                     r2yo, r1zo, r2zo, nzb_s_inner, logc_u_s,   &
    3408                                     logc_ratio_u_s, nzt_topo_nestbc_s, 's',    &
    3409                                     'e' )
    3410           IF ( .NOT. neutral )  THEN
    3411              CALL pmci_interp_tril_sn( pt, ptc, ico, jco, kco, r1xo, r2xo,     &
    3412                                        r1yo, r2yo, r1zo, r2zo, nzb_s_inner,    &
    3413                                        logc_u_s, logc_ratio_u_s,               &
    3414                                        nzt_topo_nestbc_s, 's', 's' )
    3415           ENDIF
    3416           IF ( humidity  .OR.  passive_scalar )  THEN
    3417              CALL pmci_interp_tril_sn( q, qc, ico, jco, kco, r1xo, r2xo, r1yo, &
    3418                                        r2yo, r1zo, r2zo, nzb_s_inner,          &
    3419                                        logc_u_s, logc_ratio_u_s,               &
    3420                                        nzt_topo_nestbc_s, 's', 's' )
    3421           ENDIF
    3422 
    3423           IF ( nesting_mode == 'one-way' )  THEN
    3424              CALL pmci_extrap_ifoutflow_sn( u, nzb_u_inner, 's', 'u' )
    3425              CALL pmci_extrap_ifoutflow_sn( v, nzb_v_inner, 's', 'v' )
    3426              CALL pmci_extrap_ifoutflow_sn( w, nzb_w_inner, 's', 'w' )
    3427              CALL pmci_extrap_ifoutflow_sn( e, nzb_s_inner, 's', 'e' )
     3432   !
     3433   !--    South border pe
     3434          IF ( nest_bound_s )  THEN
     3435             CALL pmci_interp_tril_sn( u,  uc,  icu, jco, kco, r1xu, r2xu,      &
     3436                                       r1yo, r2yo, r1zo, r2zo, nzb_u_inner,     &
     3437                                       logc_u_s, logc_ratio_u_s,                &
     3438                                       nzt_topo_nestbc_s, 's', 'u' )
     3439             CALL pmci_interp_tril_sn( v,  vc,  ico, jcv, kco, r1xo, r2xo,      &
     3440                                       r1yv, r2yv, r1zo, r2zo, nzb_v_inner,     &
     3441                                       logc_v_s, logc_ratio_v_s,                &
     3442                                       nzt_topo_nestbc_s, 's', 'v' )
     3443             CALL pmci_interp_tril_sn( w,  wc,  ico, jco, kcw, r1xo, r2xo,      &
     3444                                       r1yo, r2yo, r1zw, r2zw, nzb_w_inner,     &
     3445                                       logc_w_s, logc_ratio_w_s,                &
     3446                                       nzt_topo_nestbc_s, 's','w' )
     3447             CALL pmci_interp_tril_sn( e,  ec,  ico, jco, kco, r1xo, r2xo,      &
     3448                                       r1yo, r2yo, r1zo, r2zo, nzb_s_inner,     &
     3449                                       logc_u_s, logc_ratio_u_s,                &
     3450                                       nzt_topo_nestbc_s, 's', 'e' )
    34283451             IF ( .NOT. neutral )  THEN
    3429                 CALL pmci_extrap_ifoutflow_sn( pt,nzb_s_inner, 's', 's' )
     3452                CALL pmci_interp_tril_sn( pt, ptc, ico, jco, kco, r1xo, r2xo,   &
     3453                                          r1yo, r2yo, r1zo, r2zo, nzb_s_inner,  &
     3454                                          logc_u_s, logc_ratio_u_s,             &
     3455                                          nzt_topo_nestbc_s, 's', 's' )
    34303456             ENDIF
    34313457             IF ( humidity  .OR.  passive_scalar )  THEN
    3432                 CALL pmci_extrap_ifoutflow_sn( q, nzb_s_inner, 's', 's' )
     3458                CALL pmci_interp_tril_sn( q, qc, ico, jco, kco, r1xo, r2xo,     &
     3459                                          r1yo,r2yo, r1zo, r2zo, nzb_s_inner,   &
     3460                                          logc_u_s, logc_ratio_u_s,             &
     3461                                          nzt_topo_nestbc_s, 's', 's' )
    34333462             ENDIF
     3463
     3464             IF ( TRIM( nesting_mode ) == 'one-way' )  THEN
     3465                CALL pmci_extrap_ifoutflow_sn( u, nzb_u_inner, 's', 'u' )
     3466                CALL pmci_extrap_ifoutflow_sn( v, nzb_v_inner, 's', 'v' )
     3467                CALL pmci_extrap_ifoutflow_sn( w, nzb_w_inner, 's', 'w' )
     3468                CALL pmci_extrap_ifoutflow_sn( e, nzb_s_inner, 's', 'e' )
     3469                IF ( .NOT. neutral )  THEN
     3470                   CALL pmci_extrap_ifoutflow_sn( pt,nzb_s_inner, 's', 's' )
     3471                ENDIF
     3472                IF ( humidity  .OR.  passive_scalar )  THEN
     3473                   CALL pmci_extrap_ifoutflow_sn( q, nzb_s_inner, 's', 's' )
     3474                ENDIF
     3475             ENDIF
     3476
    34343477          ENDIF
    34353478
    3436        ENDIF
    3437 !
    3438 !--    North border pe
    3439        IF ( nest_bound_n )  THEN
    3440           CALL pmci_interp_tril_sn( u,  uc,  icu, jco, kco, r1xu, r2xu, r1yo,  &
    3441                                     r2yo, r1zo, r2zo, nzb_u_inner, logc_u_n,   &
    3442                                     logc_ratio_u_n, nzt_topo_nestbc_n, 'n',    &
    3443                                     'u' )
    3444           CALL pmci_interp_tril_sn( v,  vc,  ico, jcv, kco, r1xo, r2xo, r1yv,  &
    3445                                     r2yv, r1zo, r2zo, nzb_v_inner, logc_v_n,   &
    3446                                     logc_ratio_v_n, nzt_topo_nestbc_n, 'n',    &
    3447                                     'v' )
    3448           CALL pmci_interp_tril_sn( w,  wc,  ico, jco, kcw, r1xo, r2xo, r1yo,  &
    3449                                     r2yo, r1zw, r2zw, nzb_w_inner, logc_w_n,   &
    3450                                     logc_ratio_w_n, nzt_topo_nestbc_n, 'n',    &
    3451                                     'w' )
    3452           CALL pmci_interp_tril_sn( e,  ec,  ico, jco, kco, r1xo, r2xo, r1yo,  &
    3453                                     r2yo, r1zo, r2zo, nzb_s_inner, logc_u_n,   &
    3454                                     logc_ratio_u_n, nzt_topo_nestbc_n, 'n',    &
    3455                                     'e' )
    3456           IF ( .NOT. neutral )  THEN
    3457              CALL pmci_interp_tril_sn( pt, ptc, ico, jco, kco, r1xo, r2xo,     &
    3458                                        r1yo, r2yo, r1zo, r2zo, nzb_s_inner,    &
    3459                                        logc_u_n, logc_ratio_u_n,               &
    3460                                        nzt_topo_nestbc_n, 'n', 's' )
    3461           ENDIF
    3462           IF ( humidity  .OR.  passive_scalar )  THEN
    3463              CALL pmci_interp_tril_sn( q, qc, ico, jco, kco, r1xo, r2xo, r1yo, &
    3464                                        r2yo, r1zo, r2zo, nzb_s_inner,          &
    3465                                        logc_u_n, logc_ratio_u_n,               &
    3466                                        nzt_topo_nestbc_n, 'n', 's' )
    3467           ENDIF
    3468 
    3469           IF ( nesting_mode == 'one-way' )  THEN
    3470              CALL pmci_extrap_ifoutflow_sn( u, nzb_u_inner, 'n', 'u' )
    3471              CALL pmci_extrap_ifoutflow_sn( v, nzb_v_inner, 'n', 'v' )
    3472              CALL pmci_extrap_ifoutflow_sn( w, nzb_w_inner, 'n', 'w' )
    3473              CALL pmci_extrap_ifoutflow_sn( e, nzb_s_inner, 'n', 'e' )
     3479   !
     3480   !--    North border pe
     3481          IF ( nest_bound_n )  THEN
     3482             CALL pmci_interp_tril_sn( u,  uc,  icu, jco, kco, r1xu, r2xu,      &
     3483                                       r1yo, r2yo, r1zo, r2zo, nzb_u_inner,     &
     3484                                       logc_u_n, logc_ratio_u_n,                &
     3485                                       nzt_topo_nestbc_n, 'n', 'u' )
     3486             CALL pmci_interp_tril_sn( v,  vc,  ico, jcv, kco, r1xo, r2xo,      &
     3487                                       r1yv, r2yv, r1zo, r2zo, nzb_v_inner,     &
     3488                                       logc_v_n, logc_ratio_v_n,                &
     3489                                       nzt_topo_nestbc_n, 'n', 'v' )
     3490             CALL pmci_interp_tril_sn( w,  wc,  ico, jco, kcw, r1xo, r2xo,      &
     3491                                       r1yo, r2yo, r1zw, r2zw, nzb_w_inner,     &
     3492                                       logc_w_n, logc_ratio_w_n,                &
     3493                                       nzt_topo_nestbc_n, 'n', 'w' )
     3494             CALL pmci_interp_tril_sn( e,  ec,  ico, jco, kco, r1xo, r2xo,      &
     3495                                       r1yo, r2yo, r1zo, r2zo, nzb_s_inner,     &
     3496                                       logc_u_n, logc_ratio_u_n,                &
     3497                                       nzt_topo_nestbc_n, 'n', 'e' )
    34743498             IF ( .NOT. neutral )  THEN
    3475                 CALL pmci_extrap_ifoutflow_sn( pt,nzb_s_inner, 'n', 's' )
     3499                CALL pmci_interp_tril_sn( pt, ptc, ico, jco, kco, r1xo, r2xo,   &
     3500                                          r1yo, r2yo, r1zo, r2zo, nzb_s_inner,  &
     3501                                          logc_u_n, logc_ratio_u_n,             &
     3502                                          nzt_topo_nestbc_n, 'n', 's' )
    34763503             ENDIF
    34773504             IF ( humidity  .OR.  passive_scalar )  THEN
    3478                 CALL pmci_extrap_ifoutflow_sn( q, nzb_s_inner, 'n', 's' )
     3505                CALL pmci_interp_tril_sn( q, qc, ico, jco, kco, r1xo, r2xo,     &
     3506                                          r1yo, r2yo, r1zo, r2zo, nzb_s_inner,  &
     3507                                          logc_u_n, logc_ratio_u_n,             &
     3508                                          nzt_topo_nestbc_n, 'n', 's' )
    34793509             ENDIF
    34803510
     3511             IF ( TRIM( nesting_mode ) == 'one-way' )  THEN
     3512                CALL pmci_extrap_ifoutflow_sn( u, nzb_u_inner, 'n', 'u' )
     3513                CALL pmci_extrap_ifoutflow_sn( v, nzb_v_inner, 'n', 'v' )
     3514                CALL pmci_extrap_ifoutflow_sn( w, nzb_w_inner, 'n', 'w' )
     3515                CALL pmci_extrap_ifoutflow_sn( e, nzb_s_inner, 'n', 'e' )
     3516                IF ( .NOT. neutral )  THEN
     3517                   CALL pmci_extrap_ifoutflow_sn( pt,nzb_s_inner, 'n', 's' )
     3518                ENDIF
     3519                IF ( humidity  .OR.  passive_scalar )  THEN
     3520                   CALL pmci_extrap_ifoutflow_sn( q, nzb_s_inner, 'n', 's' )
     3521                ENDIF
     3522
     3523             ENDIF
     3524
    34813525          ENDIF
    34823526
    3483        ENDIF
     3527       ENDIF       !: IF ( nesting_mode /= 'vertical' )
    34843528
    34853529!
    34863530!--    All PEs are top-border PEs
    3487        CALL pmci_interp_tril_t( u,  uc,  icu, jco, kco, r1xu, r2xu, r1yo,      &
     3531       CALL pmci_interp_tril_t( u,  uc,  icu, jco, kco, r1xu, r2xu, r1yo,       &
    34883532                                r2yo, r1zo, r2zo, 'u' )
    3489        CALL pmci_interp_tril_t( v,  vc,  ico, jcv, kco, r1xo, r2xo, r1yv,      &
     3533       CALL pmci_interp_tril_t( v,  vc,  ico, jcv, kco, r1xo, r2xo, r1yv,       &
    34903534                                r2yv, r1zo, r2zo, 'v' )
    3491        CALL pmci_interp_tril_t( w,  wc,  ico, jco, kcw, r1xo, r2xo, r1yo,      &
     3535       CALL pmci_interp_tril_t( w,  wc,  ico, jco, kcw, r1xo, r2xo, r1yo,       &
    34923536                                r2yo, r1zw, r2zw, 'w' )
    3493        CALL pmci_interp_tril_t( e,  ec,  ico, jco, kco, r1xo, r2xo, r1yo,      &
     3537       CALL pmci_interp_tril_t( e,  ec,  ico, jco, kco, r1xo, r2xo, r1yo,       &
    34943538                                r2yo, r1zo, r2zo, 'e' )
    34953539       IF ( .NOT. neutral )  THEN
    3496           CALL pmci_interp_tril_t( pt, ptc, ico, jco, kco, r1xo, r2xo, r1yo,   &
     3540          CALL pmci_interp_tril_t( pt, ptc, ico, jco, kco, r1xo, r2xo, r1yo,    &
    34973541                                   r2yo, r1zo, r2zo, 's' )
    34983542       ENDIF
    34993543       IF ( humidity .OR. passive_scalar )  THEN
    3500           CALL pmci_interp_tril_t( q, qc, ico, jco, kco, r1xo, r2xo, r1yo,     &
     3544          CALL pmci_interp_tril_t( q, qc, ico, jco, kco, r1xo, r2xo, r1yo,      &
    35013545                                   r2yo, r1zo, r2zo, 's' )
    35023546       ENDIF
    35033547
    3504        IF ( nesting_mode == 'one-way' )  THEN
     3548       IF ( TRIM( nesting_mode ) == 'one-way' )  THEN
    35053549          CALL pmci_extrap_ifoutflow_t( u,  'u' )
    35063550          CALL pmci_extrap_ifoutflow_t( v,  'v' )
    … …  
    35133557             CALL pmci_extrap_ifoutflow_t( q, 's' )
    35143558          ENDIF
    3515       ENDIF
     3559       ENDIF
    35163560
    35173561   END SUBROUTINE pmci_interpolation
    … …  
    35263570      IMPLICIT NONE
    35273571
    3528       CALL pmci_anterp_tophat( u,  uc,  kctu, iflu, ifuu, jflo, jfuo, kflo,    &
     3572      CALL pmci_anterp_tophat( u,  uc,  kctu, iflu, ifuu, jflo, jfuo, kflo,     &
    35293573                               kfuo, ijfc_u, 'u' )
    3530       CALL pmci_anterp_tophat( v,  vc,  kctu, iflo, ifuo, jflv, jfuv, kflo,    &
     3574      CALL pmci_anterp_tophat( v,  vc,  kctu, iflo, ifuo, jflv, jfuv, kflo,     &
    35313575                               kfuo, ijfc_v, 'v' )
    3532       CALL pmci_anterp_tophat( w,  wc,  kctw, iflo, ifuo, jflo, jfuo, kflw,    &
     3576      CALL pmci_anterp_tophat( w,  wc,  kctw, iflo, ifuo, jflo, jfuo, kflw,     &
    35333577                               kfuw, ijfc_s, 'w' )
    35343578      IF ( .NOT. neutral )  THEN
    3535          CALL pmci_anterp_tophat( pt, ptc, kctu, iflo, ifuo, jflo, jfuo, kflo, &
     3579         CALL pmci_anterp_tophat( pt, ptc, kctu, iflo, ifuo, jflo, jfuo, kflo,  &
    35363580                                  kfuo, ijfc_s, 's' )
    35373581      ENDIF
    35383582      IF ( humidity  .OR.  passive_scalar )  THEN
    3539          CALL pmci_anterp_tophat( q, qc, kctu, iflo, ifuo, jflo, jfuo, kflo,   &
     3583         CALL pmci_anterp_tophat( q, qc, kctu, iflo, ifuo, jflo, jfuo, kflo,    &
    35403584                                  kfuo, ijfc_s, 's' )
    35413585      ENDIF
    … …  
    35453589
    35463590
    3547    SUBROUTINE pmci_interp_tril_lr( f, fc, ic, jc, kc, r1x, r2x, r1y, r2y, r1z, &
    3548                                    r2z, kb, logc, logc_ratio, nzt_topo_nestbc, &
     3591   SUBROUTINE pmci_interp_tril_lr( f, fc, ic, jc, kc, r1x, r2x, r1y, r2y, r1z,  &
     3592                                   r2z, kb, logc, logc_ratio, nzt_topo_nestbc,  &
    35493593                                   edge, var )
    35503594!
    3551 !--   Interpolation of ghost-node values used as the client-domain boundary
     3595!--   Interpolation of ghost-node values used as the child-domain boundary
    35523596!--   conditions. This subroutine handles the left and right boundaries. It is
    35533597!--   based on trilinear interpolation.
    … …  
    35553599      IMPLICIT NONE
    35563600
    3557       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                      &
     3601      REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                       &
    35583602                                      INTENT(INOUT) ::  f       !:
    3559       REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr),                          &
     3603      REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr),                           &
    35603604                                      INTENT(IN)    ::  fc      !:
    3561       REAL(wp), DIMENSION(1:2,0:ncorr-1,nzb:nzt_topo_nestbc,nys:nyn),          &
     3605      REAL(wp), DIMENSION(1:2,0:ncorr-1,nzb:nzt_topo_nestbc,nys:nyn),           &
    35623606                                      INTENT(IN)    ::  logc_ratio   !:
    35633607      REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN)    ::  r1x     !:
    … …  
    35723616      INTEGER(iwp), DIMENSION(nysg:nyng,nxlg:nxrg), INTENT(IN) ::  kb     !:
    35733617      INTEGER(iwp), DIMENSION(nzb:nzt+1), INTENT(IN)           ::  kc     !:
    3574       INTEGER(iwp), DIMENSION(1:2,nzb:nzt_topo_nestbc,nys:nyn),                &
     3618      INTEGER(iwp), DIMENSION(1:2,nzb:nzt_topo_nestbc,nys:nyn),                 &
    35753619                                          INTENT(IN)           ::  logc   !:
    35763620      INTEGER(iwp) ::  nzt_topo_nestbc   !:
    35773621
    3578       CHARACTER(LEN=1),INTENT(IN) ::  edge   !:
    3579       CHARACTER(LEN=1),INTENT(IN) ::  var    !:
     3622      CHARACTER(LEN=1), INTENT(IN) ::  edge   !:
     3623      CHARACTER(LEN=1), INTENT(IN) ::  var    !:
    35803624
    35813625      INTEGER(iwp) ::  i       !:
    … …  
    37013745                     DO  kcorr = 0, ncorr-1
    37023746                        kco = k + kcorr
    3703                         f(kco,jco,i) = 0.5_wp * ( logc_ratio(1,kcorr,k,j) *    &
    3704                                                   f(k1,j,i)                    &
    3705                                                 + logc_ratio(2,jcorr,k,j) *    &
     3747                        f(kco,jco,i) = 0.5_wp * ( logc_ratio(1,kcorr,k,j) *     &
     3748                                                  f(k1,j,i)                     &
     3749                                                + logc_ratio(2,jcorr,k,j) *     &
    37063750                                                  f(k,j1,i) )
    37073751                     ENDDO
    … …  
    37473791
    37483792
    3749    SUBROUTINE pmci_interp_tril_sn( f, fc, ic, jc, kc, r1x, r2x, r1y, r2y, r1z, &
    3750                                    r2z, kb, logc, logc_ratio,                  &
     3793   SUBROUTINE pmci_interp_tril_sn( f, fc, ic, jc, kc, r1x, r2x, r1y, r2y, r1z,  &
     3794                                   r2z, kb, logc, logc_ratio,                   &
    37513795                                   nzt_topo_nestbc, edge, var )
    37523796
    37533797!
    3754 !--   Interpolation of ghost-node values used as the client-domain boundary
     3798!--   Interpolation of ghost-node values used as the child-domain boundary
    37553799!--   conditions. This subroutine handles the south and north boundaries.
    37563800!--   This subroutine is based on trilinear interpolation.
    … …  
    37583802      IMPLICIT NONE
    37593803
    3760       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                      &
     3804      REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                       &
    37613805                                      INTENT(INOUT) ::  f             !:
    3762       REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr),                          &
     3806      REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr),                           &
    37633807                                      INTENT(IN)    ::  fc            !:
    3764       REAL(wp), DIMENSION(1:2,0:ncorr-1,nzb:nzt_topo_nestbc,nxl:nxr),          &
     3808      REAL(wp), DIMENSION(1:2,0:ncorr-1,nzb:nzt_topo_nestbc,nxl:nxr),           &
    37653809                                      INTENT(IN)    ::  logc_ratio    !:
    37663810      REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN)    ::  r1x           !:
    … …  
    37753819      INTEGER(iwp), DIMENSION(nysg:nyng,nxlg:nxrg), INTENT(IN) ::  kb    !:
    37763820      INTEGER(iwp), DIMENSION(nzb:nzt+1), INTENT(IN)           ::  kc    !:
    3777       INTEGER(iwp), DIMENSION(1:2,nzb:nzt_topo_nestbc,nxl:nxr),                &
     3821      INTEGER(iwp), DIMENSION(1:2,nzb:nzt_topo_nestbc,nxl:nxr),                 &
    37783822                                          INTENT(IN)           ::  logc  !:
    37793823      INTEGER(iwp) ::  nzt_topo_nestbc   !:
    … …  
    39023946                     DO  kcorr = 0, ncorr-1
    39033947                        kco = k + kcorr
    3904                         f(kco,i,ico) = 0.5_wp * ( logc_ratio(1,kcorr,k,i) *    &
     3948                        f(kco,i,ico) = 0.5_wp * ( logc_ratio(1,kcorr,k,i) *     &
    39053949                                                  f(k1,j,i)  &
    3906                                                 + logc_ratio(2,icorr,k,i) *    &
     3950                                                + logc_ratio(2,icorr,k,i) *     &
    39073951                                                  f(k,j,i1) )
    39083952                     ENDDO
    … …  
    39483992 
    39493993
    3950    SUBROUTINE pmci_interp_tril_t( f, fc, ic, jc, kc, r1x, r2x, r1y, r2y, r1z,  &
     3994   SUBROUTINE pmci_interp_tril_t( f, fc, ic, jc, kc, r1x, r2x, r1y, r2y, r1z,   &
    39513995                                  r2z, var )
    39523996
    39533997!
    3954 !--   Interpolation of ghost-node values used as the client-domain boundary
     3998!--   Interpolation of ghost-node values used as the child-domain boundary
    39553999!--   conditions. This subroutine handles the top boundary.
    39564000!--   This subroutine is based on trilinear interpolation.
    … …  
    39584002      IMPLICIT NONE
    39594003
    3960       REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                      &
     4004      REAL(wp), DIMENSION(nzb:nzt+1,nysg:nyng,nxlg:nxrg),                       &
    39614005                                      INTENT(INOUT) ::  f     !:
    3962       REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr),                          &
     4006      REAL(wp), DIMENSION(0:cg%nz+1,jcs:jcn,icl:icr),                           &
    39634007                                      INTENT(IN)    ::  fc    !:
    39644008      REAL(wp), DIMENSION(nxlg:nxrg), INTENT(IN)    ::  r1x   !:
    … …  
    39694013      REAL(wp), DIMENSION(nzb:nzt+1), INTENT(IN)    ::  r2z   !:
    39704014     
    3971       INTEGER(iwp), DIMENSION(nxlg:nxrg), INTENT(IN) ::  ic   !:
    3972       INTEGER(iwp), DIMENSION(nysg:nyng), INTENT(IN) ::  jc   !:
    3973       INTEGER(iwp), DIMENSION(nzb:nzt+1), INTENT(IN) ::  kc   !:
     4015      INTEGER(iwp), DIMENSION(nxlg:nxrg), INTENT(IN) ::  ic    !:
     4016      INTEGER(iwp), DIMENSION(nysg:nyng), INTENT(IN) ::  jc    !:
     4017      INTEGER(iwp), DIMENSION(nzb:nzt+1), INTENT(IN) ::  kc    !:
    39744018     
    39754019      CHARACTER(LEN=1), INTENT(IN) :: var   !:
    … …  
    40384082    SUBROUTINE pmci_extrap_ifoutflow_lr( f, kb, edge, var )
    40394083!
    4040 !--    After the interpolation of ghost-node values for the client-domain
     4084!--    After the interpolation of ghost-node values for the child-domain
    40414085!--    boundary conditions, this subroutine checks if there is a local outflow
    40424086!--    through the boundary. In that case this subroutine overwrites the
    … …  
    40474091       IMPLICIT NONE
    40484092
    4049        CHARACTER(LEN=1),INTENT(IN) ::  edge   !:
    4050        CHARACTER(LEN=1),INTENT(IN) ::  var    !:
     4093       CHARACTER(LEN=1), INTENT(IN) ::  edge   !:
     4094       CHARACTER(LEN=1), INTENT(IN) ::  var    !:
    40514095
    40524096       INTEGER(iwp) ::  i     !:
    … …  
    41164160    SUBROUTINE pmci_extrap_ifoutflow_sn( f, kb, edge, var )
    41174161!
    4118 !--    After  the interpolation of ghost-node values for the client-domain
     4162!--    After  the interpolation of ghost-node values for the child-domain
    41194163!--    boundary conditions, this subroutine checks if there is a local outflow
    41204164!--    through the boundary. In that case this subroutine overwrites the
    … …  
    41934237    SUBROUTINE pmci_extrap_ifoutflow_t( f, var )
    41944238!
    4195 !--    Interpolation of ghost-node values used as the client-domain boundary
     4239!--    Interpolation of ghost-node values used as the child-domain boundary
    41964240!--    conditions. This subroutine handles the top boundary. It is based on
    41974241!--    trilinear interpolation.
    … …  
    42084252       REAL(wp) ::  vdotnor   !:
    42094253
    4210        REAL(wp), DIMENSION(nzb:nzt+1,nys-nbgp:nyn+nbgp,nxl-nbgp:nxr+nbgp),     &
     4254       REAL(wp), DIMENSION(nzb:nzt+1,nys-nbgp:nyn+nbgp,nxl-nbgp:nxr+nbgp),      &
    42114255                 INTENT(INOUT) ::  f   !:
    42124256     
    … …  
    42414285
    42424286
    4243     SUBROUTINE pmci_anterp_tophat( f, fc, kct, ifl, ifu, jfl, jfu, kfl, kfu,   &
     4287    SUBROUTINE pmci_anterp_tophat( f, fc, kct, ifl, ifu, jfl, jfu, kfl, kfu,    &
    42444288                                   ijfc, var )
    42454289!
    4246 !--    Anterpolation of internal-node values to be used as the server-domain
     4290!--    Anterpolation of internal-node values to be used as the parent-domain
    42474291!--    values. This subroutine is based on the first-order numerical
    42484292!--    integration of the fine-grid values contained within the coarse-grid
    … …  
    42964340!--    Note that kcb is simply zero and kct enters here as a parameter and it is
    42974341!--    determined in pmci_init_anterp_tophat
    4298        IF ( nest_bound_l )  THEN
    4299           IF ( var == 'u' )  THEN
    4300              iclp = icl + nhll + 1
    4301           ELSE
     4342
     4343       IF ( nesting_mode == 'vertical' )  THEN
     4344          IF ( nest_bound_l )  THEN
    43024345             iclp = icl + nhll
    43034346          ENDIF
    4304        ENDIF
    4305        IF ( nest_bound_r )  THEN
    4306           icrm = icr - nhlr
    4307        ENDIF
    4308 
    4309        IF ( nest_bound_s )  THEN
    4310           IF ( var == 'v' )  THEN
    4311              jcsp = jcs + nhls + 1
    4312           ELSE
     4347          IF ( nest_bound_r ) THEN
     4348             icrm = icr - nhlr
     4349          ENDIF
     4350          IF ( nest_bound_s )  THEN
    43134351             jcsp = jcs + nhls
    43144352          ENDIF
    4315        ENDIF
    4316        IF ( nest_bound_n )  THEN
    4317           jcnm = jcn - nhln
    4318        ENDIF
    4319        kcb = 0
    4320 
     4353          IF ( nest_bound_n )  THEN
     4354             jcnm = jcn - nhln
     4355          ENDIF
     4356       ELSE
     4357          IF ( nest_bound_l )  THEN
     4358             IF ( var == 'u' )  THEN
     4359                iclp = icl + nhll + 1
     4360             ELSE
     4361                iclp = icl + nhll
     4362             ENDIF
     4363          ENDIF
     4364          IF ( nest_bound_r )  THEN
     4365             icrm = icr - nhlr
     4366          ENDIF
     4367
     4368          IF ( nest_bound_s )  THEN
     4369             IF ( var == 'v' )  THEN
     4370                jcsp = jcs + nhls + 1
     4371             ELSE
     4372                jcsp = jcs + nhls
     4373             ENDIF
     4374          ENDIF
     4375          IF ( nest_bound_n )  THEN
     4376             jcnm = jcn - nhln
     4377          ENDIF
     4378          kcb = 0
     4379       ENDIF
     4380       
    43214381!
    43224382!--    Note that ii, jj, and kk are coarse-grid indices and i,j, and k
    … …  
    43494409                ENDIF
    43504410
    4351                 fc(kk,jj,ii) = ( 1.0_wp - fra ) * fc(kk,jj,ii) +               &
     4411                fc(kk,jj,ii) = ( 1.0_wp - fra ) * fc(kk,jj,ii) +                &
    43524412                               fra * cellsum / REAL( nfc, KIND = wp )
    43534413
    … …  
    43594419
    43604420#endif
    4361  END SUBROUTINE pmci_client_datatrans
     4421 END SUBROUTINE pmci_child_datatrans
    43624422
    43634423END MODULE pmc_interface

  • palm/trunk/SOURCE/pmc_mpi_wrapper_mod.f90

    r1901 r1933  
    11 MODULE pmc_mpi_wrapper
    22
    3 !--------------------------------------------------------------------------------!
     3!-------------------------------------------------------------------------------!
    44! This file is part of PALM.
    55!
    … …  
    1616!
    1717! Copyright 1997-2016 Leibniz Universitaet Hannover
    18 !--------------------------------------------------------------------------------!
     18!-------------------------------------------------------------------------------!
    1919!
    2020! Current revisions:
    2121! ------------------
    2222!
    23 !
     23! 
    2424! Former revisions:
    2525! -----------------
    2626! $Id$
    2727!
     28! 1901 2016-05-04 15:39:38Z raasch
     29! Code clean up. The words server/client changed to parent/child.
     30!
    2831! 1900 2016-05-04 15:27:53Z raasch
    2932! re-formatted to match PALM style
    … …  
    5053!
    5154! MPI Wrapper of Palm Model Coupler
    52 !------------------------------------------------------------------------------!
     55!-------------------------------------------------------------------------------!
    5356
    5457#if defined( __parallel )
    … …  
    6265
    6366    USE kinds
    64     USE pmc_handle_communicator,                                               &
    65         ONLY: m_model_comm, m_model_rank, m_to_server_comm, m_to_client_comm
     67    USE pmc_handle_communicator,                                                &
     68        ONLY: m_model_comm, m_model_rank, m_to_parent_comm, m_to_child_comm
    6669
    6770    IMPLICIT NONE
    … …  
    7073    SAVE
    7174
    72     INTERFACE pmc_send_to_server
    73        MODULE PROCEDURE pmc_send_to_server_integer
    74        MODULE PROCEDURE pmc_send_to_server_integer_2
    75        MODULE PROCEDURE pmc_send_to_server_real_r1
    76        MODULE PROCEDURE pmc_send_to_server_real_r2
    77        MODULE PROCEDURE pmc_send_to_server_real_r3
    78     END INTERFACE pmc_send_to_server
    79 
    80     INTERFACE pmc_recv_from_server
    81        MODULE PROCEDURE pmc_recv_from_server_integer
    82        MODULE PROCEDURE pmc_recv_from_server_real_r1
    83        MODULE PROCEDURE pmc_recv_from_server_real_r2
    84        MODULE PROCEDURE pmc_recv_from_server_real_r3
    85     END INTERFACE pmc_recv_from_server
    86 
    87     INTERFACE pmc_send_to_client
    88        MODULE PROCEDURE pmc_send_to_client_integer
    89        MODULE PROCEDURE pmc_send_to_client_real_r1
    90        MODULE PROCEDURE pmc_send_to_client_real_r2
    91        MODULE PROCEDURE pmc_send_to_client_real_r3
    92     END INTERFACE pmc_send_to_client
    93 
    94     INTERFACE pmc_recv_from_client
    95        MODULE PROCEDURE pmc_recv_from_client_integer
    96        MODULE PROCEDURE pmc_recv_from_client_integer_2
    97        MODULE PROCEDURE pmc_recv_from_client_real_r1
    98        MODULE PROCEDURE pmc_recv_from_client_real_r2
    99        MODULE PROCEDURE pmc_recv_from_client_real_r3
    100     END INTERFACE pmc_recv_from_client
     75    INTERFACE pmc_send_to_parent
     76       MODULE PROCEDURE pmc_send_to_parent_integer
     77       MODULE PROCEDURE pmc_send_to_parent_integer_2
     78       MODULE PROCEDURE pmc_send_to_parent_real_r1
     79       MODULE PROCEDURE pmc_send_to_parent_real_r2
     80       MODULE PROCEDURE pmc_send_to_parent_real_r3
     81    END INTERFACE pmc_send_to_parent
     82
     83    INTERFACE pmc_recv_from_parent
     84       MODULE PROCEDURE pmc_recv_from_parent_integer
     85       MODULE PROCEDURE pmc_recv_from_parent_real_r1
     86       MODULE PROCEDURE pmc_recv_from_parent_real_r2
     87       MODULE PROCEDURE pmc_recv_from_parent_real_r3
     88    END INTERFACE pmc_recv_from_parent
     89
     90    INTERFACE pmc_send_to_child
     91       MODULE PROCEDURE pmc_send_to_child_integer
     92       MODULE PROCEDURE pmc_send_to_child_real_r1
     93       MODULE PROCEDURE pmc_send_to_child_real_r2
     94       MODULE PROCEDURE pmc_send_to_child_real_r3
     95    END INTERFACE pmc_send_to_child
     96
     97    INTERFACE pmc_recv_from_child
     98       MODULE PROCEDURE pmc_recv_from_child_integer
     99       MODULE PROCEDURE pmc_recv_from_child_integer_2
     100       MODULE PROCEDURE pmc_recv_from_child_real_r1
     101       MODULE PROCEDURE pmc_recv_from_child_real_r2
     102       MODULE PROCEDURE pmc_recv_from_child_real_r3
     103    END INTERFACE pmc_recv_from_child
    101104
    102105    INTERFACE pmc_bcast
    … …  
    118121    END INTERFACE pmc_time
    119122
    120     PUBLIC pmc_alloc_mem, pmc_bcast, pmc_inter_bcast, pmc_recv_from_client,    &
    121            pmc_recv_from_server, pmc_send_to_client, pmc_send_to_server,       &
     123    PUBLIC pmc_alloc_mem, pmc_bcast, pmc_inter_bcast, pmc_recv_from_child,      &
     124           pmc_recv_from_parent, pmc_send_to_child, pmc_send_to_parent,         &
    122125           pmc_time
    123126
    … …  
    125128
    126129
    127  SUBROUTINE pmc_send_to_server_integer( buf, n, server_rank, tag, ierr )
     130 SUBROUTINE pmc_send_to_parent_integer( buf, n, parent_rank, tag, ierr )
    128131
    129132    IMPLICIT NONE
    … …  
    131134    INTEGER, DIMENSION(:), INTENT(IN) ::  buf          !<
    132135    INTEGER, INTENT(IN)               ::  n            !<
    133     INTEGER, INTENT(IN)               ::  server_rank  !<
     136    INTEGER, INTENT(IN)               ::  parent_rank  !<
    134137    INTEGER, INTENT(IN)               ::  tag          !<
    135138    INTEGER, INTENT(OUT)              ::  ierr         !<
    136139
    137140    ierr = 0
    138     CALL MPI_SEND( buf, n, MPI_INTEGER, server_rank, tag, m_to_server_comm,    &
     141    CALL MPI_SEND( buf, n, MPI_INTEGER, parent_rank, tag, m_to_parent_comm,     &
    139142                   ierr)
    140143
    141  END SUBROUTINE pmc_send_to_server_integer
    142 
    143 
    144 
    145  SUBROUTINE pmc_recv_from_server_integer( buf, n, server_rank, tag, ierr )
     144 END SUBROUTINE pmc_send_to_parent_integer
     145
     146
     147
     148 SUBROUTINE pmc_recv_from_parent_integer( buf, n, parent_rank, tag, ierr )
    146149
    147150    IMPLICIT NONE
    … …  
    149152    INTEGER, DIMENSION(:), INTENT(OUT) ::  buf          !<
    150153    INTEGER, INTENT(IN)                ::  n            !<
    151     INTEGER, INTENT(IN)                ::  server_rank  !<
     154    INTEGER, INTENT(IN)                ::  parent_rank  !<
    152155    INTEGER, INTENT(IN)                ::  tag          !<
    153156    INTEGER, INTENT(OUT)               ::  ierr         !<
    154157
    155158    ierr = 0
    156     CALL MPI_RECV( buf, n, MPI_INTEGER, server_rank, tag, m_to_server_comm,    &
     159    CALL MPI_RECV( buf, n, MPI_INTEGER, parent_rank, tag, m_to_parent_comm,     &
    157160                   MPI_STATUS_IGNORE, ierr )
    158161
    159  END SUBROUTINE pmc_recv_from_server_integer
    160 
    161 
    162 
    163  SUBROUTINE pmc_send_to_server_integer_2( buf, n, server_rank, tag, ierr )
     162 END SUBROUTINE pmc_recv_from_parent_integer
     163
     164
     165
     166 SUBROUTINE pmc_send_to_parent_integer_2( buf, n, parent_rank, tag, ierr )
    164167
    165168    IMPLICIT NONE
    … …  
    167170    INTEGER, DIMENSION(:,:), INTENT(IN) :: buf          !<
    168171    INTEGER, INTENT(IN)                 :: n            !<
    169     INTEGER, INTENT(IN)                 :: server_rank  !<
     172    INTEGER, INTENT(IN)                 :: parent_rank  !<
    170173    INTEGER, INTENT(IN)                 :: tag          !<
    171174    INTEGER, INTENT(OUT)                :: ierr         !<
    172175
    173176    ierr = 0
    174     CALL MPI_SEND( buf, n, MPI_INTEGER, server_rank, tag, m_to_server_comm,    &
     177    CALL MPI_SEND( buf, n, MPI_INTEGER, parent_rank, tag, m_to_parent_comm,     &
    175178                   ierr )
    176179
    177  END SUBROUTINE pmc_send_to_server_integer_2
    178 
    179 
    180 
    181  SUBROUTINE pmc_send_to_server_real_r1( buf, n, server_rank, tag, ierr )
     180 END SUBROUTINE pmc_send_to_parent_integer_2
     181
     182
     183
     184 SUBROUTINE pmc_send_to_parent_real_r1( buf, n, parent_rank, tag, ierr )
    182185
    183186    IMPLICIT NONE
    … …  
    185188    REAL(wp), DIMENSION(:), INTENT(IN) ::  buf          !<
    186189    INTEGER, INTENT(IN)                ::  n            !<
    187     INTEGER, INTENT(IN)                ::  server_rank  !<
     190    INTEGER, INTENT(IN)                ::  parent_rank  !<
    188191    INTEGER, INTENT(IN)                ::  tag          !<
    189192    INTEGER, INTENT(OUT)               ::  ierr         !<
    190193
    191194    ierr = 0
    192     CALL MPI_SEND( buf, n, MPI_REAL, server_rank, tag, m_to_server_comm, ierr )
    193 
    194  END SUBROUTINE pmc_send_to_server_real_r1
    195 
    196 
    197 
    198  SUBROUTINE pmc_recv_from_server_real_r1( buf, n, server_rank, tag, ierr )
     195    CALL MPI_SEND( buf, n, MPI_REAL, parent_rank, tag, m_to_parent_comm, ierr )
     196
     197 END SUBROUTINE pmc_send_to_parent_real_r1
     198
     199
     200
     201 SUBROUTINE pmc_recv_from_parent_real_r1( buf, n, parent_rank, tag, ierr )
    199202
    200203    IMPLICIT NONE
    … …  
    202205    REAL(wp), DIMENSION(:), INTENT(OUT) ::  buf          !<
    203206    INTEGER, INTENT(IN)                 ::  n            !<
    204     INTEGER, INTENT(IN)                 ::  server_rank  !<
     207    INTEGER, INTENT(IN)                 ::  parent_rank  !<
    205208    INTEGER, INTENT(IN)                 ::  tag          !<
    206209    INTEGER, INTENT(OUT)                ::  ierr         !<
    207210
    208211    ierr = 0
    209     CALL MPI_RECV( buf, n, MPI_REAL, server_rank, tag, m_to_server_comm,       &
     212    CALL MPI_RECV( buf, n, MPI_REAL, parent_rank, tag, m_to_parent_comm,        &
    210213                   MPI_STATUS_IGNORE, ierr )
    211214
    212  END SUBROUTINE pmc_recv_from_server_real_r1
    213 
    214 
    215 
    216  SUBROUTINE pmc_send_to_server_real_r2( buf, n, server_rank, tag, ierr )
     215 END SUBROUTINE pmc_recv_from_parent_real_r1
     216
     217
     218
     219 SUBROUTINE pmc_send_to_parent_real_r2( buf, n, parent_rank, tag, ierr )
    217220
    218221    IMPLICIT NONE
    … …  
    220223    REAL(wp), DIMENSION(:,:), INTENT(IN) ::  buf          !<
    221224    INTEGER, INTENT(IN)                  ::  n            !<
    222     INTEGER, INTENT(IN)                  ::  server_rank  !<
     225    INTEGER, INTENT(IN)                  ::  parent_rank  !<
    223226    INTEGER, INTENT(IN)                  ::  tag          !<
    224227    INTEGER, INTENT(OUT)                 ::  ierr         !<
    225228
    226229    ierr = 0
    227     CALL MPI_SEND( buf, n, MPI_REAL, server_rank, tag, m_to_server_comm, ierr )
    228 
    229  END SUBROUTINE pmc_send_to_server_real_r2
    230 
    231 
    232  SUBROUTINE pmc_recv_from_server_real_r2( buf, n, server_rank, tag, ierr )
     230    CALL MPI_SEND( buf, n, MPI_REAL, parent_rank, tag, m_to_parent_comm, ierr )
     231
     232 END SUBROUTINE pmc_send_to_parent_real_r2
     233
     234
     235 SUBROUTINE pmc_recv_from_parent_real_r2( buf, n, parent_rank, tag, ierr )
    233236
    234237    IMPLICIT NONE
    … …  
    236239    REAL(wp), DIMENSION(:,:), INTENT(OUT) ::  buf          !<
    237240    INTEGER, INTENT(IN)                   ::  n            !<
    238     INTEGER, INTENT(IN)                   ::  server_rank  !<
     241    INTEGER, INTENT(IN)                   ::  parent_rank  !<
    239242    INTEGER, INTENT(IN)                   ::  tag          !<
    240243    INTEGER, INTENT(OUT)                  ::  ierr         !<
    241244
    242245    ierr = 0
    243     CALL MPI_RECV( buf, n, MPI_REAL, server_rank, tag, m_to_server_comm,       &
     246    CALL MPI_RECV( buf, n, MPI_REAL, parent_rank, tag, m_to_parent_comm,        &
    244247                   MPI_STATUS_IGNORE, ierr )
    245248
    246  END SUBROUTINE pmc_recv_from_server_real_r2
    247 
    248 
    249 
    250  SUBROUTINE pmc_send_to_server_real_r3( buf, n, server_rank, tag, ierr )
     249 END SUBROUTINE pmc_recv_from_parent_real_r2
     250
     251
     252
     253 SUBROUTINE pmc_send_to_parent_real_r3( buf, n, parent_rank, tag, ierr )
    251254
    252255    IMPLICIT NONE
    … …  
    254257    REAL(wp), DIMENSION(:,:,:), INTENT(IN) ::  buf          !<
    255258    INTEGER, INTENT(IN)                    ::  n            !<
    256     INTEGER, INTENT(IN)                    ::  server_rank  !<
     259    INTEGER, INTENT(IN)                    ::  parent_rank  !<
    257260    INTEGER, INTENT(IN)                    ::  tag          !<
    258261    INTEGER, INTENT(OUT)                   ::  ierr         !<
    259262
    260263    ierr = 0
    261     CALL MPI_SEND( buf, n, MPI_REAL, server_rank, tag, m_to_server_comm, ierr )
    262 
    263  END SUBROUTINE pmc_send_to_server_real_r3
    264 
    265 
    266 
    267  SUBROUTINE pmc_recv_from_server_real_r3( buf, n, server_rank, tag, ierr )
     264    CALL MPI_SEND( buf, n, MPI_REAL, parent_rank, tag, m_to_parent_comm, ierr )
     265
     266 END SUBROUTINE pmc_send_to_parent_real_r3
     267
     268
     269
     270 SUBROUTINE pmc_recv_from_parent_real_r3( buf, n, parent_rank, tag, ierr )
    268271
    269272    IMPLICIT NONE
    … …  
    271274    REAL(wp), DIMENSION(:,:,:), INTENT(OUT) ::  buf          !<
    272275    INTEGER, INTENT(IN)                     ::  n            !<
    273     INTEGER, INTENT(IN)                     ::  server_rank  !<
     276    INTEGER, INTENT(IN)                     ::  parent_rank  !<
    274277    INTEGER, INTENT(IN)                     ::  tag          !<
    275278    INTEGER, INTENT(OUT)                    ::  ierr         !<
    276279
    277280    ierr = 0
    278     CALL MPI_RECV( buf, n, MPI_REAL, server_rank, tag, m_to_server_comm,       &
     281    CALL MPI_RECV( buf, n, MPI_REAL, parent_rank, tag, m_to_parent_comm,        &
    279282                   MPI_STATUS_IGNORE, ierr )
    280283
    281  END SUBROUTINE pmc_recv_from_server_real_r3
    282 
    283 
    284 
    285  SUBROUTINE pmc_send_to_client_integer( client_id, buf, n, client_rank, tag,   &
    286                                         ierr )
    287 
    288     IMPLICIT NONE
    289 
    290     INTEGER, INTENT(IN)               ::  client_id    !<
     284 END SUBROUTINE pmc_recv_from_parent_real_r3
     285
     286
     287
     288 SUBROUTINE pmc_send_to_child_integer( child_id, buf, n, child_rank, tag,       &
     289                                       ierr )
     290
     291    IMPLICIT NONE
     292
     293    INTEGER, INTENT(IN)               ::  child_id     !<
    291294    INTEGER, DIMENSION(:), INTENT(IN) ::  buf          !<
    292295    INTEGER, INTENT(IN)               ::  n            !<
    293     INTEGER, INTENT(IN)               ::  client_rank  !<
     296    INTEGER, INTENT(IN)               ::  child_rank   !<
    294297    INTEGER, INTENT(IN)               ::  tag          !<
    295298    INTEGER, INTENT(OUT)              ::  ierr         !<
    296299
    297300    ierr = 0
    298     CALL MPI_SEND( buf, n, MPI_INTEGER, client_rank, tag,                      &
    299                    m_to_client_comm(client_id), ierr )
    300 
    301  END SUBROUTINE pmc_send_to_client_integer
    302 
    303 
    304 
    305  SUBROUTINE pmc_recv_from_client_integer( client_id, buf, n, client_rank, tag, &
    306                                           ierr )
    307 
    308     IMPLICIT NONE
    309 
    310     INTEGER, INTENT(IN)                  ::  client_id    !<
     301    CALL MPI_SEND( buf, n, MPI_INTEGER, child_rank, tag,                        &
     302                   m_to_child_comm(child_id), ierr )
     303
     304 END SUBROUTINE pmc_send_to_child_integer
     305
     306
     307
     308 SUBROUTINE pmc_recv_from_child_integer( child_id, buf, n, child_rank, tag,    &
     309                                         ierr )
     310
     311    IMPLICIT NONE
     312
     313    INTEGER, INTENT(IN)                  ::  child_id     !<
    311314    INTEGER, DIMENSION(:), INTENT(INOUT) ::  buf          !<
    312315    INTEGER, INTENT(IN)                  ::  n            !<
    313     INTEGER, INTENT(IN)                  ::  client_rank  !<
     316    INTEGER, INTENT(IN)                  ::  child_rank   !<
    314317    INTEGER, INTENT(IN)                  ::  tag          !<
    315318    INTEGER, INTENT(OUT)                 ::  ierr         !<
    316319
    317320    ierr = 0
    318     CALL MPI_RECV( buf, n, MPI_INTEGER, client_rank, tag,                      &
    319                    m_to_client_comm(client_id), MPI_STATUS_IGNORE, ierr )
    320 
    321  END SUBROUTINE pmc_recv_from_client_integer
    322 
    323 
    324 
    325  SUBROUTINE pmc_recv_from_client_integer_2( client_id, buf, n, client_rank,    &
    326                                             tag, ierr )
    327 
    328     IMPLICIT NONE
    329 
    330     INTEGER, INTENT(IN)                  ::  client_id    !<
     321    CALL MPI_RECV( buf, n, MPI_INTEGER, child_rank, tag,                        &
     322                   m_to_child_comm(child_id), MPI_STATUS_IGNORE, ierr )
     323
     324 END SUBROUTINE pmc_recv_from_child_integer
     325
     326
     327
     328 SUBROUTINE pmc_recv_from_child_integer_2( child_id, buf, n, child_rank,        &
     329                                           tag, ierr )
     330
     331    IMPLICIT NONE
     332
     333    INTEGER, INTENT(IN)                  ::  child_id     !<
    331334    INTEGER, DIMENSION(:,:), INTENT(OUT) ::  buf          !<
    332335    INTEGER, INTENT(IN)                  ::  n            !<
    333     INTEGER, INTENT(IN)                  ::  client_rank  !<
     336    INTEGER, INTENT(IN)                  ::  child_rank   !<
    334337    INTEGER, INTENT(IN)                  ::  tag          !<
    335338    INTEGER, INTENT(OUT)                 ::  ierr         !<
    336339
    337340    ierr = 0
    338     CALL MPI_RECV( buf, n, MPI_INTEGER, client_rank, tag,                      &
    339                    m_to_client_comm(client_id), MPI_STATUS_IGNORE, ierr )
    340 
    341  END SUBROUTINE pmc_recv_from_client_integer_2
    342 
    343 
    344 
    345  SUBROUTINE pmc_send_to_client_real_r1( client_id, buf, n, client_rank, tag,   &
    346                                         ierr )
    347 
    348     IMPLICIT NONE
    349 
    350     INTEGER, INTENT(IN)                ::  client_id    !<
     341    CALL MPI_RECV( buf, n, MPI_INTEGER, child_rank, tag,                        &
     342                   m_to_child_comm(child_id), MPI_STATUS_IGNORE, ierr )
     343
     344 END SUBROUTINE pmc_recv_from_child_integer_2
     345
     346
     347
     348 SUBROUTINE pmc_send_to_child_real_r1( child_id, buf, n, child_rank, tag,       &
     349                                       ierr )
     350
     351    IMPLICIT NONE
     352
     353    INTEGER, INTENT(IN)                ::  child_id     !<
    351354    REAL(wp), DIMENSION(:), INTENT(IN) ::  buf          !<
    352355    INTEGER, INTENT(IN)                ::  n            !<
    353     INTEGER, INTENT(IN)                ::  client_rank  !<
     356    INTEGER, INTENT(IN)                ::  child_rank   !<
    354357    INTEGER, INTENT(IN)                ::  tag          !<
    355358    INTEGER, INTENT(OUT)               ::  ierr         !<
    356359
    357360    ierr = 0
    358     CALL MPI_SEND( buf, n, MPI_REAL, client_rank, tag,                         &
    359                    m_to_client_comm(client_id), ierr )
    360 
    361  END SUBROUTINE pmc_send_to_client_real_r1
    362 
    363 
    364 
    365  SUBROUTINE pmc_recv_from_client_real_r1( client_id, buf, n, client_rank, tag, &
    366                                           ierr )
    367 
    368     IMPLICIT NONE
    369 
    370     INTEGER, INTENT(IN)                   ::  client_id    !<
     361    CALL MPI_SEND( buf, n, MPI_REAL, child_rank, tag,                           &
     362                   m_to_child_comm(child_id), ierr )
     363
     364 END SUBROUTINE pmc_send_to_child_real_r1
     365
     366
     367
     368 SUBROUTINE pmc_recv_from_child_real_r1( child_id, buf, n, child_rank, tag,    &
     369                                         ierr )
     370
     371    IMPLICIT NONE
     372
     373    INTEGER, INTENT(IN)                   ::  child_id     !<
    371374    REAL(wp), DIMENSION(:), INTENT(INOUT) ::  buf          !<
    372375    INTEGER, INTENT(IN)                   ::  n            !<
    373     INTEGER, INTENT(IN)                   ::  client_rank  !<
     376    INTEGER, INTENT(IN)                   ::  child_rank   !<
    374377    INTEGER, INTENT(IN)                   ::  tag          !<
    375378    INTEGER, INTENT(OUT)                  ::  ierr         !<
    376379
    377380    ierr = 0
    378     CALL MPI_RECV( buf, n, MPI_REAL, client_rank, tag,                         &
    379                    m_to_client_comm(client_id), MPI_STATUS_IGNORE, ierr )
    380 
    381  END SUBROUTINE pmc_recv_from_client_real_r1
    382 
    383 
    384 
    385  SUBROUTINE pmc_send_to_client_real_r2( client_id, buf, n, client_rank, tag,   &
    386                                         ierr )
    387 
    388     IMPLICIT NONE
    389 
    390     INTEGER, INTENT(IN)                  ::  client_id    !<
     381    CALL MPI_RECV( buf, n, MPI_REAL, child_rank, tag,                           &
     382                   m_to_child_comm(child_id), MPI_STATUS_IGNORE, ierr )
     383
     384 END SUBROUTINE pmc_recv_from_child_real_r1
     385
     386
     387
     388 SUBROUTINE pmc_send_to_child_real_r2( child_id, buf, n, child_rank, tag,       &
     389                                       ierr )
     390
     391    IMPLICIT NONE
     392
     393    INTEGER, INTENT(IN)                  ::  child_id     !<
    391394    REAL(wp), DIMENSION(:,:), INTENT(IN) ::  buf          !<
    392395    INTEGER, INTENT(IN)                  ::  n            !<
    393     INTEGER, INTENT(IN)                  ::  client_rank  !<
     396    INTEGER, INTENT(IN)                  ::  child_rank   !<
    394397    INTEGER, INTENT(IN)                  ::  tag          !<
    395398    INTEGER, INTENT(OUT)                 ::  ierr         !<
    396399
    397400    ierr = 0
    398     CALL MPI_SEND( buf, n, MPI_REAL, client_rank, tag,                         &
    399                    m_to_client_comm(client_id), ierr )
    400 
    401  END SUBROUTINE pmc_send_to_client_real_r2
    402 
    403 
    404 
    405  SUBROUTINE pmc_recv_from_client_real_r2( client_id, buf, n, client_rank, tag, &
    406                                           ierr )
    407 
    408     IMPLICIT NONE
    409 
    410     INTEGER, INTENT(IN)                   ::  client_id    !<
     401    CALL MPI_SEND( buf, n, MPI_REAL, child_rank, tag,                           &
     402                   m_to_child_comm(child_id), ierr )
     403
     404 END SUBROUTINE pmc_send_to_child_real_r2
     405
     406
     407
     408 SUBROUTINE pmc_recv_from_child_real_r2( child_id, buf, n, child_rank, tag,    &
     409                                         ierr )
     410
     411    IMPLICIT NONE
     412
     413    INTEGER, INTENT(IN)                   ::  child_id     !<
    411414    REAL(wp), DIMENSION(:,:), INTENT(OUT) ::  buf          !<
    412415    INTEGER, INTENT(IN)                   ::  n            !<
    413     INTEGER, INTENT(IN)                   ::  client_rank  !<
     416    INTEGER, INTENT(IN)                   ::  child_rank   !<
    414417    INTEGER, INTENT(IN)                   ::  tag          !<
    415418    INTEGER, INTENT(OUT)                  ::  ierr         !<
    416419
    417420    ierr = 0
    418     CALL MPI_RECV( buf, n, MPI_REAL, client_rank, tag,                         &
    419                    m_to_client_comm(client_id), MPI_STATUS_IGNORE, ierr )
    420 
    421  END SUBROUTINE pmc_recv_from_client_real_r2
    422 
    423 
    424 
    425  SUBROUTINE pmc_send_to_client_real_r3( client_id, buf, n, client_rank, tag,   &
    426                                         ierr)
    427 
    428     IMPLICIT NONE
    429 
    430     INTEGER, INTENT(IN)                    ::  client_id    !<
     421    CALL MPI_RECV( buf, n, MPI_REAL, child_rank, tag,                           &
     422                   m_to_child_comm(child_id), MPI_STATUS_IGNORE, ierr )
     423
     424 END SUBROUTINE pmc_recv_from_child_real_r2
     425
     426
     427
     428 SUBROUTINE pmc_send_to_child_real_r3( child_id, buf, n, child_rank, tag,       &
     429                                       ierr)
     430
     431    IMPLICIT NONE
     432
     433    INTEGER, INTENT(IN)                    ::  child_id     !<
    431434    REAL(wp), DIMENSION(:,:,:), INTENT(IN) ::  buf          !<
    432435    INTEGER, INTENT(IN)                    ::  n            !<
    433     INTEGER, INTENT(IN)                    ::  client_rank  !<
     436    INTEGER, INTENT(IN)                    ::  child_rank   !<
    434437    INTEGER, INTENT(IN)                    ::  tag          !<
    435438    INTEGER, INTENT(OUT)                   ::  ierr         !<
    436439
    437440    ierr = 0
    438     CALL MPI_SEND( buf, n, MPI_REAL, client_rank, tag,                         &
    439                    m_to_client_comm(client_id), ierr )
    440 
    441  END SUBROUTINE pmc_send_to_client_real_r3
    442 
    443 
    444 
    445  SUBROUTINE pmc_recv_from_client_real_r3( client_id, buf, n, client_rank, tag, &
    446                                           ierr )
    447 
    448     IMPLICIT NONE
    449 
    450     INTEGER, INTENT(IN)                     ::  client_id    !<
     441    CALL MPI_SEND( buf, n, MPI_REAL, child_rank, tag,                           &
     442                   m_to_child_comm(child_id), ierr )
     443
     444 END SUBROUTINE pmc_send_to_child_real_r3
     445
     446
     447
     448 SUBROUTINE pmc_recv_from_child_real_r3( child_id, buf, n, child_rank, tag,    &
     449                                         ierr )
     450
     451    IMPLICIT NONE
     452
     453    INTEGER, INTENT(IN)                     ::  child_id     !<
    451454    REAL(wp), DIMENSION(:,:,:), INTENT(OUT) ::  buf          !<
    452455    INTEGER, INTENT(IN)                     ::  n            !<
    453     INTEGER, INTENT(IN)                     ::  client_rank  !<
     456    INTEGER, INTENT(IN)                     ::  child_rank   !<
    454457    INTEGER, INTENT(IN)                     ::  tag          !<
    455458    INTEGER, INTENT(OUT)                    ::  ierr         !<
    456459
    457460    ierr = 0
    458     CALL MPI_RECV( buf, n, MPI_REAL, client_rank, tag,                         &
    459                    m_to_client_comm(client_id), MPI_STATUS_IGNORE, ierr )
    460 
    461  END SUBROUTINE pmc_recv_from_client_real_r3
     461    CALL MPI_RECV( buf, n, MPI_REAL, child_rank, tag,                           &
     462                   m_to_child_comm(child_id), MPI_STATUS_IGNORE, ierr )
     463
     464 END SUBROUTINE pmc_recv_from_child_real_r3
    462465
    463466
    … …  
    520523
    521524
    522  SUBROUTINE pmc_inter_bcast_integer_1( buf, client_id, ierr )
     525 SUBROUTINE pmc_inter_bcast_integer_1( buf, child_id, ierr )
    523526
    524527    IMPLICIT NONE
    525528
    526529    INTEGER, INTENT(INOUT),DIMENSION(:) ::  buf        !<
    527     INTEGER, INTENT(IN),optional        ::  client_id  !<
     530    INTEGER, INTENT(IN),optional        ::  child_id   !<
    528531    INTEGER, INTENT(OUT),optional       ::  ierr       !<
    529532
    … …  
    533536
    534537!
    535 !-- PE 0 server broadcast to all client PEs
    536     IF ( PRESENT( client_id ) )  THEN
    537 
    538        mycomm = m_to_client_comm(client_id)
     538!-- PE 0 on parent broadcast to all child PEs
     539    IF ( PRESENT( child_id ) )  THEN
     540
     541       mycomm = m_to_child_comm(child_id)
    539542
    540543       IF ( m_model_rank == 0 )  THEN
    … …  
    545548
    546549    ELSE
    547        mycomm  = m_to_server_comm
     550       mycomm  = m_to_parent_comm
    548551       root_pe = 0
    549552    ENDIF

  • palm/trunk/SOURCE/pmc_parent_mod.f90

    r1927 r1933  
    1  MODULE pmc_server
    2 
    3 !--------------------------------------------------------------------------------!
     1 MODULE pmc_parent
     2
     3!-------------------------------------------------------------------------------!
    44! This file is part of PALM.
    55!
    … …  
    1616!
    1717! Copyright 1997-2016 Leibniz Universitaet Hannover
    18 !--------------------------------------------------------------------------------!
     18!-------------------------------------------------------------------------------!
    1919!
    2020! Current revisions:
    2121! ------------------
    2222!
    23 !
     23! 
    2424! Former revisions:
    2525! -----------------
    2626! $Id$
     27!
     28! 1901 2016-05-04 15:39:38Z raasch
     29! Module renamed. Code clean up. The words server/client changed to parent/child.
    2730!
    2831! 1900 2016-05-04 15:27:53Z raasch
    … …  
    4750!
    4851! 1786 2016-03-08 05:49:27Z raasch
    49 ! change in client-server data transfer: server now gets data from client
    50 ! instead that client put's it to the server
     52! change in child-parent data transfer: parent now gets data from child
     53! instead that child put's it to the parent
    5154!
    5255! 1779 2016-03-03 08:01:28Z raasch
    … …  
    6871! ------------
    6972!
    70 ! Server part of Palm Model Coupler
    71 !------------------------------------------------------------------------------!
     73! Parent part of Palm Model Coupler
     74!-------------------------------------------------------------------------------!
    7275
    7376#if defined( __parallel )
    … …  
    8083#endif
    8184    USE kinds
    82     USE pmc_general,                                                           &
    83         ONLY: arraydef, clientdef, da_namedef, da_namelen, pedef,              &
     85    USE pmc_general,                                                            &
     86        ONLY: arraydef, childdef, da_namedef, da_namelen, pedef,                &
    8487              pmc_g_setname, pmc_max_array, pmc_max_models, pmc_sort
    8588
    86     USE pmc_handle_communicator,                                               &
    87         ONLY: m_model_comm,m_model_rank,m_model_npes, m_to_client_comm,        &
    88               m_world_rank, pmc_server_for_client
    89 
    90     USE pmc_mpi_wrapper,                                                       &
     89    USE pmc_handle_communicator,                                                &
     90        ONLY: m_model_comm,m_model_rank,m_model_npes, m_to_child_comm,          &
     91              m_world_rank, pmc_parent_for_child
     92
     93    USE pmc_mpi_wrapper,                                                        &
    9194        ONLY: pmc_alloc_mem, pmc_bcast, pmc_time
    9295
    … …  
    9699   SAVE
    97100
    98    TYPE clientindexdef
     101   TYPE childindexdef
    99102      INTEGER                              ::  nrpoints       !<
    100103      INTEGER, DIMENSION(:,:), ALLOCATABLE ::  index_list_2d  !<
    101    END TYPE clientindexdef
    102 
    103    TYPE(clientdef), DIMENSION(pmc_max_models)      ::  clients     !<
    104    TYPE(clientindexdef), DIMENSION(pmc_max_models) ::  indclients  !<
     104   END TYPE childindexdef
     105
     106   TYPE(childdef), DIMENSION(pmc_max_models)       ::  children     !<
     107   TYPE(childindexdef), DIMENSION(pmc_max_models)  ::  indchildren  !<
    105108
    106109   INTEGER ::  next_array_in_list = 0  !<
    107110
    108111
    109    PUBLIC pmc_server_for_client
    110 
    111 
    112    INTERFACE pmc_serverinit
    113       MODULE PROCEDURE  pmc_serverinit
    114    END INTERFACE pmc_serverinit
     112   PUBLIC pmc_parent_for_child
     113
     114
     115   INTERFACE pmc_parentinit
     116      MODULE PROCEDURE  pmc_parentinit
     117   END INTERFACE pmc_parentinit
    115118
    116119    INTERFACE pmc_s_set_2d_index_list
    … …  
    147150    END INTERFACE pmc_s_set_active_data_array
    148151
    149     PUBLIC pmc_serverinit, pmc_s_clear_next_array_list, pmc_s_fillbuffer,      &
    150            pmc_s_getdata_from_buffer, pmc_s_getnextarray,                      &
    151            pmc_s_setind_and_allocmem, pmc_s_set_active_data_array,             &
     152    PUBLIC pmc_parentinit, pmc_s_clear_next_array_list, pmc_s_fillbuffer,       &
     153           pmc_s_getdata_from_buffer, pmc_s_getnextarray,                       &
     154           pmc_s_setind_and_allocmem, pmc_s_set_active_data_array,              &
    152155           pmc_s_set_dataarray, pmc_s_set_2d_index_list
    153156
    … …  
    155158
    156159
    157  SUBROUTINE pmc_serverinit
     160 SUBROUTINE pmc_parentinit
    158161
    159162    IMPLICIT NONE
    160163
    161     INTEGER ::  clientid  !<
     164    INTEGER ::  childid   !<
    162165    INTEGER ::  i         !<
    163166    INTEGER ::  j         !<
    … …  
    165168
    166169
    167     DO  i = 1, SIZE( pmc_server_for_client )-1
    168 
    169        clientid = pmc_server_for_client( i )
    170 
    171        clients(clientid)%model_comm = m_model_comm
    172        clients(clientid)%inter_comm = m_to_client_comm(clientid)
     170    DO  i = 1, SIZE( pmc_parent_for_child )-1
     171
     172       childid = pmc_parent_for_child( i )
     173
     174       children(childid)%model_comm = m_model_comm
     175       children(childid)%inter_comm = m_to_child_comm(childid)
     176
    173177!
    174178!--    Get rank and size
    175        CALL MPI_COMM_RANK( clients(clientid)%model_comm,                       &
    176                            clients(clientid)%model_rank, istat )
    177        CALL MPI_COMM_SIZE( clients(clientid)%model_comm,                       &
    178                            clients(clientid)%model_npes, istat )
    179        CALL MPI_COMM_REMOTE_SIZE( clients(clientid)%inter_comm,                &
    180                                   clients(clientid)%inter_npes, istat )
     179       CALL MPI_COMM_RANK( children(childid)%model_comm,                        &
     180                           children(childid)%model_rank, istat )
     181       CALL MPI_COMM_SIZE( children(childid)%model_comm,                        &
     182                           children(childid)%model_npes, istat )
     183       CALL MPI_COMM_REMOTE_SIZE( children(childid)%inter_comm,                 &
     184                                  children(childid)%inter_npes, istat )
     185
    181186!
    182187!--    Intra communicater is used for MPI_GET
    183        CALL MPI_INTERCOMM_MERGE( clients(clientid)%inter_comm, .FALSE.,        &
    184                                  clients(clientid)%intra_comm, istat )
    185        CALL MPI_COMM_RANK( clients(clientid)%intra_comm,                       &
    186                            clients(clientid)%intra_rank, istat )
    187 
    188        ALLOCATE( clients(clientid)%pes(clients(clientid)%inter_npes))
    189 !
    190 !--    Allocate array of TYPE arraydef for all client PEs to store information
     188       CALL MPI_INTERCOMM_MERGE( children(childid)%inter_comm, .FALSE.,         &
     189                                 children(childid)%intra_comm, istat )
     190       CALL MPI_COMM_RANK( children(childid)%intra_comm,                        &
     191                           children(childid)%intra_rank, istat )
     192
     193       ALLOCATE( children(childid)%pes(children(childid)%inter_npes))
     194
     195!
     196!--    Allocate array of TYPE arraydef for all child PEs to store information
    191197!--    of the transfer array
    192        DO  j = 1, clients(clientid)%inter_npes
    193          ALLOCATE( clients(clientid)%pes(j)%array_list(pmc_max_array) )
     198       DO  j = 1, children(childid)%inter_npes
     199         ALLOCATE( children(childid)%pes(j)%array_list(pmc_max_array) )
    194200       ENDDO
    195201
    196        CALL get_da_names_from_client (clientid)
    197 
    198     ENDDO
    199 
    200  END SUBROUTINE pmc_serverinit
    201 
    202 
    203 
    204  SUBROUTINE pmc_s_set_2d_index_list( clientid, index_list )
     202       CALL get_da_names_from_child (childid)
     203
     204    ENDDO
     205
     206 END SUBROUTINE pmc_parentinit
     207
     208
     209
     210 SUBROUTINE pmc_s_set_2d_index_list( childid, index_list )
    205211
    206212     IMPLICIT NONE
    207213
    208      INTEGER, INTENT(IN)                    :: clientid    !<
     214     INTEGER, INTENT(IN)                    :: childid     !<
    209215     INTEGER, DIMENSION(:,:), INTENT(INOUT) :: index_list  !<
    210216
    … …  
    219225
    220226     IF ( m_model_rank == 0 )  THEN
    221 !
    222 !--     Sort to ascending server PE
     227
     228!
     229!--     Sort to ascending parent PE order
    223230        CALL pmc_sort( index_list, 6 )
    224231
    225232        is = 1
    226233        DO  ip = 0, m_model_npes-1
    227 !
    228 !--        Split into server PEs
     234
     235!
     236!--        Split into parent PEs
    229237           ie = is - 1
     238
    230239!
    231240!--        There may be no entry for this PE
    … …  
    244253              ian =  0
    245254           ENDIF
    246 !
    247 !--        Send data to other server PEs
     255
     256!
     257!--        Send data to other parent PEs
    248258           IF ( ip == 0 )  THEN
    249               indclients(clientid)%nrpoints = ian
     259              indchildren(childid)%nrpoints = ian
    250260              IF ( ian > 0)  THEN
    251                   ALLOCATE( indclients(clientid)%index_list_2d(6,ian) )
    252                   indclients(clientid)%index_list_2d(:,1:ian) =                &
     261                  ALLOCATE( indchildren(childid)%index_list_2d(6,ian) )
     262                  indchildren(childid)%index_list_2d(:,1:ian) =                 &
    253263                                                             index_list(:,is:ie)
    254264              ENDIF
    255265           ELSE
    256               CALL MPI_SEND( ian, 1, MPI_INTEGER, ip, 1000, m_model_comm,      &
     266              CALL MPI_SEND( ian, 1, MPI_INTEGER, ip, 1000, m_model_comm,       &
    257267                             istat )
    258268              IF ( ian > 0)  THEN
    259                   CALL MPI_SEND( index_list(1,is), 6*ian, MPI_INTEGER, ip,  &
     269                  CALL MPI_SEND( index_list(1,is), 6*ian, MPI_INTEGER, ip,      &
    260270                                 1001, m_model_comm, istat )
    261271              ENDIF
    … …  
    267277     ELSE
    268278
    269         CALL MPI_RECV( indclients(clientid)%nrpoints, 1, MPI_INTEGER, 0, 1000, &
     279        CALL MPI_RECV( indchildren(childid)%nrpoints, 1, MPI_INTEGER, 0, 1000, &
    270280                       m_model_comm, MPI_STATUS_IGNORE, istat )
    271         ian = indclients(clientid)%nrpoints
     281        ian = indchildren(childid)%nrpoints
    272282
    273283        IF ( ian > 0 )  THEN
    274            ALLOCATE( indclients(clientid)%index_list_2d(6,ian) )
    275            CALL MPI_RECV( indclients(clientid)%index_list_2d, 6*ian,           &
    276                           MPI_INTEGER, 0, 1001, m_model_comm,                  &
     284           ALLOCATE( indchildren(childid)%index_list_2d(6,ian) )
     285           CALL MPI_RECV( indchildren(childid)%index_list_2d, 6*ian,            &
     286                          MPI_INTEGER, 0, 1001, m_model_comm,                   &
    277287                          MPI_STATUS_IGNORE, istat)
    278288        ENDIF
    … …  
    280290     ENDIF
    281291
    282      CALL set_pe_index_list( clientid, clients(clientid),                      &
    283                              indclients(clientid)%index_list_2d,               &
    284                              indclients(clientid)%nrpoints )
     292     CALL set_pe_index_list( childid, children(childid),                        &
     293                             indchildren(childid)%index_list_2d,                &
     294                             indchildren(childid)%nrpoints )
    285295
    286296 END SUBROUTINE pmc_s_set_2d_index_list
    … …  
    298308
    299309
    300  LOGICAL FUNCTION pmc_s_getnextarray( clientid, myname )
     310 LOGICAL FUNCTION pmc_s_getnextarray( childid, myname )
     311
    301312!
    302313!-- List handling is still required to get minimal interaction with
    … …  
    304315!-- TODO: what does "still" mean? Is there a chance to change this!
    305316    CHARACTER(LEN=*), INTENT(OUT) ::  myname    !<
    306     INTEGER(iwp), INTENT(IN)      ::  clientid  !<
     317    INTEGER(iwp), INTENT(IN)      ::  childid   !<
    307318
    308319    TYPE(arraydef), POINTER :: ar
    … …  
    310321
    311322    next_array_in_list = next_array_in_list + 1
    312 !
    313 !-- Array names are the same on all client PEs, so take first PE to get the name
    314     ape => clients(clientid)%pes(1)
     323
     324!
     325!-- Array names are the same on all children PEs, so take first PE to get the name
     326    ape => children(childid)%pes(1)
    315327
    316328    IF ( next_array_in_list > ape%nr_arrays )  THEN
     329
    317330!
    318331!--    All arrays are done
    … …  
    323336    ar => ape%array_list(next_array_in_list)
    324337    myname = ar%name
     338
    325339!
    326340!-- Return true if legal array
    … …  
    332346
    333347
    334  SUBROUTINE pmc_s_set_dataarray_2d( clientid, array, array_2 )
     348 SUBROUTINE pmc_s_set_dataarray_2d( childid, array, array_2 )
    335349
    336350    IMPLICIT NONE
    337351
    338     INTEGER,INTENT(IN) ::  clientid  !<
     352    INTEGER,INTENT(IN) ::  childid   !<
    339353
    340354    REAL(wp), INTENT(IN), DIMENSION(:,:), POINTER           ::  array    !<
    … …  
    355369    IF ( PRESENT( array_2 ) )  THEN
    356370       second_adr = C_LOC(array_2)
    357        CALL pmc_s_setarray( clientid, nrdims, dims, array_adr,                 &
     371       CALL pmc_s_setarray( childid, nrdims, dims, array_adr,                   &
    358372                            second_adr = second_adr)
    359373    ELSE
    360        CALL pmc_s_setarray( clientid, nrdims, dims, array_adr )
     374       CALL pmc_s_setarray( childid, nrdims, dims, array_adr )
    361375    ENDIF
    362376
    … …  
    365379
    366380
    367  SUBROUTINE pmc_s_set_dataarray_3d( clientid, array, nz_cl, nz, array_2 )
     381 SUBROUTINE pmc_s_set_dataarray_3d( childid, array, nz_cl, nz, array_2 )
    368382
    369383    IMPLICIT NONE
    370384
    371     INTEGER, INTENT(IN) ::  clientid  !<
     385    INTEGER, INTENT(IN) ::  childid   !<
    372386    INTEGER, INTENT(IN) ::  nz        !<
    373387    INTEGER, INTENT(IN) ::  nz_cl     !<
    … …  
    381395    TYPE(C_PTR)           ::  second_adr  !<
    382396
     397!
    383398!-- TODO: the next assignment seems to be obsolete. Please check!
    384399    dims      = 1
    … …  
    397412    IF ( PRESENT( array_2 ) )  THEN
    398413      second_adr = C_LOC( array_2 )
    399       CALL pmc_s_setarray( clientid, nrdims, dims, array_adr,                  &
     414      CALL pmc_s_setarray( childid, nrdims, dims, array_adr,                    &
    400415                           second_adr = second_adr)
    401416    ELSE
    402        CALL pmc_s_setarray( clientid, nrdims, dims, array_adr )
     417       CALL pmc_s_setarray( childid, nrdims, dims, array_adr )
    403418    ENDIF
    404419
    … …  
    407422
    408423
    409  SUBROUTINE pmc_s_setind_and_allocmem( clientid )
    410 
    411     USE control_parameters,                                                    &
     424 SUBROUTINE pmc_s_setind_and_allocmem( childid )
     425
     426    USE control_parameters,                                                     &
    412427        ONLY:  message_string
    413428
    … …  
    415430
    416431!
    417 !-- Naming convention for appendices:   _sc  -> server to client transfer
    418 !--                                     _cs  -> client to server transfer
    419 !--                                     send -> server to client transfer
    420 !--                                     recv -> client to server transfer
    421     INTEGER, INTENT(IN) ::  clientid  !<
     432!-- Naming convention for appendices:   _pc  -> parent to child transfer
     433!--                                     _cp  -> child to parent transfer
     434!--                                     send -> parent to child transfer
     435!--                                     recv -> child to parent transfer
     436    INTEGER, INTENT(IN) ::  childid   !<
    422437
    423438    INTEGER                        ::  arlen    !<
    … …  
    439454    TYPE(arraydef), POINTER ::  ar        !<
    440455
    441     REAL(wp),DIMENSION(:), POINTER, SAVE ::  base_array_sc  !< base array for server to client transfer
    442     REAL(wp),DIMENSION(:), POINTER, SAVE ::  base_array_cs  !< base array for client to server transfer
    443 
    444 !
    445 !-- Server to client direction
     456    REAL(wp),DIMENSION(:), POINTER, SAVE ::  base_array_pc  !< base array for parent to child transfer
     457    REAL(wp),DIMENSION(:), POINTER, SAVE ::  base_array_cp  !< base array for child to parent transfer
     458
     459!
     460!-- Parent to child direction
    446461    myindex = 1
    447462    rcount  = 0
    … …  
    450465!
    451466!-- First stride: compute size and set index
    452     DO  i = 1, clients(clientid)%inter_npes
    453 
    454        ape => clients(clientid)%pes(i)
     467    DO  i = 1, children(childid)%inter_npes
     468
     469       ape => children(childid)%pes(i)
    455470       tag = 200
    456471
    … …  
    469484          tag    = tag + 1
    470485          rcount = rcount + 1
    471           CALL MPI_ISEND( myindex, 1, MPI_INTEGER, i-1, tag,                   &
    472                           clients(clientid)%inter_comm, req(rcount), ierr )
     486          CALL MPI_ISEND( myindex, 1, MPI_INTEGER, i-1, tag,                    &
     487                          children(childid)%inter_comm, req(rcount), ierr )
     488
    473489!
    474490!--       Maximum of 1024 outstanding requests
    475 !--       TODO: what does this limit means?
     491!--       TODO: what does this limit mean?
    476492          IF ( rcount == 1024 )  THEN
    477493             CALL MPI_WAITALL( rcount, req, MPI_STATUSES_IGNORE, ierr )
    … …  
    492508
    493509!
    494 !-- Create RMA (One Sided Communication) window for data buffer server to
    495 !-- client transfer.
     510!-- Create RMA (One Sided Communication) window for data buffer parent to
     511!-- child transfer.
    496512!-- The buffer of MPI_GET (counterpart of transfer) can be PE-local, i.e.
    497513!-- it can but must not be part of the MPI RMA window. Only one RMA window is
    498514!-- required to prepare the data for
    499 !--                       server -> client transfer on the server side
     515!--                       parent -> child transfer on the parent side
    500516!-- and for
    501 !--                       client -> server transfer on the client side
    502     CALL pmc_alloc_mem( base_array_sc, bufsize )
    503     clients(clientid)%totalbuffersize = bufsize * wp
     517!--                       child -> parent transfer on the child side
     518    CALL pmc_alloc_mem( base_array_pc, bufsize )
     519    children(childid)%totalbuffersize = bufsize * wp
    504520
    505521    winsize = bufsize * wp
    506     CALL MPI_WIN_CREATE( base_array_sc, winsize, wp, MPI_INFO_NULL,            &
    507                          clients(clientid)%intra_comm,                         &
    508                          clients(clientid)%win_server_client, ierr )
     522    CALL MPI_WIN_CREATE( base_array_pc, winsize, wp, MPI_INFO_NULL,             &
     523                         children(childid)%intra_comm,                          &
     524                         children(childid)%win_parent_child, ierr )
     525
    509526!
    510527!-- Open window to set data
    511     CALL MPI_WIN_FENCE( 0, clients(clientid)%win_server_client, ierr )
     528    CALL MPI_WIN_FENCE( 0, children(childid)%win_parent_child, ierr )
     529
    512530!
    513531!-- Second stride: set buffer pointer
    514     DO  i = 1, clients(clientid)%inter_npes
    515 
    516        ape => clients(clientid)%pes(i)
     532    DO  i = 1, children(childid)%inter_npes
     533
     534       ape => children(childid)%pes(i)
    517535
    518536       DO  j = 1, ape%nr_arrays
    519537
    520538          ar => ape%array_list(j)
    521           ar%sendbuf = C_LOC( base_array_sc(ar%sendindex) )
    522 
    523 !--       TODO: replace this by standard PALM error message using the message routine
    524           IF ( ar%sendindex + ar%sendsize > bufsize )  THEN
    525              write(0,'(a,i4,4i7,1x,a)') 'Server Buffer too small ',i,        &
    526                 ar%sendindex,ar%sendsize,ar%sendindex+ar%sendsize,bufsize,trim(ar%name)
    527              CALL MPI_Abort (MPI_COMM_WORLD, istat, ierr)
     539          ar%sendbuf = C_LOC( base_array_pc(ar%sendindex) )
     540
     541          IF ( ar%sendindex + ar%sendsize > bufsize )  THEN             
     542             WRITE( message_string, '(a,i4,4i7,1x,a)' )                         &
     543                    'Parent buffer too small ',i,                               &
     544                    ar%sendindex,ar%sendsize,ar%sendindex+ar%sendsize,          &
     545                    bufsize,trim(ar%name)
     546             CALL message( 'pmc_s_setind_and_allocmem', 'PA0429', 3, 2, 0, 6, 0 )
    528547          ENDIF
    529548       ENDDO
    … …  
    531550
    532551!
    533 !-- Client to server direction
     552!-- Child to parent direction
    534553    bufsize = 8
     554
    535555!
    536556!-- First stride: compute size and set index
    537     DO  i = 1, clients(clientid)%inter_npes
    538 
    539        ape => clients(clientid)%pes(i)
     557    DO  i = 1, children(childid)%inter_npes
     558
     559       ape => children(childid)%pes(i)
    540560       tag = 300
    541561
    … …  
    543563
    544564          ar => ape%array_list(j)
    545 !
    546 !--       Receive index from client
     565
     566!
     567!--       Receive index from child
    547568          tag = tag + 1
    548           CALL MPI_RECV( myindex, 1, MPI_INTEGER, i-1, tag,                    &
    549                          clients(clientid)%inter_comm, MPI_STATUS_IGNORE, ierr )
     569          CALL MPI_RECV( myindex, 1, MPI_INTEGER, i-1, tag,                     &
     570                         children(childid)%inter_comm, MPI_STATUS_IGNORE, ierr )
    550571
    551572          IF ( ar%nrdims == 3 )  THEN
    … …  
    564585!-- The buffer for MPI_GET can be PE local, i.e. it can but must not be part of
    565586!-- the MPI RMA window
    566     CALL pmc_alloc_mem( base_array_cs, bufsize, base_ptr )
    567     clients(clientid)%totalbuffersize = bufsize * wp
    568 
    569     CALL MPI_BARRIER( clients(clientid)%intra_comm, ierr )
     587    CALL pmc_alloc_mem( base_array_cp, bufsize, base_ptr )
     588    children(childid)%totalbuffersize = bufsize * wp
     589
     590    CALL MPI_BARRIER( children(childid)%intra_comm, ierr )
     591
    570592!
    571593!-- Second stride: set buffer pointer
    572     DO  i = 1, clients(clientid)%inter_npes
    573 
    574        ape => clients(clientid)%pes(i)
     594    DO  i = 1, children(childid)%inter_npes
     595
     596       ape => children(childid)%pes(i)
    575597
    576598       DO  j = 1, ape%nr_arrays
    … …  
    585607
    586608
    587  SUBROUTINE pmc_s_fillbuffer( clientid, waittime )
     609 SUBROUTINE pmc_s_fillbuffer( childid, waittime )
    588610
    589611    IMPLICIT NONE
    590612
    591     INTEGER, INTENT(IN)             ::  clientid  !<
     613    INTEGER, INTENT(IN)             ::  childid   !<
    592614
    593615    REAL(wp), INTENT(OUT), OPTIONAL ::  waittime  !<
    … …  
    612634
    613635!
    614 !-- Synchronization of the model is done in pmci_client_synchronize and
    615 !-- pmci_server_synchronize. Therefor the RMA window can be filled without
     636!-- Synchronization of the model is done in pmci_synchronize.
     637!-- Therefor the RMA window can be filled without
    616638!-- sychronization at this point and a barrier is not necessary.
    617639!-- Please note that waittime has to be set in pmc_s_fillbuffer AND
    … …  
    619641    IF ( PRESENT( waittime) )  THEN
    620642      t1 = pmc_time()
    621       CALL MPI_BARRIER( clients(clientid)%intra_comm, ierr )
     643      CALL MPI_BARRIER( children(childid)%intra_comm, ierr )
    622644      t2 = pmc_time()
    623645      waittime = t2- t1
    624646    ENDIF
    625647
    626     DO  ip = 1, clients(clientid)%inter_npes
    627 
    628        ape => clients(clientid)%pes(ip)
     648    DO  ip = 1, children(childid)%inter_npes
     649
     650       ape => children(childid)%pes(ip)
    629651
    630652       DO  j = 1, ape%nr_arrays
    … …  
    649671             CALL C_F_POINTER( ar%data, data_3d, ar%a_dim(1:3) )
    650672             DO  ij = 1, ape%nrele
    651                 buf(myindex:myindex+ar%a_dim(4)-1) =                           &
     673                buf(myindex:myindex+ar%a_dim(4)-1) =                            &
    652674                        data_3d(1:ar%a_dim(4),ape%locind(ij)%j,ape%locind(ij)%i)
    653675                myindex = myindex + ar%a_dim(4)
    … …  
    659681
    660682    ENDDO
     683
    661684!
    662685!-- Buffer is filled
    663     CALL MPI_BARRIER( clients(clientid)%intra_comm, ierr )
     686    CALL MPI_BARRIER( children(childid)%intra_comm, ierr )
    664687
    665688 END SUBROUTINE pmc_s_fillbuffer
    … …  
    667690
    668691
    669  SUBROUTINE pmc_s_getdata_from_buffer( clientid, waittime )
     692 SUBROUTINE pmc_s_getdata_from_buffer( childid, waittime )
    670693
    671694    IMPLICIT NONE
    672695
    673     INTEGER, INTENT(IN)             ::  clientid  !<
    674     REAL(wp), INTENT(OUT), OPTIONAL ::  waittime  !<
    675 
    676     INTEGER                        ::  ierr         !<
    677     INTEGER                        ::  ij           !<
    678     INTEGER                        ::  ip           !<
    679     INTEGER                        ::  istat        !<
    680     INTEGER                        ::  j            !<
    681     INTEGER                        ::  myindex      !<
    682     INTEGER                        ::  nr           !<
    683     INTEGER                        ::  target_pe    !<
    684     INTEGER(kind=MPI_ADDRESS_KIND) ::  target_disp  !<
    685 
    686     INTEGER, DIMENSION(1)          ::  buf_shape    !<
     696    INTEGER, INTENT(IN)             ::  childid      !<
     697    REAL(wp), INTENT(OUT), OPTIONAL ::  waittime     !<
     698
     699    INTEGER                        ::  ierr          !<
     700    INTEGER                        ::  ij            !<
     701    INTEGER                        ::  ip            !<
     702    INTEGER                        ::  istat         !<
     703    INTEGER                        ::  j             !<
     704    INTEGER                        ::  myindex       !<
     705    INTEGER                        ::  nr            !<
     706    INTEGER                        ::  target_pe     !<
     707    INTEGER(kind=MPI_ADDRESS_KIND) ::  target_disp   !<
     708
     709    INTEGER, DIMENSION(1)          ::  buf_shape     !<
    687710
    688711    REAL(wp)                            ::  t1       !<
    … …  
    697720
    698721    t1 = pmc_time()
    699 !
    700 !-- Wait for client to fill buffer
    701     CALL MPI_BARRIER( clients(clientid)%intra_comm, ierr )
     722
     723!
     724!-- Wait for child to fill buffer
     725    CALL MPI_BARRIER( children(childid)%intra_comm, ierr )
    702726    t2 = pmc_time() - t1
    703727    IF ( PRESENT( waittime ) )  waittime = t2
     728
    704729!
    705730!-- TODO: check next statement
    706731!-- Fence might do it, test later
    707 !-- CALL MPI_WIN_FENCE( 0, clients(clientid)%win_server_client, ierr)
    708     CALL MPI_BARRIER( clients(clientid)%intra_comm, ierr )
    709 
    710     DO  ip = 1, clients(clientid)%inter_npes
    711 
    712        ape => clients(clientid)%pes(ip)
     732!-- CALL MPI_WIN_FENCE( 0, children(childid)%win_parent_child, ierr)
     733    CALL MPI_BARRIER( children(childid)%intra_comm, ierr )
     734
     735    DO  ip = 1, children(childid)%inter_npes
     736
     737       ape => children(childid)%pes(ip)
    713738
    714739       DO  j = 1, ape%nr_arrays
    … …  
    731756          IF ( nr > 0 )  THEN
    732757             target_disp = ar%recvindex - 1
    733 !
    734 !--          Client PEs are located behind server PEs
     758
     759!
     760!--          Child PEs are located behind parent PEs
    735761             target_pe = ip - 1 + m_model_npes
    736              CALL MPI_WIN_LOCK( MPI_LOCK_SHARED, target_pe, 0,                 &
    737                                 clients(clientid)%win_server_client, ierr )
    738              CALL MPI_GET( buf, nr, MPI_REAL, target_pe, target_disp, nr,      &
    739                            MPI_REAL, clients(clientid)%win_server_client, ierr )
    740              CALL MPI_WIN_UNLOCK( target_pe,                                   &
    741                                   clients(clientid)%win_server_client, ierr )
     762             CALL MPI_WIN_LOCK( MPI_LOCK_SHARED, target_pe, 0,                  &
     763                                children(childid)%win_parent_child, ierr )
     764             CALL MPI_GET( buf, nr, MPI_REAL, target_pe, target_disp, nr,       &
     765                           MPI_REAL, children(childid)%win_parent_child, ierr )
     766             CALL MPI_WIN_UNLOCK( target_pe,                                    &
     767                                  children(childid)%win_parent_child, ierr )
    742768          ENDIF
    743769
    … …  
    755781             CALL C_F_POINTER( ar%data, data_3d, ar%a_dim(1:3))
    756782             DO  ij = 1, ape%nrele
    757                 data_3d(1:ar%a_dim(4),ape%locind(ij)%j,ape%locind(ij)%i) =     &
     783                data_3d(1:ar%a_dim(4),ape%locind(ij)%j,ape%locind(ij)%i) =      &
    758784                                              buf(myindex:myindex+ar%a_dim(4)-1)
    759785                myindex = myindex + ar%a_dim(4)
    … …  
    770796
    771797
    772  SUBROUTINE get_da_names_from_client( clientid )
    773 !
    774 !-- Get data array description and name from client
     798 SUBROUTINE get_da_names_from_child( childid )
     799
     800!
     801!-- Get data array description and name from child
    775802    IMPLICIT NONE
    776803
    777     INTEGER, INTENT(IN) ::  clientid  !<
     804    INTEGER, INTENT(IN) ::  childid  !<
    778805
    779806    TYPE(da_namedef) ::  myname  !<
    780807
    781808    DO
    782        CALL pmc_bcast( myname%couple_index, 0, comm=m_to_client_comm(clientid) )
     809       CALL pmc_bcast( myname%couple_index, 0, comm=m_to_child_comm(childid) )
    783810       IF ( myname%couple_index == -1 )  EXIT
    784        CALL pmc_bcast( myname%serverdesc,   0, comm=m_to_client_comm(clientid) )
    785        CALL pmc_bcast( myname%nameonserver, 0, comm=m_to_client_comm(clientid) )
    786        CALL pmc_bcast( myname%clientdesc,   0, comm=m_to_client_comm(clientid) )
    787        CALL pmc_bcast( myname%nameonclient, 0, comm=m_to_client_comm(clientid) )
    788 
    789        CALL pmc_g_setname( clients(clientid), myname%couple_index,             &
    790                            myname%nameonserver )
     811       CALL pmc_bcast( myname%parentdesc,   0, comm=m_to_child_comm(childid) )
     812       CALL pmc_bcast( myname%nameonparent, 0, comm=m_to_child_comm(childid) )
     813       CALL pmc_bcast( myname%childdesc,    0, comm=m_to_child_comm(childid) )
     814       CALL pmc_bcast( myname%nameonchild,  0, comm=m_to_child_comm(childid) )
     815
     816       CALL pmc_g_setname( children(childid), myname%couple_index,              &
     817                           myname%nameonparent )
    791818   ENDDO
    792819
    793  END SUBROUTINE get_da_names_from_client
    794 
    795 
    796 
    797  SUBROUTINE pmc_s_setarray(clientid, nrdims, dims, array_adr, second_adr )
    798 !
    799 !-- Set array for client interPE 0
     820 END SUBROUTINE get_da_names_from_child
     821
     822
     823
     824 SUBROUTINE pmc_s_setarray(childid, nrdims, dims, array_adr, second_adr )
     825
     826!
     827!-- Set array for child inter PE 0
    800828    IMPLICIT NONE
    801829
    802     INTEGER, INTENT(IN)               ::  clientid  !<
    803     INTEGER, INTENT(IN)               ::  nrdims    !<
    804     INTEGER, INTENT(IN), DIMENSION(:) ::  dims      !<
     830    INTEGER, INTENT(IN)               ::  childid    !<
     831    INTEGER, INTENT(IN)               ::  nrdims     !<
     832    INTEGER, INTENT(IN), DIMENSION(:) ::  dims       !<
    805833
    806834    TYPE(C_PTR), INTENT(IN)           :: array_adr   !<
    … …  
    813841
    814842
    815     DO  i = 1, clients(clientid)%inter_npes
    816 
    817        ape => clients(clientid)%pes(i)
     843    DO  i = 1, children(childid)%inter_npes
     844
     845       ape => children(childid)%pes(i)
    818846       ar  => ape%array_list(next_array_in_list)
    819847       ar%nrdims = nrdims
    … …  
    835863
    836864
    837  SUBROUTINE pmc_s_set_active_data_array( clientid, iactive )
     865 SUBROUTINE pmc_s_set_active_data_array( childid, iactive )
    838866
    839867    IMPLICIT NONE
    840868
    841     INTEGER, INTENT(IN) ::  clientid  !<
     869    INTEGER, INTENT(IN) ::  childid   !<
    842870    INTEGER, INTENT(IN) ::  iactive   !<
    843871
    … …  
    849877    TYPE(arraydef), POINTER ::  ar   !<
    850878
    851     DO  ip = 1, clients(clientid)%inter_npes
    852 
    853        ape => clients(clientid)%pes(ip)
     879    DO  ip = 1, children(childid)%inter_npes
     880
     881       ape => children(childid)%pes(ip)
    854882
    855883       DO  j = 1, ape%nr_arrays
    … …  
    868896
    869897
    870  SUBROUTINE set_pe_index_list( clientid, myclient, index_list, nrp )
     898 SUBROUTINE set_pe_index_list( childid, mychild, index_list, nrp )
    871899
    872900    IMPLICIT NONE
    873901
    874     INTEGER, INTENT(IN)                 ::  clientid    !<
     902    INTEGER, INTENT(IN)                 ::  childid     !<
    875903    INTEGER, INTENT(IN), DIMENSION(:,:) ::  index_list  !<
    876904    INTEGER, INTENT(IN)                 ::  nrp         !<
    877905
    878     TYPE(clientdef), INTENT(INOUT) ::  myclient  !<
     906    TYPE(childdef), INTENT(INOUT)       ::  mychild     !<
    879907
    880908    INTEGER                                 :: i        !<
    … …  
    888916    INTEGER(KIND=MPI_ADDRESS_KIND)          :: winsize  !<
    889917
    890     INTEGER, DIMENSION(myclient%inter_npes) :: remind   !<
     918    INTEGER, DIMENSION(mychild%inter_npes) :: remind   !<
    891919
    892920    INTEGER, DIMENSION(:), POINTER          :: remindw  !<
    … …  
    896924
    897925!
    898 !-- First, count entries for every remote client PE
    899     DO  i = 1, myclient%inter_npes
    900        ape => myclient%pes(i)
     926!-- First, count entries for every remote child PE
     927    DO  i = 1, mychild%inter_npes
     928       ape => mychild%pes(i)
    901929       ape%nrele = 0
    902930    ENDDO
     931
    903932!
    904933!-- Loop over number of coarse grid cells
    905934    DO  j = 1, nrp
    906935       rempe = index_list(5,j) + 1   ! PE number on remote PE
    907        ape => myclient%pes(rempe)
    908        ape%nrele = ape%nrele + 1 ! Increment number of elements for this client PE
    909     ENDDO
    910 
    911     DO  i = 1, myclient%inter_npes
    912        ape => myclient%pes(i)
     936       ape => mychild%pes(rempe)
     937       ape%nrele = ape%nrele + 1     ! Increment number of elements for this child PE
     938    ENDDO
     939
     940    DO  i = 1, mychild%inter_npes
     941       ape => mychild%pes(i)
    913942       ALLOCATE( ape%locind(ape%nrele) )
    914943    ENDDO
    … …  
    921950    DO  j = 1, nrp
    922951       rempe = index_list(5,j) + 1
    923        ape => myclient%pes(rempe)
     952       ape => mychild%pes(rempe)
    924953       remind(rempe)     = remind(rempe)+1
    925954       ind               = remind(rempe)
    … …  
    927956       ape%locind(ind)%j = index_list(2,j)
    928957    ENDDO
    929 !
    930 !-- Prepare number of elements for client PEs
    931     CALL pmc_alloc_mem( rldef, myclient%inter_npes*2 )
    932 !
    933 !-- Number of client PEs * size of INTEGER (i just arbitrary INTEGER)
    934     winsize = myclient%inter_npes*c_sizeof(i)*2
    935 
    936     CALL MPI_WIN_CREATE( rldef, winsize, iwp, MPI_INFO_NULL,                   &
    937                          myclient%intra_comm, indwin, ierr )
     958
     959!
     960!-- Prepare number of elements for children PEs
     961    CALL pmc_alloc_mem( rldef, mychild%inter_npes*2 )
     962
     963!
     964!-- Number of child PEs * size of INTEGER (i just arbitrary INTEGER)
     965    winsize = mychild%inter_npes*c_sizeof(i)*2
     966
     967    CALL MPI_WIN_CREATE( rldef, winsize, iwp, MPI_INFO_NULL,                    &
     968                         mychild%intra_comm, indwin, ierr )
     969
    938970!
    939971!-- Open window to set data
    … …  
    942974    rldef(1) = 0            ! index on remote PE 0
    943975    rldef(2) = remind(1)    ! number of elements on remote PE 0
     976
    944977!
    945978!-- Reserve buffer for index array
    946     DO  i = 2, myclient%inter_npes
     979    DO  i = 2, mychild%inter_npes
    947980       i2          = (i-1) * 2 + 1
    948981       rldef(i2)   = rldef(i2-2) + rldef(i2-1) * 2  ! index on remote PE
    949        rldef(i2+1) = remind(i)                ! number of elements on remote PE
    950     ENDDO
    951 !
    952 !-- Close window to allow client to access data
     982       rldef(i2+1) = remind(i)                      ! number of elements on remote PE
     983    ENDDO
     984
     985!
     986!-- Close window to allow child to access data
    953987    CALL MPI_WIN_FENCE( 0, indwin, ierr )
    954 !
    955 !-- Client has retrieved data
     988
     989!
     990!-- Child has retrieved data
    956991    CALL MPI_WIN_FENCE( 0, indwin, ierr )
    957992
    958     i2 = 2 * myclient%inter_npes - 1
     993    i2 = 2 * mychild%inter_npes - 1
    959994    winsize = ( rldef(i2) + rldef(i2+1) ) * 2
     995
    960996!
    961997!-- Make sure, MPI_ALLOC_MEM works
    … …  
    9651001
    9661002    CALL MPI_BARRIER( m_model_comm, ierr )
    967     CALL MPI_WIN_CREATE( remindw, winsize*c_sizeof(i), iwp, MPI_INFO_NULL,     &
    968                          myclient%intra_comm, indwin2, ierr )
     1003    CALL MPI_WIN_CREATE( remindw, winsize*c_sizeof(i), iwp, MPI_INFO_NULL,      &
     1004                         mychild%intra_comm, indwin2, ierr )
    9691005!
    9701006!-- Open window to set data
    9711007    CALL MPI_WIN_FENCE( 0, indwin2, ierr )
     1008
    9721009!
    9731010!-- Create the 2D index list
    9741011    DO  j = 1, nrp
    9751012       rempe = index_list(5,j) + 1    ! PE number on remote PE
    976        ape => myclient%pes(rempe)
     1013       ape => mychild%pes(rempe)
    9771014       i2    = rempe * 2 - 1
    9781015       ind   = rldef(i2) + 1
    … …  
    9811018       rldef(i2)      = rldef(i2)+2
    9821019    ENDDO
    983 !
    984 !-- All data areset
     1020
     1021!
     1022!-- All data are set
    9851023    CALL MPI_WIN_FENCE( 0, indwin2, ierr )
     1024
    9861025!
    9871026!-- Don't know why, but this barrier is necessary before windows can be freed
    9881027!-- TODO: find out why this is required
    989     CALL MPI_BARRIER( myclient%intra_comm, ierr )
     1028    CALL MPI_BARRIER( mychild%intra_comm, ierr )
    9901029
    9911030    CALL MPI_WIN_FREE( indwin, ierr )
    9921031    CALL MPI_WIN_FREE( indwin2, ierr )
    9931032
     1033!
    9941034!-- TODO: check if the following idea needs to be done
    9951035!-- Sollte funktionieren, Problem mit MPI implementation
    … …  
    10001040
    10011041#endif
    1002  END MODULE pmc_server
     1042 END MODULE pmc_parent

  • palm/trunk/SOURCE/pres.f90

    r1932 r1933  
    2424! -----------------
    2525! $Id$
     26!
     27! 1932 2016-06-10 12:09:21Z suehring
     28! Initial version of purely vertical nesting introduced.
    2629!
    2730! 1931 2016-06-10 12:06:59Z suehring
    … …  
    127130               gathered_size, ibc_p_b, ibc_p_t, intermediate_timestep_count,   &
    128131               intermediate_timestep_count_max, mg_switch_to_pe0_level,        &
    129                nest_domain, nest_bound_l, nest_bound_n, nest_bound_r,          &
    130                nest_bound_s, on_device, outflow_l, outflow_n, outflow_r,       &
     132               nest_domain, on_device, outflow_l, outflow_n, outflow_r,        &
    131133               outflow_s, psolver, subdomain_size, topography, volume_flow,    &
    132134               volume_flow_area, volume_flow_initial
    … …  
    147149
    148150    USE pegrid
     151   
     152    USE pmc_interface,                                                         &
     153        ONLY:  nesting_mode
    149154
    150155    USE poisfft_mod,                                                           &
    … …  
    174179    REAL(wp), DIMENSION(1:nzt) ::  w_l                 !<
    175180    REAL(wp), DIMENSION(1:nzt) ::  w_l_l               !<
     181
     182    LOGICAL :: nest_domain_nvn      !<
    176183
    177184
    … …  
    312319!
    313320!-- Remove mean vertical velocity in case that Neumann conditions are
    314 !-- used both at bottom and top boundary, and if not a nested domain.
     321!-- used both at bottom and top boundary, and if not a nested domain in a
     322!-- normal nesting run. In case of vertical nesting, this must be done.
     323!-- Therefore an auxiliary logical variable nest_domain_nvn is used here, and
     324!-- nvn stands for non-vertical nesting.
    315325!-- This cannot be done before the first initial time step because ngp_2dh_outer
    316326!-- is not yet known then.
    317     IF ( ibc_p_b == 1  .AND.  ibc_p_t == 1  .AND.  .NOT. nest_domain  .AND.    &
    318          intermediate_timestep_count /= 0 )                                    &
     327    nest_domain_nvn = nest_domain
     328    IF ( nest_domain .AND. nesting_mode == 'vertical' )  THEN
     329       nest_domain_nvn = .FALSE.
     330    ENDIF
     331
     332    IF ( ibc_p_b == 1  .AND.  ibc_p_t == 1  .AND.                               &
     333         .NOT. nest_domain_nvn  .AND. intermediate_timestep_count /= 0 )        &
    319334    THEN
    320335       w_l = 0.0_wp;  w_l_l = 0.0_wp

  • palm/trunk/SOURCE/time_integration.f90

    r1928 r1933  
    2525! $Id$
    2626!
    27 ! 1927 2016-06-07 11:56:53Z hellstea
    28 ! Synchronization moved before CALL run_control. Exchange_horiz for pt after
    29 ! CALL pmci_datatrans is now only called if ( .NOT. neutral ). 
     27! 1919 2016-05-27 14:51:23Z raasch
     28! Initial version of purely vertical nesting introduced.
    3029!
    3130! 1918 2016-05-27 14:35:57Z raasch
    … …  
    298297
    299298    USE pmc_interface,                                                         &
    300         ONLY:  client_to_server, nested_run, nesting_mode,                     &
    301                pmci_datatrans, pmci_ensure_nest_mass_conservation,             &
    302                pmci_synchronize, server_to_client
     299        ONLY:  nested_run, nesting_mode, pmci_datatrans,                       &
     300               pmci_ensure_nest_mass_conservation, pmci_synchronize
    303301
    304302    USE production_e_mod,                                                      &
    … …  
    726724             CALL cpu_log( log_point(60), 'nesting', 'start' )
    727725!
    728 !--          Domain nesting. The data transfer subroutines pmci_server_datatrans
    729 !--          and pmci_client_datatatrans are called inside the wrapper
     726!--          Domain nesting. The data transfer subroutines pmci_parent_datatrans
     727!--          and pmci_child_datatrans are called inside the wrapper
    730728!--          subroutine pmci_datatrans according to the control parameters
    731729!--          nesting_mode and nesting_datatransfer_mode.
    … …  
    733731             CALL pmci_datatrans( nesting_mode )
    734732
    735              IF ( nesting_mode == 'two-way' )  THEN
    736 !
    737 !--             Exchange_horiz is needed for all server-domains after the
     733             IF ( TRIM( nesting_mode ) == 'two-way' .OR.                               &
     734                  nesting_mode == 'vertical' )  THEN
     735!
     736!--             Exchange_horiz is needed for all parent-domains after the
    738737!--             anterpolation
    739738                CALL exchange_horiz( u, nbgp )
    … …  
    750749!
    751750!--          Correct the w top-BC in nest domains to ensure mass conservation.
    752 !--          This action must never be done for the root domain.
     751!--          This action must never be done for the root domain. Vertical
     752!--          nesting implies mass conservation.
    753753             IF ( nest_domain )  THEN
    754754                CALL pmci_ensure_nest_mass_conservation
Note: See TracChangeset for help on using the changeset viewer.
                                                                                                                                                                                                                                                                                                                                                                               
  | Impressum | ©Leibniz Universität Hannover |