LAPACK  3.9.0
LAPACK: Linear Algebra PACKage
slasq4.f
Go to the documentation of this file.
1 *> \brief \b SLASQ4 computes an approximation to the smallest eigenvalue using values of d from the previous transform. Used by sbdsqr.
2 *
3 * =========== DOCUMENTATION ===========
4 *
5 * Online html documentation available at
6 * http://www.netlib.org/lapack/explore-html/
7 *
8 *> \htmlonly
9 *> Download SLASQ4 + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slasq4.f">
11 *> [TGZ]</a>
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slasq4.f">
13 *> [ZIP]</a>
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slasq4.f">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 * Definition:
19 * ===========
20 *
21 * SUBROUTINE SLASQ4( I0, N0, Z, PP, N0IN, DMIN, DMIN1, DMIN2, DN,
22 * DN1, DN2, TAU, TTYPE, G )
23 *
24 * .. Scalar Arguments ..
25 * INTEGER I0, N0, N0IN, PP, TTYPE
26 * REAL DMIN, DMIN1, DMIN2, DN, DN1, DN2, G, TAU
27 * ..
28 * .. Array Arguments ..
29 * REAL Z( * )
30 * ..
31 *
32 *
33 *> \par Purpose:
34 * =============
35 *>
36 *> \verbatim
37 *>
38 *> SLASQ4 computes an approximation TAU to the smallest eigenvalue
39 *> using values of d from the previous transform.
40 *> \endverbatim
41 *
42 * Arguments:
43 * ==========
44 *
45 *> \param[in] I0
46 *> \verbatim
47 *> I0 is INTEGER
48 *> First index.
49 *> \endverbatim
50 *>
51 *> \param[in] N0
52 *> \verbatim
53 *> N0 is INTEGER
54 *> Last index.
55 *> \endverbatim
56 *>
57 *> \param[in] Z
58 *> \verbatim
59 *> Z is REAL array, dimension ( 4*N0 )
60 *> Z holds the qd array.
61 *> \endverbatim
62 *>
63 *> \param[in] PP
64 *> \verbatim
65 *> PP is INTEGER
66 *> PP=0 for ping, PP=1 for pong.
67 *> \endverbatim
68 *>
69 *> \param[in] N0IN
70 *> \verbatim
71 *> N0IN is INTEGER
72 *> The value of N0 at start of EIGTEST.
73 *> \endverbatim
74 *>
75 *> \param[in] DMIN
76 *> \verbatim
77 *> DMIN is REAL
78 *> Minimum value of d.
79 *> \endverbatim
80 *>
81 *> \param[in] DMIN1
82 *> \verbatim
83 *> DMIN1 is REAL
84 *> Minimum value of d, excluding D( N0 ).
85 *> \endverbatim
86 *>
87 *> \param[in] DMIN2
88 *> \verbatim
89 *> DMIN2 is REAL
90 *> Minimum value of d, excluding D( N0 ) and D( N0-1 ).
91 *> \endverbatim
92 *>
93 *> \param[in] DN
94 *> \verbatim
95 *> DN is REAL
96 *> d(N)
97 *> \endverbatim
98 *>
99 *> \param[in] DN1
100 *> \verbatim
101 *> DN1 is REAL
102 *> d(N-1)
103 *> \endverbatim
104 *>
105 *> \param[in] DN2
106 *> \verbatim
107 *> DN2 is REAL
108 *> d(N-2)
109 *> \endverbatim
110 *>
111 *> \param[out] TAU
112 *> \verbatim
113 *> TAU is REAL
114 *> This is the shift.
115 *> \endverbatim
116 *>
117 *> \param[out] TTYPE
118 *> \verbatim
119 *> TTYPE is INTEGER
120 *> Shift type.
121 *> \endverbatim
122 *>
123 *> \param[in,out] G
124 *> \verbatim
125 *> G is REAL
126 *> G is passed as an argument in order to save its value between
127 *> calls to SLASQ4.
128 *> \endverbatim
129 *
130 * Authors:
131 * ========
132 *
133 *> \author Univ. of Tennessee
134 *> \author Univ. of California Berkeley
135 *> \author Univ. of Colorado Denver
136 *> \author NAG Ltd.
137 *
138 *> \date June 2016
139 *
140 *> \ingroup auxOTHERcomputational
141 *
142 *> \par Further Details:
143 * =====================
144 *>
145 *> \verbatim
146 *>
147 *> CNST1 = 9/16
148 *> \endverbatim
149 *>
150 * =====================================================================
151  SUBROUTINE slasq4( I0, N0, Z, PP, N0IN, DMIN, DMIN1, DMIN2, DN,
152  $ DN1, DN2, TAU, TTYPE, G )
153 *
154 * -- LAPACK computational routine (version 3.7.1) --
155 * -- LAPACK is a software package provided by Univ. of Tennessee, --
156 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
157 * June 2016
158 *
159 * .. Scalar Arguments ..
160  INTEGER I0, N0, N0IN, PP, TTYPE
161  REAL DMIN, DMIN1, DMIN2, DN, DN1, DN2, G, TAU
162 * ..
163 * .. Array Arguments ..
164  REAL Z( * )
165 * ..
166 *
167 * =====================================================================
168 *
169 * .. Parameters ..
170  REAL CNST1, CNST2, CNST3
171  parameter( cnst1 = 0.5630e0, cnst2 = 1.010e0,
172  $ cnst3 = 1.050e0 )
173  REAL QURTR, THIRD, HALF, ZERO, ONE, TWO, HUNDRD
174  parameter( qurtr = 0.250e0, third = 0.3330e0,
175  $ half = 0.50e0, zero = 0.0e0, one = 1.0e0,
176  $ two = 2.0e0, hundrd = 100.0e0 )
177 * ..
178 * .. Local Scalars ..
179  INTEGER I4, NN, NP
180  REAL A2, B1, B2, GAM, GAP1, GAP2, S
181 * ..
182 * .. Intrinsic Functions ..
183  INTRINSIC max, min, sqrt
184 * ..
185 * .. Executable Statements ..
186 *
187 * A negative DMIN forces the shift to take that absolute value
188 * TTYPE records the type of shift.
189 *
190  IF( dmin.LE.zero ) THEN
191  tau = -dmin
192  ttype = -1
193  RETURN
194  END IF
195 *
196  nn = 4*n0 + pp
197  IF( n0in.EQ.n0 ) THEN
198 *
199 * No eigenvalues deflated.
200 *
201  IF( dmin.EQ.dn .OR. dmin.EQ.dn1 ) THEN
202 *
203  b1 = sqrt( z( nn-3 ) )*sqrt( z( nn-5 ) )
204  b2 = sqrt( z( nn-7 ) )*sqrt( z( nn-9 ) )
205  a2 = z( nn-7 ) + z( nn-5 )
206 *
207 * Cases 2 and 3.
208 *
209  IF( dmin.EQ.dn .AND. dmin1.EQ.dn1 ) THEN
210  gap2 = dmin2 - a2 - dmin2*qurtr
211  IF( gap2.GT.zero .AND. gap2.GT.b2 ) THEN
212  gap1 = a2 - dn - ( b2 / gap2 )*b2
213  ELSE
214  gap1 = a2 - dn - ( b1+b2 )
215  END IF
216  IF( gap1.GT.zero .AND. gap1.GT.b1 ) THEN
217  s = max( dn-( b1 / gap1 )*b1, half*dmin )
218  ttype = -2
219  ELSE
220  s = zero
221  IF( dn.GT.b1 )
222  $ s = dn - b1
223  IF( a2.GT.( b1+b2 ) )
224  $ s = min( s, a2-( b1+b2 ) )
225  s = max( s, third*dmin )
226  ttype = -3
227  END IF
228  ELSE
229 *
230 * Case 4.
231 *
232  ttype = -4
233  s = qurtr*dmin
234  IF( dmin.EQ.dn ) THEN
235  gam = dn
236  a2 = zero
237  IF( z( nn-5 ) .GT. z( nn-7 ) )
238  $ RETURN
239  b2 = z( nn-5 ) / z( nn-7 )
240  np = nn - 9
241  ELSE
242  np = nn - 2*pp
243  gam = dn1
244  IF( z( np-4 ) .GT. z( np-2 ) )
245  $ RETURN
246  a2 = z( np-4 ) / z( np-2 )
247  IF( z( nn-9 ) .GT. z( nn-11 ) )
248  $ RETURN
249  b2 = z( nn-9 ) / z( nn-11 )
250  np = nn - 13
251  END IF
252 *
253 * Approximate contribution to norm squared from I < NN-1.
254 *
255  a2 = a2 + b2
256  DO 10 i4 = np, 4*i0 - 1 + pp, -4
257  IF( b2.EQ.zero )
258  $ GO TO 20
259  b1 = b2
260  IF( z( i4 ) .GT. z( i4-2 ) )
261  $ RETURN
262  b2 = b2*( z( i4 ) / z( i4-2 ) )
263  a2 = a2 + b2
264  IF( hundrd*max( b2, b1 ).LT.a2 .OR. cnst1.LT.a2 )
265  $ GO TO 20
266  10 CONTINUE
267  20 CONTINUE
268  a2 = cnst3*a2
269 *
270 * Rayleigh quotient residual bound.
271 *
272  IF( a2.LT.cnst1 )
273  $ s = gam*( one-sqrt( a2 ) ) / ( one+a2 )
274  END IF
275  ELSE IF( dmin.EQ.dn2 ) THEN
276 *
277 * Case 5.
278 *
279  ttype = -5
280  s = qurtr*dmin
281 *
282 * Compute contribution to norm squared from I > NN-2.
283 *
284  np = nn - 2*pp
285  b1 = z( np-2 )
286  b2 = z( np-6 )
287  gam = dn2
288  IF( z( np-8 ).GT.b2 .OR. z( np-4 ).GT.b1 )
289  $ RETURN
290  a2 = ( z( np-8 ) / b2 )*( one+z( np-4 ) / b1 )
291 *
292 * Approximate contribution to norm squared from I < NN-2.
293 *
294  IF( n0-i0.GT.2 ) THEN
295  b2 = z( nn-13 ) / z( nn-15 )
296  a2 = a2 + b2
297  DO 30 i4 = nn - 17, 4*i0 - 1 + pp, -4
298  IF( b2.EQ.zero )
299  $ GO TO 40
300  b1 = b2
301  IF( z( i4 ) .GT. z( i4-2 ) )
302  $ RETURN
303  b2 = b2*( z( i4 ) / z( i4-2 ) )
304  a2 = a2 + b2
305  IF( hundrd*max( b2, b1 ).LT.a2 .OR. cnst1.LT.a2 )
306  $ GO TO 40
307  30 CONTINUE
308  40 CONTINUE
309  a2 = cnst3*a2
310  END IF
311 *
312  IF( a2.LT.cnst1 )
313  $ s = gam*( one-sqrt( a2 ) ) / ( one+a2 )
314  ELSE
315 *
316 * Case 6, no information to guide us.
317 *
318  IF( ttype.EQ.-6 ) THEN
319  g = g + third*( one-g )
320  ELSE IF( ttype.EQ.-18 ) THEN
321  g = qurtr*third
322  ELSE
323  g = qurtr
324  END IF
325  s = g*dmin
326  ttype = -6
327  END IF
328 *
329  ELSE IF( n0in.EQ.( n0+1 ) ) THEN
330 *
331 * One eigenvalue just deflated. Use DMIN1, DN1 for DMIN and DN.
332 *
333  IF( dmin1.EQ.dn1 .AND. dmin2.EQ.dn2 ) THEN
334 *
335 * Cases 7 and 8.
336 *
337  ttype = -7
338  s = third*dmin1
339  IF( z( nn-5 ).GT.z( nn-7 ) )
340  $ RETURN
341  b1 = z( nn-5 ) / z( nn-7 )
342  b2 = b1
343  IF( b2.EQ.zero )
344  $ GO TO 60
345  DO 50 i4 = 4*n0 - 9 + pp, 4*i0 - 1 + pp, -4
346  a2 = b1
347  IF( z( i4 ).GT.z( i4-2 ) )
348  $ RETURN
349  b1 = b1*( z( i4 ) / z( i4-2 ) )
350  b2 = b2 + b1
351  IF( hundrd*max( b1, a2 ).LT.b2 )
352  $ GO TO 60
353  50 CONTINUE
354  60 CONTINUE
355  b2 = sqrt( cnst3*b2 )
356  a2 = dmin1 / ( one+b2**2 )
357  gap2 = half*dmin2 - a2
358  IF( gap2.GT.zero .AND. gap2.GT.b2*a2 ) THEN
359  s = max( s, a2*( one-cnst2*a2*( b2 / gap2 )*b2 ) )
360  ELSE
361  s = max( s, a2*( one-cnst2*b2 ) )
362  ttype = -8
363  END IF
364  ELSE
365 *
366 * Case 9.
367 *
368  s = qurtr*dmin1
369  IF( dmin1.EQ.dn1 )
370  $ s = half*dmin1
371  ttype = -9
372  END IF
373 *
374  ELSE IF( n0in.EQ.( n0+2 ) ) THEN
375 *
376 * Two eigenvalues deflated. Use DMIN2, DN2 for DMIN and DN.
377 *
378 * Cases 10 and 11.
379 *
380  IF( dmin2.EQ.dn2 .AND. two*z( nn-5 ).LT.z( nn-7 ) ) THEN
381  ttype = -10
382  s = third*dmin2
383  IF( z( nn-5 ).GT.z( nn-7 ) )
384  $ RETURN
385  b1 = z( nn-5 ) / z( nn-7 )
386  b2 = b1
387  IF( b2.EQ.zero )
388  $ GO TO 80
389  DO 70 i4 = 4*n0 - 9 + pp, 4*i0 - 1 + pp, -4
390  IF( z( i4 ).GT.z( i4-2 ) )
391  $ RETURN
392  b1 = b1*( z( i4 ) / z( i4-2 ) )
393  b2 = b2 + b1
394  IF( hundrd*b1.LT.b2 )
395  $ GO TO 80
396  70 CONTINUE
397  80 CONTINUE
398  b2 = sqrt( cnst3*b2 )
399  a2 = dmin2 / ( one+b2**2 )
400  gap2 = z( nn-7 ) + z( nn-9 ) -
401  $ sqrt( z( nn-11 ) )*sqrt( z( nn-9 ) ) - a2
402  IF( gap2.GT.zero .AND. gap2.GT.b2*a2 ) THEN
403  s = max( s, a2*( one-cnst2*a2*( b2 / gap2 )*b2 ) )
404  ELSE
405  s = max( s, a2*( one-cnst2*b2 ) )
406  END IF
407  ELSE
408  s = qurtr*dmin2
409  ttype = -11
410  END IF
411  ELSE IF( n0in.GT.( n0+2 ) ) THEN
412 *
413 * Case 12, more than two eigenvalues deflated. No information.
414 *
415  s = zero
416  ttype = -12
417  END IF
418 *
419  tau = s
420  RETURN
421 *
422 * End of SLASQ4
423 *
424  END
slasq4
subroutine slasq4(I0, N0, Z, PP, N0IN, DMIN, DMIN1, DMIN2, DN, DN1, DN2, TAU, TTYPE, G)
SLASQ4 computes an approximation to the smallest eigenvalue using values of d from the previous trans...
Definition: slasq4.f:153