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
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,
LOGICAL function lsame(CA, CB)
LSAME
subroutine zhptrd(UPLO, N, AP, D, E, TAU, INFO)
ZHPTRD
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine zaxpy(N, ZA, ZX, INCX, ZY, INCY)
ZAXPY
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).
COMPLEX *16 function zdotc(N, ZX, INCX, ZY, INCY)
ZDOTC
subroutine zhpmv(UPLO, N, ALPHA, AP, X, INCX, BETA, Y, INCY)
ZHPMV