re-create the system default communicator with a different MPI rank order
should only be called once, at very beginning of CP2K run
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
integer, | intent(in) | :: | mp_comm |
[output] : handle of the default communicator |
||
integer, | intent(out) | :: | mp_new_comm | |||
integer, | DIMENSION(:), CONTIGUOUS | :: | ranks_order |
SUBROUTINE mp_reordering(mp_comm, mp_new_comm, ranks_order)
!! re-create the system default communicator with a different MPI
!! rank order
!! @note
!! should only be called once, at very beginning of CP2K run
INTEGER, INTENT(IN) :: mp_comm
!! [output] : handle of the default communicator
INTEGER, INTENT(out) :: mp_new_comm
INTEGER, DIMENSION(:), CONTIGUOUS :: ranks_order
CHARACTER(LEN=*), PARAMETER :: routineN = 'mp_reordering'
INTEGER :: handle, ierr
#if defined(__parallel)
INTEGER :: newcomm, newgroup, oldgroup
#endif
CALL timeset(routineN, handle)
ierr = 0
#if defined(__parallel)
CALL mpi_comm_group(mp_comm, oldgroup, ierr)
IF (ierr /= 0) CALL mp_stop(ierr, "mpi_comm_group @ "//routineN)
CALL mpi_group_incl(oldgroup, SIZE(ranks_order), ranks_order, newgroup, ierr)
IF (ierr /= 0) CALL mp_stop(ierr, "mpi_group_incl @ "//routineN)
CALL mpi_comm_create(mp_comm, newgroup, newcomm, ierr)
IF (ierr /= 0) CALL mp_stop(ierr, "mpi_comm_create @ "//routineN)
CALL mpi_group_free(oldgroup, ierr)
IF (ierr /= 0) CALL mp_stop(ierr, "mpi_group_free @ "//routineN)
CALL mpi_group_free(newgroup, ierr)
IF (ierr /= 0) CALL mp_stop(ierr, "mpi_group_free @ "//routineN)
! update the system default communicator
mp_new_comm = newcomm
debug_comm_count = debug_comm_count + 1
#else
MARK_USED(ranks_order)
mp_new_comm = mp_comm
#endif
CALL timestop(handle)
END SUBROUTINE mp_reordering