1 SUBROUTINE dsytrd( UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO )
10 INTEGER INFO, LDA, LWORK, N
13 DOUBLE PRECISION A( LDA, * ), D( * ), E( * ), TAU( * ),
132 parameter( one = 1.0d+0 )
135 LOGICAL LQUERY, UPPER
136 INTEGER I, IINFO, IWS, J, KK, LDWORK, LWKOPT, NB,
148 EXTERNAL lsame, ilaenv
155 upper = lsame( uplo,
'U' )
156 lquery = ( lwork.EQ.-1 )
157 IF( .NOT.upper .AND. .NOT.lsame( uplo,
'L' ) )
THEN
159 ELSE IF( n.LT.0 )
THEN
161 ELSE IF( lda.LT.max( 1, n ) )
THEN
163 ELSE IF( lwork.LT.1 .AND. .NOT.lquery )
THEN
171 nb = ilaenv( 1,
'DSYTRD', uplo, n, -1, -1, -1 )
177 CALL xerbla(
'DSYTRD', -info )
179 ELSE IF( lquery )
THEN
192 IF( nb.GT.1 .AND. nb.LT.n )
THEN
197 nx = max( nb, ilaenv( 3,
'DSYTRD', uplo, n, -1, -1, -1 ) )
204 IF( lwork.LT.iws )
THEN
210 nb = max( lwork / ldwork, 1 )
211 nbmin = ilaenv( 2,
'DSYTRD', uplo, n, -1, -1, -1 )
227 kk = n - ( ( n-nx+nb-1 ) / nb )*nb
228 DO 20 i = n - nb + 1, kk + 1, -nb
234 CALL dlatrd( uplo, i+nb-1, nb, a, lda, e, tau, work,
240 CALL dsyr2k( uplo,
'No transpose', i-1, nb, -one, a( 1, i ),
241 $ lda, work, ldwork, one, a, lda )
246 DO 10 j = i, i + nb - 1
247 a( j-1, j ) = e( j-1 )
254 CALL dsytd2( uplo, kk, a, lda, d, e, tau, iinfo )
259 DO 40 i = 1, n - nx, nb
265 CALL dlatrd( uplo, n-i+1, nb, a( i, i ), lda, e( i ),
266 $ tau( i ), work, ldwork )
271 CALL dsyr2k( uplo,
'No transpose', n-i-nb+1, nb, -one,
272 $ a( i+nb, i ), lda, work( nb+1 ), ldwork, one,
273 $ a( i+nb, i+nb ), lda )
278 DO 30 j = i, i + nb - 1
286 CALL dsytd2( uplo, n-i+1, a( i, i ), lda, d( i ), e( i ),
subroutine dlatrd(UPLO, N, NB, A, LDA, E, TAU, W, LDW)
subroutine dsyr2k(UPLO, TRANS, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
subroutine dsytd2(UPLO, N, A, LDA, D, E, TAU, INFO)
subroutine dsytrd(UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO)
subroutine xerbla(SRNAME, INFO)