ctbmv.f.html
来自「famous linear algebra library (LAPACK) p」· HTML 代码 · 共 388 行 · 第 1/2 页
HTML
388 行
END IF
IF (INFO.NE.0) THEN
CALL <a name="XERBLA.178"></a><a href="xerbla.f.html#XERBLA.1">XERBLA</a>(<span class="string">'<a name="CTBMV.178"></a><a href="ctbmv.f.html#CTBMV.1">CTBMV</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.186"></a><a href="lsame.f.html#LSAME.1">LSAME</a>(TRANS,<span class="string">'T'</span>)
NOUNIT = <a name="LSAME.187"></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 sequentially with one pass through A.
</span><span class="comment">*</span><span class="comment">
</span> IF (<a name="LSAME.201"></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 := A*x.
</span><span class="comment">*</span><span class="comment">
</span> IF (<a name="LSAME.205"></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 = 1,N
IF (X(J).NE.ZERO) THEN
TEMP = X(J)
L = KPLUS1 - J
DO 10 I = MAX(1,J-K),J - 1
X(I) = X(I) + TEMP*A(L+I,J)
10 CONTINUE
IF (NOUNIT) X(J) = X(J)*A(KPLUS1,J)
END IF
20 CONTINUE
ELSE
JX = KX
DO 40 J = 1,N
IF (X(JX).NE.ZERO) THEN
TEMP = X(JX)
IX = KX
L = KPLUS1 - J
DO 30 I = MAX(1,J-K),J - 1
X(IX) = X(IX) + TEMP*A(L+I,J)
IX = IX + INCX
30 CONTINUE
IF (NOUNIT) X(JX) = X(JX)*A(KPLUS1,J)
END IF
JX = JX + INCX
IF (J.GT.K) KX = KX + INCX
40 CONTINUE
END IF
ELSE
IF (INCX.EQ.1) THEN
DO 60 J = N,1,-1
IF (X(J).NE.ZERO) THEN
TEMP = X(J)
L = 1 - J
DO 50 I = MIN(N,J+K),J + 1,-1
X(I) = X(I) + TEMP*A(L+I,J)
50 CONTINUE
IF (NOUNIT) X(J) = X(J)*A(1,J)
END IF
60 CONTINUE
ELSE
KX = KX + (N-1)*INCX
JX = KX
DO 80 J = N,1,-1
IF (X(JX).NE.ZERO) THEN
TEMP = X(JX)
IX = KX
L = 1 - J
DO 70 I = MIN(N,J+K),J + 1,-1
X(IX) = X(IX) + TEMP*A(L+I,J)
IX = IX - INCX
70 CONTINUE
IF (NOUNIT) X(JX) = X(JX)*A(1,J)
END IF
JX = JX - INCX
IF ((N-J).GE.K) KX = KX - 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 := A'*x or x := conjg( A' )*x.
</span><span class="comment">*</span><span class="comment">
</span> IF (<a name="LSAME.270"></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 = N,1,-1
TEMP = X(J)
L = KPLUS1 - J
IF (NOCONJ) THEN
IF (NOUNIT) TEMP = TEMP*A(KPLUS1,J)
DO 90 I = J - 1,MAX(1,J-K),-1
TEMP = TEMP + A(L+I,J)*X(I)
90 CONTINUE
ELSE
IF (NOUNIT) TEMP = TEMP*CONJG(A(KPLUS1,J))
DO 100 I = J - 1,MAX(1,J-K),-1
TEMP = TEMP + CONJG(A(L+I,J))*X(I)
100 CONTINUE
END IF
X(J) = TEMP
110 CONTINUE
ELSE
KX = KX + (N-1)*INCX
JX = KX
DO 140 J = N,1,-1
TEMP = X(JX)
KX = KX - INCX
IX = KX
L = KPLUS1 - J
IF (NOCONJ) THEN
IF (NOUNIT) TEMP = TEMP*A(KPLUS1,J)
DO 120 I = J - 1,MAX(1,J-K),-1
TEMP = TEMP + A(L+I,J)*X(IX)
IX = IX - INCX
120 CONTINUE
ELSE
IF (NOUNIT) TEMP = TEMP*CONJG(A(KPLUS1,J))
DO 130 I = J - 1,MAX(1,J-K),-1
TEMP = TEMP + CONJG(A(L+I,J))*X(IX)
IX = IX - INCX
130 CONTINUE
END IF
X(JX) = TEMP
JX = JX - INCX
140 CONTINUE
END IF
ELSE
IF (INCX.EQ.1) THEN
DO 170 J = 1,N
TEMP = X(J)
L = 1 - J
IF (NOCONJ) THEN
IF (NOUNIT) TEMP = TEMP*A(1,J)
DO 150 I = J + 1,MIN(N,J+K)
TEMP = TEMP + A(L+I,J)*X(I)
150 CONTINUE
ELSE
IF (NOUNIT) TEMP = TEMP*CONJG(A(1,J))
DO 160 I = J + 1,MIN(N,J+K)
TEMP = TEMP + CONJG(A(L+I,J))*X(I)
160 CONTINUE
END IF
X(J) = TEMP
170 CONTINUE
ELSE
JX = KX
DO 200 J = 1,N
TEMP = X(JX)
KX = KX + INCX
IX = KX
L = 1 - J
IF (NOCONJ) THEN
IF (NOUNIT) TEMP = TEMP*A(1,J)
DO 180 I = J + 1,MIN(N,J+K)
TEMP = TEMP + A(L+I,J)*X(IX)
IX = IX + INCX
180 CONTINUE
ELSE
IF (NOUNIT) TEMP = TEMP*CONJG(A(1,J))
DO 190 I = J + 1,MIN(N,J+K)
TEMP = TEMP + CONJG(A(L+I,J))*X(IX)
IX = IX + INCX
190 CONTINUE
END IF
X(JX) = TEMP
JX = JX + 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="CTBMV.361"></a><a href="ctbmv.f.html#CTBMV.1">CTBMV</a> .
</span><span class="comment">*</span><span class="comment">
</span> END
</pre>
</body>
</html>
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?