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 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
subroutine strmv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
STRMV