dstech()

subroutine dstech	(	integer	n,
		double precision, dimension( * )	a,
		double precision, dimension( * )	b,
		double precision, dimension( * )	eig,
		double precision	tol,
		double precision, dimension( * )	work,
		integer	info )

DSTECH

Purpose:

!>
!>    Let T be the tridiagonal matrix with diagonal entries A(1) ,...,
!>    A(N) and offdiagonal entries B(1) ,..., B(N-1)).  DSTECH checks to
!>    see if EIG(1) ,..., EIG(N) are indeed accurate eigenvalues of T.
!>    It does this by expanding each EIG(I) into an interval
!>    [SVD(I) - EPS, SVD(I) + EPS], merging overlapping intervals if
!>    any, and using Sturm sequences to count and verify whether each
!>    resulting interval has the correct number of eigenvalues (using
!>    DSTECT).  Here EPS = TOL*MAZHEPS*MAXEIG, where MACHEPS is the
!>    machine precision and MAXEIG is the absolute value of the largest
!>    eigenvalue. If each interval contains the correct number of
!>    eigenvalues, INFO = 0 is returned, otherwise INFO is the index of
!>    the first eigenvalue in the first bad interval.
!> 

Parameters

[in]	N	!> N is INTEGER !> The dimension of the tridiagonal matrix T. !>
[in]	A	!> A is DOUBLE PRECISION array, dimension (N) !> The diagonal entries of the tridiagonal matrix T. !>
[in]	B	!> B is DOUBLE PRECISION array, dimension (N-1) !> The offdiagonal entries of the tridiagonal matrix T. !>
[in]	EIG	!> EIG is DOUBLE PRECISION array, dimension (N) !> The purported eigenvalues to be checked. !>
[in]	TOL	!> TOL is DOUBLE PRECISION !> Error tolerance for checking, a multiple of the !> machine precision. !>
[out]	WORK	!> WORK is DOUBLE PRECISION array, dimension (N) !>
[out]	INFO	!> INFO is INTEGER !> 0 if the eigenvalues are all correct (to within !> 1 +- TOL*MAZHEPS*MAXEIG) !> >0 if the interval containing the INFO-th eigenvalue !> contains the incorrect number of eigenvalues. !>

Author

Univ. of Tennessee

Univ. of California Berkeley

Univ. of Colorado Denver

NAG Ltd.

Definition at line 100 of file dstech.f.

*
*  -- LAPACK test routine --
*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
*
*     .. Scalar Arguments ..
      INTEGER            INFO, N
      DOUBLE PRECISION   TOL
*     ..
*     .. Array Arguments ..
      DOUBLE PRECISION   A( * ), B( * ), EIG( * ), WORK( * )
*     ..
*
*  =====================================================================
*
*     .. Parameters ..
      DOUBLE PRECISION   ZERO
      parameter( zero = 0.0d0 )
*     ..
*     .. Local Scalars ..
      INTEGER            BPNT, COUNT, I, ISUB, J, NUML, NUMU, TPNT
      DOUBLE PRECISION   EMIN, EPS, LOWER, MX, TUPPR, UNFLEP, UPPER
*     ..
*     .. External Functions ..
      DOUBLE PRECISION   DLAMCH
      EXTERNAL           dlamch
*     ..
*     .. External Subroutines ..
      EXTERNAL           dstect
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          abs, max
*     ..
*     .. Executable Statements ..
*
*     Check input parameters
*
      info = 0
      IF( n.EQ.0 )
     $   RETURN
      IF( n.LT.0 ) THEN
         info = -1
         RETURN
      END IF
      IF( tol.LT.zero ) THEN
         info = -5
         RETURN
      END IF
*
*     Get machine constants
*
      eps = dlamch( 'Epsilon' )*dlamch( 'Base' )
      unflep = dlamch( 'Safe minimum' ) / eps
      eps = tol*eps
*
*     Compute maximum absolute eigenvalue, error tolerance
*
      mx = abs( eig( 1 ) )
      DO 10 i = 2, n
         mx = max( mx, abs( eig( i ) ) )
   10 CONTINUE
      eps = max( eps*mx, unflep )
*
*     Sort eigenvalues from EIG into WORK
*
      DO 20 i = 1, n
         work( i ) = eig( i )
   20 CONTINUE
      DO 40 i = 1, n - 1
         isub = 1
         emin = work( 1 )
         DO 30 j = 2, n + 1 - i
            IF( work( j ).LT.emin ) THEN
               isub = j
               emin = work( j )
            END IF
   30    CONTINUE
         IF( isub.NE.n+1-i ) THEN
            work( isub ) = work( n+1-i )
            work( n+1-i ) = emin
         END IF
   40 CONTINUE
*
*     TPNT points to singular value at right endpoint of interval
*     BPNT points to singular value at left  endpoint of interval
*
      tpnt = 1
      bpnt = 1
*
*     Begin loop over all intervals
*
   50 CONTINUE
      upper = work( tpnt ) + eps
      lower = work( bpnt ) - eps
*
*     Begin loop merging overlapping intervals
*
   60 CONTINUE
      IF( bpnt.EQ.n )
     $   GO TO 70
      tuppr = work( bpnt+1 ) + eps
      IF( tuppr.LT.lower )
     $   GO TO 70
*
*     Merge
*
      bpnt = bpnt + 1
      lower = work( bpnt ) - eps
      GO TO 60
   70 CONTINUE
*
*     Count singular values in interval [ LOWER, UPPER ]
*
      CALL dstect( n, a, b, lower, numl )
      CALL dstect( n, a, b, upper, numu )
      count = numu - numl
      IF( count.NE.bpnt-tpnt+1 ) THEN
*
*        Wrong number of singular values in interval
*
         info = tpnt
         GO TO 80
      END IF
      tpnt = bpnt + 1
      bpnt = tpnt
      IF( tpnt.LE.n )
     $   GO TO 50
   80 CONTINUE
      RETURN
*
*     End of DSTECH
*

Here is the call graph for this function:

Here is the caller graph for this function: