174 SUBROUTINE chetd2( UPLO, N, A, LDA, D, E, TAU, INFO )
186 COMPLEX A( LDA, * ), TAU( * )
192 COMPLEX ONE, ZERO, HALF
193 parameter( one = ( 1.0e+0, 0.0e+0 ),
194 $ zero = ( 0.0e+0, 0.0e+0 ),
195 $ half = ( 0.5e+0, 0.0e+0 ) )
208 EXTERNAL lsame, cdotc
211 INTRINSIC max, min, real
218 upper = lsame( uplo,
'U' )
219 IF( .NOT.upper .AND. .NOT.lsame( uplo,
'L' ) )
THEN
221 ELSE IF( n.LT.0 )
THEN
223 ELSE IF( lda.LT.max( 1, n ) )
THEN
227 CALL xerbla(
'CHETD2', -info )
240 a( n, n ) = real( a( n, n ) )
241 DO 10 i = n - 1, 1, -1
247 CALL clarfg( i, alpha, a( 1, i+1 ), 1, taui )
248 e( i ) = real( alpha )
250 IF( taui.NE.zero )
THEN
258 CALL chemv( uplo, i, taui, a, lda, a( 1, i+1 ), 1, zero,
263 alpha = -half*taui*cdotc( i, tau, 1, a( 1, i+1 ), 1 )
264 CALL caxpy( i, alpha, a( 1, i+1 ), 1, tau, 1 )
269 CALL cher2( uplo, i, -one, a( 1, i+1 ), 1, tau, 1, a,
273 a( i, i ) = real( a( i, i ) )
276 d( i+1 ) = real( a( i+1, i+1 ) )
279 d( 1 ) = real( a( 1, 1 ) )
284 a( 1, 1 ) = real( a( 1, 1 ) )
291 CALL clarfg( n-i, alpha, a( min( i+2, n ), i ), 1, taui )
292 e( i ) = real( alpha )
294 IF( taui.NE.zero )
THEN
302 CALL chemv( uplo, n-i, taui, a( i+1, i+1 ), lda,
303 $ a( i+1, i ), 1, zero, tau( i ), 1 )
307 alpha = -half*taui*cdotc( n-i, tau( i ), 1, a( i+1, i ),
309 CALL caxpy( n-i, alpha, a( i+1, i ), 1, tau( i ), 1 )
314 CALL cher2( uplo, n-i, -one, a( i+1, i ), 1, tau( i ), 1,
315 $ a( i+1, i+1 ), lda )
318 a( i+1, i+1 ) = real( a( i+1, i+1 ) )
321 d( i ) = real( a( i, i ) )
324 d( n ) = real( a( n, n ) )
subroutine xerbla(srname, info)
subroutine caxpy(n, ca, cx, incx, cy, incy)
CAXPY
subroutine chemv(uplo, n, alpha, a, lda, x, incx, beta, y, incy)
CHEMV
subroutine cher2(uplo, n, alpha, x, incx, y, incy, a, lda)
CHER2
subroutine chetd2(uplo, n, a, lda, d, e, tau, info)
CHETD2 reduces a Hermitian matrix to real symmetric tridiagonal form by an unitary similarity transfo...
subroutine clarfg(n, alpha, x, incx, tau)
CLARFG generates an elementary reflector (Householder matrix).