125 SUBROUTINE slarf( SIDE, M, N, V, INCV, TAU, C, LDC, WORK )
134 INTEGER incv, ldc, m, n
138 REAL c( ldc, * ), v( * ), work( * )
145 parameter( one = 1.0e+0, zero = 0.0e+0 )
149 INTEGER i, lastv, lastc
161 applyleft =
lsame( side,
'L' )
164 IF( tau.NE.zero )
THEN
173 i = 1 + (lastv-1) * incv
178 DO WHILE( lastv.GT.0 .AND. v( i ).EQ.zero )
184 lastc =
ilaslc(lastv, n, c, ldc)
187 lastc =
ilaslr(m, lastv, c, ldc)
196 IF( lastv.GT.0 )
THEN
200 CALL
sgemv(
'Transpose', lastv, lastc, one, c, ldc, v, incv,
205 CALL
sger( lastv, lastc, -tau, v, incv, work, 1, c, ldc )
211 IF( lastv.GT.0 )
THEN
215 CALL
sgemv(
'No transpose', lastc, lastv, one, c, ldc,
216 $ v, incv, zero, work, 1 )
220 CALL
sger( lastc, lastv, -tau, work, 1, v, incv, c, ldc )
LOGICAL function lsame(CA, CB)
LSAME
subroutine slarf(SIDE, M, N, V, INCV, TAU, C, LDC, WORK)
SLARF applies an elementary reflector to a general rectangular matrix.
INTEGER function ilaslc(M, N, A, LDA)
ILASLC scans a matrix for its last non-zero column.
subroutine sgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
SGEMV
subroutine sger(M, N, ALPHA, X, INCX, Y, INCY, A, LDA)
SGER
INTEGER function ilaslr(M, N, A, LDA)
ILASLR scans a matrix for its last non-zero row.