200 SUBROUTINE zlatrd( UPLO, N, NB, A, LDA, E, TAU, W, LDW )
209 INTEGER lda, ldw, n, nb
212 DOUBLE PRECISION e( * )
213 COMPLEX*16 a( lda, * ), tau( * ), w( ldw, * )
219 COMPLEX*16 zero, one, half
220 parameter( zero = ( 0.0d+0, 0.0d+0 ),
221 $ one = ( 1.0d+0, 0.0d+0 ),
222 $ half = ( 0.5d+0, 0.0d+0 ) )
246 IF(
lsame( uplo,
'U' ) )
THEN
250 DO 10 i = n, n - nb + 1, -1
256 a( i, i ) = dble( a( i, i ) )
257 CALL
zlacgv( n-i, w( i, iw+1 ), ldw )
258 CALL
zgemv(
'No transpose', i, n-i, -one, a( 1, i+1 ),
259 $ lda, w( i, iw+1 ), ldw, one, a( 1, i ), 1 )
260 CALL
zlacgv( n-i, w( i, iw+1 ), ldw )
261 CALL
zlacgv( n-i, a( i, i+1 ), lda )
262 CALL
zgemv(
'No transpose', i, n-i, -one, w( 1, iw+1 ),
263 $ ldw, a( i, i+1 ), lda, one, a( 1, i ), 1 )
264 CALL
zlacgv( n-i, a( i, i+1 ), lda )
265 a( i, i ) = dble( a( i, i ) )
273 CALL
zlarfg( i-1, alpha, a( 1, i ), 1, tau( i-1 ) )
279 CALL
zhemv(
'Upper', i-1, one, a, lda, a( 1, i ), 1,
280 $ zero, w( 1, iw ), 1 )
282 CALL
zgemv(
'Conjugate transpose', i-1, n-i, one,
283 $ w( 1, iw+1 ), ldw, a( 1, i ), 1, zero,
285 CALL
zgemv(
'No transpose', i-1, n-i, -one,
286 $ a( 1, i+1 ), lda, w( i+1, iw ), 1, one,
288 CALL
zgemv(
'Conjugate transpose', i-1, n-i, one,
289 $ a( 1, i+1 ), lda, a( 1, i ), 1, zero,
291 CALL
zgemv(
'No transpose', i-1, n-i, -one,
292 $ w( 1, iw+1 ), ldw, w( i+1, iw ), 1, one,
295 CALL
zscal( i-1, tau( i-1 ), w( 1, iw ), 1 )
296 alpha = -half*tau( i-1 )*
zdotc( i-1, w( 1, iw ), 1,
298 CALL
zaxpy( i-1, alpha, a( 1, i ), 1, w( 1, iw ), 1 )
310 a( i, i ) = dble( a( i, i ) )
311 CALL
zlacgv( i-1, w( i, 1 ), ldw )
312 CALL
zgemv(
'No transpose', n-i+1, i-1, -one, a( i, 1 ),
313 $ lda, w( i, 1 ), ldw, one, a( i, i ), 1 )
314 CALL
zlacgv( i-1, w( i, 1 ), ldw )
315 CALL
zlacgv( i-1, a( i, 1 ), lda )
316 CALL
zgemv(
'No transpose', n-i+1, i-1, -one, w( i, 1 ),
317 $ ldw, a( i, 1 ), lda, one, a( i, i ), 1 )
318 CALL
zlacgv( i-1, a( i, 1 ), lda )
319 a( i, i ) = dble( a( i, i ) )
326 CALL
zlarfg( n-i, alpha, a( min( i+2, n ), i ), 1,
333 CALL
zhemv(
'Lower', n-i, one, a( i+1, i+1 ), lda,
334 $ a( i+1, i ), 1, zero, w( i+1, i ), 1 )
335 CALL
zgemv(
'Conjugate transpose', n-i, i-1, one,
336 $ w( i+1, 1 ), ldw, a( i+1, i ), 1, zero,
338 CALL
zgemv(
'No transpose', n-i, i-1, -one, a( i+1, 1 ),
339 $ lda, w( 1, i ), 1, one, w( i+1, i ), 1 )
340 CALL
zgemv(
'Conjugate transpose', n-i, i-1, one,
341 $ a( i+1, 1 ), lda, a( i+1, i ), 1, zero,
343 CALL
zgemv(
'No transpose', n-i, i-1, -one, w( i+1, 1 ),
344 $ ldw, w( 1, i ), 1, one, w( i+1, i ), 1 )
345 CALL
zscal( n-i, tau( i ), w( i+1, i ), 1 )
346 alpha = -half*tau( i )*
zdotc( n-i, w( i+1, i ), 1,
348 CALL
zaxpy( n-i, alpha, a( i+1, i ), 1, w( i+1, i ), 1 )
LOGICAL function lsame(CA, CB)
LSAME
subroutine zgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
ZGEMV
subroutine zlacgv(N, X, INCX)
ZLACGV conjugates a complex vector.
subroutine zaxpy(N, ZA, ZX, INCX, ZY, INCY)
ZAXPY
subroutine zhemv(UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
ZHEMV
subroutine zlarfg(N, ALPHA, X, INCX, TAU)
ZLARFG generates an elementary reflector (Householder matrix).
COMPLEX *16 function zdotc(N, ZX, INCX, ZY, INCY)
ZDOTC
subroutine zlatrd(UPLO, N, NB, A, LDA, E, TAU, W, LDW)
ZLATRD reduces the first nb rows and columns of a symmetric/Hermitian matrix A to real tridiagonal fo...
subroutine zscal(N, ZA, ZX, INCX)
ZSCAL