clatbs.f.html
来自「famous linear algebra library (LAPACK) p」· HTML 代码 · 共 933 行 · 第 1/4 页
HTML
933 行
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01 Transitional//EN">
<html>
<head>
<title>clatbs.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="CLATBS.1"></a><a href="clatbs.f.html#CLATBS.1">CLATBS</a>( UPLO, TRANS, DIAG, NORMIN, N, KD, AB, LDAB, X,
$ SCALE, CNORM, 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 DIAG, NORMIN, TRANS, UPLO
INTEGER INFO, KD, LDAB, N
REAL SCALE
<span class="comment">*</span><span class="comment"> ..
</span><span class="comment">*</span><span class="comment"> .. Array Arguments ..
</span> REAL CNORM( * )
COMPLEX AB( LDAB, * ), X( * )
<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="CLATBS.21"></a><a href="clatbs.f.html#CLATBS.1">CLATBS</a> solves one of the triangular systems
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> A * x = s*b, A**T * x = s*b, or A**H * x = s*b,
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> with scaling to prevent overflow, where A is an upper or lower
</span><span class="comment">*</span><span class="comment"> triangular band matrix. Here A' denotes the transpose of A, x and b
</span><span class="comment">*</span><span class="comment"> are n-element vectors, and s is a scaling factor, usually less than
</span><span class="comment">*</span><span class="comment"> or equal to 1, chosen so that the components of x will be less than
</span><span class="comment">*</span><span class="comment"> the overflow threshold. If the unscaled problem will not cause
</span><span class="comment">*</span><span class="comment"> overflow, the Level 2 BLAS routine CTBSV is called. If the matrix A
</span><span class="comment">*</span><span class="comment"> is singular (A(j,j) = 0 for some j), then s is set to 0 and a
</span><span class="comment">*</span><span class="comment"> non-trivial solution to A*x = 0 is returned.
</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"> UPLO (input) CHARACTER*1
</span><span class="comment">*</span><span class="comment"> Specifies whether the matrix A is upper or lower triangular.
</span><span class="comment">*</span><span class="comment"> = 'U': Upper triangular
</span><span class="comment">*</span><span class="comment"> = 'L': Lower triangular
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> TRANS (input) CHARACTER*1
</span><span class="comment">*</span><span class="comment"> Specifies the operation applied to A.
</span><span class="comment">*</span><span class="comment"> = 'N': Solve A * x = s*b (No transpose)
</span><span class="comment">*</span><span class="comment"> = 'T': Solve A**T * x = s*b (Transpose)
</span><span class="comment">*</span><span class="comment"> = 'C': Solve A**H * x = s*b (Conjugate transpose)
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> DIAG (input) CHARACTER*1
</span><span class="comment">*</span><span class="comment"> Specifies whether or not the matrix A is unit triangular.
</span><span class="comment">*</span><span class="comment"> = 'N': Non-unit triangular
</span><span class="comment">*</span><span class="comment"> = 'U': Unit triangular
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> NORMIN (input) CHARACTER*1
</span><span class="comment">*</span><span class="comment"> Specifies whether CNORM has been set or not.
</span><span class="comment">*</span><span class="comment"> = 'Y': CNORM contains the column norms on entry
</span><span class="comment">*</span><span class="comment"> = 'N': CNORM is not set on entry. On exit, the norms will
</span><span class="comment">*</span><span class="comment"> be computed and stored in CNORM.
</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"> KD (input) INTEGER
</span><span class="comment">*</span><span class="comment"> The number of subdiagonals or superdiagonals in the
</span><span class="comment">*</span><span class="comment"> triangular matrix A. KD >= 0.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> AB (input) COMPLEX array, dimension (LDAB,N)
</span><span class="comment">*</span><span class="comment"> The upper or lower triangular band matrix A, stored in the
</span><span class="comment">*</span><span class="comment"> first KD+1 rows of the array. The j-th column of A is stored
</span><span class="comment">*</span><span class="comment"> in the j-th column of the array AB as follows:
</span><span class="comment">*</span><span class="comment"> if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for max(1,j-kd)<=i<=j;
</span><span class="comment">*</span><span class="comment"> if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=min(n,j+kd).
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> LDAB (input) INTEGER
</span><span class="comment">*</span><span class="comment"> The leading dimension of the array AB. LDAB >= KD+1.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> X (input/output) COMPLEX array, dimension (N)
</span><span class="comment">*</span><span class="comment"> On entry, the right hand side b of the triangular system.
</span><span class="comment">*</span><span class="comment"> On exit, X is overwritten by the solution vector x.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> SCALE (output) REAL
</span><span class="comment">*</span><span class="comment"> The scaling factor s for the triangular system
</span><span class="comment">*</span><span class="comment"> A * x = s*b, A**T * x = s*b, or A**H * x = s*b.
</span><span class="comment">*</span><span class="comment"> If SCALE = 0, the matrix A is singular or badly scaled, and
</span><span class="comment">*</span><span class="comment"> the vector x is an exact or approximate solution to A*x = 0.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> CNORM (input or output) REAL array, dimension (N)
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> If NORMIN = 'Y', CNORM is an input argument and CNORM(j)
</span><span class="comment">*</span><span class="comment"> contains the norm of the off-diagonal part of the j-th column
</span><span class="comment">*</span><span class="comment"> of A. If TRANS = 'N', CNORM(j) must be greater than or equal
</span><span class="comment">*</span><span class="comment"> to the infinity-norm, and if TRANS = 'T' or 'C', CNORM(j)
</span><span class="comment">*</span><span class="comment"> must be greater than or equal to the 1-norm.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> If NORMIN = 'N', CNORM is an output argument and CNORM(j)
</span><span class="comment">*</span><span class="comment"> returns the 1-norm of the offdiagonal part of the j-th column
</span><span class="comment">*</span><span class="comment"> of A.
</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 = -k, the k-th argument had an illegal value
</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"> A rough bound on x is computed; if that is less than overflow, CTBSV
</span><span class="comment">*</span><span class="comment"> is called, otherwise, specific code is used which checks for possible
</span><span class="comment">*</span><span class="comment"> overflow or divide-by-zero at every operation.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> A columnwise scheme is used for solving A*x = b. The basic algorithm
</span><span class="comment">*</span><span class="comment"> if A is lower triangular is
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> x[1:n] := b[1:n]
</span><span class="comment">*</span><span class="comment"> for j = 1, ..., n
</span><span class="comment">*</span><span class="comment"> x(j) := x(j) / A(j,j)
</span><span class="comment">*</span><span class="comment"> x[j+1:n] := x[j+1:n] - x(j) * A[j+1:n,j]
</span><span class="comment">*</span><span class="comment"> end
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> Define bounds on the components of x after j iterations of the loop:
</span><span class="comment">*</span><span class="comment"> M(j) = bound on x[1:j]
</span><span class="comment">*</span><span class="comment"> G(j) = bound on x[j+1:n]
</span><span class="comment">*</span><span class="comment"> Initially, let M(0) = 0 and G(0) = max{x(i), i=1,...,n}.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> Then for iteration j+1 we have
</span><span class="comment">*</span><span class="comment"> M(j+1) <= G(j) / | A(j+1,j+1) |
</span><span class="comment">*</span><span class="comment"> G(j+1) <= G(j) + M(j+1) * | A[j+2:n,j+1] |
</span><span class="comment">*</span><span class="comment"> <= G(j) ( 1 + CNORM(j+1) / | A(j+1,j+1) | )
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> where CNORM(j+1) is greater than or equal to the infinity-norm of
</span><span class="comment">*</span><span class="comment"> column j+1 of A, not counting the diagonal. Hence
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> G(j) <= G(0) product ( 1 + CNORM(i) / | A(i,i) | )
</span><span class="comment">*</span><span class="comment"> 1<=i<=j
</span><span class="comment">*</span><span class="comment"> and
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> |x(j)| <= ( G(0) / |A(j,j)| ) product ( 1 + CNORM(i) / |A(i,i)| )
</span><span class="comment">*</span><span class="comment"> 1<=i< j
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> Since |x(j)| <= M(j), we use the Level 2 BLAS routine CTBSV if the
</span><span class="comment">*</span><span class="comment"> reciprocal of the largest M(j), j=1,..,n, is larger than
</span><span class="comment">*</span><span class="comment"> max(underflow, 1/overflow).
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> The bound on x(j) is also used to determine when a step in the
</span><span class="comment">*</span><span class="comment"> columnwise method can be performed without fear of overflow. If
</span><span class="comment">*</span><span class="comment"> the computed bound is greater than a large constant, x is scaled to
</span><span class="comment">*</span><span class="comment"> prevent overflow, but if the bound overflows, x is set to 0, x(j) to
</span><span class="comment">*</span><span class="comment"> 1, and scale to 0, and a non-trivial solution to A*x = 0 is found.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> Similarly, a row-wise scheme is used to solve A**T *x = b or
</span><span class="comment">*</span><span class="comment"> A**H *x = b. The basic algorithm for A upper triangular is
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> for j = 1, ..., n
</span><span class="comment">*</span><span class="comment"> x(j) := ( b(j) - A[1:j-1,j]' * x[1:j-1] ) / A(j,j)
</span><span class="comment">*</span><span class="comment"> end
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> We simultaneously compute two bounds
</span><span class="comment">*</span><span class="comment"> G(j) = bound on ( b(i) - A[1:i-1,i]' * x[1:i-1] ), 1<=i<=j
</span><span class="comment">*</span><span class="comment"> M(j) = bound on x(i), 1<=i<=j
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> The initial values are G(0) = 0, M(0) = max{b(i), i=1,..,n}, and we
</span><span class="comment">*</span><span class="comment"> add the constraint G(j) >= G(j-1) and M(j) >= M(j-1) for j >= 1.
</span><span class="comment">*</span><span class="comment"> Then the bound on x(j) is
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> M(j) <= M(j-1) * ( 1 + CNORM(j) ) / | A(j,j) |
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> <= M(0) * product ( ( 1 + CNORM(i) ) / |A(i,i)| )
</span><span class="comment">*</span><span class="comment"> 1<=i<=j
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> and we can safely call CTBSV if 1/M(n) and 1/G(n) are both greater
</span><span class="comment">*</span><span class="comment"> than max(underflow, 1/overflow).
</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> REAL ZERO, HALF, ONE, TWO
PARAMETER ( ZERO = 0.0E+0, HALF = 0.5E+0, ONE = 1.0E+0,
$ TWO = 2.0E+0 )
<span class="comment">*</span><span class="comment"> ..
</span><span class="comment">*</span><span class="comment"> .. Local Scalars ..
</span> LOGICAL NOTRAN, NOUNIT, UPPER
INTEGER I, IMAX, J, JFIRST, JINC, JLAST, JLEN, MAIND
REAL BIGNUM, GROW, REC, SMLNUM, TJJ, TMAX, TSCAL,
$ XBND, XJ, XMAX
COMPLEX CSUMJ, TJJS, USCAL, ZDUM
<span class="comment">*</span><span class="comment"> ..
</span><span class="comment">*</span><span class="comment"> .. External Functions ..
</span> LOGICAL <a name="LSAME.186"></a><a href="lsame.f.html#LSAME.1">LSAME</a>
INTEGER ICAMAX, ISAMAX
REAL SCASUM, <a name="SLAMCH.188"></a><a href="slamch.f.html#SLAMCH.1">SLAMCH</a>
COMPLEX CDOTC, CDOTU, <a name="CLADIV.189"></a><a href="cladiv.f.html#CLADIV.1">CLADIV</a>
EXTERNAL <a name="LSAME.190"></a><a href="lsame.f.html#LSAME.1">LSAME</a>, ICAMAX, ISAMAX, SCASUM, <a name="SLAMCH.190"></a><a href="slamch.f.html#SLAMCH.1">SLAMCH</a>, CDOTC,
$ CDOTU, <a name="CLADIV.191"></a><a href="cladiv.f.html#CLADIV.1">CLADIV</a>
<span class="comment">*</span><span class="comment"> ..
</span><span class="comment">*</span><span class="comment"> .. External Subroutines ..
</span> EXTERNAL CAXPY, CSSCAL, CTBSV, <a name="SLABAD.194"></a><a href="slabad.f.html#SLABAD.1">SLABAD</a>, SSCAL, <a name="XERBLA.194"></a><a href="xerbla.f.html#XERBLA.1">XERBLA</a>
<span class="comment">*</span><span class="comment"> ..
</span><span class="comment">*</span><span class="comment"> .. Intrinsic Functions ..
</span> INTRINSIC ABS, AIMAG, CMPLX, CONJG, MAX, MIN, REAL
<span class="comment">*</span><span class="comment"> ..
</span><span class="comment">*</span><span class="comment"> .. Statement Functions ..
</span> REAL CABS1, CABS2
<span class="comment">*</span><span class="comment"> ..
</span><span class="comment">*</span><span class="comment"> .. Statement Function definitions ..
</span> CABS1( ZDUM ) = ABS( REAL( ZDUM ) ) + ABS( AIMAG( ZDUM ) )
CABS2( ZDUM ) = ABS( REAL( ZDUM ) / 2. ) +
$ ABS( AIMAG( ZDUM ) / 2. )
<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
UPPER = <a name="LSAME.210"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( UPLO, <span class="string">'U'</span> )
NOTRAN = <a name="LSAME.211"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( TRANS, <span class="string">'N'</span> )
NOUNIT = <a name="LSAME.212"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( DIAG, <span class="string">'N'</span> )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> Test the input parameters.
</span><span class="comment">*</span><span class="comment">
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?