264 SUBROUTINE ssbevx( JOBZ, RANGE, UPLO, N, KD, AB, LDAB, Q, LDQ, VL,
265 $ vu, il, iu, abstol, m, w, z, ldz, work, iwork,
274 CHARACTER JOBZ, RANGE, UPLO
275 INTEGER IL, INFO, IU, KD, LDAB, LDQ, LDZ, M, N
279 INTEGER IFAIL( * ), IWORK( * )
280 REAL AB( ldab, * ), Q( ldq, * ), W( * ), WORK( * ),
288 parameter ( zero = 0.0e0, one = 1.0e0 )
291 LOGICAL ALLEIG, INDEIG, LOWER, TEST, VALEIG, WANTZ
293 INTEGER I, IINFO, IMAX, INDD, INDE, INDEE, INDIBL,
294 $ indisp, indiwo, indwrk, iscale, itmp1, j, jj,
296 REAL ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
297 $ sigma, smlnum, tmp1, vll, vuu
302 EXTERNAL lsame, slamch, slansb
309 INTRINSIC max, min, sqrt
315 wantz = lsame( jobz,
'V' )
316 alleig = lsame( range,
'A' )
317 valeig = lsame( range,
'V' )
318 indeig = lsame( range,
'I' )
319 lower = lsame( uplo,
'L' )
322 IF( .NOT.( wantz .OR. lsame( jobz,
'N' ) ) )
THEN
324 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN
326 ELSE IF( .NOT.( lower .OR. lsame( uplo,
'U' ) ) )
THEN
328 ELSE IF( n.LT.0 )
THEN
330 ELSE IF( kd.LT.0 )
THEN
332 ELSE IF( ldab.LT.kd+1 )
THEN
334 ELSE IF( wantz .AND. ldq.LT.max( 1, n ) )
THEN
338 IF( n.GT.0 .AND. vu.LE.vl )
340 ELSE IF( indeig )
THEN
341 IF( il.LT.1 .OR. il.GT.max( 1, n ) )
THEN
343 ELSE IF( iu.LT.min( n, il ) .OR. iu.GT.n )
THEN
349 IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
354 CALL xerbla(
'SSBEVX', -info )
372 IF( .NOT.( vl.LT.tmp1 .AND. vu.GE.tmp1 ) )
385 safmin = slamch(
'Safe minimum' )
386 eps = slamch(
'Precision' )
387 smlnum = safmin / eps
388 bignum = one / smlnum
389 rmin = sqrt( smlnum )
390 rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
403 anrm = slansb(
'M', uplo, n, kd, ab, ldab, work )
404 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
407 ELSE IF( anrm.GT.rmax )
THEN
411 IF( iscale.EQ.1 )
THEN
413 CALL slascl(
'B', kd, kd, one, sigma, n, n, ab, ldab, info )
415 CALL slascl(
'Q', kd, kd, one, sigma, n, n, ab, ldab, info )
418 $ abstll = abstol*sigma
430 CALL ssbtrd( jobz, uplo, n, kd, ab, ldab, work( indd ),
431 $ work( inde ), q, ldq, work( indwrk ), iinfo )
439 IF (il.EQ.1 .AND. iu.EQ.n)
THEN
443 IF ((alleig .OR. test) .AND. (abstol.LE.zero))
THEN
444 CALL scopy( n, work( indd ), 1, w, 1 )
446 IF( .NOT.wantz )
THEN
447 CALL scopy( n-1, work( inde ), 1, work( indee ), 1 )
448 CALL ssterf( n, w, work( indee ), info )
450 CALL slacpy(
'A', n, n, q, ldq, z, ldz )
451 CALL scopy( n-1, work( inde ), 1, work( indee ), 1 )
452 CALL ssteqr( jobz, n, w, work( indee ), z, ldz,
453 $ work( indwrk ), info )
477 CALL sstebz( range, order, n, vll, vuu, il, iu, abstll,
478 $ work( indd ), work( inde ), m, nsplit, w,
479 $ iwork( indibl ), iwork( indisp ), work( indwrk ),
480 $ iwork( indiwo ), info )
483 CALL sstein( n, work( indd ), work( inde ), m, w,
484 $ iwork( indibl ), iwork( indisp ), z, ldz,
485 $ work( indwrk ), iwork( indiwo ), ifail, info )
491 CALL scopy( n, z( 1, j ), 1, work( 1 ), 1 )
492 CALL sgemv(
'N', n, n, one, q, ldq, work, 1, zero,
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 )
subroutine ssteqr(COMPZ, N, D, E, Z, LDZ, WORK, INFO)
SSTEQR
subroutine sgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
SGEMV
subroutine sstein(N, D, E, M, W, IBLOCK, ISPLIT, Z, LDZ, WORK, IWORK, IFAIL, INFO)
SSTEIN
subroutine xerbla(SRNAME, INFO)
XERBLA
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 ssbtrd(VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ, WORK, INFO)
SSBTRD
subroutine sstebz(RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E, M, NSPLIT, W, IBLOCK, ISPLIT, WORK, IWORK, INFO)
SSTEBZ
subroutine sscal(N, SA, SX, INCX)
SSCAL
subroutine sswap(N, SX, INCX, SY, INCY)
SSWAP
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 slacpy(UPLO, M, N, A, LDA, B, LDB)
SLACPY copies all or part of one two-dimensional array to another.
subroutine ssterf(N, D, E, INFO)
SSTERF
subroutine scopy(N, SX, INCX, SY, INCY)
SCOPY