245 SUBROUTINE dsyevx( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU,
246 $ abstol, m, w, z, ldz, work, lwork, iwork,
255 CHARACTER jobz, range, uplo
256 INTEGER il, info, iu, lda, ldz, lwork, m, n
257 DOUBLE PRECISION abstol, vl, vu
260 INTEGER ifail( * ), iwork( * )
261 DOUBLE PRECISION a( lda, * ), w( * ), work( * ), z( ldz, * )
267 DOUBLE PRECISION zero, one
268 parameter( zero = 0.0d+0, one = 1.0d+0 )
271 LOGICAL alleig, indeig, lower, lquery, test, valeig,
274 INTEGER i, iinfo, imax, indd, inde, indee, indibl,
275 $ indisp, indiwo, indtau, indwkn, indwrk, iscale,
276 $ itmp1,
j, jj, llwork, llwrkn, lwkmin,
278 DOUBLE PRECISION abstll, anrm, bignum, eps, rmax, rmin, safmin,
279 $ sigma, smlnum, tmp1, vll, vuu
292 INTRINSIC max, min, sqrt
298 lower =
lsame( uplo,
'L' )
299 wantz =
lsame( jobz,
'V' )
300 alleig =
lsame( range,
'A' )
301 valeig =
lsame( range,
'V' )
302 indeig =
lsame( range,
'I' )
303 lquery = ( lwork.EQ.-1 )
306 IF( .NOT.( wantz .OR.
lsame( jobz,
'N' ) ) )
THEN
308 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN
310 ELSE IF( .NOT.( lower .OR.
lsame( uplo,
'U' ) ) )
THEN
312 ELSE IF( n.LT.0 )
THEN
314 ELSE IF( lda.LT.max( 1, n ) )
THEN
318 IF( n.GT.0 .AND. vu.LE.vl )
320 ELSE IF( indeig )
THEN
321 IF( il.LT.1 .OR. il.GT.max( 1, n ) )
THEN
323 ELSE IF( iu.LT.min( n, il ) .OR. iu.GT.n )
THEN
329 IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
340 nb =
ilaenv( 1,
'DSYTRD', uplo, n, -1, -1, -1 )
341 nb = max( nb,
ilaenv( 1,
'DORMTR', uplo, n, -1, -1, -1 ) )
342 lwkopt = max( lwkmin, ( nb + 3 )*n )
346 IF( lwork.LT.lwkmin .AND. .NOT.lquery )
351 CALL
xerbla(
'DSYEVX', -info )
353 ELSE IF( lquery )
THEN
365 IF( alleig .OR. indeig )
THEN
369 IF( vl.LT.a( 1, 1 ) .AND. vu.GE.a( 1, 1 ) )
THEN
381 safmin =
dlamch(
'Safe minimum' )
382 eps =
dlamch(
'Precision' )
383 smlnum = safmin / eps
384 bignum = one / smlnum
385 rmin = sqrt( smlnum )
386 rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
396 anrm =
dlansy(
'M', uplo, n, a, lda, work )
397 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
400 ELSE IF( anrm.GT.rmax )
THEN
404 IF( iscale.EQ.1 )
THEN
407 CALL
dscal( n-
j+1, sigma, a(
j,
j ), 1 )
411 CALL
dscal(
j, sigma, a( 1,
j ), 1 )
415 $ abstll = abstol*sigma
428 llwork = lwork - indwrk + 1
429 CALL
dsytrd( uplo, n, a, lda, work( indd ), work( inde ),
430 $ work( indtau ), work( indwrk ), llwork, iinfo )
438 IF( il.EQ.1 .AND. iu.EQ.n )
THEN
442 IF( ( alleig .OR. test ) .AND. ( abstol.LE.zero ) )
THEN
443 CALL
dcopy( n, work( indd ), 1, w, 1 )
445 IF( .NOT.wantz )
THEN
446 CALL
dcopy( n-1, work( inde ), 1, work( indee ), 1 )
447 CALL
dsterf( n, w, work( indee ), info )
449 CALL
dlacpy(
'A', n, n, a, lda, z, ldz )
450 CALL
dorgtr( uplo, n, z, ldz, work( indtau ),
451 $ work( indwrk ), llwork, iinfo )
452 CALL
dcopy( n-1, work( inde ), 1, work( indee ), 1 )
453 CALL
dsteqr( jobz, n, w, work( indee ), z, ldz,
454 $ work( indwrk ), info )
478 CALL
dstebz( range, order, n, vll, vuu, il, iu, abstll,
479 $ work( indd ), work( inde ), m, nsplit, w,
480 $ iwork( indibl ), iwork( indisp ), work( indwrk ),
481 $ iwork( indiwo ), info )
484 CALL
dstein( n, work( indd ), work( inde ), m, w,
485 $ iwork( indibl ), iwork( indisp ), z, ldz,
486 $ work( indwrk ), iwork( indiwo ), ifail, info )
492 llwrkn = lwork - indwkn + 1
493 CALL
dormtr(
'L', uplo,
'N', n, m, a, lda, work( indtau ), z,
494 $ ldz, work( indwkn ), llwrkn, iinfo )
500 IF( iscale.EQ.1 )
THEN
506 CALL
dscal( imax, one / sigma, w, 1 )
517 IF( w( jj ).LT.tmp1 )
THEN
524 itmp1 = iwork( indibl+i-1 )
526 iwork( indibl+i-1 ) = iwork( indibl+
j-1 )
528 iwork( indibl+
j-1 ) = itmp1
529 CALL
dswap( n, z( 1, i ), 1, z( 1,
j ), 1 )
532 ifail( i ) = ifail(
j )
subroutine dsteqr(COMPZ, N, D, E, Z, LDZ, WORK, INFO)
DSTEQR
subroutine dstein(N, D, E, M, W, IBLOCK, ISPLIT, Z, LDZ, WORK, IWORK, IFAIL, INFO)
DSTEIN
subroutine dormtr(SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
DORMTR
LOGICAL function lsame(CA, CB)
LSAME
DOUBLE PRECISION function dlansy(NORM, UPLO, N, A, LDA, WORK)
DLANSY returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a real symmetric matrix.
subroutine dsterf(N, D, E, INFO)
DSTERF
subroutine dsyevx(JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, LWORK, IWORK, IFAIL, INFO)
DSYEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices ...
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dscal(N, DA, DX, INCX)
DSCAL
INTEGER function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
DOUBLE PRECISION function dlamch(CMACH)
DLAMCH
subroutine dswap(N, DX, INCX, DY, INCY)
DSWAP
subroutine dsytrd(UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO)
DSYTRD
subroutine dorgtr(UPLO, N, A, LDA, TAU, WORK, LWORK, INFO)
DORGTR
subroutine dstebz(RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E, M, NSPLIT, W, IBLOCK, ISPLIT, WORK, IWORK, INFO)
DSTEBZ