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 )
subroutine clarft(DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT)
CLARFT forms the triangular factor T of a block reflector H = I - vtvH
subroutine clacgv(N, X, INCX)
CLACGV conjugates a complex vector.
subroutine cgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
CGEMV
subroutine ctrmv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
CTRMV
subroutine cgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
CGEMM