257 SUBROUTINE ssbevx( JOBZ, RANGE, UPLO, N, KD, AB, LDAB, Q, LDQ, VL,
258 $ vu, il, iu, abstol, m, w, z, ldz, work, iwork,
267 CHARACTER jobz, range, uplo
268 INTEGER il, info, iu, kd, ldab, ldq, ldz, m, n
272 INTEGER ifail( * ), iwork( * )
273 REAL ab( ldab, * ), q( ldq, * ), w( * ), work( * ),
281 parameter( zero = 0.0e0, one = 1.0e0 )
284 LOGICAL alleig, indeig, lower, test, valeig, wantz
286 INTEGER i, iinfo, imax, indd, inde, indee, indibl,
287 $ indisp, indiwo, indwrk, iscale, itmp1,
j, jj,
289 REAL abstll, anrm, bignum, eps, rmax, rmin, safmin,
290 $ sigma, smlnum, tmp1, vll, vuu
302 INTRINSIC max, min, sqrt
308 wantz =
lsame( jobz,
'V' )
309 alleig =
lsame( range,
'A' )
310 valeig =
lsame( range,
'V' )
311 indeig =
lsame( range,
'I' )
312 lower =
lsame( uplo,
'L' )
315 IF( .NOT.( wantz .OR.
lsame( jobz,
'N' ) ) )
THEN
317 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN
319 ELSE IF( .NOT.( lower .OR.
lsame( uplo,
'U' ) ) )
THEN
321 ELSE IF( n.LT.0 )
THEN
323 ELSE IF( kd.LT.0 )
THEN
325 ELSE IF( ldab.LT.kd+1 )
THEN
327 ELSE IF( wantz .AND. ldq.LT.max( 1, n ) )
THEN
331 IF( n.GT.0 .AND. vu.LE.vl )
333 ELSE IF( indeig )
THEN
334 IF( il.LT.1 .OR. il.GT.max( 1, n ) )
THEN
336 ELSE IF( iu.LT.min( n, il ) .OR. iu.GT.n )
THEN
342 IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
347 CALL
xerbla(
'SSBEVX', -info )
365 IF( .NOT.( vl.LT.tmp1 .AND. vu.GE.tmp1 ) )
378 safmin =
slamch(
'Safe minimum' )
379 eps =
slamch(
'Precision' )
380 smlnum = safmin / eps
381 bignum = one / smlnum
382 rmin = sqrt( smlnum )
383 rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
396 anrm =
slansb(
'M', uplo, n, kd, ab, ldab, work )
397 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
400 ELSE IF( anrm.GT.rmax )
THEN
404 IF( iscale.EQ.1 )
THEN
406 CALL
slascl(
'B', kd, kd, one, sigma, n, n, ab, ldab, info )
408 CALL
slascl(
'Q', kd, kd, one, sigma, n, n, ab, ldab, info )
411 $ abstll = abstol*sigma
423 CALL
ssbtrd( jobz, uplo, n, kd, ab, ldab, work( indd ),
424 $ work( inde ), q, ldq, work( indwrk ), iinfo )
432 IF (il.EQ.1 .AND. iu.EQ.n)
THEN
436 IF ((alleig .OR. test) .AND. (abstol.LE.zero))
THEN
437 CALL
scopy( n, work( indd ), 1, w, 1 )
439 IF( .NOT.wantz )
THEN
440 CALL
scopy( n-1, work( inde ), 1, work( indee ), 1 )
441 CALL
ssterf( n, w, work( indee ), info )
443 CALL
slacpy(
'A', n, n, q, ldq, z, ldz )
444 CALL
scopy( n-1, work( inde ), 1, work( indee ), 1 )
445 CALL
ssteqr( jobz, n, w, work( indee ), z, ldz,
446 $ work( indwrk ), info )
470 CALL
sstebz( range, order, n, vll, vuu, il, iu, abstll,
471 $ work( indd ), work( inde ), m, nsplit, w,
472 $ iwork( indibl ), iwork( indisp ), work( indwrk ),
473 $ iwork( indiwo ), info )
476 CALL
sstein( n, work( indd ), work( inde ), m, w,
477 $ iwork( indibl ), iwork( indisp ), z, ldz,
478 $ work( indwrk ), iwork( indiwo ), ifail, info )
484 CALL
scopy( n, z( 1,
j ), 1, work( 1 ), 1 )
485 CALL
sgemv(
'N', n, n, one, q, ldq, work, 1, zero,
493 IF( iscale.EQ.1 )
THEN
499 CALL
sscal( imax, one / sigma, w, 1 )
510 IF( w( jj ).LT.tmp1 )
THEN
517 itmp1 = iwork( indibl+i-1 )
519 iwork( indibl+i-1 ) = iwork( indibl+
j-1 )
521 iwork( indibl+
j-1 ) = itmp1
522 CALL
sswap( n, z( 1, i ), 1, z( 1,
j ), 1 )
525 ifail( i ) = ifail(
j )
subroutine sswap(N, SX, INCX, SY, INCY)
SSWAP
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY
logical function lsame(CA, CB)
LSAME
real function slansb(NORM, UPLO, N, K, AB, LDAB, WORK)
SLANSB returns the value of the 1-norm, or the Frobenius norm, or the infinity norm, or the element of largest absolute value of a symmetric band matrix.
subroutine sstein(N, D, E, M, W, IBLOCK, ISPLIT, Z, LDZ, WORK, IWORK, IFAIL, INFO)
SSTEIN
subroutine sgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
SGEMV
subroutine ssbevx(JOBZ, RANGE, UPLO, N, KD, AB, LDAB, Q, LDQ, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, IWORK, IFAIL, INFO)
SSBEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matric...
subroutine slascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
SLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
subroutine slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
subroutine sstebz(RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E, M, NSPLIT, W, IBLOCK, ISPLIT, WORK, IWORK, INFO)
SSTEBZ
real function slamch(CMACH)
SLAMCH
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 ssbtrd(VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ, WORK, INFO)
SSBTRD
subroutine sscal(N, SA, SX, INCX)
SSCAL