SRC/slarra.f

   1 *> \brief \b SLARRA computes the splitting points with the specified threshold.
   2 *
   3 *  =========== DOCUMENTATION ===========
   4 *
   5 * Online html documentation available at
   6 *            http://www.netlib.org/lapack/explore-html/
   7 *
   8 *> \htmlonly
   9 *> Download SLARRA + dependencies
  10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slarra.f">
  11 *> [TGZ]</a>
  12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slarra.f">
  13 *> [ZIP]</a>
  14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slarra.f">
  15 *> [TXT]</a>
  16 *> \endhtmlonly
  17 *
  18 *  Definition:
  19 *  ===========
  20 *
  21 *       SUBROUTINE SLARRA( N, D, E, E2, SPLTOL, TNRM,
  22 *                           NSPLIT, ISPLIT, INFO )
  23 *
  24 *       .. Scalar Arguments ..
  25 *       INTEGER            INFO, N, NSPLIT
  26 *       REAL                SPLTOL, TNRM
  27 *       ..
  28 *       .. Array Arguments ..
  29 *       INTEGER            ISPLIT( * )
  30 *       REAL               D( * ), E( * ), E2( * )
  31 *       ..
  32 *
  33 *
  34 *> \par Purpose:
  35 *  =============
  36 *>
  37 *> \verbatim
  38 *>
  39 *> Compute the splitting points with threshold SPLTOL.
  40 *> SLARRA sets any "small" off-diagonal elements to zero.
  41 *> \endverbatim
  42 *
  43 *  Arguments:
  44 *  ==========
  45 *
  46 *> \param[in] N
  47 *> \verbatim
  48 *>          N is INTEGER
  49 *>          The order of the matrix. N > 0.
  50 *> \endverbatim
  51 *>
  52 *> \param[in] D
  53 *> \verbatim
  54 *>          D is REAL array, dimension (N)
  55 *>          On entry, the N diagonal elements of the tridiagonal
  56 *>          matrix T.
  57 *> \endverbatim
  58 *>
  59 *> \param[in,out] E
  60 *> \verbatim
  61 *>          E is REAL array, dimension (N)
  62 *>          On entry, the first (N-1) entries contain the subdiagonal
  63 *>          elements of the tridiagonal matrix T; E(N) need not be set.
  64 *>          On exit, the entries E( ISPLIT( I ) ), 1 <= I <= NSPLIT,
  65 *>          are set to zero, the other entries of E are untouched.
  66 *> \endverbatim
  67 *>
  68 *> \param[in,out] E2
  69 *> \verbatim
  70 *>          E2 is REAL array, dimension (N)
  71 *>          On entry, the first (N-1) entries contain the SQUARES of the
  72 *>          subdiagonal elements of the tridiagonal matrix T;
  73 *>          E2(N) need not be set.
  74 *>          On exit, the entries E2( ISPLIT( I ) ),
  75 *>          1 <= I <= NSPLIT, have been set to zero
  76 *> \endverbatim
  77 *>
  78 *> \param[in] SPLTOL
  79 *> \verbatim
  80 *>          SPLTOL is REAL
  81 *>          The threshold for splitting. Two criteria can be used:
  82 *>          SPLTOL<0 : criterion based on absolute off-diagonal value
  83 *>          SPLTOL>0 : criterion that preserves relative accuracy
  84 *> \endverbatim
  85 *>
  86 *> \param[in] TNRM
  87 *> \verbatim
  88 *>          TNRM is REAL
  89 *>          The norm of the matrix.
  90 *> \endverbatim
  91 *>
  92 *> \param[out] NSPLIT
  93 *> \verbatim
  94 *>          NSPLIT is INTEGER
  95 *>          The number of blocks T splits into. 1 <= NSPLIT <= N.
  96 *> \endverbatim
  97 *>
  98 *> \param[out] ISPLIT
  99 *> \verbatim
 100 *>          ISPLIT is INTEGER array, dimension (N)
 101 *>          The splitting points, at which T breaks up into blocks.
 102 *>          The first block consists of rows/columns 1 to ISPLIT(1),
 103 *>          the second of rows/columns ISPLIT(1)+1 through ISPLIT(2),
 104 *>          etc., and the NSPLIT-th consists of rows/columns
 105 *>          ISPLIT(NSPLIT-1)+1 through ISPLIT(NSPLIT)=N.
 106 *> \endverbatim
 107 *>
 108 *> \param[out] INFO
 109 *> \verbatim
 110 *>          INFO is INTEGER
 111 *>          = 0:  successful exit
 112 *> \endverbatim
 113 *
 114 *  Authors:
 115 *  ========
 116 *
 117 *> \author Univ. of Tennessee
 118 *> \author Univ. of California Berkeley
 119 *> \author Univ. of Colorado Denver
 120 *> \author NAG Ltd.
 121 *
 122 *> \date September 2012
 123 *
 124 *> \ingroup auxOTHERauxiliary
 125 *
 126 *> \par Contributors:
 127 *  ==================
 128 *>
 129 *> Beresford Parlett, University of California, Berkeley, USA \n
 130 *> Jim Demmel, University of California, Berkeley, USA \n
 131 *> Inderjit Dhillon, University of Texas, Austin, USA \n
 132 *> Osni Marques, LBNL/NERSC, USA \n
 133 *> Christof Voemel, University of California, Berkeley, USA
 134 *
 135 *  =====================================================================
 136       SUBROUTINE SLARRA( N, D, E, E2, SPLTOL, TNRM,
 137      $                    NSPLIT, ISPLIT, INFO )
 138 *
 139 *  -- LAPACK auxiliary routine (version 3.4.2) --
 140 *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
 141 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
 142 *     September 2012
 143 *
 144 *     .. Scalar Arguments ..
 145       INTEGER            INFO, N, NSPLIT
 146       REAL                SPLTOL, TNRM
 147 *     ..
 148 *     .. Array Arguments ..
 149       INTEGER            ISPLIT( * )
 150       REAL               D( * ), E( * ), E2( * )
 151 *     ..
 152 *
 153 *  =====================================================================
 154 *
 155 *     .. Parameters ..
 156       REAL               ZERO
 157       PARAMETER          ( ZERO = 0.0E0 )
 158 *     ..
 159 *     .. Local Scalars ..
 160       INTEGER            I
 161       REAL               EABS, TMP1
 162
 163 *     ..
 164 *     .. Intrinsic Functions ..
 165       INTRINSIC          ABS
 166 *     ..
 167 *     .. Executable Statements ..
 168 *
 169       INFO = 0
 170
 171 *     Compute splitting points
 172       NSPLIT = 1
 173       IF(SPLTOL.LT.ZERO) THEN
 174 *        Criterion based on absolute off-diagonal value
 175          TMP1 = ABS(SPLTOL)* TNRM
 176          DO 9 I = 1, N-1
 177             EABS = ABS( E(I) )
 178             IF( EABS .LE. TMP1) THEN
 179                E(I) = ZERO
 180                E2(I) = ZERO
 181                ISPLIT( NSPLIT ) = I
 182                NSPLIT = NSPLIT + 1
 183             END IF
 184  9       CONTINUE
 185       ELSE
 186 *        Criterion that guarantees relative accuracy
 187          DO 10 I = 1, N-1
 188             EABS = ABS( E(I) )
 189             IF( EABS .LE. SPLTOL * SQRT(ABS(D(I)))*SQRT(ABS(D(I+1))) )
 190      $      THEN
 191                E(I) = ZERO
 192                E2(I) = ZERO
 193                ISPLIT( NSPLIT ) = I
 194                NSPLIT = NSPLIT + 1
 195             END IF
 196  10      CONTINUE
 197       ENDIF
 198       ISPLIT( NSPLIT ) = N
 199
 200       RETURN
 201 *
 202 *     End of SLARRA
 203 *
 204       END