zgtcon.f.html
来自「famous linear algebra library (LAPACK) p」· HTML 代码 · 共 196 行
HTML
196 行
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<title>zgtcon.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="ZGTCON.1"></a><a href="zgtcon.f.html#ZGTCON.1">ZGTCON</a>( NORM, N, DL, D, DU, DU2, IPIV, ANORM, RCOND,
$ WORK, INFO )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> -- LAPACK 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"> Modified to call <a name="ZLACN2.8"></a><a href="zlacn2.f.html#ZLACN2.1">ZLACN2</a> in place of <a name="ZLACON.8"></a><a href="zlacon.f.html#ZLACON.1">ZLACON</a>, 10 Feb 03, SJH.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> .. Scalar Arguments ..
</span> CHARACTER NORM
INTEGER INFO, N
DOUBLE PRECISION ANORM, RCOND
<span class="comment">*</span><span class="comment"> ..
</span><span class="comment">*</span><span class="comment"> .. Array Arguments ..
</span> INTEGER IPIV( * )
COMPLEX*16 D( * ), DL( * ), DU( * ), DU2( * ), WORK( * )
<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="ZGTCON.23"></a><a href="zgtcon.f.html#ZGTCON.1">ZGTCON</a> estimates the reciprocal of the condition number of a complex
</span><span class="comment">*</span><span class="comment"> tridiagonal matrix A using the LU factorization as computed by
</span><span class="comment">*</span><span class="comment"> <a name="ZGTTRF.25"></a><a href="zgttrf.f.html#ZGTTRF.1">ZGTTRF</a>.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> An estimate is obtained for norm(inv(A)), and the reciprocal of the
</span><span class="comment">*</span><span class="comment"> condition number is computed as RCOND = 1 / (ANORM * norm(inv(A))).
</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"> NORM (input) CHARACTER*1
</span><span class="comment">*</span><span class="comment"> Specifies whether the 1-norm condition number or the
</span><span class="comment">*</span><span class="comment"> infinity-norm condition number is required:
</span><span class="comment">*</span><span class="comment"> = '1' or 'O': 1-norm;
</span><span class="comment">*</span><span class="comment"> = 'I': Infinity-norm.
</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 A. N >= 0.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> DL (input) COMPLEX*16 array, dimension (N-1)
</span><span class="comment">*</span><span class="comment"> The (n-1) multipliers that define the matrix L from the
</span><span class="comment">*</span><span class="comment"> LU factorization of A as computed by <a name="ZGTTRF.44"></a><a href="zgttrf.f.html#ZGTTRF.1">ZGTTRF</a>.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> D (input) COMPLEX*16 array, dimension (N)
</span><span class="comment">*</span><span class="comment"> The n diagonal elements of the upper triangular matrix U from
</span><span class="comment">*</span><span class="comment"> the LU factorization of A.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> DU (input) COMPLEX*16 array, dimension (N-1)
</span><span class="comment">*</span><span class="comment"> The (n-1) elements of the first superdiagonal of U.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> DU2 (input) COMPLEX*16 array, dimension (N-2)
</span><span class="comment">*</span><span class="comment"> The (n-2) elements of the second superdiagonal of U.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> IPIV (input) INTEGER array, dimension (N)
</span><span class="comment">*</span><span class="comment"> The pivot indices; for 1 <= i <= n, row i of the matrix was
</span><span class="comment">*</span><span class="comment"> interchanged with row IPIV(i). IPIV(i) will always be either
</span><span class="comment">*</span><span class="comment"> i or i+1; IPIV(i) = i indicates a row interchange was not
</span><span class="comment">*</span><span class="comment"> required.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> ANORM (input) DOUBLE PRECISION
</span><span class="comment">*</span><span class="comment"> If NORM = '1' or 'O', the 1-norm of the original matrix A.
</span><span class="comment">*</span><span class="comment"> If NORM = 'I', the infinity-norm of the original matrix A.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> RCOND (output) DOUBLE PRECISION
</span><span class="comment">*</span><span class="comment"> The reciprocal of the condition number of the matrix A,
</span><span class="comment">*</span><span class="comment"> computed as RCOND = 1/(ANORM * AINVNM), where AINVNM is an
</span><span class="comment">*</span><span class="comment"> estimate of the 1-norm of inv(A) computed in this routine.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> WORK (workspace) COMPLEX*16 array, dimension (2*N)
</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"> = 0: successful exit
</span><span class="comment">*</span><span class="comment"> < 0: if INFO = -i, the i-th argument had an illegal value
</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 ONE, ZERO
PARAMETER ( ONE = 1.0D+0, ZERO = 0.0D+0 )
<span class="comment">*</span><span class="comment"> ..
</span><span class="comment">*</span><span class="comment"> .. Local Scalars ..
</span> LOGICAL ONENRM
INTEGER I, KASE, KASE1
DOUBLE PRECISION AINVNM
<span class="comment">*</span><span class="comment"> ..
</span><span class="comment">*</span><span class="comment"> .. Local Arrays ..
</span> INTEGER ISAVE( 3 )
<span class="comment">*</span><span class="comment"> ..
</span><span class="comment">*</span><span class="comment"> .. External Functions ..
</span> LOGICAL <a name="LSAME.92"></a><a href="lsame.f.html#LSAME.1">LSAME</a>
EXTERNAL <a name="LSAME.93"></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"> .. External Subroutines ..
</span> EXTERNAL <a name="XERBLA.96"></a><a href="xerbla.f.html#XERBLA.1">XERBLA</a>, <a name="ZGTTRS.96"></a><a href="zgttrs.f.html#ZGTTRS.1">ZGTTRS</a>, <a name="ZLACN2.96"></a><a href="zlacn2.f.html#ZLACN2.1">ZLACN2</a>
<span class="comment">*</span><span class="comment"> ..
</span><span class="comment">*</span><span class="comment"> .. Intrinsic Functions ..
</span> INTRINSIC DCMPLX
<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"> Test the input arguments.
</span><span class="comment">*</span><span class="comment">
</span> INFO = 0
ONENRM = NORM.EQ.<span class="string">'1'</span> .OR. <a name="LSAME.106"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( NORM, <span class="string">'O'</span> )
IF( .NOT.ONENRM .AND. .NOT.<a name="LSAME.107"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( NORM, <span class="string">'I'</span> ) ) THEN
INFO = -1
ELSE IF( N.LT.0 ) THEN
INFO = -2
ELSE IF( ANORM.LT.ZERO ) THEN
INFO = -8
END IF
IF( INFO.NE.0 ) THEN
CALL <a name="XERBLA.115"></a><a href="xerbla.f.html#XERBLA.1">XERBLA</a>( <span class="string">'<a name="ZGTCON.115"></a><a href="zgtcon.f.html#ZGTCON.1">ZGTCON</a>'</span>, -INFO )
RETURN
END IF
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> Quick return if possible
</span><span class="comment">*</span><span class="comment">
</span> RCOND = ZERO
IF( N.EQ.0 ) THEN
RCOND = ONE
RETURN
ELSE IF( ANORM.EQ.ZERO ) THEN
RETURN
END IF
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> Check that D(1:N) is non-zero.
</span><span class="comment">*</span><span class="comment">
</span> DO 10 I = 1, N
IF( D( I ).EQ.DCMPLX( ZERO ) )
$ RETURN
10 CONTINUE
<span class="comment">*</span><span class="comment">
</span> AINVNM = ZERO
IF( ONENRM ) THEN
KASE1 = 1
ELSE
KASE1 = 2
END IF
KASE = 0
20 CONTINUE
CALL <a name="ZLACN2.144"></a><a href="zlacn2.f.html#ZLACN2.1">ZLACN2</a>( N, WORK( N+1 ), WORK, AINVNM, KASE, ISAVE )
IF( KASE.NE.0 ) THEN
IF( KASE.EQ.KASE1 ) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> Multiply by inv(U)*inv(L).
</span><span class="comment">*</span><span class="comment">
</span> CALL <a name="ZGTTRS.150"></a><a href="zgttrs.f.html#ZGTTRS.1">ZGTTRS</a>( <span class="string">'No transpose'</span>, N, 1, DL, D, DU, DU2, IPIV,
$ WORK, N, INFO )
ELSE
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> Multiply by inv(L')*inv(U').
</span><span class="comment">*</span><span class="comment">
</span> CALL <a name="ZGTTRS.156"></a><a href="zgttrs.f.html#ZGTTRS.1">ZGTTRS</a>( <span class="string">'Conjugate transpose'</span>, N, 1, DL, D, DU, DU2,
$ IPIV, WORK, N, INFO )
END IF
GO TO 20
END IF
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> Compute the estimate of the reciprocal condition number.
</span><span class="comment">*</span><span class="comment">
</span> IF( AINVNM.NE.ZERO )
$ RCOND = ( ONE / AINVNM ) / ANORM
<span class="comment">*</span><span class="comment">
</span> RETURN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> End of <a name="ZGTCON.169"></a><a href="zgtcon.f.html#ZGTCON.1">ZGTCON</a>
</span><span class="comment">*</span><span class="comment">
</span> END
</pre>
</body>
</html>
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?