174 SUBROUTINE ssytd2( UPLO, N, A, LDA, D, E, TAU, INFO )
186 REAL a( lda, * ), d( * ), e( * ), tau( * )
193 parameter( one = 1.0, zero = 0.0, half = 1.0 / 2.0 )
216 upper =
lsame( uplo,
'U' )
217 IF( .NOT.upper .AND. .NOT.
lsame( uplo,
'L' ) )
THEN
219 ELSE IF( n.LT.0 )
THEN
221 ELSE IF( lda.LT.max( 1, n ) )
THEN
225 CALL
xerbla(
'SSYTD2', -info )
238 DO 10 i = n - 1, 1, -1
243 CALL
slarfg( i, a( i, i+1 ), a( 1, i+1 ), 1, taui )
246 IF( taui.NE.zero )
THEN
254 CALL
ssymv( uplo, i, taui, a, lda, a( 1, i+1 ), 1, zero,
259 alpha = -half*taui*
sdot( i, tau, 1, a( 1, i+1 ), 1 )
260 CALL
saxpy( i, alpha, a( 1, i+1 ), 1, tau, 1 )
265 CALL
ssyr2( uplo, i, -one, a( 1, i+1 ), 1, tau, 1, a,
270 d( i+1 ) = a( i+1, i+1 )
283 CALL
slarfg( n-i, a( i+1, i ), a( min( i+2, n ), i ), 1,
287 IF( taui.NE.zero )
THEN
295 CALL
ssymv( uplo, n-i, taui, a( i+1, i+1 ), lda,
296 $ a( i+1, i ), 1, zero, tau( i ), 1 )
300 alpha = -half*taui*
sdot( n-i, tau( i ), 1, a( i+1, i ),
302 CALL
saxpy( n-i, alpha, a( i+1, i ), 1, tau( i ), 1 )
307 CALL
ssyr2( uplo, n-i, -one, a( i+1, i ), 1, tau( i ), 1,
308 $ a( i+1, i+1 ), lda )
subroutine ssytd2(UPLO, N, A, LDA, D, E, TAU, INFO)
SSYTD2 reduces a symmetric matrix to real symmetric tridiagonal form by an orthogonal similarity tran...
subroutine ssymv(UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
SSYMV
real function sdot(N, SX, INCX, SY, INCY)
SDOT
subroutine ssyr2(UPLO, N, ALPHA, X, INCX, Y, INCY, A, LDA)
SSYR2
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).