dbcsr_impose_sparsity Subroutine

   SUBROUTINE dbcsr_impose_sparsity(sparse, dense)
      !! Impose sparsity on a dense matrix based on a dbcsr

      TYPE(dbcsr_type), INTENT(IN)                       :: sparse
         !! sparse matrix
      TYPE(dbcsr_data_obj), INTENT(inout)                :: dense
         !! dense matrix Take into account the symmetry of the sparse matrix. The dense matrix need to be valid. The operation is
         !! done locally.

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

      CHARACTER                                          :: symm
      INTEGER                                            :: blk, col, col_offset, col_size, &
                                                            data_type, dense_col_size, &
                                                            dense_row_size, handle, row, &
                                                            row_offset, row_size
      LOGICAL                                            :: valid
      TYPE(dbcsr_data_obj)                               :: tmp
      TYPE(dbcsr_iterator)                               :: iter

      CALL timeset(routineN, handle)

      CALL dbcsr_data_get_sizes(dense, dense_row_size, dense_col_size, valid)
      IF (.NOT. valid) &
         DBCSR_ABORT("dense matrix not valid")
      data_type = dbcsr_data_get_type(dense)
      symm = dbcsr_get_matrix_type(sparse)

      CALL dbcsr_data_init(tmp)
      CALL dbcsr_data_new(tmp, dbcsr_type_1d_to_2d(data_type), data_size=dense_row_size, &
                          data_size2=dense_col_size)
      CALL dbcsr_data_set(dst=tmp, lb=1, data_size=dense_row_size, src=dense, source_lb=1, &
                          lb2=1, data_size2=dense_col_size, source_lb2=1)
      CALL dbcsr_data_clear(dense)

      CALL dbcsr_iterator_start(iter, sparse)
      DO WHILE (dbcsr_iterator_blocks_left(iter))
         CALL dbcsr_iterator_next_block(iter, row, col, blk, &
                                        row_size=row_size, col_size=col_size, &
                                        row_offset=row_offset, col_offset=col_offset)
         CALL dbcsr_block_partial_copy( &
            dst=dense, &
            dst_rs=dense_row_size, dst_cs=dense_col_size, dst_tr=.FALSE., &
            dst_r_lb=row_offset, dst_c_lb=col_offset, &
            src=tmp, &
            src_rs=dense_row_size, src_cs=dense_col_size, src_tr=.FALSE., &
            src_r_lb=row_offset, src_c_lb=col_offset, &
            nrow=row_size, ncol=col_size)
         IF (symm .NE. dbcsr_type_no_symmetry) THEN
            SELECT CASE (symm)
            CASE (dbcsr_type_symmetric)
               CALL dbcsr_block_partial_copy( &
                  dst=dense, &
                  dst_rs=dense_row_size, dst_cs=dense_col_size, dst_tr=.TRUE., &
                  dst_r_lb=row_offset, dst_c_lb=col_offset, &
                  src=tmp, &
                  src_rs=dense_row_size, src_cs=dense_col_size, src_tr=.FALSE., &
                  src_r_lb=row_offset, src_c_lb=col_offset, &
                  nrow=row_size, ncol=col_size)
            CASE (dbcsr_type_antisymmetric)
               CALL dbcsr_block_partial_copy( &
                  dst=dense, &
                  dst_rs=dense_row_size, dst_cs=dense_col_size, dst_tr=.TRUE., &
                  dst_r_lb=row_offset, dst_c_lb=col_offset, &
                  src=tmp, &
                  src_rs=dense_row_size, src_cs=dense_col_size, src_tr=.FALSE., &
                  src_r_lb=row_offset, src_c_lb=col_offset, &
                  nrow=row_size, ncol=col_size)
               CALL dbcsr_block_scale(dense, dbcsr_scalar_negative(dbcsr_scalar_one( &
                                                                   dbcsr_type_2d_to_1d(data_type))), &
                                      row_size=col_size, col_size=row_size, &
                                      lb=col_offset, lb2=row_offset)
            CASE (dbcsr_type_hermitian)
               CALL dbcsr_block_partial_copy( &
                  dst=dense, &
                  dst_rs=dense_row_size, dst_cs=dense_col_size, dst_tr=.TRUE., &
                  dst_r_lb=row_offset, dst_c_lb=col_offset, &
                  src=tmp, &
                  src_rs=dense_row_size, src_cs=dense_col_size, src_tr=.FALSE., &
                  src_r_lb=row_offset, src_c_lb=col_offset, &
                  nrow=row_size, ncol=col_size)
               CALL dbcsr_block_conjg(dense, row_size=col_size, col_size=row_size, &
                                      lb=col_offset, lb2=row_offset)
            CASE (dbcsr_type_antihermitian)
               CALL dbcsr_block_partial_copy( &
                  dst=dense, &
                  dst_rs=dense_row_size, dst_cs=dense_col_size, dst_tr=.TRUE., &
                  dst_r_lb=row_offset, dst_c_lb=col_offset, &
                  src=tmp, &
                  src_rs=dense_row_size, src_cs=dense_col_size, src_tr=.FALSE., &
                  src_r_lb=row_offset, src_c_lb=col_offset, &
                  nrow=row_size, ncol=col_size)
               CALL dbcsr_block_scale(dense, dbcsr_scalar_negative(dbcsr_scalar_one( &
                                                                   dbcsr_type_2d_to_1d(data_type))), &
                                      row_size=col_size, col_size=row_size, &
                                      lb=col_offset, lb2=row_offset)
               CALL dbcsr_block_conjg(dense, row_size=col_size, col_size=row_size, &
                                      lb=col_offset, lb2=row_offset)
            CASE DEFAULT
               DBCSR_ABORT("wrong matrix symmetry")
            END SELECT
         END IF
      END DO
      CALL dbcsr_iterator_stop(iter)

      CALL dbcsr_data_release(tmp)

      CALL timestop(handle)

   END SUBROUTINE dbcsr_impose_sparsity