![]() |
LAPACK
3.4.1
LAPACK: Linear Algebra PACKage
|
00001 *> \brief \b DLARRC 00002 * 00003 * =========== DOCUMENTATION =========== 00004 * 00005 * Online html documentation available at 00006 * http://www.netlib.org/lapack/explore-html/ 00007 * 00008 *> \htmlonly 00009 *> Download DLARRC + dependencies 00010 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlarrc.f"> 00011 *> [TGZ]</a> 00012 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlarrc.f"> 00013 *> [ZIP]</a> 00014 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlarrc.f"> 00015 *> [TXT]</a> 00016 *> \endhtmlonly 00017 * 00018 * Definition: 00019 * =========== 00020 * 00021 * SUBROUTINE DLARRC( JOBT, N, VL, VU, D, E, PIVMIN, 00022 * EIGCNT, LCNT, RCNT, INFO ) 00023 * 00024 * .. Scalar Arguments .. 00025 * CHARACTER JOBT 00026 * INTEGER EIGCNT, INFO, LCNT, N, RCNT 00027 * DOUBLE PRECISION PIVMIN, VL, VU 00028 * .. 00029 * .. Array Arguments .. 00030 * DOUBLE PRECISION D( * ), E( * ) 00031 * .. 00032 * 00033 * 00034 *> \par Purpose: 00035 * ============= 00036 *> 00037 *> \verbatim 00038 *> 00039 *> Find the number of eigenvalues of the symmetric tridiagonal matrix T 00040 *> that are in the interval (VL,VU] if JOBT = 'T', and of L D L^T 00041 *> if JOBT = 'L'. 00042 *> \endverbatim 00043 * 00044 * Arguments: 00045 * ========== 00046 * 00047 *> \param[in] JOBT 00048 *> \verbatim 00049 *> JOBT is CHARACTER*1 00050 *> = 'T': Compute Sturm count for matrix T. 00051 *> = 'L': Compute Sturm count for matrix L D L^T. 00052 *> \endverbatim 00053 *> 00054 *> \param[in] N 00055 *> \verbatim 00056 *> N is INTEGER 00057 *> The order of the matrix. N > 0. 00058 *> \endverbatim 00059 *> 00060 *> \param[in] VL 00061 *> \verbatim 00062 *> VL is DOUBLE PRECISION 00063 *> \endverbatim 00064 *> 00065 *> \param[in] VU 00066 *> \verbatim 00067 *> VU is DOUBLE PRECISION 00068 *> The lower and upper bounds for the eigenvalues. 00069 *> \endverbatim 00070 *> 00071 *> \param[in] D 00072 *> \verbatim 00073 *> D is DOUBLE PRECISION array, dimension (N) 00074 *> JOBT = 'T': The N diagonal elements of the tridiagonal matrix T. 00075 *> JOBT = 'L': The N diagonal elements of the diagonal matrix D. 00076 *> \endverbatim 00077 *> 00078 *> \param[in] E 00079 *> \verbatim 00080 *> E is DOUBLE PRECISION array, dimension (N) 00081 *> JOBT = 'T': The N-1 offdiagonal elements of the matrix T. 00082 *> JOBT = 'L': The N-1 offdiagonal elements of the matrix L. 00083 *> \endverbatim 00084 *> 00085 *> \param[in] PIVMIN 00086 *> \verbatim 00087 *> PIVMIN is DOUBLE PRECISION 00088 *> The minimum pivot in the Sturm sequence for T. 00089 *> \endverbatim 00090 *> 00091 *> \param[out] EIGCNT 00092 *> \verbatim 00093 *> EIGCNT is INTEGER 00094 *> The number of eigenvalues of the symmetric tridiagonal matrix T 00095 *> that are in the interval (VL,VU] 00096 *> \endverbatim 00097 *> 00098 *> \param[out] LCNT 00099 *> \verbatim 00100 *> LCNT is INTEGER 00101 *> \endverbatim 00102 *> 00103 *> \param[out] RCNT 00104 *> \verbatim 00105 *> RCNT is INTEGER 00106 *> The left and right negcounts of the interval. 00107 *> \endverbatim 00108 *> 00109 *> \param[out] INFO 00110 *> \verbatim 00111 *> INFO is INTEGER 00112 *> \endverbatim 00113 * 00114 * Authors: 00115 * ======== 00116 * 00117 *> \author Univ. of Tennessee 00118 *> \author Univ. of California Berkeley 00119 *> \author Univ. of Colorado Denver 00120 *> \author NAG Ltd. 00121 * 00122 *> \date November 2011 00123 * 00124 *> \ingroup auxOTHERauxiliary 00125 * 00126 *> \par Contributors: 00127 * ================== 00128 *> 00129 *> Beresford Parlett, University of California, Berkeley, USA \n 00130 *> Jim Demmel, University of California, Berkeley, USA \n 00131 *> Inderjit Dhillon, University of Texas, Austin, USA \n 00132 *> Osni Marques, LBNL/NERSC, USA \n 00133 *> Christof Voemel, University of California, Berkeley, USA 00134 * 00135 * ===================================================================== 00136 SUBROUTINE DLARRC( JOBT, N, VL, VU, D, E, PIVMIN, 00137 $ EIGCNT, LCNT, RCNT, INFO ) 00138 * 00139 * -- LAPACK auxiliary routine (version 3.4.0) -- 00140 * -- LAPACK is a software package provided by Univ. of Tennessee, -- 00141 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- 00142 * November 2011 00143 * 00144 * .. Scalar Arguments .. 00145 CHARACTER JOBT 00146 INTEGER EIGCNT, INFO, LCNT, N, RCNT 00147 DOUBLE PRECISION PIVMIN, VL, VU 00148 * .. 00149 * .. Array Arguments .. 00150 DOUBLE PRECISION D( * ), E( * ) 00151 * .. 00152 * 00153 * ===================================================================== 00154 * 00155 * .. Parameters .. 00156 DOUBLE PRECISION ZERO 00157 PARAMETER ( ZERO = 0.0D0 ) 00158 * .. 00159 * .. Local Scalars .. 00160 INTEGER I 00161 LOGICAL MATT 00162 DOUBLE PRECISION LPIVOT, RPIVOT, SL, SU, TMP, TMP2 00163 00164 * .. 00165 * .. External Functions .. 00166 LOGICAL LSAME 00167 EXTERNAL LSAME 00168 * .. 00169 * .. Executable Statements .. 00170 * 00171 INFO = 0 00172 LCNT = 0 00173 RCNT = 0 00174 EIGCNT = 0 00175 MATT = LSAME( JOBT, 'T' ) 00176 00177 00178 IF (MATT) THEN 00179 * Sturm sequence count on T 00180 LPIVOT = D( 1 ) - VL 00181 RPIVOT = D( 1 ) - VU 00182 IF( LPIVOT.LE.ZERO ) THEN 00183 LCNT = LCNT + 1 00184 ENDIF 00185 IF( RPIVOT.LE.ZERO ) THEN 00186 RCNT = RCNT + 1 00187 ENDIF 00188 DO 10 I = 1, N-1 00189 TMP = E(I)**2 00190 LPIVOT = ( D( I+1 )-VL ) - TMP/LPIVOT 00191 RPIVOT = ( D( I+1 )-VU ) - TMP/RPIVOT 00192 IF( LPIVOT.LE.ZERO ) THEN 00193 LCNT = LCNT + 1 00194 ENDIF 00195 IF( RPIVOT.LE.ZERO ) THEN 00196 RCNT = RCNT + 1 00197 ENDIF 00198 10 CONTINUE 00199 ELSE 00200 * Sturm sequence count on L D L^T 00201 SL = -VL 00202 SU = -VU 00203 DO 20 I = 1, N - 1 00204 LPIVOT = D( I ) + SL 00205 RPIVOT = D( I ) + SU 00206 IF( LPIVOT.LE.ZERO ) THEN 00207 LCNT = LCNT + 1 00208 ENDIF 00209 IF( RPIVOT.LE.ZERO ) THEN 00210 RCNT = RCNT + 1 00211 ENDIF 00212 TMP = E(I) * D(I) * E(I) 00213 * 00214 TMP2 = TMP / LPIVOT 00215 IF( TMP2.EQ.ZERO ) THEN 00216 SL = TMP - VL 00217 ELSE 00218 SL = SL*TMP2 - VL 00219 END IF 00220 * 00221 TMP2 = TMP / RPIVOT 00222 IF( TMP2.EQ.ZERO ) THEN 00223 SU = TMP - VU 00224 ELSE 00225 SU = SU*TMP2 - VU 00226 END IF 00227 20 CONTINUE 00228 LPIVOT = D( N ) + SL 00229 RPIVOT = D( N ) + SU 00230 IF( LPIVOT.LE.ZERO ) THEN 00231 LCNT = LCNT + 1 00232 ENDIF 00233 IF( RPIVOT.LE.ZERO ) THEN 00234 RCNT = RCNT + 1 00235 ENDIF 00236 ENDIF 00237 EIGCNT = RCNT - LCNT 00238 00239 RETURN 00240 * 00241 * end of DLARRC 00242 * 00243 END