Creates new distribution
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(dbcsr_distribution_obj), | intent(out) | :: | dist |
distribution |
||
type(dbcsr_mp_obj), | intent(in) | :: | mp_env |
multiprocessing environment |
||
integer, | intent(in), | DIMENSION(:), POINTER, CONTIGUOUS | :: | row_dist_block | ||
integer, | intent(in), | DIMENSION(:), POINTER, CONTIGUOUS | :: | col_dist_block | ||
integer, | intent(in), | optional, | DIMENSION(:), POINTER, CONTIGUOUS | :: | local_rows | |
integer, | intent(in), | optional, | DIMENSION(:), POINTER, CONTIGUOUS | :: | local_cols | |
logical, | optional | :: | reuse_arrays |
SUBROUTINE dbcsr_distribution_new_low(dist, mp_env, row_dist_block, col_dist_block, &
local_rows, local_cols, &
reuse_arrays)
!! Creates new distribution
TYPE(dbcsr_distribution_obj), INTENT(OUT) :: dist
!! distribution
TYPE(dbcsr_mp_obj), INTENT(IN) :: mp_env
!! multiprocessing environment
INTEGER, DIMENSION(:), INTENT(IN), POINTER, CONTIGUOUS :: row_dist_block, col_dist_block
INTEGER, DIMENSION(:), INTENT(IN), OPTIONAL, &
POINTER, CONTIGUOUS :: local_rows, local_cols
LOGICAL, OPTIONAL :: reuse_arrays
CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_distribution_new'
INTEGER :: handle, i, lcmv, mypcoor, npcols, &
nprows, seq
INTEGER, DIMENSION(:), POINTER, CONTIGUOUS :: col_dist_tmp, row_dist_tmp
! ---------------------------------------------------------------------------
CALL timeset(routineN, handle)
nprows = dbcsr_mp_nprows(mp_env)
npcols = dbcsr_mp_npcols(mp_env)
lcmv = lcm(nprows, npcols)
ALLOCATE (dist%d)
dist%d%refcount = 1
row_dist_tmp => row_dist_block
col_dist_tmp => col_dist_block
CALL array_new(dist%d%row_dist_block, row_dist_tmp, gift=reuse_arrays)
CALL array_new(dist%d%col_dist_block, col_dist_tmp, gift=reuse_arrays)
dist%d%mp_env = mp_env
CALL dbcsr_mp_hold(dist%d%mp_env)
! Verify given process row distribution.
dist%d%max_row_dist = MAXVAL(row_dist_block)
IF (dist%d%max_row_dist .GE. nprows) &
DBCSR_ABORT("A process row is too big for process grid")
! Verify given process column distribution.
dist%d%max_col_dist = MAXVAL(col_dist_block)
IF (dist%d%max_col_dist .GE. npcols) &
DBCSR_ABORT("A process column is too big for process grid")
IF (PRESENT(local_rows)) THEN
CALL array_new(dist%d%local_rows, local_rows, gift=reuse_arrays)
ELSE
mypcoor = dbcsr_mp_myprow(mp_env)
i = COUNT(row_dist_block .EQ. mypcoor)
ALLOCATE (row_dist_tmp(i))
seq = 1
DO i = 1, SIZE(row_dist_block)
IF (row_dist_block(i) .EQ. mypcoor) THEN
row_dist_tmp(seq) = i
seq = seq + 1
END IF
END DO
CALL array_new(dist%d%local_rows, row_dist_tmp, gift=.TRUE.)
END IF
IF (PRESENT(local_cols)) THEN
CALL array_new(dist%d%local_cols, local_cols, gift=reuse_arrays)
ELSE
mypcoor = dbcsr_mp_mypcol(mp_env)
i = COUNT(col_dist_block .EQ. mypcoor)
ALLOCATE (col_dist_tmp(i))
seq = 1
DO i = 1, SIZE(col_dist_block)
IF (col_dist_block(i) .EQ. mypcoor) THEN
col_dist_tmp(seq) = i
seq = seq + 1
END IF
END DO
CALL array_new(dist%d%local_cols, col_dist_tmp, gift=.TRUE.)
END IF
dist%d%num_threads = 1
!$ dist%d%num_threads = OMP_GET_MAX_THREADS()
dist%d%has_thread_dist = .FALSE.
CALL array_nullify(dist%d%thread_dist)
CALL array_nullify(dist%d%row_map)
CALL array_nullify(dist%d%col_map)
NULLIFY (dist%d%other_l_rows)
NULLIFY (dist%d%other_l_cols)
dist%d%has_other_l_rows = .FALSE.
dist%d%has_other_l_cols = .FALSE.
CALL array_nullify(dist%d%global_row_map)
CALL array_nullify(dist%d%global_col_map)
dist%d%has_global_row_map = .FALSE.
dist%d%has_global_col_map = .FALSE.
CALL timestop(handle)
END SUBROUTINE dbcsr_distribution_new_low