324 SUBROUTINE dsyevr( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU,
325 $ abstol, m, w, z, ldz, isuppz, work, lwork,
326 $ iwork, liwork, info )
334 CHARACTER JOBZ, RANGE, UPLO
335 INTEGER IL, INFO, IU, LDA, LDZ, LIWORK, LWORK, M, N
336 DOUBLE PRECISION ABSTOL, VL, VU
339 INTEGER ISUPPZ( * ), IWORK( * )
340 DOUBLE PRECISION A( lda, * ), W( * ), WORK( * ), Z( ldz, * )
346 DOUBLE PRECISION ZERO, ONE, TWO
347 parameter( zero = 0.0d+0, one = 1.0d+0, two = 2.0d+0 )
350 LOGICAL ALLEIG, INDEIG, LOWER, LQUERY, VALEIG, WANTZ,
353 INTEGER I, IEEEOK, IINFO, IMAX, INDD, INDDD, INDE,
354 $ indee, indibl, indifl, indisp, indiwo, indtau,
355 $ indwk, indwkn, iscale, j, jj, liwmin,
356 $ llwork, llwrkn, lwkopt, lwmin, nb, nsplit
357 DOUBLE PRECISION ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
358 $ sigma, smlnum, tmp1, vll, vuu
363 DOUBLE PRECISION DLAMCH, DLANSY
364 EXTERNAL lsame, ilaenv, dlamch, dlansy
371 INTRINSIC max, min, sqrt
377 ieeeok = ilaenv( 10,
'DSYEVR',
'N', 1, 2, 3, 4 )
379 lower = lsame( uplo,
'L' )
380 wantz = lsame( jobz,
'V' )
381 alleig = lsame( range,
'A' )
382 valeig = lsame( range,
'V' )
383 indeig = lsame( range,
'I' )
385 lquery = ( ( lwork.EQ.-1 ) .OR. ( liwork.EQ.-1 ) )
387 lwmin = max( 1, 26*n )
388 liwmin = max( 1, 10*n )
391 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN
393 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN
395 ELSE IF( .NOT.( lower .OR. lsame( uplo,
'U' ) ) )
THEN
397 ELSE IF( n.LT.0 )
THEN
399 ELSE IF( lda.LT.max( 1, n ) )
THEN
403 IF( n.GT.0 .AND. vu.LE.vl )
405 ELSE IF( indeig )
THEN
406 IF( il.LT.1 .OR. il.GT.max( 1, n ) )
THEN
408 ELSE IF( iu.LT.min( n, il ) .OR. iu.GT.n )
THEN
414 IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
416 ELSE IF( lwork.LT.lwmin .AND. .NOT.lquery )
THEN
418 ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery )
THEN
424 nb = ilaenv( 1,
'DSYTRD', uplo, n, -1, -1, -1 )
425 nb = max( nb, ilaenv( 1,
'DORMTR', uplo, n, -1, -1, -1 ) )
426 lwkopt = max( ( nb+1 )*n, lwmin )
432 CALL xerbla(
'DSYEVR', -info )
434 ELSE IF( lquery )
THEN
448 IF( alleig .OR. indeig )
THEN
452 IF( vl.LT.a( 1, 1 ) .AND. vu.GE.a( 1, 1 ) )
THEN
467 safmin = dlamch(
'Safe minimum' )
468 eps = dlamch(
'Precision' )
469 smlnum = safmin / eps
470 bignum = one / smlnum
471 rmin = sqrt( smlnum )
472 rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
482 anrm = dlansy(
'M', uplo, n, a, lda, work )
483 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
486 ELSE IF( anrm.GT.rmax )
THEN
490 IF( iscale.EQ.1 )
THEN
493 CALL dscal( n-j+1, sigma, a( j, j ), 1 )
497 CALL dscal( j, sigma, a( 1, j ), 1 )
501 $ abstll = abstol*sigma
528 llwork = lwork - indwk + 1
547 CALL dsytrd( uplo, n, a, lda, work( indd ), work( inde ),
548 $ work( indtau ), work( indwk ), llwork, iinfo )
553 IF( ( alleig .OR. ( indeig .AND. il.EQ.1 .AND. iu.EQ.n ) ) .AND.
555 IF( .NOT.wantz )
THEN
556 CALL dcopy( n, work( indd ), 1, w, 1 )
557 CALL dcopy( n-1, work( inde ), 1, work( indee ), 1 )
558 CALL dsterf( n, w, work( indee ), info )
560 CALL dcopy( n-1, work( inde ), 1, work( indee ), 1 )
561 CALL dcopy( n, work( indd ), 1, work( inddd ), 1 )
563 IF (abstol .LE. two*n*eps)
THEN
568 CALL dstemr( jobz,
'A', n, work( inddd ), work( indee ),
569 $ vl, vu, il, iu, m, w, z, ldz, n, isuppz,
570 $ tryrac, work( indwk ), lwork, iwork, liwork,
578 IF( wantz .AND. info.EQ.0 )
THEN
580 llwrkn = lwork - indwkn + 1
581 CALL dormtr(
'L', uplo,
'N', n, m, a, lda,
582 $ work( indtau ), z, ldz, work( indwkn ),
606 CALL dstebz( range, order, n, vll, vuu, il, iu, abstll,
607 $ work( indd ), work( inde ), m, nsplit, w,
608 $ iwork( indibl ), iwork( indisp ), work( indwk ),
609 $ iwork( indiwo ), info )
612 CALL dstein( n, work( indd ), work( inde ), m, w,
613 $ iwork( indibl ), iwork( indisp ), z, ldz,
614 $ work( indwk ), iwork( indiwo ), iwork( indifl ),
621 llwrkn = lwork - indwkn + 1
622 CALL dormtr(
'L', uplo,
'N', n, m, a, lda, work( indtau ), z,
623 $ ldz, work( indwkn ), llwrkn, iinfo )
630 IF( iscale.EQ.1 )
THEN
636 CALL dscal( imax, one / sigma, w, 1 )
649 IF( w( jj ).LT.tmp1 )
THEN
658 CALL dswap( n, z( 1, i ), 1, z( 1, j ), 1 )
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
subroutine dsterf(N, D, E, INFO)
DSTERF
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
subroutine xerbla(SRNAME, INFO)
XERBLA
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 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 dscal(N, DA, DX, INCX)
DSCAL
subroutine dswap(N, DX, INCX, DY, INCY)
DSWAP
subroutine dsytrd(UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO)
DSYTRD
subroutine dstebz(RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E, M, NSPLIT, W, IBLOCK, ISPLIT, WORK, IWORK, INFO)
DSTEBZ