152 SUBROUTINE zhptrd( UPLO, N, AP, D, E, TAU, INFO )
164 DOUBLE PRECISION D( * ), E( * )
165 COMPLEX*16 AP( * ), TAU( * )
171 COMPLEX*16 ONE, ZERO, HALF
172 parameter ( one = ( 1.0d+0, 0.0d+0 ),
173 $ zero = ( 0.0d+0, 0.0d+0 ),
174 $ half = ( 0.5d+0, 0.0d+0 ) )
178 INTEGER I, I1, I1I1, II
179 COMPLEX*16 ALPHA, TAUI
187 EXTERNAL lsame, zdotc
197 upper = lsame( uplo,
'U' )
198 IF( .NOT.upper .AND. .NOT.lsame( uplo,
'L' ) )
THEN
200 ELSE IF( n.LT.0 )
THEN
204 CALL xerbla(
'ZHPTRD', -info )
218 i1 = n*( n-1 ) / 2 + 1
219 ap( i1+n-1 ) = dble( ap( i1+n-1 ) )
220 DO 10 i = n - 1, 1, -1
226 CALL zlarfg( i, alpha, ap( i1 ), 1, taui )
229 IF( taui.NE.zero )
THEN
237 CALL zhpmv( uplo, i, taui, ap, ap( i1 ), 1, zero, tau,
242 alpha = -half*taui*zdotc( i, tau, 1, ap( i1 ), 1 )
243 CALL zaxpy( i, alpha, ap( i1 ), 1, tau, 1 )
248 CALL zhpr2( uplo, i, -one, ap( i1 ), 1, tau, 1, ap )
251 ap( i1+i-1 ) = e( i )
252 d( i+1 ) = ap( i1+i )
263 ap( 1 ) = dble( ap( 1 ) )
265 i1i1 = ii + n - i + 1
271 CALL zlarfg( n-i, alpha, ap( ii+2 ), 1, taui )
274 IF( taui.NE.zero )
THEN
282 CALL zhpmv( uplo, n-i, taui, ap( i1i1 ), ap( ii+1 ), 1,
283 $ zero, tau( i ), 1 )
287 alpha = -half*taui*zdotc( n-i, tau( i ), 1, ap( ii+1 ),
289 CALL zaxpy( n-i, alpha, ap( ii+1 ), 1, tau( i ), 1 )
294 CALL zhpr2( uplo, n-i, -one, ap( ii+1 ), 1, tau( i ), 1,
subroutine zhpr2(UPLO, N, ALPHA, X, INCX, Y, INCY, AP)
ZHPR2
subroutine zlarfg(N, ALPHA, X, INCX, TAU)
ZLARFG generates an elementary reflector (Householder matrix).
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zhptrd(UPLO, N, AP, D, E, TAU, INFO)
ZHPTRD
subroutine zhpmv(UPLO, N, ALPHA, AP, X, INCX, BETA, Y, INCY)
ZHPMV
subroutine zaxpy(N, ZA, ZX, INCX, ZY, INCY)
ZAXPY