193 SUBROUTINE dsytrd( UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO )
202 INTEGER info, lda, lwork, n
205 DOUBLE PRECISION a( lda, * ), d( * ), e( * ), tau( * ),
213 parameter( one = 1.0d+0 )
216 LOGICAL lquery, upper
217 INTEGER i, iinfo, iws,
j, kk, ldwork, lwkopt, nb,
236 upper =
lsame( uplo,
'U' )
237 lquery = ( lwork.EQ.-1 )
238 IF( .NOT.upper .AND. .NOT.
lsame( uplo,
'L' ) )
THEN
240 ELSE IF( n.LT.0 )
THEN
242 ELSE IF( lda.LT.max( 1, n ) )
THEN
244 ELSE IF( lwork.LT.1 .AND. .NOT.lquery )
THEN
252 nb =
ilaenv( 1,
'DSYTRD', uplo, n, -1, -1, -1 )
258 CALL
xerbla(
'DSYTRD', -info )
260 ELSE IF( lquery )
THEN
273 IF( nb.GT.1 .AND. nb.LT.n )
THEN
278 nx = max( nb,
ilaenv( 3,
'DSYTRD', uplo, n, -1, -1, -1 ) )
285 IF( lwork.LT.iws )
THEN
291 nb = max( lwork / ldwork, 1 )
292 nbmin =
ilaenv( 2,
'DSYTRD', uplo, n, -1, -1, -1 )
308 kk = n - ( ( n-nx+nb-1 ) / nb )*nb
309 DO 20 i = n - nb + 1, kk + 1, -nb
315 CALL
dlatrd( uplo, i+nb-1, nb, a, lda, e, tau, work,
321 CALL
dsyr2k( uplo,
'No transpose', i-1, nb, -one, a( 1, i ),
322 $ lda, work, ldwork, one, a, lda )
327 DO 10
j = i, i + nb - 1
328 a(
j-1,
j ) = e(
j-1 )
335 CALL
dsytd2( uplo, kk, a, lda, d, e, tau, iinfo )
340 DO 40 i = 1, n - nx, nb
346 CALL
dlatrd( uplo, n-i+1, nb, a( i, i ), lda, e( i ),
347 $ tau( i ), work, ldwork )
352 CALL
dsyr2k( uplo,
'No transpose', n-i-nb+1, nb, -one,
353 $ a( i+nb, i ), lda, work( nb+1 ), ldwork, one,
354 $ a( i+nb, i+nb ), lda )
359 DO 30
j = i, i + nb - 1
367 CALL
dsytd2( uplo, n-i+1, a( i, i ), lda, d( i ), e( i ),
LOGICAL function lsame(CA, CB)
LSAME
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dlatrd(UPLO, N, NB, A, LDA, E, TAU, W, LDW)
DLATRD reduces the first nb rows and columns of a symmetric/Hermitian matrix A to real tridiagonal fo...
INTEGER function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
subroutine dsytd2(UPLO, N, A, LDA, D, E, TAU, INFO)
DSYTD2 reduces a symmetric matrix to real symmetric tridiagonal form by an orthogonal similarity tran...
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine dsytrd(UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO)
DSYTRD
subroutine dsyr2k(UPLO, TRANS, N, K, ALPHA, A, LDA, B, LDB, BETA, C, LDC)
DSYR2K