LAPACK 3.3.1
Linear Algebra PACKage
|
00001 SUBROUTINE DLARRC( JOBT, N, VL, VU, D, E, PIVMIN, 00002 $ EIGCNT, LCNT, RCNT, INFO ) 00003 * 00004 * -- LAPACK auxiliary routine (version 3.2) -- 00005 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00006 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00007 * November 2006 00008 * 00009 * .. Scalar Arguments .. 00010 CHARACTER JOBT 00011 INTEGER EIGCNT, INFO, LCNT, N, RCNT 00012 DOUBLE PRECISION PIVMIN, VL, VU 00013 * .. 00014 * .. Array Arguments .. 00015 DOUBLE PRECISION D( * ), E( * ) 00016 * .. 00017 * 00018 * Purpose 00019 * ======= 00020 * 00021 * Find the number of eigenvalues of the symmetric tridiagonal matrix T 00022 * that are in the interval (VL,VU] if JOBT = 'T', and of L D L^T 00023 * if JOBT = 'L'. 00024 * 00025 * Arguments 00026 * ========= 00027 * 00028 * JOBT (input) CHARACTER*1 00029 * = 'T': Compute Sturm count for matrix T. 00030 * = 'L': Compute Sturm count for matrix L D L^T. 00031 * 00032 * N (input) INTEGER 00033 * The order of the matrix. N > 0. 00034 * 00035 * VL (input) DOUBLE PRECISION 00036 * VU (input) DOUBLE PRECISION 00037 * The lower and upper bounds for the eigenvalues. 00038 * 00039 * D (input) DOUBLE PRECISION array, dimension (N) 00040 * JOBT = 'T': The N diagonal elements of the tridiagonal matrix T. 00041 * JOBT = 'L': The N diagonal elements of the diagonal matrix D. 00042 * 00043 * E (input) DOUBLE PRECISION array, dimension (N) 00044 * JOBT = 'T': The N-1 offdiagonal elements of the matrix T. 00045 * JOBT = 'L': The N-1 offdiagonal elements of the matrix L. 00046 * 00047 * PIVMIN (input) DOUBLE PRECISION 00048 * The minimum pivot in the Sturm sequence for T. 00049 * 00050 * EIGCNT (output) INTEGER 00051 * The number of eigenvalues of the symmetric tridiagonal matrix T 00052 * that are in the interval (VL,VU] 00053 * 00054 * LCNT (output) INTEGER 00055 * RCNT (output) INTEGER 00056 * The left and right negcounts of the interval. 00057 * 00058 * INFO (output) INTEGER 00059 * 00060 * Further Details 00061 * =============== 00062 * 00063 * Based on contributions by 00064 * Beresford Parlett, University of California, Berkeley, USA 00065 * Jim Demmel, University of California, Berkeley, USA 00066 * Inderjit Dhillon, University of Texas, Austin, USA 00067 * Osni Marques, LBNL/NERSC, USA 00068 * Christof Voemel, University of California, Berkeley, USA 00069 * 00070 * ===================================================================== 00071 * 00072 * .. Parameters .. 00073 DOUBLE PRECISION ZERO 00074 PARAMETER ( ZERO = 0.0D0 ) 00075 * .. 00076 * .. Local Scalars .. 00077 INTEGER I 00078 LOGICAL MATT 00079 DOUBLE PRECISION LPIVOT, RPIVOT, SL, SU, TMP, TMP2 00080 00081 * .. 00082 * .. External Functions .. 00083 LOGICAL LSAME 00084 EXTERNAL LSAME 00085 * .. 00086 * .. Executable Statements .. 00087 * 00088 INFO = 0 00089 LCNT = 0 00090 RCNT = 0 00091 EIGCNT = 0 00092 MATT = LSAME( JOBT, 'T' ) 00093 00094 00095 IF (MATT) THEN 00096 * Sturm sequence count on T 00097 LPIVOT = D( 1 ) - VL 00098 RPIVOT = D( 1 ) - VU 00099 IF( LPIVOT.LE.ZERO ) THEN 00100 LCNT = LCNT + 1 00101 ENDIF 00102 IF( RPIVOT.LE.ZERO ) THEN 00103 RCNT = RCNT + 1 00104 ENDIF 00105 DO 10 I = 1, N-1 00106 TMP = E(I)**2 00107 LPIVOT = ( D( I+1 )-VL ) - TMP/LPIVOT 00108 RPIVOT = ( D( I+1 )-VU ) - TMP/RPIVOT 00109 IF( LPIVOT.LE.ZERO ) THEN 00110 LCNT = LCNT + 1 00111 ENDIF 00112 IF( RPIVOT.LE.ZERO ) THEN 00113 RCNT = RCNT + 1 00114 ENDIF 00115 10 CONTINUE 00116 ELSE 00117 * Sturm sequence count on L D L^T 00118 SL = -VL 00119 SU = -VU 00120 DO 20 I = 1, N - 1 00121 LPIVOT = D( I ) + SL 00122 RPIVOT = D( I ) + SU 00123 IF( LPIVOT.LE.ZERO ) THEN 00124 LCNT = LCNT + 1 00125 ENDIF 00126 IF( RPIVOT.LE.ZERO ) THEN 00127 RCNT = RCNT + 1 00128 ENDIF 00129 TMP = E(I) * D(I) * E(I) 00130 * 00131 TMP2 = TMP / LPIVOT 00132 IF( TMP2.EQ.ZERO ) THEN 00133 SL = TMP - VL 00134 ELSE 00135 SL = SL*TMP2 - VL 00136 END IF 00137 * 00138 TMP2 = TMP / RPIVOT 00139 IF( TMP2.EQ.ZERO ) THEN 00140 SU = TMP - VU 00141 ELSE 00142 SU = SU*TMP2 - VU 00143 END IF 00144 20 CONTINUE 00145 LPIVOT = D( N ) + SL 00146 RPIVOT = D( N ) + SU 00147 IF( LPIVOT.LE.ZERO ) THEN 00148 LCNT = LCNT + 1 00149 ENDIF 00150 IF( RPIVOT.LE.ZERO ) THEN 00151 RCNT = RCNT + 1 00152 ENDIF 00153 ENDIF 00154 EIGCNT = RCNT - LCNT 00155 00156 RETURN 00157 * 00158 * end of DLARRC 00159 * 00160 END