Distributes a matrix that is currently replicated.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(dbcsr_type), | intent(inout) | :: | matrix |
matrix to replicate |
||
logical, | intent(in), | optional | :: | fast |
change just the index, don't touch the data |
SUBROUTINE dbcsr_distribute(matrix, fast)
!! Distributes a matrix that is currently replicated.
TYPE(dbcsr_type), INTENT(INOUT) :: matrix
!! matrix to replicate
LOGICAL, INTENT(in), OPTIONAL :: fast
!! change just the index, don't touch the data
CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_distribute'
COMPLEX(KIND=dp), DIMENSION(:), POINTER, CONTIGUOUS :: c_dp
COMPLEX(KIND=sp), DIMENSION(:), POINTER, CONTIGUOUS :: c_sp
INTEGER :: blk, col, handle, mynode, nblks, nze, p, &
row
INTEGER, DIMENSION(:), POINTER, CONTIGUOUS :: col_blk_size, row_blk_size, tmp_index
LOGICAL :: mini, tr
REAL(KIND=dp), DIMENSION(:), POINTER, CONTIGUOUS :: r_dp
REAL(KIND=sp), DIMENSION(:), POINTER, CONTIGUOUS :: r_sp
TYPE(dbcsr_data_obj) :: tmp_data
TYPE(dbcsr_distribution_obj) :: dist
TYPE(dbcsr_iterator) :: iter
TYPE(dbcsr_mp_obj) :: mp_obj
TYPE(dbcsr_type) :: distributed
! ---------------------------------------------------------------------------
CALL timeset(routineN, handle)
IF (.NOT. dbcsr_valid_index(matrix)) &
DBCSR_ABORT("Matrix not initialized.")
IF (matrix%replication_type .EQ. dbcsr_repl_none) &
DBCSR_WARN("Distributing a non-replicated matrix makes no sense.")
IF (PRESENT(fast)) THEN
mini = fast
ELSE
mini = .FALSE.
END IF
SELECT CASE (matrix%data_type)
CASE (dbcsr_type_real_8)
CALL dbcsr_get_data(matrix%data_area, r_dp)
CASE (dbcsr_type_real_4)
CALL dbcsr_get_data(matrix%data_area, r_sp)
DBCSR_ABORT("Only real double precision")
CASE (dbcsr_type_complex_8)
CALL dbcsr_get_data(matrix%data_area, c_dp)
DBCSR_ABORT("Only real double precision")
CASE (dbcsr_type_complex_4)
CALL dbcsr_get_data(matrix%data_area, c_sp)
DBCSR_ABORT("Only real double precision")
END SELECT
row_blk_size => array_data(matrix%row_blk_size)
col_blk_size => array_data(matrix%col_blk_size)
dist = dbcsr_distribution(matrix)
mp_obj = dbcsr_distribution_mp(dist)
mynode = dbcsr_mp_mynode(dbcsr_distribution_mp(dist))
!
IF (mini) THEN
! We just mark the blocks as deleted.
CALL dbcsr_iterator_start(iter, matrix)
DO WHILE (dbcsr_iterator_blocks_left(iter))
CALL dbcsr_iterator_next_block(iter, row, col, r_dp, tr, blk)
tr = .FALSE.
CALL dbcsr_get_stored_coordinates(matrix, row, col, p)
IF (mynode .EQ. p) THEN
matrix%blk_p(blk) = 0
END IF
END DO
CALL dbcsr_iterator_stop(iter)
matrix%replication_type = dbcsr_repl_none
ELSE
CALL dbcsr_create(distributed, name='Distributed '//TRIM(matrix%name), &
template=matrix, &
matrix_type=dbcsr_type_no_symmetry, &
replication_type=dbcsr_repl_none)
distributed%replication_type = dbcsr_repl_none
! First count how many blocks are local.
nze = 0
nblks = 0
CALL dbcsr_iterator_start(iter, matrix)
DO WHILE (dbcsr_iterator_blocks_left(iter))
CALL dbcsr_iterator_next_block(iter, row, col, r_dp, tr, blk)
tr = .FALSE.
CALL dbcsr_get_stored_coordinates(matrix, row, col, p)
IF (mynode .EQ. p) THEN
nze = nze + row_blk_size(row)*col_blk_size(col)
nblks = nblks + 1
END IF
END DO
CALL dbcsr_iterator_stop(iter)
! Preallocate the array
CALL dbcsr_work_create(distributed, nblks_guess=nblks, &
sizedata_guess=nze, work_mutable=.FALSE.)
! Now actually do the work
CALL dbcsr_iterator_start(iter, matrix)
DO WHILE (dbcsr_iterator_blocks_left(iter))
CALL dbcsr_iterator_next_block(iter, row, col, r_dp, tr, blk)
tr = .FALSE.
CALL dbcsr_get_stored_coordinates(matrix, row, col, p)
IF (mynode .EQ. p) THEN
CALL dbcsr_put_block(distributed, row, col, r_dp, transposed=tr)
END IF
END DO
CALL dbcsr_iterator_stop(iter)
CALL dbcsr_finalize(distributed)
! Now replace the data and index
CALL dbcsr_switch_data_area(matrix, distributed%data_area, &
previous_data_area=tmp_data)
CALL dbcsr_switch_data_area(distributed, tmp_data)
CALL dbcsr_data_release(tmp_data)
tmp_index => matrix%index
matrix%index => distributed%index
distributed%index => tmp_index
CALL dbcsr_repoint_index(matrix)
matrix%nze = distributed%nze
matrix%nblks = distributed%nblks
CALL dbcsr_release(distributed)
END IF
CALL timestop(handle)
END SUBROUTINE dbcsr_distribute