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
CVSweb interface <joel.bertrand@systella.fr>