151 SUBROUTINE dsptrd( UPLO, N, AP, D, E, TAU, INFO )
163 DOUBLE PRECISION AP( * ), D( * ), E( * ), TAU( * )
169 DOUBLE PRECISION ONE, ZERO, HALF
170 parameter( one = 1.0d0, zero = 0.0d0,
171 $ half = 1.0d0 / 2.0d0 )
175 INTEGER I, I1, I1I1, II
176 DOUBLE PRECISION ALPHA, TAUI
183 DOUBLE PRECISION DDOT
191 upper = lsame( uplo,
'U' )
192 IF( .NOT.upper .AND. .NOT.lsame( uplo,
'L' ) )
THEN
194 ELSE IF( n.LT.0 )
THEN
198 CALL
xerbla(
'DSPTRD', -info )
212 i1 = n*( n-1 ) / 2 + 1
213 DO 10 i = n - 1, 1, -1
218 CALL
dlarfg( i, ap( i1+i-1 ), ap( i1 ), 1, taui )
219 e( i ) = ap( i1+i-1 )
221 IF( taui.NE.zero )
THEN
229 CALL
dspmv( uplo, i, taui, ap, ap( i1 ), 1, zero, tau,
234 alpha = -half*taui*ddot( i, tau, 1, ap( i1 ), 1 )
235 CALL
daxpy( i, alpha, ap( i1 ), 1, tau, 1 )
240 CALL
dspr2( uplo, i, -one, ap( i1 ), 1, tau, 1, ap )
242 ap( i1+i-1 ) = e( i )
244 d( i+1 ) = ap( i1+i )
256 i1i1 = ii + n - i + 1
261 CALL
dlarfg( n-i, ap( ii+1 ), ap( ii+2 ), 1, taui )
264 IF( taui.NE.zero )
THEN
272 CALL
dspmv( uplo, n-i, taui, ap( i1i1 ), ap( ii+1 ), 1,
273 $ zero, tau( i ), 1 )
277 alpha = -half*taui*ddot( n-i, tau( i ), 1, ap( ii+1 ),
279 CALL
daxpy( n-i, alpha, ap( ii+1 ), 1, tau( i ), 1 )
284 CALL
dspr2( uplo, n-i, -one, ap( ii+1 ), 1, tau( i ), 1,
subroutine dsptrd(UPLO, N, AP, D, E, TAU, INFO)
DSPTRD
subroutine dlarfg(N, ALPHA, X, INCX, TAU)
DLARFG generates an elementary reflector (Householder matrix).
subroutine dspmv(UPLO, N, ALPHA, AP, X, INCX, BETA, Y, INCY)
DSPMV
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dspr2(UPLO, N, ALPHA, X, INCX, Y, INCY, AP)
DSPR2
subroutine daxpy(N, DA, DX, INCX, DY, INCY)
DAXPY