re-create the system default communicator with a different MPI rank order
Note
should only be called once, at very beginning of CP2K run
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(mp_comm_type), | intent(in) | :: | mp_comm |
[output] : handle of the default communicator |
||
type(mp_comm_type), | 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 TYPE(mp_comm_type), INTENT(IN) :: mp_comm !! [output] : handle of the default communicator TYPE(mp_comm_type), INTENT(out) :: mp_new_comm INTEGER, DIMENSION(:), CONTIGUOUS :: ranks_order CHARACTER(LEN=*), PARAMETER :: routineN = 'mp_reordering' INTEGER :: handle, ierr #if defined(__parallel) MPI_GROUP_TYPE :: newgroup, oldgroup TYPE(mp_comm_type) :: newcomm #endif CALL timeset(routineN, handle) ierr = 0 #if defined(__parallel) CALL mpi_comm_group(mp_comm%handle, 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%handle, newgroup, newcomm%handle, 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