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 chpmv(UPLO, N, ALPHA, AP, X, INCX, BETA, Y, INCY)
CHPMV
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine chpr2(UPLO, N, ALPHA, X, INCX, Y, INCY, AP)
CHPR2
subroutine chptrd(UPLO, N, AP, D, E, TAU, INFO)
CHPTRD
subroutine caxpy(N, CA, CX, INCX, CY, INCY)
CAXPY
subroutine clarfg(N, ALPHA, X, INCX, TAU)
CLARFG generates an elementary reflector (Householder matrix).