1 SUBROUTINE dsytd2( UPLO, N, A, LDA, D, E, TAU, INFO )
13 DOUBLE PRECISION A( LDA, * ), D( * ), E( * ), TAU( * )
118 DOUBLE PRECISION ONE, ZERO, HALF
119 parameter( one = 1.0d0, zero = 0.0d0,
120 $ half = 1.0d0 / 2.0d0 )
125 DOUBLE PRECISION ALPHA, TAUI
132 DOUBLE PRECISION DDOT
143 upper = lsame( uplo,
'U' )
144 IF( .NOT.upper .AND. .NOT.lsame( uplo,
'L' ) )
THEN
146 ELSE IF( n.LT.0 )
THEN
148 ELSE IF( lda.LT.max( 1, n ) )
THEN
152 CALL xerbla(
'DSYTD2', -info )
165 DO 10 i = n - 1, 1, -1
170 CALL dlarfg( i, a( i, i+1 ), a( 1, i+1 ), 1, taui )
173 IF( taui.NE.zero )
THEN
181 CALL dsymv( uplo, i, taui, a, lda, a( 1, i+1 ), 1, zero,
186 alpha = -half*taui*ddot( i, tau, 1, a( 1, i+1 ), 1 )
187 CALL daxpy( i, alpha, a( 1, i+1 ), 1, tau, 1 )
192 CALL dsyr2( uplo, i, -one, a( 1, i+1 ), 1, tau, 1, a,
197 d( i+1 ) = a( i+1, i+1 )
210 CALL dlarfg( n-i, a( i+1, i ), a( min( i+2, n ), i ), 1,
214 IF( taui.NE.zero )
THEN
222 CALL dsymv( uplo, n-i, taui, a( i+1, i+1 ), lda,
223 $ a( i+1, i ), 1, zero, tau( i ), 1 )
227 alpha = -half*taui*ddot( n-i, tau( i ), 1, a( i+1, i ),
229 CALL daxpy( n-i, alpha, a( i+1, i ), 1, tau( i ), 1 )
234 CALL dsyr2( uplo, n-i, -one, a( i+1, i ), 1, tau( i ), 1,
235 $ a( i+1, i+1 ), lda )
subroutine daxpy(n, da, dx, incx, dy, incy)
subroutine dlarfg(N, ALPHA, X, INCX, TAU)
subroutine dsymv(UPLO, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
subroutine dsyr2(UPLO, N, ALPHA, X, INCX, Y, INCY, A, LDA)
subroutine dsytd2(UPLO, N, A, LDA, D, E, TAU, INFO)
subroutine xerbla(SRNAME, INFO)