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

last commit documented

File:
1 edited

Legend:

Unmodified
Added
Removed
  • 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
Note: See TracChangeset for help on using the changeset viewer.