Copies data from a CSR matrix to a block-row distributed DBCSR matrix. The DBCSR matrix must have a block structure consistent with the CSR matrix.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(dbcsr_type), | intent(inout) | :: | brd_mat |
block-row distributed DBCSR matrix |
||
type(csr_type), | intent(in) | :: | csr_mat |
CSR matrix |
SUBROUTINE convert_csr_to_brd(brd_mat, csr_mat)
!! Copies data from a CSR matrix to a block-row distributed DBCSR matrix.
!! The DBCSR matrix must have a block structure consistent with the CSR matrix.
TYPE(dbcsr_type), INTENT(INOUT) :: brd_mat
!! block-row distributed DBCSR matrix
TYPE(csr_type), INTENT(IN) :: csr_mat
!! CSR matrix
CHARACTER(LEN=*), PARAMETER :: routineN = 'convert_csr_to_brd'
INTEGER :: data_type, handle, ind, k, nze
CALL timeset(routineN, handle)
data_type = dbcsr_get_data_type(brd_mat)
nze = dbcsr_get_nze(brd_mat)
CALL dbcsr_data_release(brd_mat%data_area)
CALL dbcsr_data_new(brd_mat%data_area, data_type, nze)
SELECT CASE (data_type)
CASE (dbcsr_type_real_4)
brd_mat%data_area%d%r_sp(1:nze) = 0.0_sp
CASE (dbcsr_type_real_8)
brd_mat%data_area%d%r_dp(1:nze) = 0.0_dp
CASE (dbcsr_type_complex_4)
brd_mat%data_area%d%c_sp(1:nze) = 0.0_sp
CASE (dbcsr_type_complex_8)
brd_mat%data_area%d%c_dp(1:nze) = 0.0_dp
END SELECT
DO k = 1, csr_mat%nze_local
ind = csr_mat%dbcsr_mapping%csr_to_brd_ind(k)
SELECT CASE (data_type)
CASE (dbcsr_type_real_4)
brd_mat%data_area%d%r_sp(ind) = csr_mat%nzval_local%r_sp(k)
CASE (dbcsr_type_real_8)
brd_mat%data_area%d%r_dp(ind) = csr_mat%nzval_local%r_dp(k)
CASE (dbcsr_type_complex_4)
brd_mat%data_area%d%c_sp(ind) = csr_mat%nzval_local%c_sp(k)
CASE (dbcsr_type_complex_8)
brd_mat%data_area%d%c_dp(ind) = csr_mat%nzval_local%c_dp(k)
END SELECT
END DO
CALL timestop(handle)
END SUBROUTINE convert_csr_to_brd