245 SUBROUTINE ssyevx( 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
260 INTEGER ifail( * ), iwork( * )
261 REAL a( lda, * ), w( * ), work( * ), z( ldz, * )
268 parameter( zero = 0.0e+0, one = 1.0e+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 REAL 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,
'SSYTRD', uplo, n, -1, -1, -1 )
341 nb = max( nb,
ilaenv( 1,
'SORMTR', uplo, n, -1, -1, -1 ) )
342 lwkopt = max( lwkmin, ( nb + 3 )*n )
346 IF( lwork.LT.lwkmin .AND. .NOT.lquery )
351 CALL
xerbla(
'SSYEVX', -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 =
slamch(
'Safe minimum' )
382 eps =
slamch(
'Precision' )
383 smlnum = safmin / eps
384 bignum = one / smlnum
385 rmin = sqrt( smlnum )
386 rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
396 anrm =
slansy(
'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
sscal( n-
j+1, sigma, a(
j,
j ), 1 )
411 CALL
sscal(
j, sigma, a( 1,
j ), 1 )
415 $ abstll = abstol*sigma
428 llwork = lwork - indwrk + 1
429 CALL
ssytrd( 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
scopy( n, work( indd ), 1, w, 1 )
445 IF( .NOT.wantz )
THEN
446 CALL
scopy( n-1, work( inde ), 1, work( indee ), 1 )
447 CALL
ssterf( n, w, work( indee ), info )
449 CALL
slacpy(
'A', n, n, a, lda, z, ldz )
450 CALL
sorgtr( uplo, n, z, ldz, work( indtau ),
451 $ work( indwrk ), llwork, iinfo )
452 CALL
scopy( n-1, work( inde ), 1, work( indee ), 1 )
453 CALL
ssteqr( jobz, n, w, work( indee ), z, ldz,
454 $ work( indwrk ), info )
478 CALL
sstebz( 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
sstein( 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
sormtr(
'L', uplo,
'N', n, m, a, lda, work( indtau ), z,
494 $ ldz, work( indwkn ), llwrkn, iinfo )
500 IF( iscale.EQ.1 )
THEN
506 CALL
sscal( 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
sswap( n, z( 1, i ), 1, z( 1,
j ), 1 )
532 ifail( i ) = ifail(
j )
REAL function slansy(NORM, UPLO, N, A, LDA, WORK)
SLANSY 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.
LOGICAL function lsame(CA, CB)
LSAME
subroutine sormtr(SIDE, UPLO, TRANS, M, N, A, LDA, TAU, C, LDC, WORK, LWORK, INFO)
SORMTR
subroutine sswap(N, SX, INCX, SY, INCY)
SSWAP
subroutine sorgtr(UPLO, N, A, LDA, TAU, WORK, LWORK, INFO)
SORGTR
REAL function slamch(CMACH)
SLAMCH
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
subroutine ssytrd(UPLO, N, A, LDA, D, E, TAU, WORK, LWORK, INFO)
SSYTRD
subroutine sstein(N, D, E, M, W, IBLOCK, ISPLIT, Z, LDZ, WORK, IWORK, IFAIL, INFO)
SSTEIN
subroutine ssyevx(JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, LWORK, IWORK, IFAIL, INFO)
SSYEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for SY matrices ...
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
INTEGER function ilaenv(ISPEC, NAME, OPTS, N1, N2, N3, N4)
subroutine sstebz(RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E, M, NSPLIT, W, IBLOCK, ISPLIT, WORK, IWORK, INFO)
SSTEBZ
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine ssterf(N, D, E, INFO)
SSTERF
subroutine ssteqr(COMPZ, N, D, E, Z, LDZ, WORK, INFO)
SSTEQR
subroutine sscal(N, SA, SX, INCX)
SSCAL