dbcsr_copy Subroutine

public subroutine dbcsr_copy(matrix_b, matrix_a, name, keep_sparsity, shallow_data, keep_imaginary, matrix_type)

copy a matrix

Arguments

Type IntentOptional 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


Source Code

   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