Ignore:
Timestamp:
Nov 1, 2017 1:18:45 PM (7 years ago)
Author:
hellstea
Message:

i/o grouping update for nested runs

File:
1 edited

Legend:

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

    r2516 r2599  
    2626! -----------------
    2727! $Id$
     28! Separate peer communicator peer_comm introduced for MPI_INTERCOMM_CREATE.
     29! Some cleanup and commenting improvements.
     30!
     31! 2516 2017-10-04 11:03:04Z suehring
    2832! Remove tabs
    2933!
     
    127131    PUBLIC  pmc_status_ok, pmc_status_error
    128132
    129     INTEGER, PARAMETER, PUBLIC ::  pmc_error_npes        = 1  !< illegal number of PEs
     133    INTEGER, PARAMETER, PUBLIC ::  pmc_error_npes        = 1  !< illegal number of processes
    130134    INTEGER, PARAMETER, PUBLIC ::  pmc_namelist_error    = 2  !< error(s) in nestpar namelist
    131135    INTEGER, PARAMETER, PUBLIC ::  pmc_no_namelist_found = 3  !< no couple layout namelist found
     
    144148    INTEGER, PUBLIC ::  m_model_rank          !<
    145149    INTEGER, PUBLIC ::  m_model_npes          !<
    146     INTEGER         ::  m_parent_remote_size  !< number of parent PEs
     150    INTEGER         ::  m_parent_remote_size  !< number of processes in the parent model
     151    INTEGER         ::  peer_comm             !< peer_communicator for inter communicators
    147152
    148153    INTEGER, DIMENSION(pmc_max_models), PUBLIC ::  m_to_child_comm    !< communicator to the child(ren)
     
    200205    CALL MPI_COMM_SIZE( MPI_COMM_WORLD, m_world_npes, istat )
    201206!
    202 !-- Only PE 0 of root model reads
     207!-- Only process 0 of root model reads
    203208    IF ( m_world_rank == 0 )  THEN
    204209
     
    210215       THEN
    211216!
    212 !--       Calculate start PE of every model
     217!--       Determine the first process id of each model
    213218          start_pe(1) = 0
    214219          DO  i = 2, m_ncpl+1
     
    217222
    218223!
    219 !--       The number of cores provided with the run must be the same as the
    220 !--       total sum of cores required by all nest domains
     224!--       The sum of numbers of processes requested by all the domains
     225!--       must be equal to the total number of processes of the run
    221226          IF ( start_pe(m_ncpl+1) /= m_world_npes )  THEN
    222227             WRITE ( message_string, '(2A,I6,2A,I6,A)' )                        &
     
    231236    ENDIF
    232237!
    233 !-- Broadcast the read status. This synchronises all other PEs with PE 0 of
    234 !-- the root model. Without synchronisation, they would not behave in the
    235 !-- correct way (e.g. they would not return in case of a missing NAMELIST)
     238!-- Broadcast the read status. This synchronises all other processes with
     239!-- process 0 of the root model. Without synchronisation, they would not
     240!-- behave in the correct way (e.g. they would not return in case of a
     241!-- missing NAMELIST).
    236242    CALL MPI_BCAST( pmc_status, 1, MPI_INTEGER, 0, MPI_COMM_WORLD, istat )
    237243
     
    254260    ENDIF
    255261
    256     CALL MPI_BCAST( m_ncpl,          1, MPI_INTEGER, 0, MPI_COMM_WORLD, istat)
    257     CALL MPI_BCAST( start_pe, m_ncpl+1, MPI_INTEGER, 0, MPI_COMM_WORLD, istat)
    258 
     262    CALL MPI_BCAST( m_ncpl,          1, MPI_INTEGER, 0, MPI_COMM_WORLD, istat )
     263    CALL MPI_BCAST( start_pe, m_ncpl+1, MPI_INTEGER, 0, MPI_COMM_WORLD, istat )
    259264!
    260265!-- Broadcast coupling layout
     
    277282    CALL MPI_BCAST( nesting_datatransfer_mode, LEN(nesting_datatransfer_mode),  &
    278283                    MPI_CHARACTER, 0, MPI_COMM_WORLD, istat )
    279 
    280284!
    281285!-- Assign global MPI processes to individual models by setting the couple id
     
    288292    ENDDO
    289293    m_my_cpl_rank = m_world_rank - start_pe(i)
    290 
    291294!
    292295!-- MPI_COMM_WORLD is the communicator for ALL models (MPI-1 approach).
     
    296299                         istat )
    297300!
    298 !-- Get size and rank of the model running on this PE
     301!-- Get size and rank of the model running on this process
    299302    CALL  MPI_COMM_RANK( comm, m_model_rank, istat )
    300303    CALL  MPI_COMM_SIZE( comm, m_model_npes, istat )
    301 
    302 !
    303 !-- Broadcast (from PE 0) the parent id and id of every model
     304!
     305!-- Broadcast (from process 0) the parent id and id of every model
    304306    DO  i = 1, m_ncpl
    305307       CALL MPI_BCAST( m_couplers(i)%parent_id, 1, MPI_INTEGER, 0,              &
     
    308310                       MPI_COMM_WORLD, istat )
    309311    ENDDO
    310 
    311312!
    312313!-- Save the current model communicator for pmc internal use
     
    314315
    315316!
    316 !-- Create intercommunicator between parent and children.
     317!-- Create intercommunicator between the parent and children.
    317318!-- MPI_INTERCOMM_CREATE creates an intercommunicator between 2 groups of
    318319!-- different colors.
    319 !-- The grouping was done above with MPI_COMM_SPLIT
     320!-- The grouping was done above with MPI_COMM_SPLIT.
     321!-- A duplicate of MPI_COMM_WORLD is created and used as peer communicator
     322!-- (peer_comm) for MPI_INTERCOMM_CREATE.
     323    CALL MPI_COMM_DUP( MPI_COMM_WORLD, peer_comm, ierr )
    320324    DO  i = 2, m_ncpl
    321 
    322325       IF ( m_couplers(i)%parent_id == m_my_cpl_id )  THEN
    323326!
    324 !--       Collect parent PEs.
    325 !--       Every model exept the root model has a parent model which acts as
    326 !--       parent model. Create an intercommunicator to connect current PE to
    327 !--       all children PEs
     327!--       Identify all children models of the current model and create
     328!--       inter-communicators to connect between the current model and its
     329!--       children models.
    328330          tag = 500 + i
    329           CALL MPI_INTERCOMM_CREATE( comm, 0, MPI_COMM_WORLD, start_pe(i),      &
     331          CALL MPI_INTERCOMM_CREATE( comm, 0, peer_comm, start_pe(i),           &
    330332                                     tag, m_to_child_comm(i), istat)
    331333          childcount = childcount + 1
    332334          activeparent(i) = 1
    333 
    334335       ELSEIF ( i == m_my_cpl_id)  THEN
    335336!
    336 !--       Collect children PEs.
    337 !--       Every model except the root model has a parent model.
    338 !--       Create an intercommunicator to connect current PE to all parent PEs
     337!--       Create an inter-communicator to connect between the current
     338!--       model and its parent model.   
    339339          tag = 500 + i
    340           CALL MPI_INTERCOMM_CREATE( comm, 0, MPI_COMM_WORLD,                   &
     340          CALL MPI_INTERCOMM_CREATE( comm, 0, peer_comm,                        &
    341341                                     start_pe(m_couplers(i)%parent_id),         &
    342342                                     tag, m_to_parent_comm, istat )
    343343       ENDIF
    344 
    345344    ENDDO
    346 
    347 !
    348 !-- If I am parent, count the number of children that I have
     345!
     346!-- If I am a parent, count the number of children I have.
    349347!-- Although this loop is symmetric on all processes, the "activeparent" flag
    350 !-- is true (==1) on the respective individual PE only.
     348!-- is true (==1) on the respective individual process only.
    351349    ALLOCATE( pmc_parent_for_child(childcount+1) )
    352350
     
    362360    IF ( m_my_cpl_id > 1 )  THEN
    363361       CALL MPI_COMM_REMOTE_SIZE( m_to_parent_comm, m_parent_remote_size,       &
    364                                   istat)
     362                                  istat )
    365363    ELSE
    366364!
     
    369367    ENDIF
    370368!
    371 !-- Set myid to non-tero value except for the root domain. This is a setting
     369!-- Set myid to non-zero value except for the root domain. This is a setting
    372370!-- for the message routine which is called at the end of pmci_init. That
    373371!-- routine outputs messages for myid = 0, only. However, myid has not been
    374 !-- assigened so far, so that all PEs of the root model would output a
    375 !-- message. To avoid this, set myid to some other value except for PE0 of the
    376 !-- root domain.
     372!-- assigened so far, so that all processes of the root model would output a
     373!-- message. To avoid this, set myid to some other value except for process 0
     374!-- of the root domain.
    377375    IF ( m_world_rank /= 0 )  myid = 1
    378376
     
    401399    INTEGER, INTENT(OUT), OPTIONAL ::  npe_total           !<
    402400
    403     INTEGER ::  requested_cpl_id  !<
    404 
    405     REAL(wp), INTENT(OUT), OPTIONAL ::  lower_left_x  !<
    406     REAL(wp), INTENT(OUT), OPTIONAL ::  lower_left_y  !<
     401    INTEGER ::  requested_cpl_id                           !<
     402
     403    REAL(wp), INTENT(OUT), OPTIONAL ::  lower_left_x       !<
     404    REAL(wp), INTENT(OUT), OPTIONAL ::  lower_left_y       !<
    407405
    408406!
     
    416414       requested_cpl_id = m_my_cpl_id
    417415    ENDIF
    418 
    419416!
    420417!-- Return the requested information
     
    459456
    460457 SUBROUTINE read_coupling_layout( nesting_datatransfer_mode, nesting_mode,      &
    461                                   pmc_status )
     458      pmc_status )
    462459
    463460    IMPLICIT NONE
     
    481478
    482479    pmc_status = pmc_status_ok
    483 
    484480!
    485481!-- Open the NAMELIST-file and read the nesting layout
     
    487483    READ ( 11, nestpar, IOSTAT=istat )
    488484!
    489 !-- Set filepointer to the beginning of the file. Otherwise PE0 will later
     485!-- Set filepointer to the beginning of the file. Otherwise process 0 will later
    490486!-- be unable to read the inipar-NAMELIST
    491487    REWIND ( 11 )
    492488
    493489    IF ( istat < 0 )  THEN
    494 
    495490!
    496491!--    No nestpar-NAMELIST found
    497492       pmc_status = pmc_no_namelist_found
    498 
    499493       RETURN
    500 
    501494    ELSEIF ( istat > 0 )  THEN
    502 
    503495!
    504496!--    Errors in reading nestpar-NAMELIST
    505497       pmc_status = pmc_namelist_error
    506498       RETURN
    507 
    508     ENDIF
    509 
     499    ENDIF
    510500!
    511501!-- Output location message
    512502    CALL location_message( 'initialize communicators for nesting', .FALSE. )
    513 
    514 !
    515 !-- Assign the layout to the internally used variable
     503!
     504!-- Assign the layout to the corresponding internally used variable m_couplers
    516505    m_couplers = domain_layouts
    517 
    518506!
    519507!-- Get the number of nested models given in the nestpar-NAMELIST
     
    521509!
    522510!--    When id=-1 is found for the first time, the list of domains is finished
    523         IF ( m_couplers(i)%id == -1  .OR.  i == pmc_max_models )  THEN
     511       IF ( m_couplers(i)%id == -1  .OR.  i == pmc_max_models )  THEN
    524512          IF ( m_couplers(i)%id == -1 )  THEN
    525513             m_ncpl = i - 1
     
    529517          ENDIF
    530518       ENDIF
    531 
    532519    ENDDO
    533 
    534520!
    535521!-- Make sure that all domains have equal lower left corner in case of vertical
Note: See TracChangeset for help on using the changeset viewer.