333 SUBROUTINE dsyevr( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU,
334 $ abstol, m, w, z, ldz, isuppz, work, lwork,
335 $ iwork, liwork, info )
343 CHARACTER JOBZ, RANGE, UPLO
344 INTEGER IL, INFO, IU, LDA, LDZ, LIWORK, LWORK, M, N
345 DOUBLE PRECISION ABSTOL, VL, VU
348 INTEGER ISUPPZ( * ), IWORK( * )
349 DOUBLE PRECISION A( lda, * ), W( * ), WORK( * ), Z( ldz, * )
355 DOUBLE PRECISION ZERO, ONE, TWO
356 parameter ( zero = 0.0d+0, one = 1.0d+0, two = 2.0d+0 )
359 LOGICAL ALLEIG, INDEIG, LOWER, LQUERY, VALEIG, WANTZ,
362 INTEGER I, IEEEOK, IINFO, IMAX, INDD, INDDD, INDE,
363 $ indee, indibl, indifl, indisp, indiwo, indtau,
364 $ indwk, indwkn, iscale, j, jj, liwmin,
365 $ llwork, llwrkn, lwkopt, lwmin, nb, nsplit
366 DOUBLE PRECISION ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
367 $ sigma, smlnum, tmp1, vll, vuu
372 DOUBLE PRECISION DLAMCH, DLANSY
373 EXTERNAL lsame, ilaenv, dlamch, dlansy
380 INTRINSIC max, min, sqrt
386 ieeeok = ilaenv( 10,
'DSYEVR',
'N', 1, 2, 3, 4 )
388 lower = lsame( uplo,
'L' )
389 wantz = lsame( jobz,
'V' )
390 alleig = lsame( range,
'A' )
391 valeig = lsame( range,
'V' )
392 indeig = lsame( range,
'I' )
394 lquery = ( ( lwork.EQ.-1 ) .OR. ( liwork.EQ.-1 ) )
396 lwmin = max( 1, 26*n )
397 liwmin = max( 1, 10*n )
400 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN
402 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN
404 ELSE IF( .NOT.( lower .OR. lsame( uplo,
'U' ) ) )
THEN
406 ELSE IF( n.LT.0 )
THEN
408 ELSE IF( lda.LT.max( 1, n ) )
THEN
412 IF( n.GT.0 .AND. vu.LE.vl )
414 ELSE IF( indeig )
THEN
415 IF( il.LT.1 .OR. il.GT.max( 1, n ) )
THEN
417 ELSE IF( iu.LT.min( n, il ) .OR. iu.GT.n )
THEN
423 IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
425 ELSE IF( lwork.LT.lwmin .AND. .NOT.lquery )
THEN
427 ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery )
THEN
433 nb = ilaenv( 1,
'DSYTRD', uplo, n, -1, -1, -1 )
434 nb = max( nb, ilaenv( 1,
'DORMTR', uplo, n, -1, -1, -1 ) )
435 lwkopt = max( ( nb+1 )*n, lwmin )
441 CALL xerbla(
'DSYEVR', -info )
443 ELSE IF( lquery )
THEN
457 IF( alleig .OR. indeig )
THEN
461 IF( vl.LT.a( 1, 1 ) .AND. vu.GE.a( 1, 1 ) )
THEN
476 safmin = dlamch(
'Safe minimum' )
477 eps = dlamch(
'Precision' )
478 smlnum = safmin / eps
479 bignum = one / smlnum
480 rmin = sqrt( smlnum )
481 rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
491 anrm = dlansy(
'M', uplo, n, a, lda, work )
492 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
495 ELSE IF( anrm.GT.rmax )
THEN
499 IF( iscale.EQ.1 )
THEN
502 CALL dscal( n-j+1, sigma, a( j, j ), 1 )
506 CALL dscal( j, sigma, a( 1, j ), 1 )
510 $ abstll = abstol*sigma
537 llwork = lwork - indwk + 1
556 CALL dsytrd( uplo, n, a, lda, work( indd ), work( inde ),
557 $ work( indtau ), work( indwk ), llwork, iinfo )
562 IF( ( alleig .OR. ( indeig .AND. il.EQ.1 .AND. iu.EQ.n ) ) .AND.
564 IF( .NOT.wantz )
THEN
565 CALL dcopy( n, work( indd ), 1, w, 1 )
566 CALL dcopy( n-1, work( inde ), 1, work( indee ), 1 )
567 CALL dsterf( n, w, work( indee ), info )
569 CALL dcopy( n-1, work( inde ), 1, work( indee ), 1 )
570 CALL dcopy( n, work( indd ), 1, work( inddd ), 1 )
572 IF (abstol .LE. two*n*eps)
THEN
577 CALL dstemr( jobz,
'A', n, work( inddd ), work( indee ),
578 $ vl, vu, il, iu, m, w, z, ldz, n, isuppz,
579 $ tryrac, work( indwk ), lwork, iwork, liwork,
587 IF( wantz .AND. info.EQ.0 )
THEN
589 llwrkn = lwork - indwkn + 1
590 CALL dormtr(
'L', uplo,
'N', n, m, a, lda,
591 $ work( indtau ), z, ldz, work( indwkn ),
615 CALL dstebz( range, order, n, vll, vuu, il, iu, abstll,
616 $ work( indd ), work( inde ), m, nsplit, w,
617 $ iwork( indibl ), iwork( indisp ), work( indwk ),
618 $ iwork( indiwo ), info )
621 CALL dstein( n, work( indd ), work( inde ), m, w,
622 $ iwork( indibl ), iwork( indisp ), z, ldz,
623 $ work( indwk ), iwork( indiwo ), iwork( indifl ),
630 llwrkn = lwork - indwkn + 1
631 CALL dormtr(
'L', uplo,
'N', n, m, a, lda, work( indtau ), z,
632 $ ldz, work( indwkn ), llwrkn, iinfo )
639 IF( iscale.EQ.1 )
THEN
645 CALL dscal( imax, one / sigma, w, 1 )
658 IF( w( jj ).LT.tmp1 )
THEN
667 CALL dswap( n, z( 1, i ), 1, z( 1, j ), 1 )
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
subroutine dsytrd(UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO)
DSYTRD
subroutine dstein(N, D, E, M, W, IBLOCK, ISPLIT, Z, LDZ, WORK, IWORK, IFAIL, INFO)
DSTEIN
subroutine dsterf(N, D, E, INFO)
DSTERF
subroutine dsyevr(JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK, IWORK, LIWORK, INFO)
DSYEVR computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices ...
subroutine dswap(N, DX, INCX, DY, INCY)
DSWAP
subroutine dstebz(RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E, M, NSPLIT, W, IBLOCK, ISPLIT, WORK, IWORK, INFO)
DSTEBZ
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dscal(N, DA, DX, INCX)
DSCAL
subroutine dstemr(JOBZ, RANGE, N, D, E, VL, VU, IL, IU, M, W, Z, LDZ, NZC, ISUPPZ, TRYRAC, WORK, LWORK, IWORK, LIWORK, INFO)
DSTEMR
subroutine dormtr(SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
DORMTR