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