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