164 SUBROUTINE zlarft( DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT )
172 CHARACTER DIRECT, STOREV
173 INTEGER K, LDT, LDV, N
176 COMPLEX*16 T( ldt, * ), TAU( * ), V( ldv, * )
183 parameter( one = ( 1.0d+0, 0.0d+0 ),
184 $ zero = ( 0.0d+0, 0.0d+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
zgemv(
'Conjugate transpose', j-i, i-1,
231 $ -tau( i ), v( i+1, 1 ), ldv,
232 $ v( i+1, i ), 1, one, t( 1, i ), 1 )
235 DO lastv = n, i+1, -1
236 IF( v( i, lastv ).NE.zero )
EXIT
239 t( j, i ) = -tau( i ) * v( j , i )
241 j = min( lastv, prevlastv )
245 CALL
zgemm(
'N',
'C', i-1, 1, j-i, -tau( i ),
246 $ v( 1, i+1 ), ldv, v( i, i+1 ), ldv,
247 $ one, t( 1, i ), ldt )
252 CALL
ztrmv(
'Upper',
'No transpose',
'Non-unit', i-1, t,
253 $ ldt, t( 1, i ), 1 )
256 prevlastv = max( prevlastv, lastv )
265 IF( tau( i ).EQ.zero )
THEN
277 IF( lsame( storev,
'C' ) )
THEN
280 IF( v( lastv, i ).NE.zero )
EXIT
283 t( j, i ) = -tau( i ) * conjg( v( n-k+i , j ) )
285 j = max( lastv, prevlastv )
289 CALL
zgemv(
'Conjugate transpose', n-k+i-j, k-i,
290 $ -tau( i ), v( j, i+1 ), ldv, v( j, i ),
291 $ 1, one, t( i+1, i ), 1 )
295 IF( v( i, lastv ).NE.zero )
EXIT
298 t( j, i ) = -tau( i ) * v( j, n-k+i )
300 j = max( lastv, prevlastv )
304 CALL
zgemm(
'N',
'C', k-i, 1, n-k+i-j, -tau( i ),
305 $ v( i+1, j ), ldv, v( i, j ), ldv,
306 $ one, t( i+1, i ), ldt )
311 CALL
ztrmv(
'Lower',
'No transpose',
'Non-unit', k-i,
312 $ t( i+1, i+1 ), ldt, t( i+1, i ), 1 )
314 prevlastv = min( prevlastv, lastv )
subroutine zgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
ZGEMV
subroutine zgemm(TRANSA, TRANSB, M, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
ZGEMM
subroutine zlarft(DIRECT, STOREV, N, K, V, LDV, TAU, T, LDT)
ZLARFT forms the triangular factor T of a block reflector H = I - vtvH
subroutine zlacgv(N, X, INCX)
ZLACGV conjugates a complex vector.
subroutine ztrmv(UPLO, TRANS, DIAG, N, A, LDA, X, INCX)
ZTRMV