1: *> \brief \b DLARRJ performs refinement of the initial estimates of the eigenvalues of the matrix T.
2: *
3: * =========== DOCUMENTATION ===========
4: *
5: * Online html documentation available at
6: * http://www.netlib.org/lapack/explore-html/
7: *
8: *> \htmlonly
9: *> Download DLARRJ + dependencies
10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlarrj.f">
11: *> [TGZ]</a>
12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlarrj.f">
13: *> [ZIP]</a>
14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlarrj.f">
15: *> [TXT]</a>
16: *> \endhtmlonly
17: *
18: * Definition:
19: * ===========
20: *
21: * SUBROUTINE DLARRJ( N, D, E2, IFIRST, ILAST,
22: * RTOL, OFFSET, W, WERR, WORK, IWORK,
23: * PIVMIN, SPDIAM, INFO )
24: *
25: * .. Scalar Arguments ..
26: * INTEGER IFIRST, ILAST, INFO, N, OFFSET
27: * DOUBLE PRECISION PIVMIN, RTOL, SPDIAM
28: * ..
29: * .. Array Arguments ..
30: * INTEGER IWORK( * )
31: * DOUBLE PRECISION D( * ), E2( * ), W( * ),
32: * $ WERR( * ), WORK( * )
33: * ..
34: *
35: *
36: *> \par Purpose:
37: * =============
38: *>
39: *> \verbatim
40: *>
41: *> Given the initial eigenvalue approximations of T, DLARRJ
42: *> does bisection to refine the eigenvalues of T,
43: *> W( IFIRST-OFFSET ) through W( ILAST-OFFSET ), to more accuracy. Initial
44: *> guesses for these eigenvalues are input in W, the corresponding estimate
45: *> of the error in these guesses in WERR. During bisection, intervals
46: *> [left, right] are maintained by storing their mid-points and
47: *> semi-widths in the arrays W and WERR respectively.
48: *> \endverbatim
49: *
50: * Arguments:
51: * ==========
52: *
53: *> \param[in] N
54: *> \verbatim
55: *> N is INTEGER
56: *> The order of the matrix.
57: *> \endverbatim
58: *>
59: *> \param[in] D
60: *> \verbatim
61: *> D is DOUBLE PRECISION array, dimension (N)
62: *> The N diagonal elements of T.
63: *> \endverbatim
64: *>
65: *> \param[in] E2
66: *> \verbatim
67: *> E2 is DOUBLE PRECISION array, dimension (N-1)
68: *> The Squares of the (N-1) subdiagonal elements of T.
69: *> \endverbatim
70: *>
71: *> \param[in] IFIRST
72: *> \verbatim
73: *> IFIRST is INTEGER
74: *> The index of the first eigenvalue to be computed.
75: *> \endverbatim
76: *>
77: *> \param[in] ILAST
78: *> \verbatim
79: *> ILAST is INTEGER
80: *> The index of the last eigenvalue to be computed.
81: *> \endverbatim
82: *>
83: *> \param[in] RTOL
84: *> \verbatim
85: *> RTOL is DOUBLE PRECISION
86: *> Tolerance for the convergence of the bisection intervals.
87: *> An interval [LEFT,RIGHT] has converged if
88: *> RIGHT-LEFT < RTOL*MAX(|LEFT|,|RIGHT|).
89: *> \endverbatim
90: *>
91: *> \param[in] OFFSET
92: *> \verbatim
93: *> OFFSET is INTEGER
94: *> Offset for the arrays W and WERR, i.e., the IFIRST-OFFSET
95: *> through ILAST-OFFSET elements of these arrays are to be used.
96: *> \endverbatim
97: *>
98: *> \param[in,out] W
99: *> \verbatim
100: *> W is DOUBLE PRECISION array, dimension (N)
101: *> On input, W( IFIRST-OFFSET ) through W( ILAST-OFFSET ) are
102: *> estimates of the eigenvalues of L D L^T indexed IFIRST through
103: *> ILAST.
104: *> On output, these estimates are refined.
105: *> \endverbatim
106: *>
107: *> \param[in,out] WERR
108: *> \verbatim
109: *> WERR is DOUBLE PRECISION array, dimension (N)
110: *> On input, WERR( IFIRST-OFFSET ) through WERR( ILAST-OFFSET ) are
111: *> the errors in the estimates of the corresponding elements in W.
112: *> On output, these errors are refined.
113: *> \endverbatim
114: *>
115: *> \param[out] WORK
116: *> \verbatim
117: *> WORK is DOUBLE PRECISION array, dimension (2*N)
118: *> Workspace.
119: *> \endverbatim
120: *>
121: *> \param[out] IWORK
122: *> \verbatim
123: *> IWORK is INTEGER array, dimension (2*N)
124: *> Workspace.
125: *> \endverbatim
126: *>
127: *> \param[in] PIVMIN
128: *> \verbatim
129: *> PIVMIN is DOUBLE PRECISION
130: *> The minimum pivot in the Sturm sequence for T.
131: *> \endverbatim
132: *>
133: *> \param[in] SPDIAM
134: *> \verbatim
135: *> SPDIAM is DOUBLE PRECISION
136: *> The spectral diameter of T.
137: *> \endverbatim
138: *>
139: *> \param[out] INFO
140: *> \verbatim
141: *> INFO is INTEGER
142: *> Error flag.
143: *> \endverbatim
144: *
145: * Authors:
146: * ========
147: *
148: *> \author Univ. of Tennessee
149: *> \author Univ. of California Berkeley
150: *> \author Univ. of Colorado Denver
151: *> \author NAG Ltd.
152: *
153: *> \ingroup OTHERauxiliary
154: *
155: *> \par Contributors:
156: * ==================
157: *>
158: *> Beresford Parlett, University of California, Berkeley, USA \n
159: *> Jim Demmel, University of California, Berkeley, USA \n
160: *> Inderjit Dhillon, University of Texas, Austin, USA \n
161: *> Osni Marques, LBNL/NERSC, USA \n
162: *> Christof Voemel, University of California, Berkeley, USA
163: *
164: * =====================================================================
165: SUBROUTINE DLARRJ( N, D, E2, IFIRST, ILAST,
166: $ RTOL, OFFSET, W, WERR, WORK, IWORK,
167: $ PIVMIN, SPDIAM, INFO )
168: *
169: * -- LAPACK auxiliary routine --
170: * -- LAPACK is a software package provided by Univ. of Tennessee, --
171: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
172: *
173: * .. Scalar Arguments ..
174: INTEGER IFIRST, ILAST, INFO, N, OFFSET
175: DOUBLE PRECISION PIVMIN, RTOL, SPDIAM
176: * ..
177: * .. Array Arguments ..
178: INTEGER IWORK( * )
179: DOUBLE PRECISION D( * ), E2( * ), W( * ),
180: $ WERR( * ), WORK( * )
181: * ..
182: *
183: * =====================================================================
184: *
185: * .. Parameters ..
186: DOUBLE PRECISION ZERO, ONE, TWO, HALF
187: PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0, TWO = 2.0D0,
188: $ HALF = 0.5D0 )
189: INTEGER MAXITR
190: * ..
191: * .. Local Scalars ..
192: INTEGER CNT, I, I1, I2, II, ITER, J, K, NEXT, NINT,
193: $ OLNINT, P, PREV, SAVI1
194: DOUBLE PRECISION DPLUS, FAC, LEFT, MID, RIGHT, S, TMP, WIDTH
195: *
196: * ..
197: * .. Intrinsic Functions ..
198: INTRINSIC ABS, MAX
199: * ..
200: * .. Executable Statements ..
201: *
202: INFO = 0
203: *
204: * Quick return if possible
205: *
206: IF( N.LE.0 ) THEN
207: RETURN
208: END IF
209: *
210: MAXITR = INT( ( LOG( SPDIAM+PIVMIN )-LOG( PIVMIN ) ) /
211: $ LOG( TWO ) ) + 2
212: *
213: * Initialize unconverged intervals in [ WORK(2*I-1), WORK(2*I) ].
214: * The Sturm Count, Count( WORK(2*I-1) ) is arranged to be I-1, while
215: * Count( WORK(2*I) ) is stored in IWORK( 2*I ). The integer IWORK( 2*I-1 )
216: * for an unconverged interval is set to the index of the next unconverged
217: * interval, and is -1 or 0 for a converged interval. Thus a linked
218: * list of unconverged intervals is set up.
219: *
220:
221: I1 = IFIRST
222: I2 = ILAST
223: * The number of unconverged intervals
224: NINT = 0
225: * The last unconverged interval found
226: PREV = 0
227: DO 75 I = I1, I2
228: K = 2*I
229: II = I - OFFSET
230: LEFT = W( II ) - WERR( II )
231: MID = W(II)
232: RIGHT = W( II ) + WERR( II )
233: WIDTH = RIGHT - MID
234: TMP = MAX( ABS( LEFT ), ABS( RIGHT ) )
235:
236: * The following test prevents the test of converged intervals
237: IF( WIDTH.LT.RTOL*TMP ) THEN
238: * This interval has already converged and does not need refinement.
239: * (Note that the gaps might change through refining the
240: * eigenvalues, however, they can only get bigger.)
241: * Remove it from the list.
242: IWORK( K-1 ) = -1
243: * Make sure that I1 always points to the first unconverged interval
244: IF((I.EQ.I1).AND.(I.LT.I2)) I1 = I + 1
245: IF((PREV.GE.I1).AND.(I.LE.I2)) IWORK( 2*PREV-1 ) = I + 1
246: ELSE
247: * unconverged interval found
248: PREV = I
249: * Make sure that [LEFT,RIGHT] contains the desired eigenvalue
250: *
251: * Do while( CNT(LEFT).GT.I-1 )
252: *
253: FAC = ONE
254: 20 CONTINUE
255: CNT = 0
256: S = LEFT
257: DPLUS = D( 1 ) - S
258: IF( DPLUS.LT.ZERO ) CNT = CNT + 1
259: DO 30 J = 2, N
260: DPLUS = D( J ) - S - E2( J-1 )/DPLUS
261: IF( DPLUS.LT.ZERO ) CNT = CNT + 1
262: 30 CONTINUE
263: IF( CNT.GT.I-1 ) THEN
264: LEFT = LEFT - WERR( II )*FAC
265: FAC = TWO*FAC
266: GO TO 20
267: END IF
268: *
269: * Do while( CNT(RIGHT).LT.I )
270: *
271: FAC = ONE
272: 50 CONTINUE
273: CNT = 0
274: S = RIGHT
275: DPLUS = D( 1 ) - S
276: IF( DPLUS.LT.ZERO ) CNT = CNT + 1
277: DO 60 J = 2, N
278: DPLUS = D( J ) - S - E2( J-1 )/DPLUS
279: IF( DPLUS.LT.ZERO ) CNT = CNT + 1
280: 60 CONTINUE
281: IF( CNT.LT.I ) THEN
282: RIGHT = RIGHT + WERR( II )*FAC
283: FAC = TWO*FAC
284: GO TO 50
285: END IF
286: NINT = NINT + 1
287: IWORK( K-1 ) = I + 1
288: IWORK( K ) = CNT
289: END IF
290: WORK( K-1 ) = LEFT
291: WORK( K ) = RIGHT
292: 75 CONTINUE
293:
294:
295: SAVI1 = I1
296: *
297: * Do while( NINT.GT.0 ), i.e. there are still unconverged intervals
298: * and while (ITER.LT.MAXITR)
299: *
300: ITER = 0
301: 80 CONTINUE
302: PREV = I1 - 1
303: I = I1
304: OLNINT = NINT
305:
306: DO 100 P = 1, OLNINT
307: K = 2*I
308: II = I - OFFSET
309: NEXT = IWORK( K-1 )
310: LEFT = WORK( K-1 )
311: RIGHT = WORK( K )
312: MID = HALF*( LEFT + RIGHT )
313:
314: * semiwidth of interval
315: WIDTH = RIGHT - MID
316: TMP = MAX( ABS( LEFT ), ABS( RIGHT ) )
317:
318: IF( ( WIDTH.LT.RTOL*TMP ) .OR.
319: $ (ITER.EQ.MAXITR) )THEN
320: * reduce number of unconverged intervals
321: NINT = NINT - 1
322: * Mark interval as converged.
323: IWORK( K-1 ) = 0
324: IF( I1.EQ.I ) THEN
325: I1 = NEXT
326: ELSE
327: * Prev holds the last unconverged interval previously examined
328: IF(PREV.GE.I1) IWORK( 2*PREV-1 ) = NEXT
329: END IF
330: I = NEXT
331: GO TO 100
332: END IF
333: PREV = I
334: *
335: * Perform one bisection step
336: *
337: CNT = 0
338: S = MID
339: DPLUS = D( 1 ) - S
340: IF( DPLUS.LT.ZERO ) CNT = CNT + 1
341: DO 90 J = 2, N
342: DPLUS = D( J ) - S - E2( J-1 )/DPLUS
343: IF( DPLUS.LT.ZERO ) CNT = CNT + 1
344: 90 CONTINUE
345: IF( CNT.LE.I-1 ) THEN
346: WORK( K-1 ) = MID
347: ELSE
348: WORK( K ) = MID
349: END IF
350: I = NEXT
351:
352: 100 CONTINUE
353: ITER = ITER + 1
354: * do another loop if there are still unconverged intervals
355: * However, in the last iteration, all intervals are accepted
356: * since this is the best we can do.
357: IF( ( NINT.GT.0 ).AND.(ITER.LE.MAXITR) ) GO TO 80
358: *
359: *
360: * At this point, all the intervals have converged
361: DO 110 I = SAVI1, ILAST
362: K = 2*I
363: II = I - OFFSET
364: * All intervals marked by '0' have been refined.
365: IF( IWORK( K-1 ).EQ.0 ) THEN
366: W( II ) = HALF*( WORK( K-1 )+WORK( K ) )
367: WERR( II ) = WORK( K ) - W( II )
368: END IF
369: 110 CONTINUE
370: *
371:
372: RETURN
373: *
374: * End of DLARRJ
375: *
376: END
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to dlarrj.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack