Creates a new dbcsr_mp_obj based on a input template
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(dbcsr_mp_obj), | intent(out) | :: | mp_env | |||
type(mp_comm_type), | 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 TYPE(mp_comm_type), 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