257 SUBROUTINE dsbevx( 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
269 DOUBLE PRECISION abstol, vl, vu
272 INTEGER ifail( * ), iwork( * )
273 DOUBLE PRECISION ab( ldab, * ), q( ldq, * ), w( * ), work( * ),
280 DOUBLE PRECISION zero, one
281 parameter( zero = 0.0d0, one = 1.0d0 )
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 DOUBLE PRECISION 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(
'DSBEVX', -info )
365 IF( .NOT.( vl.LT.tmp1 .AND. vu.GE.tmp1 ) )
378 safmin =
dlamch(
'Safe minimum' )
379 eps =
dlamch(
'Precision' )
380 smlnum = safmin / eps
381 bignum = one / smlnum
382 rmin = sqrt( smlnum )
383 rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
396 anrm =
dlansb(
'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
dlascl(
'B', kd, kd, one, sigma, n, n, ab, ldab, info )
408 CALL
dlascl(
'Q', kd, kd, one, sigma, n, n, ab, ldab, info )
411 $ abstll = abstol*sigma
423 CALL
dsbtrd( 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
dcopy( n, work( indd ), 1, w, 1 )
439 IF( .NOT.wantz )
THEN
440 CALL
dcopy( n-1, work( inde ), 1, work( indee ), 1 )
441 CALL
dsterf( n, w, work( indee ), info )
443 CALL
dlacpy(
'A', n, n, q, ldq, z, ldz )
444 CALL
dcopy( n-1, work( inde ), 1, work( indee ), 1 )
445 CALL
dsteqr( jobz, n, w, work( indee ), z, ldz,
446 $ work( indwrk ), info )
470 CALL
dstebz( 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
dstein( n, work( indd ), work( inde ), m, w,
477 $ iwork( indibl ), iwork( indisp ), z, ldz,
478 $ work( indwrk ), iwork( indiwo ), ifail, info )
484 CALL
dcopy( n, z( 1,
j ), 1, work( 1 ), 1 )
485 CALL
dgemv(
'N', n, n, one, q, ldq, work, 1, zero,
493 IF( iscale.EQ.1 )
THEN
499 CALL
dscal( 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
dswap( n, z( 1, i ), 1, z( 1,
j ), 1 )
525 ifail( i ) = ifail(
j )
subroutine dsteqr(COMPZ, N, D, E, Z, LDZ, WORK, INFO)
DSTEQR
subroutine dstein(N, D, E, M, W, IBLOCK, ISPLIT, Z, LDZ, WORK, IWORK, IFAIL, INFO)
DSTEIN
subroutine dsterf(N, D, E, INFO)
DSTERF
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
subroutine dsbtrd(VECT, UPLO, N, KD, AB, LDAB, D, E, Q, LDQ, WORK, INFO)
DSBTRD
subroutine xerbla(SRNAME, INFO)
XERBLA
subroutine dlascl(TYPE, KL, KU, CFROM, CTO, M, N, A, LDA, INFO)
DLASCL multiplies a general rectangular matrix by a real scalar defined as cto/cfrom.
double precision function dlansb(NORM, UPLO, N, K, AB, LDAB, WORK)
DLANSB 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.
logical function lsame(CA, CB)
LSAME
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
subroutine dsbevx(JOBZ, RANGE, UPLO, N, KD, AB, LDAB, Q, LDQ, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, IWORK, IFAIL, INFO)
DSBEVX computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER matric...
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
subroutine dswap(N, DX, INCX, DY, INCY)
DSWAP
subroutine dstebz(RANGE, ORDER, N, VL, VU, IL, IU, ABSTOL, D, E, M, NSPLIT, W, IBLOCK, ISPLIT, WORK, IWORK, INFO)
DSTEBZ
subroutine dgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
DGEMV