chbgv.f.html
来自「famous linear algebra library (LAPACK) p」· HTML 代码 · 共 216 行 · 第 1/2 页
HTML
216 行
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> RWORK (workspace) REAL array, dimension (3*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 algorithm failed to converge:
</span><span class="comment">*</span><span class="comment"> i off-diagonal elements of an intermediate
</span><span class="comment">*</span><span class="comment"> tridiagonal form did not converge to zero;
</span><span class="comment">*</span><span class="comment"> > N: if INFO = N + i, for 1 <= i <= N, then <a name="CPBSTF.100"></a><a href="cpbstf.f.html#CPBSTF.1">CPBSTF</a>
</span><span class="comment">*</span><span class="comment"> returned INFO = i: B is not positive definite.
</span><span class="comment">*</span><span class="comment"> The factorization of B could not be completed and
</span><span class="comment">*</span><span class="comment"> no eigenvalues or eigenvectors were computed.
</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"> .. Local Scalars ..
</span> LOGICAL UPPER, WANTZ
CHARACTER VECT
INTEGER IINFO, INDE, INDWRK
<span class="comment">*</span><span class="comment"> ..
</span><span class="comment">*</span><span class="comment"> .. External Functions ..
</span> LOGICAL <a name="LSAME.113"></a><a href="lsame.f.html#LSAME.1">LSAME</a>
EXTERNAL <a name="LSAME.114"></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="CHBGST.117"></a><a href="chbgst.f.html#CHBGST.1">CHBGST</a>, <a name="CHBTRD.117"></a><a href="chbtrd.f.html#CHBTRD.1">CHBTRD</a>, <a name="CPBSTF.117"></a><a href="cpbstf.f.html#CPBSTF.1">CPBSTF</a>, <a name="CSTEQR.117"></a><a href="csteqr.f.html#CSTEQR.1">CSTEQR</a>, <a name="SSTERF.117"></a><a href="ssterf.f.html#SSTERF.1">SSTERF</a>, <a name="XERBLA.117"></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"> .. 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> WANTZ = <a name="LSAME.123"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( JOBZ, <span class="string">'V'</span> )
UPPER = <a name="LSAME.124"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( UPLO, <span class="string">'U'</span> )
<span class="comment">*</span><span class="comment">
</span> INFO = 0
IF( .NOT.( WANTZ .OR. <a name="LSAME.127"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( JOBZ, <span class="string">'N'</span> ) ) ) THEN
INFO = -1
ELSE IF( .NOT.( UPPER .OR. <a name="LSAME.129"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( UPLO, <span class="string">'L'</span> ) ) ) THEN
INFO = -2
ELSE IF( N.LT.0 ) THEN
INFO = -3
ELSE IF( KA.LT.0 ) THEN
INFO = -4
ELSE IF( KB.LT.0 .OR. KB.GT.KA ) THEN
INFO = -5
ELSE IF( LDAB.LT.KA+1 ) THEN
INFO = -7
ELSE IF( LDBB.LT.KB+1 ) THEN
INFO = -9
ELSE IF( LDZ.LT.1 .OR. ( WANTZ .AND. LDZ.LT.N ) ) THEN
INFO = -12
END IF
IF( INFO.NE.0 ) THEN
CALL <a name="XERBLA.145"></a><a href="xerbla.f.html#XERBLA.1">XERBLA</a>( <span class="string">'<a name="CHBGV.145"></a><a href="chbgv.f.html#CHBGV.1">CHBGV</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><span class="comment">*</span><span class="comment"> Form a split Cholesky factorization of B.
</span><span class="comment">*</span><span class="comment">
</span> CALL <a name="CPBSTF.156"></a><a href="cpbstf.f.html#CPBSTF.1">CPBSTF</a>( UPLO, N, KB, BB, LDBB, INFO )
IF( INFO.NE.0 ) THEN
INFO = N + INFO
RETURN
END IF
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> Transform problem to standard eigenvalue problem.
</span><span class="comment">*</span><span class="comment">
</span> INDE = 1
INDWRK = INDE + N
CALL <a name="CHBGST.166"></a><a href="chbgst.f.html#CHBGST.1">CHBGST</a>( JOBZ, UPLO, N, KA, KB, AB, LDAB, BB, LDBB, Z, LDZ,
$ WORK, RWORK( INDWRK ), IINFO )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> Reduce to tridiagonal form.
</span><span class="comment">*</span><span class="comment">
</span> IF( WANTZ ) THEN
VECT = <span class="string">'U'</span>
ELSE
VECT = <span class="string">'N'</span>
END IF
CALL <a name="CHBTRD.176"></a><a href="chbtrd.f.html#CHBTRD.1">CHBTRD</a>( VECT, UPLO, N, KA, AB, LDAB, W, RWORK( INDE ), Z,
$ LDZ, WORK, IINFO )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> For eigenvalues only, call <a name="SSTERF.179"></a><a href="ssterf.f.html#SSTERF.1">SSTERF</a>. For eigenvectors, call <a name="CSTEQR.179"></a><a href="csteqr.f.html#CSTEQR.1">CSTEQR</a>.
</span><span class="comment">*</span><span class="comment">
</span> IF( .NOT.WANTZ ) THEN
CALL <a name="SSTERF.182"></a><a href="ssterf.f.html#SSTERF.1">SSTERF</a>( N, W, RWORK( INDE ), INFO )
ELSE
CALL <a name="CSTEQR.184"></a><a href="csteqr.f.html#CSTEQR.1">CSTEQR</a>( JOBZ, N, W, RWORK( INDE ), Z, LDZ,
$ RWORK( INDWRK ), INFO )
END IF
RETURN
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> End of <a name="CHBGV.189"></a><a href="chbgv.f.html#CHBGV.1">CHBGV</a>
</span><span class="comment">*</span><span class="comment">
</span> END
</pre>
</body>
</html>
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?