1 SUBROUTINE SSTECT( N, A, B, SHIFT, NUM )
2 *
3 * -- LAPACK test routine (version 3.1) --
4 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
5 * November 2006
6 *
7 * .. Scalar Arguments ..
8 INTEGER N, NUM
9 REAL SHIFT
10 * ..
11 * .. Array Arguments ..
12 REAL A( * ), B( * )
13 * ..
14 *
15 * Purpose
16 * =======
17 *
18 * SSTECT counts the number NUM of eigenvalues of a tridiagonal
19 * matrix T which are less than or equal to SHIFT. T has
20 * diagonal entries A(1), ... , A(N), and offdiagonal entries
21 * B(1), ..., B(N-1).
22 * See W. Kahan "Accurate Eigenvalues of a Symmetric Tridiagonal
23 * Matrix", Report CS41, Computer Science Dept., Stanford
24 * University, July 21, 1966
25 *
26 * Arguments
27 * =========
28 *
29 * N (input) INTEGER
30 * The dimension of the tridiagonal matrix T.
31 *
32 * A (input) REAL array, dimension (N)
33 * The diagonal entries of the tridiagonal matrix T.
34 *
35 * B (input) REAL array, dimension (N-1)
36 * The offdiagonal entries of the tridiagonal matrix T.
37 *
38 * SHIFT (input) REAL
39 * The shift, used as described under Purpose.
40 *
41 * NUM (output) INTEGER
42 * The number of eigenvalues of T less than or equal
43 * to SHIFT.
44 *
45 * =====================================================================
46 *
47 * .. Parameters ..
48 REAL ZERO, ONE, THREE
49 PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0, THREE = 3.0E0 )
50 * ..
51 * .. Local Scalars ..
52 INTEGER I
53 REAL M1, M2, MX, OVFL, SOV, SSHIFT, SSUN, SUN, TMP,
54 $ TOM, U, UNFL
55 * ..
56 * .. External Functions ..
57 REAL SLAMCH
58 EXTERNAL SLAMCH
59 * ..
60 * .. Intrinsic Functions ..
61 INTRINSIC ABS, MAX, SQRT
62 * ..
63 * .. Executable Statements ..
64 *
65 * Get machine constants
66 *
67 UNFL = SLAMCH( 'Safe minimum' )
68 OVFL = SLAMCH( 'Overflow' )
69 *
70 * Find largest entry
71 *
72 MX = ABS( A( 1 ) )
73 DO 10 I = 1, N - 1
74 MX = MAX( MX, ABS( A( I+1 ) ), ABS( B( I ) ) )
75 10 CONTINUE
76 *
77 * Handle easy cases, including zero matrix
78 *
79 IF( SHIFT.GE.THREE*MX ) THEN
80 NUM = N
81 RETURN
82 END IF
83 IF( SHIFT.LT.-THREE*MX ) THEN
84 NUM = 0
85 RETURN
86 END IF
87 *
88 * Compute scale factors as in Kahan's report
89 * At this point, MX .NE. 0 so we can divide by it
90 *
91 SUN = SQRT( UNFL )
92 SSUN = SQRT( SUN )
93 SOV = SQRT( OVFL )
94 TOM = SSUN*SOV
95 IF( MX.LE.ONE ) THEN
96 M1 = ONE / MX
97 M2 = TOM
98 ELSE
99 M1 = ONE
100 M2 = TOM / MX
101 END IF
102 *
103 * Begin counting
104 *
105 NUM = 0
106 SSHIFT = ( SHIFT*M1 )*M2
107 U = ( A( 1 )*M1 )*M2 - SSHIFT
108 IF( U.LE.SUN ) THEN
109 IF( U.LE.ZERO ) THEN
110 NUM = NUM + 1
111 IF( U.GT.-SUN )
112 $ U = -SUN
113 ELSE
114 U = SUN
115 END IF
116 END IF
117 DO 20 I = 2, N
118 TMP = ( B( I-1 )*M1 )*M2
119 U = ( ( A( I )*M1 )*M2-TMP*( TMP / U ) ) - SSHIFT
120 IF( U.LE.SUN ) THEN
121 IF( U.LE.ZERO ) THEN
122 NUM = NUM + 1
123 IF( U.GT.-SUN )
124 $ U = -SUN
125 ELSE
126 U = SUN
127 END IF
128 END IF
129 20 CONTINUE
130 RETURN
131 *
132 * End of SSTECT
133 *
134 END
2 *
3 * -- LAPACK test routine (version 3.1) --
4 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
5 * November 2006
6 *
7 * .. Scalar Arguments ..
8 INTEGER N, NUM
9 REAL SHIFT
10 * ..
11 * .. Array Arguments ..
12 REAL A( * ), B( * )
13 * ..
14 *
15 * Purpose
16 * =======
17 *
18 * SSTECT counts the number NUM of eigenvalues of a tridiagonal
19 * matrix T which are less than or equal to SHIFT. T has
20 * diagonal entries A(1), ... , A(N), and offdiagonal entries
21 * B(1), ..., B(N-1).
22 * See W. Kahan "Accurate Eigenvalues of a Symmetric Tridiagonal
23 * Matrix", Report CS41, Computer Science Dept., Stanford
24 * University, July 21, 1966
25 *
26 * Arguments
27 * =========
28 *
29 * N (input) INTEGER
30 * The dimension of the tridiagonal matrix T.
31 *
32 * A (input) REAL array, dimension (N)
33 * The diagonal entries of the tridiagonal matrix T.
34 *
35 * B (input) REAL array, dimension (N-1)
36 * The offdiagonal entries of the tridiagonal matrix T.
37 *
38 * SHIFT (input) REAL
39 * The shift, used as described under Purpose.
40 *
41 * NUM (output) INTEGER
42 * The number of eigenvalues of T less than or equal
43 * to SHIFT.
44 *
45 * =====================================================================
46 *
47 * .. Parameters ..
48 REAL ZERO, ONE, THREE
49 PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0, THREE = 3.0E0 )
50 * ..
51 * .. Local Scalars ..
52 INTEGER I
53 REAL M1, M2, MX, OVFL, SOV, SSHIFT, SSUN, SUN, TMP,
54 $ TOM, U, UNFL
55 * ..
56 * .. External Functions ..
57 REAL SLAMCH
58 EXTERNAL SLAMCH
59 * ..
60 * .. Intrinsic Functions ..
61 INTRINSIC ABS, MAX, SQRT
62 * ..
63 * .. Executable Statements ..
64 *
65 * Get machine constants
66 *
67 UNFL = SLAMCH( 'Safe minimum' )
68 OVFL = SLAMCH( 'Overflow' )
69 *
70 * Find largest entry
71 *
72 MX = ABS( A( 1 ) )
73 DO 10 I = 1, N - 1
74 MX = MAX( MX, ABS( A( I+1 ) ), ABS( B( I ) ) )
75 10 CONTINUE
76 *
77 * Handle easy cases, including zero matrix
78 *
79 IF( SHIFT.GE.THREE*MX ) THEN
80 NUM = N
81 RETURN
82 END IF
83 IF( SHIFT.LT.-THREE*MX ) THEN
84 NUM = 0
85 RETURN
86 END IF
87 *
88 * Compute scale factors as in Kahan's report
89 * At this point, MX .NE. 0 so we can divide by it
90 *
91 SUN = SQRT( UNFL )
92 SSUN = SQRT( SUN )
93 SOV = SQRT( OVFL )
94 TOM = SSUN*SOV
95 IF( MX.LE.ONE ) THEN
96 M1 = ONE / MX
97 M2 = TOM
98 ELSE
99 M1 = ONE
100 M2 = TOM / MX
101 END IF
102 *
103 * Begin counting
104 *
105 NUM = 0
106 SSHIFT = ( SHIFT*M1 )*M2
107 U = ( A( 1 )*M1 )*M2 - SSHIFT
108 IF( U.LE.SUN ) THEN
109 IF( U.LE.ZERO ) THEN
110 NUM = NUM + 1
111 IF( U.GT.-SUN )
112 $ U = -SUN
113 ELSE
114 U = SUN
115 END IF
116 END IF
117 DO 20 I = 2, N
118 TMP = ( B( I-1 )*M1 )*M2
119 U = ( ( A( I )*M1 )*M2-TMP*( TMP / U ) ) - SSHIFT
120 IF( U.LE.SUN ) THEN
121 IF( U.LE.ZERO ) THEN
122 NUM = NUM + 1
123 IF( U.GT.-SUN )
124 $ U = -SUN
125 ELSE
126 U = SUN
127 END IF
128 END IF
129 20 CONTINUE
130 RETURN
131 *
132 * End of SSTECT
133 *
134 END