321 SUBROUTINE dsbevx_2stage( JOBZ, RANGE, UPLO, N, KD, AB, LDAB, Q,
322 $ ldq, vl, vu, il, iu, abstol, m, w, z,
323 $ ldz, work, lwork, iwork, ifail, info )
333 CHARACTER JOBZ, RANGE, UPLO
334 INTEGER IL, INFO, IU, KD, LDAB, LDQ, LDZ, M, N, LWORK
335 DOUBLE PRECISION ABSTOL, VL, VU
338 INTEGER IFAIL( * ), IWORK( * )
339 DOUBLE PRECISION AB( ldab, * ), Q( ldq, * ), W( * ), WORK( * ),
346 DOUBLE PRECISION ZERO, ONE
347 parameter ( zero = 0.0d0, one = 1.0d0 )
350 LOGICAL ALLEIG, INDEIG, LOWER, TEST, VALEIG, WANTZ,
353 INTEGER I, IINFO, IMAX, INDD, INDE, INDEE, INDIBL,
354 $ indisp, indiwo, indwrk, iscale, itmp1, j, jj,
355 $ llwork, lwmin, lhtrd, lwtrd, ib, indhous,
357 DOUBLE PRECISION ABSTLL, ANRM, BIGNUM, EPS, RMAX, RMIN, SAFMIN,
358 $ sigma, smlnum, tmp1, vll, vuu
363 DOUBLE PRECISION DLAMCH, DLANSB
364 EXTERNAL lsame, dlamch, dlansb, ilaenv
372 INTRINSIC max, min, sqrt
378 wantz = lsame( jobz,
'V' )
379 alleig = lsame( range,
'A' )
380 valeig = lsame( range,
'V' )
381 indeig = lsame( range,
'I' )
382 lower = lsame( uplo,
'L' )
383 lquery = ( lwork.EQ.-1 )
386 IF( .NOT.( lsame( jobz,
'N' ) ) )
THEN
388 ELSE IF( .NOT.( alleig .OR. valeig .OR. indeig ) )
THEN
390 ELSE IF( .NOT.( lower .OR. lsame( uplo,
'U' ) ) )
THEN
392 ELSE IF( n.LT.0 )
THEN
394 ELSE IF( kd.LT.0 )
THEN
396 ELSE IF( ldab.LT.kd+1 )
THEN
398 ELSE IF( wantz .AND. ldq.LT.max( 1, n ) )
THEN
402 IF( n.GT.0 .AND. vu.LE.vl )
404 ELSE IF( indeig )
THEN
405 IF( il.LT.1 .OR. il.GT.max( 1, n ) )
THEN
407 ELSE IF( iu.LT.min( n, il ) .OR. iu.GT.n )
THEN
413 IF( ldz.LT.1 .OR. ( wantz .AND. ldz.LT.n ) )
422 ib = ilaenv( 18,
'DSYTRD_SB2ST', jobz, n, kd, -1, -1 )
423 lhtrd = ilaenv( 19,
'DSYTRD_SB2ST', jobz, n, kd, ib, -1 )
424 lwtrd = ilaenv( 20,
'DSYTRD_SB2ST', jobz, n, kd, ib, -1 )
425 lwmin = 2*n + lhtrd + lwtrd
429 IF( lwork.LT.lwmin .AND. .NOT.lquery )
434 CALL xerbla(
'DSBEVX_2STAGE ', -info )
436 ELSE IF( lquery )
THEN
454 IF( .NOT.( vl.LT.tmp1 .AND. vu.GE.tmp1 ) )
467 safmin = dlamch(
'Safe minimum' )
468 eps = dlamch(
'Precision' )
469 smlnum = safmin / eps
470 bignum = one / smlnum
471 rmin = sqrt( smlnum )
472 rmax = min( sqrt( bignum ), one / sqrt( sqrt( safmin ) ) )
485 anrm = dlansb(
'M', uplo, n, kd, ab, ldab, work )
486 IF( anrm.GT.zero .AND. anrm.LT.rmin )
THEN
489 ELSE IF( anrm.GT.rmax )
THEN
493 IF( iscale.EQ.1 )
THEN
495 CALL dlascl(
'B', kd, kd, one, sigma, n, n, ab, ldab, info )
497 CALL dlascl(
'Q', kd, kd, one, sigma, n, n, ab, ldab, info )
500 $ abstll = abstol*sigma
512 indwrk = indhous + lhtrd
513 llwork = lwork - indwrk + 1
515 CALL dsytrd_sb2st(
"N", jobz, uplo, n, kd, ab, ldab, work( indd ),
516 $ work( inde ), work( indhous ), lhtrd,
517 $ work( indwrk ), llwork, iinfo )
525 IF (il.EQ.1 .AND. iu.EQ.n)
THEN
529 IF ((alleig .OR. test) .AND. (abstol.LE.zero))
THEN
530 CALL dcopy( n, work( indd ), 1, w, 1 )
532 IF( .NOT.wantz )
THEN
533 CALL dcopy( n-1, work( inde ), 1, work( indee ), 1 )
534 CALL dsterf( n, w, work( indee ), info )
536 CALL dlacpy(
'A', n, n, q, ldq, z, ldz )
537 CALL dcopy( n-1, work( inde ), 1, work( indee ), 1 )
538 CALL dsteqr( jobz, n, w, work( indee ), z, ldz,
539 $ work( indwrk ), info )
563 CALL dstebz( range, order, n, vll, vuu, il, iu, abstll,
564 $ work( indd ), work( inde ), m, nsplit, w,
565 $ iwork( indibl ), iwork( indisp ), work( indwrk ),
566 $ iwork( indiwo ), info )
569 CALL dstein( n, work( indd ), work( inde ), m, w,
570 $ iwork( indibl ), iwork( indisp ), z, ldz,
571 $ work( indwrk ), iwork( indiwo ), ifail, info )
577 CALL dcopy( n, z( 1, j ), 1, work( 1 ), 1 )
578 CALL dgemv(
'N', n, n, one, q, ldq, work, 1, zero,
586 IF( iscale.EQ.1 )
THEN
592 CALL dscal( imax, one / sigma, w, 1 )
603 IF( w( jj ).LT.tmp1 )
THEN
610 itmp1 = iwork( indibl+i-1 )
612 iwork( indibl+i-1 ) = iwork( indibl+j-1 )
614 iwork( indibl+j-1 ) = itmp1
615 CALL dswap( n, z( 1, i ), 1, z( 1, j ), 1 )
618 ifail( i ) = ifail( j )
subroutine dlacpy(UPLO, M, N, A, LDA, B, LDB)
DLACPY copies all or part of one two-dimensional array to another.
subroutine dsteqr(COMPZ, N, D, E, Z, LDZ, WORK, INFO)
DSTEQR
subroutine dcopy(N, DX, INCX, DY, INCY)
DCOPY
subroutine dgemv(TRANS, M, N, ALPHA, A, LDA, X, INCX, BETA, Y, INCY)
DGEMV
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.
subroutine dstein(N, D, E, M, W, IBLOCK, ISPLIT, Z, LDZ, WORK, IWORK, IFAIL, INFO)
DSTEIN
subroutine dsterf(N, D, E, INFO)
DSTERF
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 xerbla(SRNAME, INFO)
XERBLA
subroutine dscal(N, DA, DX, INCX)
DSCAL
subroutine dsbevx_2stage(JOBZ, RANGE, UPLO, N, KD, AB, LDAB, Q, LDQ, VL, VU, IL, IU, ABSTOL, M, W, Z, LDZ, WORK, LWORK, IWORK, IFAIL, INFO)
DSBEVX_2STAGE computes the eigenvalues and, optionally, the left and/or right eigenvectors for OTHER...