152 SUBROUTINE chptrd( UPLO, N, AP, D, E, TAU, INFO )
165 COMPLEX AP( * ), TAU( * )
171 COMPLEX ONE, ZERO, HALF
172 parameter( one = ( 1.0e+0, 0.0e+0 ),
173 $ zero = ( 0.0e+0, 0.0e+0 ),
174 $ half = ( 0.5e+0, 0.0e+0 ) )
178 INTEGER I, I1, I1I1, II
187 EXTERNAL lsame, cdotc
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(
'CHPTRD', -info )
218 i1 = n*( n-1 ) / 2 + 1
219 ap( i1+n-1 ) =
REAL( AP( I1+N-1 ) )
220 DO 10 i = n - 1, 1, -1
226 CALL
clarfg( i, alpha, ap( i1 ), 1, taui )
229 IF( taui.NE.zero )
THEN
237 CALL
chpmv( uplo, i, taui, ap, ap( i1 ), 1, zero, tau,
242 alpha = -half*taui*cdotc( i, tau, 1, ap( i1 ), 1 )
243 CALL
caxpy( i, alpha, ap( i1 ), 1, tau, 1 )
248 CALL
chpr2( 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 ) =
REAL( AP( 1 ) )
265 i1i1 = ii + n - i + 1
271 CALL
clarfg( n-i, alpha, ap( ii+2 ), 1, taui )
274 IF( taui.NE.zero )
THEN
282 CALL
chpmv( uplo, n-i, taui, ap( i1i1 ), ap( ii+1 ), 1,
283 $ zero, tau( i ), 1 )
287 alpha = -half*taui*cdotc( n-i, tau( i ), 1, ap( ii+1 ),
289 CALL
caxpy( n-i, alpha, ap( ii+1 ), 1, tau( i ), 1 )
294 CALL
chpr2( uplo, n-i, -one, ap( ii+1 ), 1, tau( i ), 1,
subroutine caxpy(N, CA, CX, INCX, CY, INCY)
CAXPY
subroutine chptrd(UPLO, N, AP, D, E, TAU, INFO)
CHPTRD
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine chpr2(UPLO, N, ALPHA, X, INCX, Y, INCY, AP)
CHPR2
subroutine clarfg(N, ALPHA, X, INCX, TAU)
CLARFG generates an elementary reflector (Householder matrix).
subroutine chpmv(UPLO, N, ALPHA, AP, X, INCX, BETA, Y, INCY)
CHPMV