1 SUBROUTINE slarft( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT )
10 INTEGER k, ldt, ldv, n
13 REAL t( ldt, * ), tau( * ), v( ldv, * )
108 parameter( one = 1.0e+0, zero = 0.0e+0 )
111 INTEGER i, j, prevlastv, lastv
115 EXTERNAL sgemv, strmv
128 IF( lsame( direct,
'F' ) )
THEN
131 prevlastv =
max( i, prevlastv )
132 IF( tau( i ).EQ.zero )
THEN
145 IF( lsame(
storev,
'C' ) )
THEN
147 DO 50 lastv = n, i+1, -1
148 IF( v( lastv, i ).NE.zero ) goto 55
151 j =
min( lastv, prevlastv )
155 CALL sgemv(
'Transpose', j-i+1, i-1, -tau( i ),
156 $ v( i, 1 ), ldv, v( i, i ), 1, zero,
160 DO 60 lastv = n, i+1, -1
161 IF( v( i, lastv ).NE.zero ) goto 65
164 j =
min( lastv, prevlastv )
168 CALL sgemv(
'No transpose', i-1, j-i+1, -tau( i ),
169 $ v( 1, i ), ldv, v( i, i ), ldv, zero,
176 CALL strmv(
'Upper',
'No transpose',
'Non-unit', i-1, t,
177 $ ldt, t( 1, i ), 1 )
180 prevlastv =
max( prevlastv, lastv )
189 IF( tau( i ).EQ.zero )
THEN
201 IF( lsame(
storev,
'C' ) )
THEN
206 IF( v( lastv, i ).NE.zero ) goto 75
209 j =
max( lastv, prevlastv )
214 CALL sgemv(
'Transpose', n-k+i-j+1, k-i, -tau( i ),
215 $ v( j, i+1 ), ldv, v( j, i ), 1, zero,
223 IF( v( i, lastv ).NE.zero ) goto 85
226 j =
max( lastv, prevlastv )
231 CALL sgemv(
'No transpose', k-i, n-k+i-j+1,
232 $ -tau( i ), v( i+1, j ), ldv, v( i, j ), ldv,
233 $ zero, t( i+1, i ), 1 )
239 CALL strmv(
'Lower',
'No transpose',
'Non-unit', k-i,
240 $ t( i+1, i+1 ), ldt, t( i+1, i ), 1 )
242 prevlastv =
min( prevlastv, lastv )