dbcsr_remove_block Subroutine

public subroutine dbcsr_remove_block(matrix, row, col, block_nze, block_number)

Marks a block for removal from a DBCSR matrix. Handles symmetric matrices.

Arguments

TypeIntentOptionalAttributesName
type(dbcsr_type), intent(inout) :: matrix

DBCSR matrix

integer, intent(in) :: row

row of block to remove column of block to remove

integer, intent(in) :: col

row of block to remove column of block to remove

integer, intent(in) :: block_nze

row of block to remove column of block to remove

integer, intent(in), optional :: block_number

the block number, if it is known


Contents

Source Code


Source Code

   SUBROUTINE dbcsr_remove_block(matrix, row, col, block_nze, block_number)
      !! Marks a block for removal from a DBCSR matrix. Handles
      !! symmetric matrices.

      TYPE(dbcsr_type), INTENT(INOUT)                    :: matrix
         !! DBCSR matrix
      INTEGER, INTENT(IN)                                :: row, col, block_nze
         !! row of block to remove
         !! column of block to remove
      INTEGER, INTENT(IN), OPTIONAL                      :: block_number
         !! the block number, if it is known

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

      INTEGER                                            :: b, c, error_handle, r
      LOGICAL                                            :: found, tr

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

      IF (careful_mod) CALL timeset(routineN, error_handle)
      IF (PRESENT(block_number)) THEN
         b = block_number
         IF (block_number .GT. matrix%nblks) &
            DBCSR_ABORT("Block number too big.")
         found = .TRUE.
      ELSE
         CALL dbcsr_get_block_index(matrix, row, col, r, c, tr, found, b)
      END IF
      b = ABS(b)
      IF (found .AND. b .GT. 0) THEN
         ! Mark the block for deletion.
         matrix%blk_p(b) = 0
         matrix%valid = .FALSE.
         ! update nze accordingly
         matrix%nze = matrix%nze - block_nze
         IF (debug_mod) THEN
            IF (matrix%nze < 0) DBCSR_ABORT("nze < 0!")
         END IF
      ELSE
         IF (debug_mod) THEN
            IF (b .EQ. 0) &
               DBCSR_WARN("Block does not exist or is already deleted.")
         END IF
      END IF
      IF (careful_mod) CALL timestop(error_handle)
   END SUBROUTINE dbcsr_remove_block