1 SUBROUTINE DLARRC( JOBT, N, VL, VU, D, E, PIVMIN,
2 $ EIGCNT, LCNT, RCNT, INFO )
3 *
4 * -- LAPACK auxiliary routine (version 3.2) --
5 * -- LAPACK is a software package provided by Univ. of Tennessee, --
6 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
7 * November 2006
8 *
9 * .. Scalar Arguments ..
10 CHARACTER JOBT
11 INTEGER EIGCNT, INFO, LCNT, N, RCNT
12 DOUBLE PRECISION PIVMIN, VL, VU
13 * ..
14 * .. Array Arguments ..
15 DOUBLE PRECISION D( * ), E( * )
16 * ..
17 *
18 * Purpose
19 * =======
20 *
21 * Find the number of eigenvalues of the symmetric tridiagonal matrix T
22 * that are in the interval (VL,VU] if JOBT = 'T', and of L D L^T
23 * if JOBT = 'L'.
24 *
25 * Arguments
26 * =========
27 *
28 * JOBT (input) CHARACTER*1
29 * = 'T': Compute Sturm count for matrix T.
30 * = 'L': Compute Sturm count for matrix L D L^T.
31 *
32 * N (input) INTEGER
33 * The order of the matrix. N > 0.
34 *
35 * VL (input) DOUBLE PRECISION
36 * VU (input) DOUBLE PRECISION
37 * The lower and upper bounds for the eigenvalues.
38 *
39 * D (input) DOUBLE PRECISION array, dimension (N)
40 * JOBT = 'T': The N diagonal elements of the tridiagonal matrix T.
41 * JOBT = 'L': The N diagonal elements of the diagonal matrix D.
42 *
43 * E (input) DOUBLE PRECISION array, dimension (N)
44 * JOBT = 'T': The N-1 offdiagonal elements of the matrix T.
45 * JOBT = 'L': The N-1 offdiagonal elements of the matrix L.
46 *
47 * PIVMIN (input) DOUBLE PRECISION
48 * The minimum pivot in the Sturm sequence for T.
49 *
50 * EIGCNT (output) INTEGER
51 * The number of eigenvalues of the symmetric tridiagonal matrix T
52 * that are in the interval (VL,VU]
53 *
54 * LCNT (output) INTEGER
55 * RCNT (output) INTEGER
56 * The left and right negcounts of the interval.
57 *
58 * INFO (output) INTEGER
59 *
60 * Further Details
61 * ===============
62 *
63 * Based on contributions by
64 * Beresford Parlett, University of California, Berkeley, USA
65 * Jim Demmel, University of California, Berkeley, USA
66 * Inderjit Dhillon, University of Texas, Austin, USA
67 * Osni Marques, LBNL/NERSC, USA
68 * Christof Voemel, University of California, Berkeley, USA
69 *
70 * =====================================================================
71 *
72 * .. Parameters ..
73 DOUBLE PRECISION ZERO
74 PARAMETER ( ZERO = 0.0D0 )
75 * ..
76 * .. Local Scalars ..
77 INTEGER I
78 LOGICAL MATT
79 DOUBLE PRECISION LPIVOT, RPIVOT, SL, SU, TMP, TMP2
80
81 * ..
82 * .. External Functions ..
83 LOGICAL LSAME
84 EXTERNAL LSAME
85 * ..
86 * .. Executable Statements ..
87 *
88 INFO = 0
89 LCNT = 0
90 RCNT = 0
91 EIGCNT = 0
92 MATT = LSAME( JOBT, 'T' )
93
94
95 IF (MATT) THEN
96 * Sturm sequence count on T
97 LPIVOT = D( 1 ) - VL
98 RPIVOT = D( 1 ) - VU
99 IF( LPIVOT.LE.ZERO ) THEN
100 LCNT = LCNT + 1
101 ENDIF
102 IF( RPIVOT.LE.ZERO ) THEN
103 RCNT = RCNT + 1
104 ENDIF
105 DO 10 I = 1, N-1
106 TMP = E(I)**2
107 LPIVOT = ( D( I+1 )-VL ) - TMP/LPIVOT
108 RPIVOT = ( D( I+1 )-VU ) - TMP/RPIVOT
109 IF( LPIVOT.LE.ZERO ) THEN
110 LCNT = LCNT + 1
111 ENDIF
112 IF( RPIVOT.LE.ZERO ) THEN
113 RCNT = RCNT + 1
114 ENDIF
115 10 CONTINUE
116 ELSE
117 * Sturm sequence count on L D L^T
118 SL = -VL
119 SU = -VU
120 DO 20 I = 1, N - 1
121 LPIVOT = D( I ) + SL
122 RPIVOT = D( I ) + SU
123 IF( LPIVOT.LE.ZERO ) THEN
124 LCNT = LCNT + 1
125 ENDIF
126 IF( RPIVOT.LE.ZERO ) THEN
127 RCNT = RCNT + 1
128 ENDIF
129 TMP = E(I) * D(I) * E(I)
130 *
131 TMP2 = TMP / LPIVOT
132 IF( TMP2.EQ.ZERO ) THEN
133 SL = TMP - VL
134 ELSE
135 SL = SL*TMP2 - VL
136 END IF
137 *
138 TMP2 = TMP / RPIVOT
139 IF( TMP2.EQ.ZERO ) THEN
140 SU = TMP - VU
141 ELSE
142 SU = SU*TMP2 - VU
143 END IF
144 20 CONTINUE
145 LPIVOT = D( N ) + SL
146 RPIVOT = D( N ) + SU
147 IF( LPIVOT.LE.ZERO ) THEN
148 LCNT = LCNT + 1
149 ENDIF
150 IF( RPIVOT.LE.ZERO ) THEN
151 RCNT = RCNT + 1
152 ENDIF
153 ENDIF
154 EIGCNT = RCNT - LCNT
155
156 RETURN
157 *
158 * end of DLARRC
159 *
160 END
2 $ EIGCNT, LCNT, RCNT, INFO )
3 *
4 * -- LAPACK auxiliary routine (version 3.2) --
5 * -- LAPACK is a software package provided by Univ. of Tennessee, --
6 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
7 * November 2006
8 *
9 * .. Scalar Arguments ..
10 CHARACTER JOBT
11 INTEGER EIGCNT, INFO, LCNT, N, RCNT
12 DOUBLE PRECISION PIVMIN, VL, VU
13 * ..
14 * .. Array Arguments ..
15 DOUBLE PRECISION D( * ), E( * )
16 * ..
17 *
18 * Purpose
19 * =======
20 *
21 * Find the number of eigenvalues of the symmetric tridiagonal matrix T
22 * that are in the interval (VL,VU] if JOBT = 'T', and of L D L^T
23 * if JOBT = 'L'.
24 *
25 * Arguments
26 * =========
27 *
28 * JOBT (input) CHARACTER*1
29 * = 'T': Compute Sturm count for matrix T.
30 * = 'L': Compute Sturm count for matrix L D L^T.
31 *
32 * N (input) INTEGER
33 * The order of the matrix. N > 0.
34 *
35 * VL (input) DOUBLE PRECISION
36 * VU (input) DOUBLE PRECISION
37 * The lower and upper bounds for the eigenvalues.
38 *
39 * D (input) DOUBLE PRECISION array, dimension (N)
40 * JOBT = 'T': The N diagonal elements of the tridiagonal matrix T.
41 * JOBT = 'L': The N diagonal elements of the diagonal matrix D.
42 *
43 * E (input) DOUBLE PRECISION array, dimension (N)
44 * JOBT = 'T': The N-1 offdiagonal elements of the matrix T.
45 * JOBT = 'L': The N-1 offdiagonal elements of the matrix L.
46 *
47 * PIVMIN (input) DOUBLE PRECISION
48 * The minimum pivot in the Sturm sequence for T.
49 *
50 * EIGCNT (output) INTEGER
51 * The number of eigenvalues of the symmetric tridiagonal matrix T
52 * that are in the interval (VL,VU]
53 *
54 * LCNT (output) INTEGER
55 * RCNT (output) INTEGER
56 * The left and right negcounts of the interval.
57 *
58 * INFO (output) INTEGER
59 *
60 * Further Details
61 * ===============
62 *
63 * Based on contributions by
64 * Beresford Parlett, University of California, Berkeley, USA
65 * Jim Demmel, University of California, Berkeley, USA
66 * Inderjit Dhillon, University of Texas, Austin, USA
67 * Osni Marques, LBNL/NERSC, USA
68 * Christof Voemel, University of California, Berkeley, USA
69 *
70 * =====================================================================
71 *
72 * .. Parameters ..
73 DOUBLE PRECISION ZERO
74 PARAMETER ( ZERO = 0.0D0 )
75 * ..
76 * .. Local Scalars ..
77 INTEGER I
78 LOGICAL MATT
79 DOUBLE PRECISION LPIVOT, RPIVOT, SL, SU, TMP, TMP2
80
81 * ..
82 * .. External Functions ..
83 LOGICAL LSAME
84 EXTERNAL LSAME
85 * ..
86 * .. Executable Statements ..
87 *
88 INFO = 0
89 LCNT = 0
90 RCNT = 0
91 EIGCNT = 0
92 MATT = LSAME( JOBT, 'T' )
93
94
95 IF (MATT) THEN
96 * Sturm sequence count on T
97 LPIVOT = D( 1 ) - VL
98 RPIVOT = D( 1 ) - VU
99 IF( LPIVOT.LE.ZERO ) THEN
100 LCNT = LCNT + 1
101 ENDIF
102 IF( RPIVOT.LE.ZERO ) THEN
103 RCNT = RCNT + 1
104 ENDIF
105 DO 10 I = 1, N-1
106 TMP = E(I)**2
107 LPIVOT = ( D( I+1 )-VL ) - TMP/LPIVOT
108 RPIVOT = ( D( I+1 )-VU ) - TMP/RPIVOT
109 IF( LPIVOT.LE.ZERO ) THEN
110 LCNT = LCNT + 1
111 ENDIF
112 IF( RPIVOT.LE.ZERO ) THEN
113 RCNT = RCNT + 1
114 ENDIF
115 10 CONTINUE
116 ELSE
117 * Sturm sequence count on L D L^T
118 SL = -VL
119 SU = -VU
120 DO 20 I = 1, N - 1
121 LPIVOT = D( I ) + SL
122 RPIVOT = D( I ) + SU
123 IF( LPIVOT.LE.ZERO ) THEN
124 LCNT = LCNT + 1
125 ENDIF
126 IF( RPIVOT.LE.ZERO ) THEN
127 RCNT = RCNT + 1
128 ENDIF
129 TMP = E(I) * D(I) * E(I)
130 *
131 TMP2 = TMP / LPIVOT
132 IF( TMP2.EQ.ZERO ) THEN
133 SL = TMP - VL
134 ELSE
135 SL = SL*TMP2 - VL
136 END IF
137 *
138 TMP2 = TMP / RPIVOT
139 IF( TMP2.EQ.ZERO ) THEN
140 SU = TMP - VU
141 ELSE
142 SU = SU*TMP2 - VU
143 END IF
144 20 CONTINUE
145 LPIVOT = D( N ) + SL
146 RPIVOT = D( N ) + SU
147 IF( LPIVOT.LE.ZERO ) THEN
148 LCNT = LCNT + 1
149 ENDIF
150 IF( RPIVOT.LE.ZERO ) THEN
151 RCNT = RCNT + 1
152 ENDIF
153 ENDIF
154 EIGCNT = RCNT - LCNT
155
156 RETURN
157 *
158 * end of DLARRC
159 *
160 END