create CSR matrix including dbcsr_mapping from arbitrary DBCSR matrix in order to prepare conversion.
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(dbcsr_type), | intent(in) | :: | dbcsr_mat | |||
type(csr_type), | intent(out) | :: | csr_mat | |||
integer, | intent(in) | :: | dist_format |
how to distribute CSR rows over processes: csr_dbcsr_blkrow_dist: the number of rows per process is adapted to the row block sizes in the DBCSR format such that blocks are not split over different processes. csr_eqrow_ceil_dist: each process holds ceiling(N/P) CSR rows. csr_eqrow_floor_dist: each process holds floor(N/P) CSR rows. |
||
type(dbcsr_type), | intent(in), | optional | :: | csr_sparsity |
DBCSR matrix containing 0 and 1, representing CSR sparsity pattern 1: non-zero element 0: zero element (not present in CSR format) Note: matrix must be of data_type dbcsr_type_real_4 or dbcsr_type_real_8 (integer types not supported) |
|
integer, | intent(in), | optional | :: | numnodes |
number of nodes to use for distributing CSR matrix (optional, default is number of nodes used for DBCSR matrix) |
SUBROUTINE csr_create_from_dbcsr(dbcsr_mat, csr_mat, dist_format, csr_sparsity, numnodes)
!! create CSR matrix including dbcsr_mapping from arbitrary DBCSR matrix
!! in order to prepare conversion.
TYPE(dbcsr_type), INTENT(IN) :: dbcsr_mat
TYPE(csr_type), INTENT(OUT) :: csr_mat
INTEGER, INTENT(IN) :: dist_format
!! how to distribute CSR rows over processes: csr_dbcsr_blkrow_dist: the number of rows per process is adapted to the row
!! block sizes in the DBCSR format such that blocks are not split over different processes. csr_eqrow_ceil_dist: each
!! process holds ceiling(N/P) CSR rows. csr_eqrow_floor_dist: each process holds floor(N/P) CSR rows.
TYPE(dbcsr_type), INTENT(IN), OPTIONAL :: csr_sparsity
!! DBCSR matrix containing 0 and 1, representing CSR sparsity pattern 1: non-zero element 0: zero element (not present in
!! CSR format) Note: matrix must be of data_type dbcsr_type_real_4 or dbcsr_type_real_8 (integer types not supported)
INTEGER, INTENT(IN), OPTIONAL :: numnodes
!! number of nodes to use for distributing CSR matrix (optional, default is number of nodes used for DBCSR matrix)
CHARACTER(LEN=*), PARAMETER :: routineN = 'csr_create_from_dbcsr'
INTEGER :: dbcsr_numnodes, handle, nblkcols_total, &
nblkrows_total, nblks_local, num_p
LOGICAL :: equal_dist, floor_dist
TYPE(dbcsr_type) :: brd_mat, csr_sparsity_brd, &
csr_sparsity_nosym, dbcsr_mat_nosym
CALL timeset(routineN, handle)
IF (.NOT. dbcsr_valid_index(dbcsr_mat)) &
DBCSR_ABORT("Invalid DBCSR matrix")
SELECT CASE (dist_format)
CASE (csr_dbcsr_blkrow_dist)
equal_dist = .FALSE.
floor_dist = .FALSE.
CASE (csr_eqrow_ceil_dist)
equal_dist = .TRUE.
floor_dist = .FALSE.
CASE (csr_eqrow_floor_dist)
equal_dist = .TRUE.
floor_dist = .TRUE.
END SELECT
! Conversion does not support matrices in symmetric format, therefore desymmetrize
IF (dbcsr_has_symmetry(dbcsr_mat)) THEN
CALL dbcsr_desymmetrize_deep(dbcsr_mat, dbcsr_mat_nosym, untransposed_data=.TRUE.)
ELSE
CALL dbcsr_copy(dbcsr_mat_nosym, dbcsr_mat)
END IF
IF (PRESENT(csr_sparsity)) THEN
IF (dbcsr_has_symmetry(csr_sparsity)) THEN
CALL dbcsr_desymmetrize_deep(csr_sparsity, csr_sparsity_nosym, &
untransposed_data=.TRUE.)
ELSE
CALL dbcsr_copy(csr_sparsity_nosym, csr_sparsity)
END IF
ELSE
CALL dbcsr_create(csr_sparsity_nosym, &
template=dbcsr_mat_nosym, &
name="CSR sparsity matrix", &
data_type=dbcsr_type_real_8)
CALL dbcsr_copy(csr_sparsity_nosym, dbcsr_mat_nosym)
CALL dbcsr_set(csr_sparsity_nosym, 1.0_dp)
END IF
IF (.NOT. dbcsr_has_same_block_structure(dbcsr_mat_nosym, csr_sparsity_nosym)) &
DBCSR_ABORT("csr_sparsity and dbcsr_mat have different sparsity pattern")
dbcsr_numnodes = dbcsr_mp_numnodes(dbcsr_distribution_mp(dbcsr_distribution(dbcsr_mat)))
IF (PRESENT(numnodes)) THEN
IF (numnodes .GT. dbcsr_numnodes) &
CALL dbcsr_abort(__LOCATION__, "Number of nodes used for CSR matrix "// &
"must not exceed total number of nodes")
num_p = numnodes
ELSE
num_p = dbcsr_numnodes
END IF
CALL dbcsr_create_brd(dbcsr_mat_nosym, brd_mat, equal_dist, floor_dist, &
num_p)
CALL dbcsr_create_brd(csr_sparsity_nosym, csr_sparsity_brd, equal_dist, floor_dist, &
num_p)
! Create CSR matrix from BRD matrix
CALL csr_create_from_brd(brd_mat, csr_mat, csr_sparsity_brd)
! Store DBCSR block data inside CSR matrix
! (otherwise, this data is lost when converting from DBCSR to CSR)
nblks_local = dbcsr_get_num_blocks(dbcsr_mat_nosym)
nblkrows_total = dbcsr_nblkrows_total(dbcsr_mat_nosym)
nblkcols_total = dbcsr_nblkcols_total(dbcsr_mat_nosym)
csr_mat%dbcsr_mapping%dbcsr_nblkcols_total = nblkcols_total
csr_mat%dbcsr_mapping%dbcsr_nblkrows_total = nblkrows_total
csr_mat%dbcsr_mapping%dbcsr_nblks_local = nblks_local
ALLOCATE (csr_mat%dbcsr_mapping%dbcsr_row_p(nblkrows_total + 1))
csr_mat%dbcsr_mapping%dbcsr_row_p = dbcsr_mat_nosym%row_p
ALLOCATE (csr_mat%dbcsr_mapping%dbcsr_col_i(nblks_local))
csr_mat%dbcsr_mapping%dbcsr_col_i = dbcsr_mat_nosym%col_i
ALLOCATE (csr_mat%dbcsr_mapping%dbcsr_row_blk_size(nblkrows_total))
ALLOCATE (csr_mat%dbcsr_mapping%dbcsr_col_blk_size(nblkcols_total))
csr_mat%dbcsr_mapping%dbcsr_row_blk_size = dbcsr_row_block_sizes(dbcsr_mat_nosym)
csr_mat%dbcsr_mapping%dbcsr_col_blk_size = dbcsr_col_block_sizes(dbcsr_mat_nosym)
csr_mat%dbcsr_mapping%has_dbcsr_block_data = .TRUE.
CALL dbcsr_release(dbcsr_mat_nosym)
CALL dbcsr_release(csr_sparsity_nosym)
CALL dbcsr_release(csr_sparsity_brd)
CALL timestop(handle)
END SUBROUTINE csr_create_from_dbcsr