copy a matrix
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(dbcsr_type), | intent(inout) | :: | matrix_b |
target DBCSR matrix |
||
type(dbcsr_type), | intent(in) | :: | matrix_a |
source DBCSR matrix |
||
character(len=*), | intent(in), | optional | :: | name |
name of the new matrix |
|
logical, | intent(in), | optional | :: | keep_sparsity |
keep the target matrix sparsity; default is False. shallow data copy when copy from complex to real,& the default is to keep only the real part; if this flag is set, the imaginary part is used |
|
logical, | intent(in), | optional | :: | shallow_data |
keep the target matrix sparsity; default is False. shallow data copy when copy from complex to real,& the default is to keep only the real part; if this flag is set, the imaginary part is used |
|
logical, | intent(in), | optional | :: | keep_imaginary |
keep the target matrix sparsity; default is False. shallow data copy when copy from complex to real,& the default is to keep only the real part; if this flag is set, the imaginary part is used |
|
character, | intent(in), | optional | :: | matrix_type |
'N' for normal, 'T' for transposed, 'S' for symmetric, and 'A' for antisymmetric |
SUBROUTINE dbcsr_copy(matrix_b, matrix_a, name, keep_sparsity, &
shallow_data, keep_imaginary, matrix_type)
!! copy a matrix
TYPE(dbcsr_type), INTENT(INOUT) :: matrix_b
!! target DBCSR matrix
TYPE(dbcsr_type), INTENT(IN) :: matrix_a
!! source DBCSR matrix
CHARACTER(LEN=*), INTENT(IN), OPTIONAL :: name
!! name of the new matrix
LOGICAL, INTENT(IN), OPTIONAL :: keep_sparsity, shallow_data, &
keep_imaginary
!! keep the target matrix sparsity; default is False.
!! shallow data copy
!! when copy from complex to real,& the default is to keep only the real part; if this flag is set, the imaginary part is
!! used
CHARACTER, INTENT(IN), OPTIONAL :: matrix_type
!! 'N' for normal, 'T' for transposed, 'S' for symmetric, and 'A' for antisymmetric
CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_copy'
CHARACTER :: new_matrix_type, repl_type
INTEGER :: handle, new_type
LOGICAL :: keep_sparse, shallow
! ---------------------------------------------------------------------------
CALL timeset(routineN, handle)
IF (.NOT. symmetry_consistent(dbcsr_get_matrix_type(matrix_a), dbcsr_get_data_type(matrix_a))) &
DBCSR_ABORT("Source matrix symmetry not consistent with its data type.")
shallow = .FALSE.; IF (PRESENT(shallow_data)) shallow = shallow_data
keep_sparse = .FALSE.
IF (PRESENT(keep_sparsity)) keep_sparse = keep_sparsity
IF (keep_sparse .AND. .NOT. dbcsr_valid_index(matrix_b)) &
DBCSR_ABORT("Target matrix must be valid to keep its sparsity")
IF (keep_sparse .AND. shallow) &
DBCSR_WARN("Shallow copy not compatibly with sparsity retainment")
IF (keep_sparse) THEN
IF (PRESENT(name)) matrix_b%name = name
CALL dbcsr_copy_into_existing(matrix_b, matrix_a)
ELSE
IF (dbcsr_valid_index(matrix_b)) THEN
new_type = dbcsr_get_data_type(matrix_b)
repl_type = dbcsr_get_replication_type(matrix_b)
ELSE
new_type = dbcsr_get_data_type(matrix_a)
repl_type = dbcsr_get_replication_type(matrix_a)
END IF
new_matrix_type = dbcsr_get_matrix_type(matrix_a)
IF (PRESENT(matrix_type)) THEN
IF (.NOT. symmetry_compatible(dbcsr_get_matrix_type(matrix_a), matrix_type)) &
CALL dbcsr_abort(__LOCATION__, "Specified target matrix symmetry "//matrix_type// &
" not compatible with source matrix type "//dbcsr_get_matrix_type(matrix_a))
new_matrix_type = matrix_type
END IF
IF (.NOT. symmetry_consistent(new_matrix_type, new_type)) &
CALL dbcsr_abort(__LOCATION__, "Target matrix symmetry "// &
new_matrix_type//" not consistent with its data type.")
IF (PRESENT(name)) THEN
CALL dbcsr_create(matrix_b, name=TRIM(name), &
template=matrix_a, &
matrix_type=new_matrix_type, &
data_type=new_type)
ELSE
CALL dbcsr_create(matrix_b, &
data_type=new_type, &
matrix_type=new_matrix_type, &
template=matrix_a)
END IF
CALL ensure_array_size(matrix_b%index, ub=SIZE(matrix_a%index), &
memory_type=dbcsr_get_index_memory_type(matrix_b))
!
! copy index and data
matrix_b%index(1:SIZE(matrix_a%index)) = matrix_a%index(:)
IF (.NOT. shallow) THEN
IF (matrix_a%nze > dbcsr_get_data_size(matrix_a)) &
DBCSR_ABORT("Source matrix sizes not consistent!")
CALL dbcsr_data_ensure_size(matrix_b%data_area, &
dbcsr_data_get_size_referenced(matrix_a%data_area))
IF (dbcsr_get_data_type(matrix_a) .EQ. dbcsr_get_data_type(matrix_b)) &
THEN
CALL dbcsr_data_copyall(matrix_b%data_area, &
matrix_a%data_area)
ELSE
CALL dbcsr_data_convert(matrix_b%data_area, &
matrix_a%data_area, drop_real=keep_imaginary)
END IF
ELSE
IF (dbcsr_get_data_type(matrix_a) .NE. dbcsr_get_data_type(matrix_b)) &
DBCSR_ABORT("Shallow copy only possible when retaining data type.")
CALL dbcsr_switch_data_area(matrix_b, matrix_a%data_area)
END IF
!
! the row_p, col_i and blk_p ...
CALL dbcsr_repoint_index(matrix_b)
matrix_b%nze = matrix_a%nze
matrix_b%nblks = matrix_b%nblks
matrix_b%valid = .TRUE.
matrix_b%sparsity_id = matrix_a%sparsity_id
END IF
CALL timestop(handle)
END SUBROUTINE dbcsr_copy