176 SUBROUTINE zhetd2( UPLO, N, A, LDA, D, E, TAU, INFO )
188 DOUBLE PRECISION D( * ), E( * )
189 COMPLEX*16 A( lda, * ), TAU( * )
195 COMPLEX*16 ONE, ZERO, HALF
196 parameter ( one = ( 1.0d+0, 0.0d+0 ),
197 $ zero = ( 0.0d+0, 0.0d+0 ),
198 $ half = ( 0.5d+0, 0.0d+0 ) )
203 COMPLEX*16 ALPHA, TAUI
211 EXTERNAL lsame, zdotc
214 INTRINSIC dble, max, min
221 upper = lsame( uplo,
'U')
222 IF( .NOT.upper .AND. .NOT.lsame( uplo,
'L' ) )
THEN
224 ELSE IF( n.LT.0 )
THEN
226 ELSE IF( lda.LT.max( 1, n ) )
THEN
230 CALL xerbla(
'ZHETD2', -info )
243 a( n, n ) = dble( a( n, n ) )
244 DO 10 i = n - 1, 1, -1
250 CALL zlarfg( i, alpha, a( 1, i+1 ), 1, taui )
253 IF( taui.NE.zero )
THEN
261 CALL zhemv( uplo, i, taui, a, lda, a( 1, i+1 ), 1, zero,
266 alpha = -half*taui*zdotc( i, tau, 1, a( 1, i+1 ), 1 )
267 CALL zaxpy( i, alpha, a( 1, i+1 ), 1, tau, 1 )
272 CALL zher2( uplo, i, -one, a( 1, i+1 ), 1, tau, 1, a,
276 a( i, i ) = dble( a( i, i ) )
279 d( i+1 ) = a( i+1, i+1 )
287 a( 1, 1 ) = dble( a( 1, 1 ) )
294 CALL zlarfg( n-i, alpha, a( min( i+2, n ), i ), 1, taui )
297 IF( taui.NE.zero )
THEN
305 CALL zhemv( uplo, n-i, taui, a( i+1, i+1 ), lda,
306 $ a( i+1, i ), 1, zero, tau( i ), 1 )
310 alpha = -half*taui*zdotc( n-i, tau( i ), 1, a( i+1, i ),
312 CALL zaxpy( n-i, alpha, a( i+1, i ), 1, tau( i ), 1 )
317 CALL zher2( uplo, n-i, -one, a( i+1, i ), 1, tau( i ), 1,
318 $ a( i+1, i+1 ), lda )
321 a( i+1, i+1 ) = dble( a( i+1, i+1 ) )
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).
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zher2(UPLO, N, ALPHA, X, INCX, Y, INCY, A, LDA)
ZHER2
subroutine zhetd2(UPLO, N, A, LDA, D, E, TAU, INFO)
ZHETD2 reduces a Hermitian matrix to real symmetric tridiagonal form by an unitary similarity transfo...
subroutine zaxpy(N, ZA, ZX, INCX, ZY, INCY)
ZAXPY