zptsvx.f.html
来自「famous linear algebra library (LAPACK) p」· HTML 代码 · 共 261 行 · 第 1/2 页
HTML
261 行
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> FERR (output) DOUBLE PRECISION array, dimension (NRHS)
</span><span class="comment">*</span><span class="comment"> The forward error bound for each solution vector
</span><span class="comment">*</span><span class="comment"> X(j) (the j-th column of the solution matrix X).
</span><span class="comment">*</span><span class="comment"> If XTRUE is the true solution corresponding to X(j), FERR(j)
</span><span class="comment">*</span><span class="comment"> is an estimated upper bound for the magnitude of the largest
</span><span class="comment">*</span><span class="comment"> element in (X(j) - XTRUE) divided by the magnitude of the
</span><span class="comment">*</span><span class="comment"> largest element in X(j).
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> BERR (output) DOUBLE PRECISION array, dimension (NRHS)
</span><span class="comment">*</span><span class="comment"> The componentwise relative backward error of each solution
</span><span class="comment">*</span><span class="comment"> vector X(j) (i.e., the smallest relative change in any
</span><span class="comment">*</span><span class="comment"> element of A or B that makes X(j) an exact solution).
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> WORK (workspace) COMPLEX*16 array, dimension (N)
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> RWORK (workspace) DOUBLE PRECISION array, dimension (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"> > 0: if INFO = i, and i is
</span><span class="comment">*</span><span class="comment"> <= N: the leading minor of order i of A is
</span><span class="comment">*</span><span class="comment"> not positive definite, so the factorization
</span><span class="comment">*</span><span class="comment"> could not be completed, and the solution has not
</span><span class="comment">*</span><span class="comment"> been computed. RCOND = 0 is returned.
</span><span class="comment">*</span><span class="comment"> = N+1: U is nonsingular, but RCOND is less than machine
</span><span class="comment">*</span><span class="comment"> precision, meaning that the matrix is singular
</span><span class="comment">*</span><span class="comment"> to working precision. Nevertheless, the
</span><span class="comment">*</span><span class="comment"> solution and error bounds are computed because
</span><span class="comment">*</span><span class="comment"> there are a number of situations where the
</span><span class="comment">*</span><span class="comment"> computed solution can be more accurate than the
</span><span class="comment">*</span><span class="comment"> value of RCOND would suggest.
</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.0D+0 )
<span class="comment">*</span><span class="comment"> ..
</span><span class="comment">*</span><span class="comment"> .. Local Scalars ..
</span> LOGICAL NOFACT
DOUBLE PRECISION ANORM
<span class="comment">*</span><span class="comment"> ..
</span><span class="comment">*</span><span class="comment"> .. External Functions ..
</span> LOGICAL <a name="LSAME.158"></a><a href="lsame.f.html#LSAME.1">LSAME</a>
DOUBLE PRECISION <a name="DLAMCH.159"></a><a href="dlamch.f.html#DLAMCH.1">DLAMCH</a>, <a name="ZLANHT.159"></a><a href="zlanht.f.html#ZLANHT.1">ZLANHT</a>
EXTERNAL <a name="LSAME.160"></a><a href="lsame.f.html#LSAME.1">LSAME</a>, <a name="DLAMCH.160"></a><a href="dlamch.f.html#DLAMCH.1">DLAMCH</a>, <a name="ZLANHT.160"></a><a href="zlanht.f.html#ZLANHT.1">ZLANHT</a>
<span class="comment">*</span><span class="comment"> ..
</span><span class="comment">*</span><span class="comment"> .. External Subroutines ..
</span> EXTERNAL DCOPY, <a name="XERBLA.163"></a><a href="xerbla.f.html#XERBLA.1">XERBLA</a>, ZCOPY, <a name="ZLACPY.163"></a><a href="zlacpy.f.html#ZLACPY.1">ZLACPY</a>, <a name="ZPTCON.163"></a><a href="zptcon.f.html#ZPTCON.1">ZPTCON</a>, <a name="ZPTRFS.163"></a><a href="zptrfs.f.html#ZPTRFS.1">ZPTRFS</a>,
$ <a name="ZPTTRF.164"></a><a href="zpttrf.f.html#ZPTTRF.1">ZPTTRF</a>, <a name="ZPTTRS.164"></a><a href="zpttrs.f.html#ZPTTRS.1">ZPTTRS</a>
<span class="comment">*</span><span class="comment"> ..
</span><span class="comment">*</span><span class="comment"> .. Intrinsic Functions ..
</span> INTRINSIC MAX
<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 parameters.
</span><span class="comment">*</span><span class="comment">
</span> INFO = 0
NOFACT = <a name="LSAME.174"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( FACT, <span class="string">'N'</span> )
IF( .NOT.NOFACT .AND. .NOT.<a name="LSAME.175"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( FACT, <span class="string">'F'</span> ) ) THEN
INFO = -1
ELSE IF( N.LT.0 ) THEN
INFO = -2
ELSE IF( NRHS.LT.0 ) THEN
INFO = -3
ELSE IF( LDB.LT.MAX( 1, N ) ) THEN
INFO = -9
ELSE IF( LDX.LT.MAX( 1, N ) ) THEN
INFO = -11
END IF
IF( INFO.NE.0 ) THEN
CALL <a name="XERBLA.187"></a><a href="xerbla.f.html#XERBLA.1">XERBLA</a>( <span class="string">'<a name="ZPTSVX.187"></a><a href="zptsvx.f.html#ZPTSVX.1">ZPTSVX</a>'</span>, -INFO )
RETURN
END IF
<span class="comment">*</span><span class="comment">
</span> IF( NOFACT ) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> Compute the L*D*L' (or U'*D*U) factorization of A.
</span><span class="comment">*</span><span class="comment">
</span> CALL DCOPY( N, D, 1, DF, 1 )
IF( N.GT.1 )
$ CALL ZCOPY( N-1, E, 1, EF, 1 )
CALL <a name="ZPTTRF.198"></a><a href="zpttrf.f.html#ZPTTRF.1">ZPTTRF</a>( N, DF, EF, INFO )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> Return if INFO is non-zero.
</span><span class="comment">*</span><span class="comment">
</span> IF( INFO.GT.0 )THEN
RCOND = ZERO
RETURN
END IF
END IF
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> Compute the norm of the matrix A.
</span><span class="comment">*</span><span class="comment">
</span> ANORM = <a name="ZLANHT.210"></a><a href="zlanht.f.html#ZLANHT.1">ZLANHT</a>( <span class="string">'1'</span>, N, D, E )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> Compute the reciprocal of the condition number of A.
</span><span class="comment">*</span><span class="comment">
</span> CALL <a name="ZPTCON.214"></a><a href="zptcon.f.html#ZPTCON.1">ZPTCON</a>( N, DF, EF, ANORM, RCOND, RWORK, INFO )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> Compute the solution vectors X.
</span><span class="comment">*</span><span class="comment">
</span> CALL <a name="ZLACPY.218"></a><a href="zlacpy.f.html#ZLACPY.1">ZLACPY</a>( <span class="string">'Full'</span>, N, NRHS, B, LDB, X, LDX )
CALL <a name="ZPTTRS.219"></a><a href="zpttrs.f.html#ZPTTRS.1">ZPTTRS</a>( <span class="string">'Lower'</span>, N, NRHS, DF, EF, X, LDX, INFO )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> Use iterative refinement to improve the computed solutions and
</span><span class="comment">*</span><span class="comment"> compute error bounds and backward error estimates for them.
</span><span class="comment">*</span><span class="comment">
</span> CALL <a name="ZPTRFS.224"></a><a href="zptrfs.f.html#ZPTRFS.1">ZPTRFS</a>( <span class="string">'Lower'</span>, N, NRHS, D, E, DF, EF, B, LDB, X, LDX, FERR,
$ BERR, WORK, RWORK, INFO )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> Set INFO = N+1 if the matrix is singular to working precision.
</span><span class="comment">*</span><span class="comment">
</span> IF( RCOND.LT.<a name="DLAMCH.229"></a><a href="dlamch.f.html#DLAMCH.1">DLAMCH</a>( <span class="string">'Epsilon'</span> ) )
$ INFO = N + 1
<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="ZPTSVX.234"></a><a href="zptsvx.f.html#ZPTSVX.1">ZPTSVX</a>
</span><span class="comment">*</span><span class="comment">
</span> END
</pre>
</body>
</html>
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?