dlarrc.f.html
来自「famous linear algebra library (LAPACK) p」· HTML 代码 · 共 184 行
HTML
184 行
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<title>dlarrc.f</title>
<meta name="generator" content="emacs 21.3.1; htmlfontify 0.20">
<style type="text/css"><!--
body { background: rgb(255, 255, 255); color: rgb(0, 0, 0); font-style: normal; font-weight: 500; font-stretch: normal; font-family: adobe-courier; font-size: 11pt; text-decoration: none; }
span.default { background: rgb(255, 255, 255); color: rgb(0, 0, 0); font-style: normal; font-weight: 500; font-stretch: normal; font-family: adobe-courier; font-size: 11pt; text-decoration: none; }
span.default a { background: rgb(255, 255, 255); color: rgb(0, 0, 0); font-style: normal; font-weight: 500; font-stretch: normal; font-family: adobe-courier; font-size: 11pt; text-decoration: underline; }
span.string { color: rgb(188, 143, 143); background: rgb(255, 255, 255); font-style: normal; font-weight: 500; font-stretch: normal; font-family: adobe-courier; font-size: 11pt; text-decoration: none; }
span.string a { color: rgb(188, 143, 143); background: rgb(255, 255, 255); font-style: normal; font-weight: 500; font-stretch: normal; font-family: adobe-courier; font-size: 11pt; text-decoration: underline; }
span.comment { color: rgb(178, 34, 34); background: rgb(255, 255, 255); font-style: normal; font-weight: 500; font-stretch: normal; font-family: adobe-courier; font-size: 11pt; text-decoration: none; }
span.comment a { color: rgb(178, 34, 34); background: rgb(255, 255, 255); font-style: normal; font-weight: 500; font-stretch: normal; font-family: adobe-courier; font-size: 11pt; text-decoration: underline; }
--></style>
</head>
<body>
<pre>
SUBROUTINE <a name="DLARRC.1"></a><a href="dlarrc.f.html#DLARRC.1">DLARRC</a>( JOBT, N, VL, VU, D, E, PIVMIN,
$ EIGCNT, LCNT, RCNT, INFO )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> -- LAPACK auxiliary routine (version 3.1) --
</span><span class="comment">*</span><span class="comment"> Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
</span><span class="comment">*</span><span class="comment"> November 2006
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> .. Scalar Arguments ..
</span> CHARACTER JOBT
INTEGER EIGCNT, INFO, LCNT, N, RCNT
DOUBLE PRECISION PIVMIN, VL, VU
<span class="comment">*</span><span class="comment"> ..
</span><span class="comment">*</span><span class="comment"> .. Array Arguments ..
</span> DOUBLE PRECISION D( * ), E( * )
<span class="comment">*</span><span class="comment"> ..
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> Purpose
</span><span class="comment">*</span><span class="comment"> =======
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> Find the number of eigenvalues of the symmetric tridiagonal matrix T
</span><span class="comment">*</span><span class="comment"> that are in the interval (VL,VU] if JOBT = 'T', and of L D L^T
</span><span class="comment">*</span><span class="comment"> if JOBT = 'L'.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> Arguments
</span><span class="comment">*</span><span class="comment"> =========
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> JOBT (input) CHARACTER*1
</span><span class="comment">*</span><span class="comment"> = 'T': Compute Sturm count for matrix T.
</span><span class="comment">*</span><span class="comment"> = 'L': Compute Sturm count for matrix L D L^T.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> N (input) INTEGER
</span><span class="comment">*</span><span class="comment"> The order of the matrix. N > 0.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> VL (input) DOUBLE PRECISION
</span><span class="comment">*</span><span class="comment"> VU (input) DOUBLE PRECISION
</span><span class="comment">*</span><span class="comment"> The lower and upper bounds for the eigenvalues.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> D (input) DOUBLE PRECISION array, dimension (N)
</span><span class="comment">*</span><span class="comment"> JOBT = 'T': The N diagonal elements of the tridiagonal matrix T.
</span><span class="comment">*</span><span class="comment"> JOBT = 'L': The N diagonal elements of the diagonal matrix D.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> E (input) DOUBLE PRECISION array, dimension (N)
</span><span class="comment">*</span><span class="comment"> JOBT = 'T': The N-1 offdiagonal elements of the matrix T.
</span><span class="comment">*</span><span class="comment"> JOBT = 'L': The N-1 offdiagonal elements of the matrix L.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> PIVMIN (input) DOUBLE PRECISION
</span><span class="comment">*</span><span class="comment"> The minimum pivot in the Sturm sequence for T.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> EIGCNT (output) INTEGER
</span><span class="comment">*</span><span class="comment"> The number of eigenvalues of the symmetric tridiagonal matrix T
</span><span class="comment">*</span><span class="comment"> that are in the interval (VL,VU]
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> LCNT (output) INTEGER
</span><span class="comment">*</span><span class="comment"> RCNT (output) INTEGER
</span><span class="comment">*</span><span class="comment"> The left and right negcounts of the interval.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> INFO (output) INTEGER
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> Further Details
</span><span class="comment">*</span><span class="comment"> ===============
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> Based on contributions by
</span><span class="comment">*</span><span class="comment"> Beresford Parlett, University of California, Berkeley, USA
</span><span class="comment">*</span><span class="comment"> Jim Demmel, University of California, Berkeley, USA
</span><span class="comment">*</span><span class="comment"> Inderjit Dhillon, University of Texas, Austin, USA
</span><span class="comment">*</span><span class="comment"> Osni Marques, LBNL/NERSC, USA
</span><span class="comment">*</span><span class="comment"> Christof Voemel, University of California, Berkeley, USA
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> =====================================================================
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> .. Parameters ..
</span> DOUBLE PRECISION ZERO
PARAMETER ( ZERO = 0.0D0 )
<span class="comment">*</span><span class="comment"> ..
</span><span class="comment">*</span><span class="comment"> .. Local Scalars ..
</span> INTEGER I
LOGICAL MATT
DOUBLE PRECISION LPIVOT, RPIVOT, SL, SU, TMP, TMP2
<span class="comment">*</span><span class="comment"> ..
</span><span class="comment">*</span><span class="comment"> .. External Functions ..
</span> LOGICAL <a name="LSAME.82"></a><a href="lsame.f.html#LSAME.1">LSAME</a>
EXTERNAL <a name="LSAME.83"></a><a href="lsame.f.html#LSAME.1">LSAME</a>
<span class="comment">*</span><span class="comment"> ..
</span><span class="comment">*</span><span class="comment"> .. Executable Statements ..
</span><span class="comment">*</span><span class="comment">
</span> INFO = 0
LCNT = 0
RCNT = 0
EIGCNT = 0
MATT = <a name="LSAME.91"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( JOBT, <span class="string">'T'</span> )
IF (MATT) THEN
<span class="comment">*</span><span class="comment"> Sturm sequence count on T
</span> LPIVOT = D( 1 ) - VL
RPIVOT = D( 1 ) - VU
IF( LPIVOT.LE.ZERO ) THEN
LCNT = LCNT + 1
ENDIF
IF( RPIVOT.LE.ZERO ) THEN
RCNT = RCNT + 1
ENDIF
DO 10 I = 1, N-1
TMP = E(I)**2
LPIVOT = ( D( I+1 )-VL ) - TMP/LPIVOT
RPIVOT = ( D( I+1 )-VU ) - TMP/RPIVOT
IF( LPIVOT.LE.ZERO ) THEN
LCNT = LCNT + 1
ENDIF
IF( RPIVOT.LE.ZERO ) THEN
RCNT = RCNT + 1
ENDIF
10 CONTINUE
ELSE
<span class="comment">*</span><span class="comment"> Sturm sequence count on L D L^T
</span> SL = -VL
SU = -VU
DO 20 I = 1, N - 1
LPIVOT = D( I ) + SL
RPIVOT = D( I ) + SU
IF( LPIVOT.LE.ZERO ) THEN
LCNT = LCNT + 1
ENDIF
IF( RPIVOT.LE.ZERO ) THEN
RCNT = RCNT + 1
ENDIF
TMP = E(I) * D(I) * E(I)
<span class="comment">*</span><span class="comment">
</span> TMP2 = TMP / LPIVOT
IF( TMP2.EQ.ZERO ) THEN
SL = TMP - VL
ELSE
SL = SL*TMP2 - VL
END IF
<span class="comment">*</span><span class="comment">
</span> TMP2 = TMP / RPIVOT
IF( TMP2.EQ.ZERO ) THEN
SU = TMP - VU
ELSE
SU = SU*TMP2 - VU
END IF
20 CONTINUE
LPIVOT = D( N ) + SL
RPIVOT = D( N ) + SU
IF( LPIVOT.LE.ZERO ) THEN
LCNT = LCNT + 1
ENDIF
IF( RPIVOT.LE.ZERO ) THEN
RCNT = RCNT + 1
ENDIF
ENDIF
EIGCNT = RCNT - LCNT
RETURN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> end of <a name="DLARRC.157"></a><a href="dlarrc.f.html#DLARRC.1">DLARRC</a>
</span><span class="comment">*</span><span class="comment">
</span> END
</pre>
</body>
</html>
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?