151 SUBROUTINE ssptrd( UPLO, N, AP, D, E, TAU, INFO )
163 REAL ap( * ), d( * ), e( * ), tau( * )
170 parameter( one = 1.0, zero = 0.0, half = 1.0 / 2.0 )
174 INTEGER i, i1, i1i1, ii
190 upper =
lsame( uplo,
'U' )
191 IF( .NOT.upper .AND. .NOT.
lsame( uplo,
'L' ) )
THEN
193 ELSE IF( n.LT.0 )
THEN
197 CALL
xerbla(
'SSPTRD', -info )
211 i1 = n*( n-1 ) / 2 + 1
212 DO 10 i = n - 1, 1, -1
217 CALL
slarfg( i, ap( i1+i-1 ), ap( i1 ), 1, taui )
218 e( i ) = ap( i1+i-1 )
220 IF( taui.NE.zero )
THEN
228 CALL
sspmv( uplo, i, taui, ap, ap( i1 ), 1, zero, tau,
233 alpha = -half*taui*
sdot( i, tau, 1, ap( i1 ), 1 )
234 CALL
saxpy( i, alpha, ap( i1 ), 1, tau, 1 )
239 CALL
sspr2( uplo, i, -one, ap( i1 ), 1, tau, 1, ap )
241 ap( i1+i-1 ) = e( i )
243 d( i+1 ) = ap( i1+i )
255 i1i1 = ii + n - i + 1
260 CALL
slarfg( n-i, ap( ii+1 ), ap( ii+2 ), 1, taui )
263 IF( taui.NE.zero )
THEN
271 CALL
sspmv( uplo, n-i, taui, ap( i1i1 ), ap( ii+1 ), 1,
272 $ zero, tau( i ), 1 )
276 alpha = -half*taui*
sdot( n-i, tau( i ), 1, ap( ii+1 ),
278 CALL
saxpy( n-i, alpha, ap( ii+1 ), 1, tau( i ), 1 )
283 CALL
sspr2( uplo, n-i, -one, ap( ii+1 ), 1, tau( i ), 1,
subroutine sspmv(UPLO, N, ALPHA, AP, X, INCX, BETA, Y, INCY)
SSPMV
real function sdot(N, SX, INCX, SY, INCY)
SDOT
subroutine ssptrd(UPLO, N, AP, D, E, TAU, INFO)
SSPTRD
subroutine xerbla(SRNAME, INFO)
XERBLA
logical function lsame(CA, CB)
LSAME
subroutine saxpy(N, SA, SX, INCX, SY, INCY)
SAXPY
subroutine slarfg(N, ALPHA, X, INCX, TAU)
SLARFG generates an elementary reflector (Householder matrix).
subroutine sspr2(UPLO, N, ALPHA, X, INCX, Y, INCY, AP)
SSPR2