dbcsr_copy_into_existing_sym Subroutine

   SUBROUTINE dbcsr_copy_into_existing_sym(matrix_b, matrix_a)
      !! copy a matrix, retaining current sparsity

      TYPE(dbcsr_type), INTENT(INOUT)                    :: matrix_b
         !! target DBCSR matrix
      TYPE(dbcsr_type), INTENT(IN)                       :: matrix_a
         !! source DBCSR matrix

      CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_copy_into_existing_sym'

      INTEGER                                            :: col_size, data_type, dst_col, dst_row, &
                                                            handle, row_size, src_col, src_cs, &
                                                            src_row, src_rs
      LOGICAL                                            :: dst_tr, found, neg_imag, neg_real, src_tr
      TYPE(dbcsr_data_obj)                               :: dst_data, src_data
      TYPE(dbcsr_iterator)                               :: dst_iter

!   ---------------------------------------------------------------------------

      CALL timeset(routineN, handle)
      IF (dbcsr_get_data_type(matrix_b) .NE. dbcsr_get_data_type(matrix_a)) &
         DBCSR_ABORT("Matrices have different data types.")
      data_type = dbcsr_get_data_type(matrix_b)
      IF (.NOT. dbcsr_has_symmetry(matrix_b) .OR. dbcsr_has_symmetry(matrix_a)) &
         DBCSR_ABORT("Must copy from non-symmetric to symmetric matrix.")
      neg_real = matrix_b%negate_real
      neg_imag = matrix_b%negate_imaginary

      CALL dbcsr_data_init(src_data)
      CALL dbcsr_data_init(dst_data)
      CALL dbcsr_data_new(src_data, data_type)
      CALL dbcsr_data_new(dst_data, data_type)
      CALL dbcsr_iterator_start(dst_iter, matrix_b)
      ! Iterate through the blocks of the destination matrix.  For each
      ! one, try to find an appropriate source matrix block and copy it
      ! into the destination matrix.
      DO WHILE (dbcsr_iterator_blocks_left(dst_iter))
         CALL dbcsr_iterator_next_block(dst_iter, dst_row, dst_col, dst_data, &
                                        dst_tr, row_size=row_size, col_size=col_size)
         src_row = dst_row
         src_col = dst_col
         IF (checker_tr(dst_row, dst_col)) &
            CALL swap(src_row, src_col)
         CALL dbcsr_get_block_p(matrix_a, src_row, src_col, src_data, src_tr, &
                                found=found, row_size=src_rs, col_size=src_cs)
         IF (.NOT. found) THEN
            CALL dbcsr_data_clear(dst_data)
         ELSE
            IF (checker_tr(dst_row, dst_col)) THEN
               src_tr = .NOT. src_tr
               CALL swap(src_rs, src_cs)
            END IF
            CALL dbcsr_block_partial_copy(dst=dst_data, dst_tr=dst_tr, &
                                          dst_rs=row_size, dst_cs=col_size, &
                                          dst_r_lb=1, dst_c_lb=1, &
                                          src=src_data, src_tr=src_tr, &
                                          src_rs=src_rs, src_cs=src_cs, &
                                          src_r_lb=1, src_c_lb=1, &
                                          nrow=row_size, ncol=col_size)
            IF (neg_real .AND. checker_tr(dst_row, dst_col)) THEN
               CALL dbcsr_block_real_neg(dst_data, row_size, col_size)
            END IF
            IF (neg_imag .AND. checker_tr(dst_row, dst_col)) THEN
               CALL dbcsr_block_conjg(dst_data, row_size, col_size)
            END IF
         END IF
      END DO
      CALL dbcsr_iterator_stop(dst_iter)
      CALL dbcsr_data_clear_pointer(src_data)
      CALL dbcsr_data_clear_pointer(dst_data)
      CALL dbcsr_data_release(src_data)
      CALL dbcsr_data_release(dst_data)
      CALL timestop(handle)

   END SUBROUTINE dbcsr_copy_into_existing_sym