dbcsr_to_csr_filter Subroutine

public subroutine dbcsr_to_csr_filter(dbcsr_mat, csr_sparsity, eps)

Apply filtering threshold eps to DBCSR blocks in order to improve CSR sparsity (currently only used for testing purposes)

Arguments

Type IntentOptional Attributes Name
type(dbcsr_type), intent(in) :: dbcsr_mat
type(dbcsr_type), intent(out) :: csr_sparsity
real(kind=real_8), intent(in) :: eps

Source Code

   SUBROUTINE dbcsr_to_csr_filter(dbcsr_mat, csr_sparsity, eps)
      !! Apply filtering threshold eps to DBCSR blocks in order to improve
      !! CSR sparsity (currently only used for testing purposes)

      TYPE(dbcsr_type), INTENT(IN)                       :: dbcsr_mat
      TYPE(dbcsr_type), INTENT(OUT)                      :: csr_sparsity
      REAL(kind=real_8), INTENT(IN)                      :: eps

      INTEGER                                            :: blkcol, blkrow, col_blk_size, data_type, &
                                                            row_blk_size
      LOGICAL                                            :: tr
      REAL(kind=real_8), ALLOCATABLE, DIMENSION(:)       :: block_abs, csr_sparsity_blk
      TYPE(dbcsr_data_obj)                               :: block
      TYPE(dbcsr_iterator)                               :: iter

!REAL(kind=real_8), DIMENSION(:), POINTER :: block

      CALL dbcsr_create(csr_sparsity, &
                        template=dbcsr_mat, &
                        name="CSR sparsity", &
                        data_type=dbcsr_type_real_8)
      CALL dbcsr_copy(csr_sparsity, dbcsr_mat)
      CALL dbcsr_set(csr_sparsity, 1.0_dp)

      IF (eps .GT. 0.0_dp) THEN
         data_type = dbcsr_get_data_type(dbcsr_mat)
         CALL dbcsr_data_init(block)
         CALL dbcsr_data_new(block, data_type)
         CALL dbcsr_iterator_start(iter, dbcsr_mat, read_only=.TRUE.)
         DO WHILE (dbcsr_iterator_blocks_left(iter))
            CALL dbcsr_iterator_next_block(iter, blkrow, blkcol, block, transposed=tr, &
                                           row_size=row_blk_size, col_size=col_blk_size)

            ALLOCATE (block_abs(row_blk_size*col_blk_size))
            ALLOCATE (csr_sparsity_blk(row_blk_size*col_blk_size))
            SELECT CASE (data_type)
            CASE (dbcsr_type_real_4)
               block_abs(:) = REAL(ABS(block%d%r_sp(:)), KIND=real_8)
            CASE (dbcsr_type_real_8)
               block_abs(:) = REAL(ABS(block%d%r_dp(:)), KIND=real_8)
            CASE (dbcsr_type_complex_4)
               block_abs(:) = REAL(ABS(block%d%c_sp(:)), KIND=real_8)
            CASE (dbcsr_type_complex_8)
               block_abs(:) = REAL(ABS(block%d%c_dp(:)), KIND=real_8)
            END SELECT

            csr_sparsity_blk = 1.0_dp
            WHERE (block_abs .LT. eps) csr_sparsity_blk = 0.0_dp
            CALL dbcsr_put_block(csr_sparsity, blkrow, blkcol, csr_sparsity_blk, transposed=tr)
            DEALLOCATE (csr_sparsity_blk, block_abs)
         END DO
         CALL dbcsr_iterator_stop(iter)
         CALL dbcsr_data_clear_pointer(block)
         CALL dbcsr_data_release(block)
      END IF

   END SUBROUTINE dbcsr_to_csr_filter