164 SUBROUTINE slarft( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT )
172 CHARACTER DIRECT, STOREV
173 INTEGER K, LDT, LDV, N
176 REAL T( ldt, * ), TAU( * ), V( ldv, * )
183 parameter( one = 1.0e+0, zero = 0.0e+0 )
186 INTEGER I, J, PREVLASTV, LASTV
202 IF( lsame( direct,
'F' ) )
THEN
205 prevlastv = max( i, prevlastv )
206 IF( tau( i ).EQ.zero )
THEN
217 IF( lsame( storev,
'C' ) )
THEN
219 DO lastv = n, i+1, -1
220 IF( v( lastv, i ).NE.zero )
EXIT
223 t( j, i ) = -tau( i ) * v( i , j )
225 j = min( lastv, prevlastv )
229 CALL sgemv(
'Transpose', j-i, i-1, -tau( i ),
230 $ v( i+1, 1 ), ldv, v( i+1, i ), 1, one,
234 DO lastv = n, i+1, -1
235 IF( v( i, lastv ).NE.zero )
EXIT
238 t( j, i ) = -tau( i ) * v( j , i )
240 j = min( lastv, prevlastv )
244 CALL sgemv(
'No transpose', i-1, j-i, -tau( i ),
245 $ v( 1, i+1 ), ldv, v( i, i+1 ), ldv,
246 $ one, t( 1, i ), 1 )
251 CALL strmv(
'Upper',
'No transpose',
'Non-unit', i-1, t,
252 $ ldt, t( 1, i ), 1 )
255 prevlastv = max( prevlastv, lastv )
264 IF( tau( i ).EQ.zero )
THEN
276 IF( lsame( storev,
'C' ) )
THEN
279 IF( v( lastv, i ).NE.zero )
EXIT
282 t( j, i ) = -tau( i ) * v( n-k+i , j )
284 j = max( lastv, prevlastv )
288 CALL sgemv(
'Transpose', n-k+i-j, k-i, -tau( i ),
289 $ v( j, i+1 ), ldv, v( j, i ), 1, one,
294 IF( v( i, lastv ).NE.zero )
EXIT
297 t( j, i ) = -tau( i ) * v( j, n-k+i )
299 j = max( lastv, prevlastv )
303 CALL sgemv(
'No transpose', k-i, n-k+i-j,
304 $ -tau( i ), v( i+1, j ), ldv, v( i, j ), ldv,
305 $ one, t( i+1, i ), 1 )
310 CALL strmv(
'Lower',
'No transpose',
'Non-unit', k-i,
311 $ t( i+1, i+1 ), ldt, t( i+1, i ), 1 )
313 prevlastv = min( prevlastv, lastv )
subroutine strmv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
STRMV
subroutine sgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
SGEMV
subroutine slarft(DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT)
SLARFT forms the triangular factor T of a block reflector H = I - vtvH