LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
slarra.f
Go to the documentation of this file.
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*> \ingroup larra
123*
124*> \par Contributors:
125* ==================
126*>
127*> Beresford Parlett, University of California, Berkeley, USA \n
128*> Jim Demmel, University of California, Berkeley, USA \n
129*> Inderjit Dhillon, University of Texas, Austin, USA \n
130*> Osni Marques, LBNL/NERSC, USA \n
131*> Christof Voemel, University of California, Berkeley, USA
132*
133* =====================================================================
134 SUBROUTINE slarra( N, D, E, E2, SPLTOL, TNRM,
135 $ NSPLIT, ISPLIT, INFO )
136*
137* -- LAPACK auxiliary routine --
138* -- LAPACK is a software package provided by Univ. of Tennessee, --
139* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
140*
141* .. Scalar Arguments ..
142 INTEGER INFO, N, NSPLIT
143 REAL SPLTOL, TNRM
144* ..
145* .. Array Arguments ..
146 INTEGER ISPLIT( * )
147 REAL D( * ), E( * ), E2( * )
148* ..
149*
150* =====================================================================
151*
152* .. Parameters ..
153 REAL ZERO
154 parameter( zero = 0.0e0 )
155* ..
156* .. Local Scalars ..
157 INTEGER I
158 REAL EABS, TMP1
159
160* ..
161* .. Intrinsic Functions ..
162 INTRINSIC abs
163* ..
164* .. Executable Statements ..
165*
166 info = 0
167 nsplit = 1
168*
169* Quick return if possible
170*
171 IF( n.LE.0 ) THEN
172 RETURN
173 END IF
174*
175* Compute splitting points
176 IF(spltol.LT.zero) THEN
177* Criterion based on absolute off-diagonal value
178 tmp1 = abs(spltol)* tnrm
179 DO 9 i = 1, n-1
180 eabs = abs( e(i) )
181 IF( eabs .LE. tmp1) THEN
182 e(i) = zero
183 e2(i) = zero
184 isplit( nsplit ) = i
185 nsplit = nsplit + 1
186 END IF
187 9 CONTINUE
188 ELSE
189* Criterion that guarantees relative accuracy
190 DO 10 i = 1, n-1
191 eabs = abs( e(i) )
192 IF( eabs .LE. spltol * sqrt(abs(d(i)))*sqrt(abs(d(i+1))) )
193 $ THEN
194 e(i) = zero
195 e2(i) = zero
196 isplit( nsplit ) = i
197 nsplit = nsplit + 1
198 END IF
199 10 CONTINUE
200 ENDIF
201 isplit( nsplit ) = n
202
203 RETURN
204*
205* End of SLARRA
206*
207 END
subroutine slarra(n, d, e, e2, spltol, tnrm, nsplit, isplit, info)
SLARRA computes the splitting points with the specified threshold.
Definition slarra.f:136