dbcsr_impose_sparsity Subroutine

public subroutine dbcsr_impose_sparsity(sparse, dense)

Impose sparsity on a dense matrix based on a dbcsr

Arguments

TypeIntentOptionalAttributesName
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.


Contents

Source Code


Source Code

   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