1*> \brief \b DLARRA 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 DLARRA + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlarra.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlarra.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlarra.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18*  Definition:
19*  ===========
20*
21*       SUBROUTINE DLARRA( N, D, E, E2, SPLTOL, TNRM,
22*                           NSPLIT, ISPLIT, INFO )
23*
24*       .. Scalar Arguments ..
25*       INTEGER            INFO, N, NSPLIT
26*       DOUBLE PRECISION    SPLTOL, TNRM
27*       ..
28*       .. Array Arguments ..
29*       INTEGER            ISPLIT( * )
30*       DOUBLE PRECISION   D( * ), E( * ), E2( * )
31*       ..
32*
33*
34*> \par Purpose:
35*  =============
36*>
37*> \verbatim
38*>
39*> Compute the splitting points with threshold SPLTOL.
40*> DLARRA 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 DOUBLE PRECISION 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 DOUBLE PRECISION 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 DOUBLE PRECISION 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 DOUBLE PRECISION
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 DOUBLE PRECISION
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 June 2017
123*
124*> \ingroup OTHERauxiliary
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 DLARRA( N, D, E, E2, SPLTOL, TNRM,
137     $                    NSPLIT, ISPLIT, INFO )
138*
139*  -- LAPACK auxiliary routine (version 3.7.1) --
140*  -- LAPACK is a software package provided by Univ. of Tennessee,    --
141*  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
142*     June 2017
143*
144*     .. Scalar Arguments ..
145      INTEGER            INFO, N, NSPLIT
146      DOUBLE PRECISION    SPLTOL, TNRM
147*     ..
148*     .. Array Arguments ..
149      INTEGER            ISPLIT( * )
150      DOUBLE PRECISION   D( * ), E( * ), E2( * )
151*     ..
152*
153*  =====================================================================
154*
155*     .. Parameters ..
156      DOUBLE PRECISION   ZERO
157      PARAMETER          ( ZERO = 0.0D0 )
158*     ..
159*     .. Local Scalars ..
160      INTEGER            I
161      DOUBLE PRECISION   EABS, TMP1
162
163*     ..
164*     .. Intrinsic Functions ..
165      INTRINSIC          ABS
166*     ..
167*     .. Executable Statements ..
168*
169      INFO = 0
170*
171*     Quick return if possible
172*
173      IF( N.LE.0 ) THEN
174         RETURN
175      END IF
176*
177*     Compute splitting points
178      NSPLIT = 1
179      IF(SPLTOL.LT.ZERO) THEN
180*        Criterion based on absolute off-diagonal value
181         TMP1 = ABS(SPLTOL)* TNRM
182         DO 9 I = 1, N-1
183            EABS = ABS( E(I) )
184            IF( EABS .LE. TMP1) THEN
185               E(I) = ZERO
186               E2(I) = ZERO
187               ISPLIT( NSPLIT ) = I
188               NSPLIT = NSPLIT + 1
189            END IF
190 9       CONTINUE
191      ELSE
192*        Criterion that guarantees relative accuracy
193         DO 10 I = 1, N-1
194            EABS = ABS( E(I) )
195            IF( EABS .LE. SPLTOL * SQRT(ABS(D(I)))*SQRT(ABS(D(I+1))) )
196     $      THEN
197               E(I) = ZERO
198               E2(I) = ZERO
199               ISPLIT( NSPLIT ) = I
200               NSPLIT = NSPLIT + 1
201            END IF
202 10      CONTINUE
203      ENDIF
204      ISPLIT( NSPLIT ) = N
205
206      RETURN
207*
208*     End of DLARRA
209*
210      END
211