Creates a new dbcsr_mp_obj based on a input template
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(dbcsr_mp_obj), | intent(out) | :: | mp_env | |||
integer, | intent(in) | :: | mp_group | |||
integer, | optional, | DIMENSION(:, :), POINTER | :: | pgrid |
Optional, if not provided group is assumed to be a 2D cartesian communicator |
SUBROUTINE dbcsr_mp_new_group(mp_env, mp_group, pgrid)
!! Creates a new dbcsr_mp_obj based on a input template
TYPE(dbcsr_mp_obj), INTENT(OUT) :: mp_env
INTEGER, INTENT(IN) :: mp_group
INTEGER, DIMENSION(:, :), OPTIONAL, POINTER :: pgrid
!! Optional, if not provided group is assumed to be a 2D cartesian communicator
INTEGER :: mynode, mypcol, myprow, numnodes, pcol, &
prow
INTEGER, DIMENSION(2) :: coord, mycoord, pdims
INTEGER, DIMENSION(:, :), POINTER :: mypgrid
LOGICAL, DIMENSION(2) :: periods
CALL mp_environ(numnodes, mynode, mp_group)
IF (PRESENT(pgrid)) THEN
mypgrid => pgrid
DBCSR_ASSERT(LBOUND(pgrid, 1) == 0 .AND. LBOUND(pgrid, 2) == 0)
pdims(1) = SIZE(pgrid, 1)
pdims(2) = SIZE(pgrid, 2)
myprow = -1; mypcol = -1
outer: &
DO prow = 0, pdims(1) - 1
DO pcol = 0, pdims(2) - 1
IF (pgrid(prow, pcol) == mynode) THEN
myprow = prow
mypcol = pcol
EXIT outer
END IF
END DO
END DO outer
ELSE
CALL mp_environ(mp_group, 2, pdims, mycoord, periods)
DBCSR_ASSERT(pdims(1)*pdims(2) == numnodes)
myprow = mycoord(1)
mypcol = mycoord(2)
ALLOCATE (mypgrid(0:pdims(1) - 1, 0:pdims(2) - 1))
DO prow = 0, pdims(1) - 1
DO pcol = 0, pdims(2) - 1
coord = (/prow, pcol/)
CALL mp_cart_rank(mp_group, coord, mypgrid(prow, pcol))
END DO
END DO
END IF
DBCSR_ASSERT(mynode == mypgrid(myprow, mypcol))
! create the new mp environment
CALL dbcsr_mp_new(mp_env, mp_group, mypgrid, &
mynode=mynode, numnodes=numnodes, myprow=myprow, mypcol=mypcol)
IF (.NOT. PRESENT(pgrid)) DEALLOCATE (mypgrid)
END SUBROUTINE dbcsr_mp_new_group