dbcsr_copy_into_existing Subroutine

   SUBROUTINE dbcsr_copy_into_existing(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'

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

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

      CALL timeset(routineN, handle)
      IF (.NOT. dbcsr_valid_index(matrix_b)) &
         DBCSR_ABORT("Matrix_b is not valid")
      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)
      neg_real = matrix_b%negate_real
      neg_imag = matrix_b%negate_imaginary
      making_symmetric = dbcsr_has_symmetry(matrix_b) &
                         .AND. .NOT. dbcsr_has_symmetry(matrix_a)
      IF (making_symmetric) THEN
         CALL dbcsr_copy_into_existing_sym(matrix_b, matrix_a)
         CALL timestop(handle)
         RETURN
      END IF
      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(src_iter, matrix_a)
      CALL dbcsr_iterator_start(dst_iter, matrix_b)
      ! Iterate through the blocks of the source and destination
      ! matrix. There are three possibilities: 1. copy the data for
      ! blocks present in both; 2 skip source blocks not present in the
      ! target; 3 zero blocks not present in the source.
      IF (dbcsr_iterator_blocks_left(src_iter)) THEN
         CALL dbcsr_iterator_next_block(src_iter, src_row, src_col, src_data, &
                                        src_tr)
      ELSE
         src_row = 0; src_col = 0
      END IF
      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)
         ! Now find the source position that is greater or equal to the
         ! target one. I.e, skip blocks that the target doesn't have.
         rel = pos_relation(dst_row, dst_col, src_row, src_col)
         DO WHILE (rel .EQ. 1 .AND. dbcsr_iterator_blocks_left(src_iter))
            CALL dbcsr_iterator_next_block(src_iter, src_row, src_col, &
                                           src_data, src_tr, row_size=src_rs, col_size=src_cs)
            rel = pos_relation(dst_row, dst_col, src_row, src_col)
         END DO
         SELECT CASE (rel)
         CASE (-1, 1)
            ! Target lags source or ran out of source
            CALL dbcsr_data_clear(dst_data)
         CASE (0)
            ! Copy the data
            IF (dbcsr_data_get_size(src_data) .NE. dbcsr_data_get_size(dst_data)) &
               DBCSR_ABORT("Block sizes not equal!")
            IF (src_tr .EQV. dst_tr) THEN
               CALL dbcsr_data_copyall(dst_data, src_data)
            ELSE
               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) THEN
                  CALL dbcsr_block_real_neg(dst_data, row_size, col_size)
               END IF
               IF (neg_imag) THEN
                  CALL dbcsr_block_conjg(dst_data, row_size, col_size)
               END IF
            END IF
         CASE default
            DBCSR_ABORT("Trouble syncing iterators")
         END SELECT
      END DO
      CALL dbcsr_iterator_stop(src_iter)
      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