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