Creates a sane mp_obj from the given MPI comm that is not a cartesian one (hack)
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(dbcsr_mp_obj), | intent(out) | :: | mp_env |
Message-passing environment object to create |
||
integer, | intent(out) | :: | cart_group |
the created cartesian group (to be freed by the user) |
||
integer, | intent(in) | :: | mp_group |
MPI group |
||
integer, | intent(in), | optional | :: | nprocs |
Number of processes |
|
integer, | intent(in), | optional, | DIMENSION(:) | :: | pgrid_dims |
Dimensions of MPI group |
SUBROUTINE dbcsr_mp_make_env(mp_env, cart_group, mp_group, &
nprocs, pgrid_dims)
!! Creates a sane mp_obj from the given MPI comm that is not a cartesian one (hack)
TYPE(dbcsr_mp_obj), INTENT(OUT) :: mp_env
!! Message-passing environment object to create
INTEGER, INTENT(OUT) :: cart_group
!! the created cartesian group (to be freed by the user)
INTEGER, INTENT(IN) :: mp_group
!! MPI group
INTEGER, INTENT(IN), OPTIONAL :: nprocs
!! Number of processes
INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL :: pgrid_dims
!! Dimensions of MPI group
CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_mp_make_env'
INTEGER :: error_handle, mynode, numnodes, pcol, &
prow
INTEGER, ALLOCATABLE, DIMENSION(:, :) :: pgrid
INTEGER, DIMENSION(2) :: coord, myploc, npdims
LOGICAL :: alive
! ---------------------------------------------------------------------------
CALL timeset(routineN, error_handle)
CALL mp_environ(numnodes, mynode, mp_group)
IF (PRESENT(nprocs)) THEN
IF (nprocs > numnodes) &
DBCSR_ABORT("Can not grow processes.")
numnodes = nprocs
END IF
!
IF (PRESENT(pgrid_dims)) THEN
npdims(:) = pgrid_dims
ELSE
npdims(:) = 0
CALL mp_dims_create(numnodes, npdims)
END IF
CALL mp_cart_create(mp_group, 2, npdims, myploc, cart_group)
alive = cart_group .NE. mp_comm_null
IF (alive) THEN
CALL mp_environ(numnodes, mynode, cart_group)
ALLOCATE (pgrid(0:npdims(1) - 1, 0:npdims(2) - 1))
DO prow = 0, npdims(1) - 1
DO pcol = 0, npdims(2) - 1
coord = (/prow, pcol/)
CALL mp_cart_rank(cart_group, coord, pgrid(prow, pcol))
END DO
END DO
CALL dbcsr_mp_new(mp_env, cart_group, pgrid, &
mynode, numnodes, &
myprow=myploc(1), mypcol=myploc(2))
ELSE
CALL dbcsr_mp_init(mp_env)
END IF
CALL timestop(error_handle)
END SUBROUTINE dbcsr_mp_make_env