dbcsr_set_diag_s Subroutine

      SUBROUTINE dbcsr_set_diag_s (matrix, diag)
         TYPE(dbcsr_type), INTENT(INOUT)            :: matrix
         REAL(kind=real_4), DIMENSION(:), INTENT(IN)          :: diag

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

         INTEGER                                            :: icol, irow, row_offset, handle, i
         LOGICAL                                            :: tr
         TYPE(dbcsr_iterator)                               :: iter
         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 (dbcsr_nfullrows_total(matrix) /= SIZE(diag)) &
            DBCSR_ABORT("Diagonal has wrong size")

         IF (.NOT. array_equality(matrix%row_blk_offset, matrix%col_blk_offset)) &
            DBCSR_ABORT("matrix not quadratic")

         CALL dbcsr_iterator_start(iter, matrix)
         DO WHILE (dbcsr_iterator_blocks_left(iter))
            CALL dbcsr_iterator_next_block(iter, irow, icol, block, tr, row_offset=row_offset)
            IF (irow /= icol) CYCLE

            IF (sIZE(block, 1) /= sIZE(block, 2)) &
               DBCSR_ABORT("Diagonal block non-squared")

            DO i = 1, sIZE(block, 1)
               block(i, i) = diag(row_offset + i - 1)
            END DO
         END DO
         CALL dbcsr_iterator_stop(iter)

         CALL timestop(handle)
      END SUBROUTINE dbcsr_set_diag_s