dbcsr_add_on_diag_s Subroutine

      SUBROUTINE dbcsr_add_on_diag_s (matrix, alpha)
      !! add a constant to the diagonal of a matrix

         TYPE(dbcsr_type), INTENT(INOUT)                    :: matrix
         !! DBCSR matrix
         REAL(kind=real_4), INTENT(IN)                                :: alpha
         !! scalar

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

         INTEGER                                            :: handle, mynode, node, irow, i, row_size
         LOGICAL                                            :: found, tr
         REAL(kind=real_4), DIMENSION(:, :), POINTER                   :: block

         CALL timeset(routineN, handle)

         IF (dbcsr_get_data_type(matrix) /= dbcsr_type_real_4) &
            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(:, :) = 0.0_real_4
            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_s