ztbsv.f.html
来自「famous linear algebra library (LAPACK) p」· HTML 代码 · 共 392 行 · 第 1/2 页
HTML
392 行
ELSE IF (INCX.EQ.0) THEN
INFO = 9
END IF
IF (INFO.NE.0) THEN
CALL <a name="XERBLA.182"></a><a href="xerbla.f.html#XERBLA.1">XERBLA</a>(<span class="string">'<a name="ZTBSV.182"></a><a href="ztbsv.f.html#ZTBSV.1">ZTBSV</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> IF (N.EQ.0) RETURN
<span class="comment">*</span><span class="comment">
</span> NOCONJ = <a name="LSAME.190"></a><a href="lsame.f.html#LSAME.1">LSAME</a>(TRANS,<span class="string">'T'</span>)
NOUNIT = <a name="LSAME.191"></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"> Set up the start point in X if the increment is not unity. This
</span><span class="comment">*</span><span class="comment"> will be ( N - 1 )*INCX too small for descending loops.
</span><span class="comment">*</span><span class="comment">
</span> IF (INCX.LE.0) THEN
KX = 1 - (N-1)*INCX
ELSE IF (INCX.NE.1) THEN
KX = 1
END IF
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> Start the operations. In this version the elements of A are
</span><span class="comment">*</span><span class="comment"> accessed by sequentially with one pass through A.
</span><span class="comment">*</span><span class="comment">
</span> IF (<a name="LSAME.205"></a><a href="lsame.f.html#LSAME.1">LSAME</a>(TRANS,<span class="string">'N'</span>)) THEN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> Form x := inv( A )*x.
</span><span class="comment">*</span><span class="comment">
</span> IF (<a name="LSAME.209"></a><a href="lsame.f.html#LSAME.1">LSAME</a>(UPLO,<span class="string">'U'</span>)) THEN
KPLUS1 = K + 1
IF (INCX.EQ.1) THEN
DO 20 J = N,1,-1
IF (X(J).NE.ZERO) THEN
L = KPLUS1 - J
IF (NOUNIT) X(J) = X(J)/A(KPLUS1,J)
TEMP = X(J)
DO 10 I = J - 1,MAX(1,J-K),-1
X(I) = X(I) - TEMP*A(L+I,J)
10 CONTINUE
END IF
20 CONTINUE
ELSE
KX = KX + (N-1)*INCX
JX = KX
DO 40 J = N,1,-1
KX = KX - INCX
IF (X(JX).NE.ZERO) THEN
IX = KX
L = KPLUS1 - J
IF (NOUNIT) X(JX) = X(JX)/A(KPLUS1,J)
TEMP = X(JX)
DO 30 I = J - 1,MAX(1,J-K),-1
X(IX) = X(IX) - TEMP*A(L+I,J)
IX = IX - INCX
30 CONTINUE
END IF
JX = JX - INCX
40 CONTINUE
END IF
ELSE
IF (INCX.EQ.1) THEN
DO 60 J = 1,N
IF (X(J).NE.ZERO) THEN
L = 1 - J
IF (NOUNIT) X(J) = X(J)/A(1,J)
TEMP = X(J)
DO 50 I = J + 1,MIN(N,J+K)
X(I) = X(I) - TEMP*A(L+I,J)
50 CONTINUE
END IF
60 CONTINUE
ELSE
JX = KX
DO 80 J = 1,N
KX = KX + INCX
IF (X(JX).NE.ZERO) THEN
IX = KX
L = 1 - J
IF (NOUNIT) X(JX) = X(JX)/A(1,J)
TEMP = X(JX)
DO 70 I = J + 1,MIN(N,J+K)
X(IX) = X(IX) - TEMP*A(L+I,J)
IX = IX + INCX
70 CONTINUE
END IF
JX = JX + INCX
80 CONTINUE
END IF
END IF
ELSE
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> Form x := inv( A' )*x or x := inv( conjg( A') )*x.
</span><span class="comment">*</span><span class="comment">
</span> IF (<a name="LSAME.274"></a><a href="lsame.f.html#LSAME.1">LSAME</a>(UPLO,<span class="string">'U'</span>)) THEN
KPLUS1 = K + 1
IF (INCX.EQ.1) THEN
DO 110 J = 1,N
TEMP = X(J)
L = KPLUS1 - J
IF (NOCONJ) THEN
DO 90 I = MAX(1,J-K),J - 1
TEMP = TEMP - A(L+I,J)*X(I)
90 CONTINUE
IF (NOUNIT) TEMP = TEMP/A(KPLUS1,J)
ELSE
DO 100 I = MAX(1,J-K),J - 1
TEMP = TEMP - DCONJG(A(L+I,J))*X(I)
100 CONTINUE
IF (NOUNIT) TEMP = TEMP/DCONJG(A(KPLUS1,J))
END IF
X(J) = TEMP
110 CONTINUE
ELSE
JX = KX
DO 140 J = 1,N
TEMP = X(JX)
IX = KX
L = KPLUS1 - J
IF (NOCONJ) THEN
DO 120 I = MAX(1,J-K),J - 1
TEMP = TEMP - A(L+I,J)*X(IX)
IX = IX + INCX
120 CONTINUE
IF (NOUNIT) TEMP = TEMP/A(KPLUS1,J)
ELSE
DO 130 I = MAX(1,J-K),J - 1
TEMP = TEMP - DCONJG(A(L+I,J))*X(IX)
IX = IX + INCX
130 CONTINUE
IF (NOUNIT) TEMP = TEMP/DCONJG(A(KPLUS1,J))
END IF
X(JX) = TEMP
JX = JX + INCX
IF (J.GT.K) KX = KX + INCX
140 CONTINUE
END IF
ELSE
IF (INCX.EQ.1) THEN
DO 170 J = N,1,-1
TEMP = X(J)
L = 1 - J
IF (NOCONJ) THEN
DO 150 I = MIN(N,J+K),J + 1,-1
TEMP = TEMP - A(L+I,J)*X(I)
150 CONTINUE
IF (NOUNIT) TEMP = TEMP/A(1,J)
ELSE
DO 160 I = MIN(N,J+K),J + 1,-1
TEMP = TEMP - DCONJG(A(L+I,J))*X(I)
160 CONTINUE
IF (NOUNIT) TEMP = TEMP/DCONJG(A(1,J))
END IF
X(J) = TEMP
170 CONTINUE
ELSE
KX = KX + (N-1)*INCX
JX = KX
DO 200 J = N,1,-1
TEMP = X(JX)
IX = KX
L = 1 - J
IF (NOCONJ) THEN
DO 180 I = MIN(N,J+K),J + 1,-1
TEMP = TEMP - A(L+I,J)*X(IX)
IX = IX - INCX
180 CONTINUE
IF (NOUNIT) TEMP = TEMP/A(1,J)
ELSE
DO 190 I = MIN(N,J+K),J + 1,-1
TEMP = TEMP - DCONJG(A(L+I,J))*X(IX)
IX = IX - INCX
190 CONTINUE
IF (NOUNIT) TEMP = TEMP/DCONJG(A(1,J))
END IF
X(JX) = TEMP
JX = JX - INCX
IF ((N-J).GE.K) KX = KX - INCX
200 CONTINUE
END IF
END IF
END IF
<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="ZTBSV.365"></a><a href="ztbsv.f.html#ZTBSV.1">ZTBSV</a> .
</span><span class="comment">*</span><span class="comment">
</span> END
</pre>
</body>
</html>
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?