dbcsr_mp_new_group Subroutine

private subroutine dbcsr_mp_new_group(mp_env, mp_group, pgrid)

Creates a new dbcsr_mp_obj based on a input template

Arguments

Type IntentOptional 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


Source Code

   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