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(len=1), | 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