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
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
logical function lsame(CA, CB)
LSAME
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
double precision function dlamch(CMACH)
DLAMCH
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
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 dswap(N, DX, INCX, DY, INCY)
DSWAP
subroutine dsytrd(UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO)
DSYTRD
integer function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
subroutine dstebz(RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E, M, NSPLIT, W, IBLOCK, ISPLIT, WORK, IWORK, INFO)
DSTEBZ