TESTING/EIG/ssvdch.f

   1 *> \brief \b SSVDCH
   2 *
   3 *  =========== DOCUMENTATION ===========
   4 *
   5 * Online html documentation available at
   6 *            http://www.netlib.org/lapack/explore-html/
   7 *
   8 *  Definition:
   9 *  ===========
  10 *
  11 *       SUBROUTINE SSVDCH( N, S, E, SVD, TOL, INFO )
  12 *
  13 *       .. Scalar Arguments ..
  14 *       INTEGER            INFO, N
  15 *       REAL               TOL
  16 *       ..
  17 *       .. Array Arguments ..
  18 *       REAL               E( * ), S( * ), SVD( * )
  19 *       ..
  20 *
  21 *
  22 *> \par Purpose:
  23 *  =============
  24 *>
  25 *> \verbatim
  26 *>
  27 *> SSVDCH checks to see if SVD(1) ,..., SVD(N) are accurate singular
  28 *> values of the bidiagonal matrix B with diagonal entries
  29 *> S(1) ,..., S(N) and superdiagonal entries E(1) ,..., E(N-1)).
  30 *> It does this by expanding each SVD(I) into an interval
  31 *> [SVD(I) * (1-EPS) , SVD(I) * (1+EPS)], merging overlapping intervals
  32 *> if any, and using Sturm sequences to count and verify whether each
  33 *> resulting interval has the correct number of singular values (using
  34 *> SSVDCT). Here EPS=TOL*MAX(N/10,1)*MACHEP, where MACHEP is the
  35 *> machine precision. The routine assumes the singular values are sorted
  36 *> with SVD(1) the largest and SVD(N) smallest.  If each interval
  37 *> contains the correct number of singular values, INFO = 0 is returned,
  38 *> otherwise INFO is the index of the first singular value in the first
  39 *> bad interval.
  40 *> \endverbatim
  41 *
  42 *  Arguments:
  43 *  ==========
  44 *
  45 *> \param[in] N
  46 *> \verbatim
  47 *>          N is INTEGER
  48 *>          The dimension of the bidiagonal matrix B.
  49 *> \endverbatim
  50 *>
  51 *> \param[in] S
  52 *> \verbatim
  53 *>          S is REAL array, dimension (N)
  54 *>          The diagonal entries of the bidiagonal matrix B.
  55 *> \endverbatim
  56 *>
  57 *> \param[in] E
  58 *> \verbatim
  59 *>          E is REAL array, dimension (N-1)
  60 *>          The superdiagonal entries of the bidiagonal matrix B.
  61 *> \endverbatim
  62 *>
  63 *> \param[in] SVD
  64 *> \verbatim
  65 *>          SVD is REAL array, dimension (N)
  66 *>          The computed singular values to be checked.
  67 *> \endverbatim
  68 *>
  69 *> \param[in] TOL
  70 *> \verbatim
  71 *>          TOL is REAL
  72 *>          Error tolerance for checking, a multiplier of the
  73 *>          machine precision.
  74 *> \endverbatim
  75 *>
  76 *> \param[out] INFO
  77 *> \verbatim
  78 *>          INFO is INTEGER
  79 *>          =0 if the singular values are all correct (to within
  80 *>             1 +- TOL*MACHEPS)
  81 *>          >0 if the interval containing the INFO-th singular value
  82 *>             contains the incorrect number of singular values.
  83 *> \endverbatim
  84 *
  85 *  Authors:
  86 *  ========
  87 *
  88 *> \author Univ. of Tennessee
  89 *> \author Univ. of California Berkeley
  90 *> \author Univ. of Colorado Denver
  91 *> \author NAG Ltd.
  92 *
  93 *> \date November 2011
  94 *
  95 *> \ingroup single_eig
  96 *
  97 *  =====================================================================
  98       SUBROUTINE SSVDCH( N, S, E, SVD, TOL, INFO )
  99 *
 100 *  -- LAPACK test routine (version 3.4.0) --
 101 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 102 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 103 *     November 2011
 104 *
 105 *     .. Scalar Arguments ..
 106       INTEGER            INFO, N
 107       REAL               TOL
 108 *     ..
 109 *     .. Array Arguments ..
 110       REAL               E( * ), S( * ), SVD( * )
 111 *     ..
 112 *
 113 *  =====================================================================
 114 *
 115 *     .. Parameters ..
 116       REAL               ONE
 117       PARAMETER          ( ONE = 1.0E0 )
 118       REAL               ZERO
 119       PARAMETER          ( ZERO = 0.0E0 )
 120 *     ..
 121 *     .. Local Scalars ..
 122       INTEGER            BPNT, COUNT, NUML, NUMU, TPNT
 123       REAL               EPS, LOWER, OVFL, TUPPR, UNFL, UNFLEP, UPPER
 124 *     ..
 125 *     .. External Functions ..
 126       REAL               SLAMCH
 127       EXTERNAL           SLAMCH
 128 *     ..
 129 *     .. External Subroutines ..
 130       EXTERNAL           SSVDCT
 131 *     ..
 132 *     .. Intrinsic Functions ..
 133       INTRINSIC          MAX, SQRT
 134 *     ..
 135 *     .. Executable Statements ..
 136 *
 137 *     Get machine constants
 138 *
 139       INFO = 0
 140       IF( N.LE.0 )
 141      $   RETURN
 142       UNFL = SLAMCH( 'Safe minimum' )
 143       OVFL = SLAMCH( 'Overflow' )
 144       EPS = SLAMCH( 'Epsilon' )*SLAMCH( 'Base' )
 145 *
 146 *     UNFLEP is chosen so that when an eigenvalue is multiplied by the
 147 *     scale factor sqrt(OVFL)*sqrt(sqrt(UNFL))/MX in SSVDCT, it exceeds
 148 *     sqrt(UNFL), which is the lower limit for SSVDCT.
 149 *
 150       UNFLEP = ( SQRT( SQRT( UNFL ) ) / SQRT( OVFL ) )*SVD( 1 ) +
 151      $         UNFL / EPS
 152 *
 153 *     The value of EPS works best when TOL .GE. 10.
 154 *
 155       EPS = TOL*MAX( N / 10, 1 )*EPS
 156 *
 157 *     TPNT points to singular value at right endpoint of interval
 158 *     BPNT points to singular value at left  endpoint of interval
 159 *
 160       TPNT = 1
 161       BPNT = 1
 162 *
 163 *     Begin loop over all intervals
 164 *
 165    10 CONTINUE
 166       UPPER = ( ONE+EPS )*SVD( TPNT ) + UNFLEP
 167       LOWER = ( ONE-EPS )*SVD( BPNT ) - UNFLEP
 168       IF( LOWER.LE.UNFLEP )
 169      $   LOWER = -UPPER
 170 *
 171 *     Begin loop merging overlapping intervals
 172 *
 173    20 CONTINUE
 174       IF( BPNT.EQ.N )
 175      $   GO TO 30
 176       TUPPR = ( ONE+EPS )*SVD( BPNT+1 ) + UNFLEP
 177       IF( TUPPR.LT.LOWER )
 178      $   GO TO 30
 179 *
 180 *     Merge
 181 *
 182       BPNT = BPNT + 1
 183       LOWER = ( ONE-EPS )*SVD( BPNT ) - UNFLEP
 184       IF( LOWER.LE.UNFLEP )
 185      $   LOWER = -UPPER
 186       GO TO 20
 187    30 CONTINUE
 188 *
 189 *     Count singular values in interval [ LOWER, UPPER ]
 190 *
 191       CALL SSVDCT( N, S, E, LOWER, NUML )
 192       CALL SSVDCT( N, S, E, UPPER, NUMU )
 193       COUNT = NUMU - NUML
 194       IF( LOWER.LT.ZERO )
 195      $   COUNT = COUNT / 2
 196       IF( COUNT.NE.BPNT-TPNT+1 ) THEN
 197 *
 198 *        Wrong number of singular values in interval
 199 *
 200          INFO = TPNT
 201          GO TO 40
 202       END IF
 203       TPNT = BPNT + 1
 204       BPNT = TPNT
 205       IF( TPNT.LE.N )
 206      $   GO TO 10
 207    40 CONTINUE
 208       RETURN
 209 *
 210 *     End of SSVDCH
 211 *
 212       END