164 SUBROUTINE clarft( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT )
172 CHARACTER direct, storev
173 INTEGER k, ldt, ldv, n
176 COMPLEX t( ldt, * ), tau( * ), v( ldv, * )
183 parameter( one = ( 1.0e+0, 0.0e+0 ),
184 $ zero = ( 0.0e+0, 0.0e+0 ) )
187 INTEGER i, j, prevlastv, lastv
203 IF(
lsame( direct,
'F' ) )
THEN
206 prevlastv = max( prevlastv, i )
207 IF( tau( i ).EQ.zero )
THEN
218 IF(
lsame( storev,
'C' ) )
THEN
220 DO lastv = n, i+1, -1
221 IF( v( lastv, i ).NE.zero ) exit
224 t( j, i ) = -tau( i ) * conjg( v( i , j ) )
226 j = min( lastv, prevlastv )
230 CALL
cgemv(
'Conjugate transpose', j-i, i-1,
231 $ -tau( i ), v( i+1, 1 ), ldv,
233 $ one, t( 1, i ), 1 )
236 DO lastv = n, i+1, -1
237 IF( v( i, lastv ).NE.zero ) exit
240 t( j, i ) = -tau( i ) * v( j , i )
242 j = min( lastv, prevlastv )
246 CALL
cgemm(
'N',
'C', i-1, 1, j-i, -tau( i ),
247 $ v( 1, i+1 ), ldv, v( i, i+1 ), ldv,
248 $ one, t( 1, i ), ldt )
253 CALL
ctrmv(
'Upper',
'No transpose',
'Non-unit', i-1, t,
254 $ ldt, t( 1, i ), 1 )
257 prevlastv = max( prevlastv, lastv )
266 IF( tau( i ).EQ.zero )
THEN
278 IF(
lsame( storev,
'C' ) )
THEN
281 IF( v( lastv, i ).NE.zero ) exit
284 t( j, i ) = -tau( i ) * conjg( v( n-k+i , j ) )
286 j = max( lastv, prevlastv )
290 CALL
cgemv(
'Conjugate transpose', n-k+i-j, k-i,
291 $ -tau( i ), v( j, i+1 ), ldv, v( j, i ),
292 $ 1, one, t( i+1, i ), 1 )
296 IF( v( i, lastv ).NE.zero ) exit
299 t( j, i ) = -tau( i ) * v( j, n-k+i )
301 j = max( lastv, prevlastv )
305 CALL
cgemm(
'N',
'C', k-i, 1, n-k+i-j, -tau( i ),
306 $ v( i+1, j ), ldv, v( i, j ), ldv,
307 $ one, t( i+1, i ), ldt )
312 CALL
ctrmv(
'Lower',
'No transpose',
'Non-unit', k-i,
313 $ t( i+1, i+1 ), ldt, t( i+1, i ), 1 )
315 prevlastv = min( prevlastv, lastv )