284 SUBROUTINE dsbgvx( JOBZ, RANGE, UPLO, N, KA, KB, AB, LDAB, BB,
285 $ ldbb, q, ldq, vl, vu, il, iu, abstol, m, w, z,
286 $ ldz, work, iwork, ifail, info )
294 CHARACTER jobz, range, uplo
295 INTEGER il, info, iu, ka, kb, ldab, ldbb, ldq, ldz, m,
297 DOUBLE PRECISION abstol, vl, vu
300 INTEGER ifail( * ), iwork( * )
301 DOUBLE PRECISION ab( ldab, * ), bb( ldbb, * ), q( ldq, * ),
302 $ w( * ), work( * ), z( ldz, * )
308 DOUBLE PRECISION zero, one
309 parameter( zero = 0.0d+0, one = 1.0d+0 )
312 LOGICAL alleig, indeig, test, upper, valeig, wantz
313 CHARACTER order, vect
314 INTEGER i, iinfo, indd, inde, indee, indibl, indisp,
315 $ indiwo, indwrk, itmp1,
j, jj, nsplit
316 DOUBLE PRECISION tmp1
333 wantz =
lsame( jobz,
'V' )
334 upper =
lsame( uplo,
'U' )
335 alleig =
lsame( range,
'A' )
336 valeig =
lsame( range,
'V' )
337 indeig =
lsame( range,
'I' )
340 IF( .NOT.( wantz .OR.
lsame( jobz,
'N' ) ) )
THEN
342 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN
344 ELSE IF( .NOT.( upper .OR.
lsame( uplo,
'L' ) ) )
THEN
346 ELSE IF( n.LT.0 )
THEN
348 ELSE IF( ka.LT.0 )
THEN
350 ELSE IF( kb.LT.0 .OR. kb.GT.ka )
THEN
352 ELSE IF( ldab.LT.ka+1 )
THEN
354 ELSE IF( ldbb.LT.kb+1 )
THEN
356 ELSE IF( ldq.LT.1 .OR. ( wantz .AND. ldq.LT.n ) )
THEN
360 IF( n.GT.0 .AND. vu.LE.vl )
362 ELSE IF( indeig )
THEN
363 IF( il.LT.1 .OR. il.GT.max( 1, n ) )
THEN
365 ELSE IF ( iu.LT.min( n, il ) .OR. iu.GT.n )
THEN
371 IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
THEN
377 CALL
xerbla(
'DSBGVX', -info )
389 CALL
dpbstf( uplo, n, kb, bb, ldbb, info )
397 CALL
dsbgst( jobz, uplo, n, ka, kb, ab, ldab, bb, ldbb, q, ldq,
410 CALL
dsbtrd( vect, uplo, n, ka, ab, ldab, work( indd ),
411 $ work( inde ), q, ldq, work( indwrk ), iinfo )
419 IF( il.EQ.1 .AND. iu.EQ.n )
THEN
423 IF( ( alleig .OR. test ) .AND. ( abstol.LE.zero ) )
THEN
424 CALL
dcopy( n, work( indd ), 1, w, 1 )
426 CALL
dcopy( n-1, work( inde ), 1, work( indee ), 1 )
427 IF( .NOT.wantz )
THEN
428 CALL
dsterf( n, w, work( indee ), info )
430 CALL
dlacpy(
'A', n, n, q, ldq, z, ldz )
431 CALL
dsteqr( jobz, n, w, work( indee ), z, ldz,
432 $ work( indwrk ), info )
457 CALL
dstebz( range, order, n, vl, vu, il, iu, abstol,
458 $ work( indd ), work( inde ), m, nsplit, w,
459 $ iwork( indibl ), iwork( indisp ), work( indwrk ),
460 $ iwork( indiwo ), info )
463 CALL
dstein( n, work( indd ), work( inde ), m, w,
464 $ iwork( indibl ), iwork( indisp ), z, ldz,
465 $ work( indwrk ), iwork( indiwo ), ifail, info )
471 CALL
dcopy( n, z( 1,
j ), 1, work( 1 ), 1 )
472 CALL
dgemv(
'N', n, n, one, q, ldq, work, 1, zero,
487 IF( w( jj ).LT.tmp1 )
THEN
494 itmp1 = iwork( indibl+i-1 )
496 iwork( indibl+i-1 ) = iwork( indibl+
j-1 )
498 iwork( indibl+
j-1 ) = itmp1
499 CALL
dswap( n, z( 1, i ), 1, z( 1,
j ), 1 )
502 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 dpbstf(UPLO, N, KD, AB, LDAB, INFO)
DPBSTF
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
logical function lsame(CA, CB)
LSAME
set ue cd $ADTTMP cat<< EOF > tmp f Program LinearEquations Implicit none Real j
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
subroutine dsbgvx(JOBZ, RANGE, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, Q, LDQ, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, IWORK, IFAIL, INFO)
DSBGST
subroutine dswap(N, DX, INCX, DY, INCY)
DSWAP
subroutine dsbgst(VECT, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, X, LDX, WORK, INFO)
DSBGST
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