add a constant to the diagonal of a matrix
Type | Intent | Optional | Attributes | Name | ||
---|---|---|---|---|---|---|
type(dbcsr_type), | intent(inout) | :: | matrix |
DBCSR matrix |
||
complex(kind=real_8), | intent(in) | :: | alpha |
scalar |
SUBROUTINE dbcsr_add_on_diag_z (matrix, alpha)
!! add a constant to the diagonal of a matrix
TYPE(dbcsr_type), INTENT(INOUT) :: matrix
!! DBCSR matrix
COMPLEX(kind=real_8), INTENT(IN) :: alpha
!! scalar
CHARACTER(len=*), PARAMETER :: routineN = 'dbcsr_add_on_diag'
INTEGER :: handle, mynode, node, irow, i, row_size
LOGICAL :: found, tr
COMPLEX(kind=real_8), DIMENSION(:, :), POINTER :: block
CALL timeset(routineN, handle)
IF (dbcsr_get_data_type(matrix) /= dbcsr_type_complex_8) &
DBCSR_ABORT("Incompatible data types")
IF (.NOT. array_equality(matrix%row_blk_offset, matrix%col_blk_offset)) &
DBCSR_ABORT("matrix not quadratic")
mynode = dbcsr_mp_mynode(dbcsr_distribution_mp(dbcsr_distribution(matrix)))
CALL dbcsr_work_create(matrix, work_mutable=.TRUE.)
DO irow = 1, dbcsr_nblkrows_total(matrix)
CALL dbcsr_get_stored_coordinates(matrix, irow, irow, node)
IF (node /= mynode) CYCLE
CALL dbcsr_get_block_p(matrix, irow, irow, block, tr, found, row_size=row_size)
IF (.NOT. found) THEN
ALLOCATE (block(row_size, row_size))
block(:, :) = CMPLX(0.0, 0.0, real_8)
END IF
DO i = 1, row_size
block(i, i) = block(i, i) + alpha
END DO
IF (.NOT. found) THEN
CALL dbcsr_put_block(matrix, irow, irow, block)
DEALLOCATE (block)
END IF
END DO
CALL dbcsr_finalize(matrix)
CALL timestop(handle)
END SUBROUTINE dbcsr_add_on_diag_z