331 SUBROUTINE dsyevr( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU,
332 $ ABSTOL, M, W, Z, LDZ, ISUPPZ, WORK, LWORK,
333 $ IWORK, LIWORK, INFO )
340 CHARACTER JOBZ, RANGE, UPLO
341 INTEGER IL, INFO, IU, LDA, LDZ, LIWORK, LWORK, M, N
342 DOUBLE PRECISION ABSTOL, VL, VU
345 INTEGER ISUPPZ( * ), IWORK( * )
346 DOUBLE PRECISION A( LDA, * ), W( * ), WORK( * ), Z( LDZ, * )
352 DOUBLE PRECISION ZERO, ONE, TWO
353 PARAMETER ( ZERO = 0.0d+0, one = 1.0d+0, two = 2.0d+0 )
356 LOGICAL ALLEIG, INDEIG, LOWER, LQUERY, VALEIG, WANTZ,
359 INTEGER I, IEEEOK, IINFO, IMAX, INDD, INDDD, INDE,
360 $ indee, indibl, indifl, indisp, indiwo, indtau,
361 $ indwk, indwkn, iscale, j, jj, liwmin,
362 $ llwork, llwrkn, lwkopt, lwmin, nb, nsplit
363 DOUBLE PRECISION ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
364 $ SIGMA, SMLNUM, TMP1, VLL, VUU
369 DOUBLE PRECISION DLAMCH, DLANSY
370 EXTERNAL lsame, ilaenv, dlamch, dlansy
377 INTRINSIC max, min, sqrt
383 ieeeok = ilaenv( 10,
'DSYEVR',
'N', 1, 2, 3, 4 )
385 lower = lsame( uplo,
'L' )
386 wantz = lsame( jobz,
'V' )
387 alleig = lsame( range,
'A' )
388 valeig = lsame( range,
'V' )
389 indeig = lsame( range,
'I' )
391 lquery = ( ( lwork.EQ.-1 ) .OR. ( liwork.EQ.-1 ) )
393 lwmin = max( 1, 26*n )
394 liwmin = max( 1, 10*n )
397 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN
399 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN
401 ELSE IF( .NOT.( lower .OR. lsame( uplo,
'U' ) ) )
THEN
403 ELSE IF( n.LT.0 )
THEN
405 ELSE IF( lda.LT.max( 1, n ) )
THEN
409 IF( n.GT.0 .AND. vu.LE.vl )
411 ELSE IF( indeig )
THEN
412 IF( il.LT.1 .OR. il.GT.max( 1, n ) )
THEN
414 ELSE IF( iu.LT.min( n, il ) .OR. iu.GT.n )
THEN
420 IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
422 ELSE IF( lwork.LT.lwmin .AND. .NOT.lquery )
THEN
424 ELSE IF( liwork.LT.liwmin .AND. .NOT.lquery )
THEN
430 nb = ilaenv( 1,
'DSYTRD', uplo, n, -1, -1, -1 )
431 nb = max( nb, ilaenv( 1,
'DORMTR', uplo, n, -1, -1, -1 ) )
432 lwkopt = max( ( nb+1 )*n, lwmin )
438 CALL xerbla(
'DSYEVR', -info )
440 ELSE IF( lquery )
THEN
454 IF( alleig .OR. indeig )
THEN
458 IF( vl.LT.a( 1, 1 ) .AND. vu.GE.a( 1, 1 ) )
THEN
473 safmin = dlamch(
'Safe minimum' )
474 eps = dlamch(
'Precision' )
475 smlnum = safmin / eps
476 bignum = one / smlnum
477 rmin = sqrt( smlnum )
478 rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
488 anrm = dlansy(
'M', uplo, n, a, lda, work )
489 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
492 ELSE IF( anrm.GT.rmax )
THEN
496 IF( iscale.EQ.1 )
THEN
499 CALL dscal( n-j+1, sigma, a( j, j ), 1 )
503 CALL dscal( j, sigma, a( 1, j ), 1 )
507 $ abstll = abstol*sigma
534 llwork = lwork - indwk + 1
553 CALL dsytrd( uplo, n, a, lda, work( indd ), work( inde ),
554 $ work( indtau ), work( indwk ), llwork, iinfo )
559 IF( ( alleig .OR. ( indeig .AND. il.EQ.1 .AND. iu.EQ.n ) ) .AND.
561 IF( .NOT.wantz )
THEN
562 CALL dcopy( n, work( indd ), 1, w, 1 )
563 CALL dcopy( n-1, work( inde ), 1, work( indee ), 1 )
564 CALL dsterf( n, w, work( indee ), info )
566 CALL dcopy( n-1, work( inde ), 1, work( indee ), 1 )
567 CALL dcopy( n, work( indd ), 1, work( inddd ), 1 )
569 IF (abstol .LE. two*n*eps)
THEN
574 CALL dstemr( jobz,
'A', n, work( inddd ), work( indee ),
575 $ vl, vu, il, iu, m, w, z, ldz, n, isuppz,
576 $ tryrac, work( indwk ), lwork, iwork, liwork,
584 IF( wantz .AND. info.EQ.0 )
THEN
586 llwrkn = lwork - indwkn + 1
587 CALL dormtr(
'L', uplo,
'N', n, m, a, lda,
588 $ work( indtau ), z, ldz, work( indwkn ),
612 CALL dstebz( range, order, n, vll, vuu, il, iu, abstll,
613 $ work( indd ), work( inde ), m, nsplit, w,
614 $ iwork( indibl ), iwork( indisp ), work( indwk ),
615 $ iwork( indiwo ), info )
618 CALL dstein( n, work( indd ), work( inde ), m, w,
619 $ iwork( indibl ), iwork( indisp ), z, ldz,
620 $ work( indwk ), iwork( indiwo ), iwork( indifl ),
627 llwrkn = lwork - indwkn + 1
628 CALL dormtr(
'L', uplo,
'N', n, m, a, lda, work( indtau ), z,
629 $ ldz, work( indwkn ), llwrkn, iinfo )
636 IF( iscale.EQ.1 )
THEN
642 CALL dscal( imax, one / sigma, w, 1 )
655 IF( w( jj ).LT.tmp1 )
THEN
664 CALL dswap( n, z( 1, i ), 1, z( 1, j ), 1 )
subroutine xerbla(srname, info)
subroutine dcopy(n, dx, incx, dy, incy)
DCOPY
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 dsytrd(uplo, n, a, lda, d, e, tau, work, lwork, info)
DSYTRD
subroutine dscal(n, da, dx, incx)
DSCAL
subroutine dstebz(range, order, n, vl, vu, il, iu, abstol, d, e, m, nsplit, w, iblock, isplit, work, iwork, info)
DSTEBZ
subroutine dstein(n, d, e, m, w, iblock, isplit, z, ldz, work, iwork, ifail, info)
DSTEIN
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 dsterf(n, d, e, info)
DSTERF
subroutine dswap(n, dx, incx, dy, incy)
DSWAP
subroutine dormtr(side, uplo, trans, m, n, a, lda, tau, c, ldc, work, lwork, info)
DORMTR