ssvdch.f

Go to the documentation of this file.

*> \brief \b SSVDCH
*
*  =========== DOCUMENTATION ===========
*
* Online html documentation available at
*            http://www.netlib.org/lapack/explore-html/
*
*  Definition:
*  ===========
*
*       SUBROUTINE SSVDCH( N, S, E, SVD, TOL, INFO )
*
*       .. Scalar Arguments ..
*       INTEGER            INFO, N
*       REAL               TOL
*       ..
*       .. Array Arguments ..
*       REAL               E( * ), S( * ), SVD( * )
*       ..
*
*
*> \par Purpose:
*  =============
*>
*> \verbatim
*>
*> SSVDCH checks to see if SVD(1) ,..., SVD(N) are accurate singular
*> values of the bidiagonal matrix B with diagonal entries
*> S(1) ,..., S(N) and superdiagonal entries E(1) ,..., E(N-1)).
*> It does this by expanding each SVD(I) into an interval
*> [SVD(I) * (1-EPS) , SVD(I) * (1+EPS)], merging overlapping intervals
*> if any, and using Sturm sequences to count and verify whether each
*> resulting interval has the correct number of singular values (using
*> SSVDCT). Here EPS=TOL*MAX(N/10,1)*MACHEP, where MACHEP is the
*> machine precision. The routine assumes the singular values are sorted
*> with SVD(1) the largest and SVD(N) smallest.  If each interval
*> contains the correct number of singular values, INFO = 0 is returned,
*> otherwise INFO is the index of the first singular value in the first
*> bad interval.
*> \endverbatim
*
*  Arguments:
*  ==========
*
*> \param[in] N
*> \verbatim
*>          N is INTEGER
*>          The dimension of the bidiagonal matrix B.
*> \endverbatim
*>
*> \param[in] S
*> \verbatim
*>          S is REAL array, dimension (N)
*>          The diagonal entries of the bidiagonal matrix B.
*> \endverbatim
*>
*> \param[in] E
*> \verbatim
*>          E is REAL array, dimension (N-1)
*>          The superdiagonal entries of the bidiagonal matrix B.
*> \endverbatim
*>
*> \param[in] SVD
*> \verbatim
*>          SVD is REAL array, dimension (N)
*>          The computed singular values to be checked.
*> \endverbatim
*>
*> \param[in] TOL
*> \verbatim
*>          TOL is REAL
*>          Error tolerance for checking, a multiplier of the
*>          machine precision.
*> \endverbatim
*>
*> \param[out] INFO
*> \verbatim
*>          INFO is INTEGER
*>          =0 if the singular values are all correct (to within
*>             1 +- TOL*MACHEPS)
*>          >0 if the interval containing the INFO-th singular value
*>             contains the incorrect number of singular values.
*> \endverbatim
*
*  Authors:
*  ========
*
*> \author Univ. of Tennessee
*> \author Univ. of California Berkeley
*> \author Univ. of Colorado Denver
*> \author NAG Ltd.
*
*> \ingroup single_eig
*
*  =====================================================================
      SUBROUTINE ssvdch( N, S, E, SVD, TOL, INFO )
*
*  -- 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
      REAL               TOL
*     ..
*     .. Array Arguments ..
      REAL               E( * ), S( * ), SVD( * )
*     ..
*
*  =====================================================================
*
*     .. Parameters ..
      REAL               ONE
      parameter( one = 1.0e0 )
      REAL               ZERO
      parameter( zero = 0.0e0 )
*     ..
*     .. Local Scalars ..
      INTEGER            BPNT, COUNT, NUML, NUMU, TPNT
      REAL               EPS, LOWER, OVFL, TUPPR, UNFL, UNFLEP, UPPER
*     ..
*     .. External Functions ..
      REAL               SLAMCH
      EXTERNAL           slamch
*     ..
*     .. External Subroutines ..
      EXTERNAL           ssvdct
*     ..
*     .. Intrinsic Functions ..
      INTRINSIC          max, sqrt
*     ..
*     .. Executable Statements ..
*
*     Get machine constants
*
      info = 0
      IF( n.LE.0 )
     $   RETURN
      unfl = slamch( 'Safe minimum' )
      ovfl = slamch( 'Overflow' )
      eps = slamch( 'Epsilon' )*slamch( 'Base' )
*
*     UNFLEP is chosen so that when an eigenvalue is multiplied by the
*     scale factor sqrt(OVFL)*sqrt(sqrt(UNFL))/MX in SSVDCT, it exceeds
*     sqrt(UNFL), which is the lower limit for SSVDCT.
*
      unflep = ( sqrt( sqrt( unfl ) ) / sqrt( ovfl ) )*svd( 1 ) +
     $         unfl / eps
*
*     The value of EPS works best when TOL .GE. 10.
*
      eps = tol*max( n / 10, 1 )*eps
*
*     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
*
   10 CONTINUE
      upper = ( one+eps )*svd( tpnt ) + unflep
      lower = ( one-eps )*svd( bpnt ) - unflep
      IF( lower.LE.unflep )
     $   lower = -upper
*
*     Begin loop merging overlapping intervals
*
   20 CONTINUE
      IF( bpnt.EQ.n )
     $   GO TO 30
      tuppr = ( one+eps )*svd( bpnt+1 ) + unflep
      IF( tuppr.LT.lower )
     $   GO TO 30
*
*     Merge
*
      bpnt = bpnt + 1
      lower = ( one-eps )*svd( bpnt ) - unflep
      IF( lower.LE.unflep )
     $   lower = -upper
      GO TO 20
   30 CONTINUE
*
*     Count singular values in interval [ LOWER, UPPER ]
*
      CALL ssvdct( n, s, e, lower, numl )
      CALL ssvdct( n, s, e, upper, numu )
      count = numu - numl
      IF( lower.LT.zero )
     $   count = count / 2
      IF( count.NE.bpnt-tpnt+1 ) THEN
*
*        Wrong number of singular values in interval
*
         info = tpnt
         GO TO 40
      END IF
      tpnt = bpnt + 1
      bpnt = tpnt
      IF( tpnt.LE.n )
     $   GO TO 10
   40 CONTINUE
      RETURN
*
*     End of SSVDCH
*
      END