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
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,