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 )