dlasq4.f.html
来自「famous linear algebra library (LAPACK) p」· HTML 代码 · 共 352 行 · 第 1/2 页
HTML
352 行
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<title>dlasq4.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.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="DLASQ4.1"></a><a href="dlasq4.f.html#DLASQ4.1">DLASQ4</a>( I0, N0, Z, PP, N0IN, DMIN, DMIN1, DMIN2, DN,
$ DN1, DN2, TAU, TTYPE )
<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> INTEGER I0, N0, N0IN, PP, TTYPE
DOUBLE PRECISION DMIN, DMIN1, DMIN2, DN, DN1, DN2, TAU
<span class="comment">*</span><span class="comment"> ..
</span><span class="comment">*</span><span class="comment"> .. Array Arguments ..
</span> DOUBLE PRECISION Z( * )
<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"> <a name="DLASQ4.19"></a><a href="dlasq4.f.html#DLASQ4.1">DLASQ4</a> computes an approximation TAU to the smallest eigenvalue
</span><span class="comment">*</span><span class="comment"> using values of d from the previous transform.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> I0 (input) INTEGER
</span><span class="comment">*</span><span class="comment"> First index.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> N0 (input) INTEGER
</span><span class="comment">*</span><span class="comment"> Last index.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> Z (input) DOUBLE PRECISION array, dimension ( 4*N )
</span><span class="comment">*</span><span class="comment"> Z holds the qd array.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> PP (input) INTEGER
</span><span class="comment">*</span><span class="comment"> PP=0 for ping, PP=1 for pong.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> N0IN (input) INTEGER
</span><span class="comment">*</span><span class="comment"> The value of N0 at start of EIGTEST.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> DMIN (input) DOUBLE PRECISION
</span><span class="comment">*</span><span class="comment"> Minimum value of d.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> DMIN1 (input) DOUBLE PRECISION
</span><span class="comment">*</span><span class="comment"> Minimum value of d, excluding D( N0 ).
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> DMIN2 (input) DOUBLE PRECISION
</span><span class="comment">*</span><span class="comment"> Minimum value of d, excluding D( N0 ) and D( N0-1 ).
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> DN (input) DOUBLE PRECISION
</span><span class="comment">*</span><span class="comment"> d(N)
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> DN1 (input) DOUBLE PRECISION
</span><span class="comment">*</span><span class="comment"> d(N-1)
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> DN2 (input) DOUBLE PRECISION
</span><span class="comment">*</span><span class="comment"> d(N-2)
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> TAU (output) DOUBLE PRECISION
</span><span class="comment">*</span><span class="comment"> This is the shift.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> TTYPE (output) INTEGER
</span><span class="comment">*</span><span class="comment"> Shift type.
</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"> CNST1 = 9/16
</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 CNST1, CNST2, CNST3
PARAMETER ( CNST1 = 0.5630D0, CNST2 = 1.010D0,
$ CNST3 = 1.050D0 )
DOUBLE PRECISION QURTR, THIRD, HALF, ZERO, ONE, TWO, HUNDRD
PARAMETER ( QURTR = 0.250D0, THIRD = 0.3330D0,
$ HALF = 0.50D0, ZERO = 0.0D0, ONE = 1.0D0,
$ TWO = 2.0D0, HUNDRD = 100.0D0 )
<span class="comment">*</span><span class="comment"> ..
</span><span class="comment">*</span><span class="comment"> .. Local Scalars ..
</span> INTEGER I4, NN, NP
DOUBLE PRECISION A2, B1, B2, G, GAM, GAP1, GAP2, S
<span class="comment">*</span><span class="comment"> ..
</span><span class="comment">*</span><span class="comment"> .. Intrinsic Functions ..
</span> INTRINSIC MAX, MIN, SQRT
<span class="comment">*</span><span class="comment"> ..
</span><span class="comment">*</span><span class="comment"> .. Save statement ..
</span> SAVE G
<span class="comment">*</span><span class="comment"> ..
</span><span class="comment">*</span><span class="comment"> .. Data statement ..
</span> DATA G / ZERO /
<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><span class="comment">*</span><span class="comment"> A negative DMIN forces the shift to take that absolute value
</span><span class="comment">*</span><span class="comment"> TTYPE records the type of shift.
</span><span class="comment">*</span><span class="comment">
</span> IF( DMIN.LE.ZERO ) THEN
TAU = -DMIN
TTYPE = -1
RETURN
END IF
<span class="comment">*</span><span class="comment">
</span> NN = 4*N0 + PP
IF( N0IN.EQ.N0 ) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> No eigenvalues deflated.
</span><span class="comment">*</span><span class="comment">
</span> IF( DMIN.EQ.DN .OR. DMIN.EQ.DN1 ) THEN
<span class="comment">*</span><span class="comment">
</span> B1 = SQRT( Z( NN-3 ) )*SQRT( Z( NN-5 ) )
B2 = SQRT( Z( NN-7 ) )*SQRT( Z( NN-9 ) )
A2 = Z( NN-7 ) + Z( NN-5 )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> Cases 2 and 3.
</span><span class="comment">*</span><span class="comment">
</span> IF( DMIN.EQ.DN .AND. DMIN1.EQ.DN1 ) THEN
GAP2 = DMIN2 - A2 - DMIN2*QURTR
IF( GAP2.GT.ZERO .AND. GAP2.GT.B2 ) THEN
GAP1 = A2 - DN - ( B2 / GAP2 )*B2
ELSE
GAP1 = A2 - DN - ( B1+B2 )
END IF
IF( GAP1.GT.ZERO .AND. GAP1.GT.B1 ) THEN
S = MAX( DN-( B1 / GAP1 )*B1, HALF*DMIN )
TTYPE = -2
ELSE
S = ZERO
IF( DN.GT.B1 )
$ S = DN - B1
IF( A2.GT.( B1+B2 ) )
$ S = MIN( S, A2-( B1+B2 ) )
S = MAX( S, THIRD*DMIN )
TTYPE = -3
END IF
ELSE
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> Case 4.
</span><span class="comment">*</span><span class="comment">
</span> TTYPE = -4
S = QURTR*DMIN
IF( DMIN.EQ.DN ) THEN
GAM = DN
A2 = ZERO
IF( Z( NN-5 ) .GT. Z( NN-7 ) )
$ RETURN
B2 = Z( NN-5 ) / Z( NN-7 )
NP = NN - 9
ELSE
NP = NN - 2*PP
B2 = Z( NP-2 )
GAM = DN1
IF( Z( NP-4 ) .GT. Z( NP-2 ) )
$ RETURN
A2 = Z( NP-4 ) / Z( NP-2 )
IF( Z( NN-9 ) .GT. Z( NN-11 ) )
$ RETURN
B2 = Z( NN-9 ) / Z( NN-11 )
NP = NN - 13
END IF
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> Approximate contribution to norm squared from I < NN-1.
</span><span class="comment">*</span><span class="comment">
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?