dbcsr_set_s Subroutine

private subroutine dbcsr_set_s(matrix, alpha)

Interface for dbcsr_set


type(dbcsr_type), intent(inout) :: matrix
real(kind=real_4), intent(in) :: alpha


Source Code

Source Code

      SUBROUTINE dbcsr_set_s (matrix, alpha)
      !! Interface for dbcsr_set
         TYPE(dbcsr_type), INTENT(INOUT)           :: matrix
         REAL(kind=real_4), INTENT(IN)                      :: alpha

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

         INTEGER                                            :: col, handle, row
         TYPE(dbcsr_iterator)                               :: iter
         REAL(kind=real_4), DIMENSION(:, :), POINTER                   :: block
         LOGICAL                                            :: tr

         CALL timeset(routineN, handle)

         IF (alpha == 0.0_real_4) THEN
            CALL dbcsr_zero(matrix)
            IF (dbcsr_get_data_type(matrix) /= dbcsr_type_real_4) &
               DBCSR_ABORT("Incompatible data types")

            !TODO: could be speedup by direct assignment to data_area, similar to dbcsr_zero()
            CALL dbcsr_iterator_start(iter, matrix)
            DO WHILE (dbcsr_iterator_blocks_left(iter))
               CALL dbcsr_iterator_next_block(iter, row, col, block, tr)
               block(:, :) = alpha
            END DO
            CALL dbcsr_iterator_stop(iter)
         END IF

         CALL timestop(handle)
      END SUBROUTINE dbcsr_set_s