cgeevx.f.html
来自「famous linear algebra library (LAPACK) p」· HTML 代码 · 共 557 行 · 第 1/3 页
HTML
557 行
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> If LWORK = -1, then a workspace query is assumed; the routine
</span><span class="comment">*</span><span class="comment"> only calculates the optimal size of the WORK array, returns
</span><span class="comment">*</span><span class="comment"> this value as the first entry of the WORK array, and no error
</span><span class="comment">*</span><span class="comment"> message related to LWORK is issued by <a name="XERBLA.172"></a><a href="xerbla.f.html#XERBLA.1">XERBLA</a>.
</span><span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> RWORK (workspace) REAL array, dimension (2*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, the QR algorithm failed to compute all the
</span><span class="comment">*</span><span class="comment"> eigenvalues, and no eigenvectors or condition numbers
</span><span class="comment">*</span><span class="comment"> have been computed; elements 1:ILO-1 and i+1:N of W
</span><span class="comment">*</span><span class="comment"> contain eigenvalues which have converged.
</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, ONE
PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 )
<span class="comment">*</span><span class="comment"> ..
</span><span class="comment">*</span><span class="comment"> .. Local Scalars ..
</span> LOGICAL LQUERY, SCALEA, WANTVL, WANTVR, WNTSNB, WNTSNE,
$ WNTSNN, WNTSNV
CHARACTER JOB, SIDE
INTEGER HSWORK, I, ICOND, IERR, ITAU, IWRK, K, MAXWRK,
$ MINWRK, NOUT
REAL ANRM, BIGNUM, CSCALE, EPS, SCL, SMLNUM
COMPLEX TMP
<span class="comment">*</span><span class="comment"> ..
</span><span class="comment">*</span><span class="comment"> .. Local Arrays ..
</span> LOGICAL SELECT( 1 )
REAL DUM( 1 )
<span class="comment">*</span><span class="comment"> ..
</span><span class="comment">*</span><span class="comment"> .. External Subroutines ..
</span> EXTERNAL <a name="CGEBAK.204"></a><a href="cgebak.f.html#CGEBAK.1">CGEBAK</a>, <a name="CGEBAL.204"></a><a href="cgebal.f.html#CGEBAL.1">CGEBAL</a>, <a name="CGEHRD.204"></a><a href="cgehrd.f.html#CGEHRD.1">CGEHRD</a>, <a name="CHSEQR.204"></a><a href="chseqr.f.html#CHSEQR.1">CHSEQR</a>, <a name="CLACPY.204"></a><a href="clacpy.f.html#CLACPY.1">CLACPY</a>, <a name="CLASCL.204"></a><a href="clascl.f.html#CLASCL.1">CLASCL</a>,
$ CSCAL, CSSCAL, <a name="CTREVC.205"></a><a href="ctrevc.f.html#CTREVC.1">CTREVC</a>, <a name="CTRSNA.205"></a><a href="ctrsna.f.html#CTRSNA.1">CTRSNA</a>, <a name="CUNGHR.205"></a><a href="cunghr.f.html#CUNGHR.1">CUNGHR</a>, <a name="SLABAD.205"></a><a href="slabad.f.html#SLABAD.1">SLABAD</a>,
$ <a name="SLASCL.206"></a><a href="slascl.f.html#SLASCL.1">SLASCL</a>, <a name="XERBLA.206"></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"> .. External Functions ..
</span> LOGICAL <a name="LSAME.209"></a><a href="lsame.f.html#LSAME.1">LSAME</a>
INTEGER <a name="ILAENV.210"></a><a href="hfy-index.html#ILAENV">ILAENV</a>, ISAMAX
REAL <a name="CLANGE.211"></a><a href="clange.f.html#CLANGE.1">CLANGE</a>, SCNRM2, <a name="SLAMCH.211"></a><a href="slamch.f.html#SLAMCH.1">SLAMCH</a>
EXTERNAL <a name="LSAME.212"></a><a href="lsame.f.html#LSAME.1">LSAME</a>, <a name="ILAENV.212"></a><a href="hfy-index.html#ILAENV">ILAENV</a>, ISAMAX, <a name="CLANGE.212"></a><a href="clange.f.html#CLANGE.1">CLANGE</a>, SCNRM2, <a name="SLAMCH.212"></a><a href="slamch.f.html#SLAMCH.1">SLAMCH</a>
<span class="comment">*</span><span class="comment"> ..
</span><span class="comment">*</span><span class="comment"> .. Intrinsic Functions ..
</span> INTRINSIC AIMAG, CMPLX, CONJG, MAX, REAL, SQRT
<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 arguments
</span><span class="comment">*</span><span class="comment">
</span> INFO = 0
LQUERY = ( LWORK.EQ.-1 )
WANTVL = <a name="LSAME.223"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( JOBVL, <span class="string">'V'</span> )
WANTVR = <a name="LSAME.224"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( JOBVR, <span class="string">'V'</span> )
WNTSNN = <a name="LSAME.225"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( SENSE, <span class="string">'N'</span> )
WNTSNE = <a name="LSAME.226"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( SENSE, <span class="string">'E'</span> )
WNTSNV = <a name="LSAME.227"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( SENSE, <span class="string">'V'</span> )
WNTSNB = <a name="LSAME.228"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( SENSE, <span class="string">'B'</span> )
IF( .NOT.( <a name="LSAME.229"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( BALANC, <span class="string">'N'</span> ) .OR. <a name="LSAME.229"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( BALANC, <span class="string">'S'</span> ) .OR.
$ <a name="LSAME.230"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( BALANC, <span class="string">'P'</span> ) .OR. <a name="LSAME.230"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( BALANC, <span class="string">'B'</span> ) ) ) THEN
INFO = -1
ELSE IF( ( .NOT.WANTVL ) .AND. ( .NOT.<a name="LSAME.232"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( JOBVL, <span class="string">'N'</span> ) ) ) THEN
INFO = -2
ELSE IF( ( .NOT.WANTVR ) .AND. ( .NOT.<a name="LSAME.234"></a><a href="lsame.f.html#LSAME.1">LSAME</a>( JOBVR, <span class="string">'N'</span> ) ) ) THEN
INFO = -3
ELSE IF( .NOT.( WNTSNN .OR. WNTSNE .OR. WNTSNB .OR. WNTSNV ) .OR.
$ ( ( WNTSNE .OR. WNTSNB ) .AND. .NOT.( WANTVL .AND.
$ WANTVR ) ) ) THEN
INFO = -4
ELSE IF( N.LT.0 ) THEN
INFO = -5
ELSE IF( LDA.LT.MAX( 1, N ) ) THEN
INFO = -7
ELSE IF( LDVL.LT.1 .OR. ( WANTVL .AND. LDVL.LT.N ) ) THEN
INFO = -10
ELSE IF( LDVR.LT.1 .OR. ( WANTVR .AND. LDVR.LT.N ) ) THEN
INFO = -12
END IF
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> Compute workspace
</span><span class="comment">*</span><span class="comment"> (Note: Comments in the code beginning "Workspace:" describe the
</span><span class="comment">*</span><span class="comment"> minimal amount of workspace needed at that point in the code,
</span><span class="comment">*</span><span class="comment"> as well as the preferred amount for good performance.
</span><span class="comment">*</span><span class="comment"> CWorkspace refers to complex workspace, and RWorkspace to real
</span><span class="comment">*</span><span class="comment"> workspace. NB refers to the optimal block size for the
</span><span class="comment">*</span><span class="comment"> immediately following subroutine, as returned by <a name="ILAENV.256"></a><a href="hfy-index.html#ILAENV">ILAENV</a>.
</span><span class="comment">*</span><span class="comment"> HSWORK refers to the workspace preferred by <a name="CHSEQR.257"></a><a href="chseqr.f.html#CHSEQR.1">CHSEQR</a>, as
</span><span class="comment">*</span><span class="comment"> calculated below. HSWORK is computed assuming ILO=1 and IHI=N,
</span><span class="comment">*</span><span class="comment"> the worst case.)
</span><span class="comment">*</span><span class="comment">
</span> IF( INFO.EQ.0 ) THEN
IF( N.EQ.0 ) THEN
MINWRK = 1
MAXWRK = 1
ELSE
MAXWRK = N + N*<a name="ILAENV.266"></a><a href="hfy-index.html#ILAENV">ILAENV</a>( 1, <span class="string">'<a name="CGEHRD.266"></a><a href="cgehrd.f.html#CGEHRD.1">CGEHRD</a>'</span>, <span class="string">' '</span>, N, 1, N, 0 )
<span class="comment">*</span><span class="comment">
</span> IF( WANTVL ) THEN
CALL <a name="CHSEQR.269"></a><a href="chseqr.f.html#CHSEQR.1">CHSEQR</a>( <span class="string">'S'</span>, <span class="string">'V'</span>, N, 1, N, A, LDA, W, VL, LDVL,
$ WORK, -1, INFO )
ELSE IF( WANTVR ) THEN
CALL <a name="CHSEQR.272"></a><a href="chseqr.f.html#CHSEQR.1">CHSEQR</a>( <span class="string">'S'</span>, <span class="string">'V'</span>, N, 1, N, A, LDA, W, VR, LDVR,
$ WORK, -1, INFO )
ELSE
IF( WNTSNN ) THEN
CALL <a name="CHSEQR.276"></a><a href="chseqr.f.html#CHSEQR.1">CHSEQR</a>( <span class="string">'E'</span>, <span class="string">'N'</span>, N, 1, N, A, LDA, W, VR, LDVR,
$ WORK, -1, INFO )
ELSE
CALL <a name="CHSEQR.279"></a><a href="chseqr.f.html#CHSEQR.1">CHSEQR</a>( <span class="string">'S'</span>, <span class="string">'N'</span>, N, 1, N, A, LDA, W, VR, LDVR,
$ WORK, -1, INFO )
END IF
END IF
HSWORK = WORK( 1 )
<span class="comment">*</span><span class="comment">
</span> IF( ( .NOT.WANTVL ) .AND. ( .NOT.WANTVR ) ) THEN
MINWRK = 2*N
IF( .NOT.( WNTSNN .OR. WNTSNE ) )
$ MINWRK = MAX( MINWRK, N*N + 2*N )
MAXWRK = MAX( MAXWRK, HSWORK )
IF( .NOT.( WNTSNN .OR. WNTSNE ) )
$ MAXWRK = MAX( MAXWRK, N*N + 2*N )
ELSE
MINWRK = 2*N
IF( .NOT.( WNTSNN .OR. WNTSNE ) )
$ MINWRK = MAX( MINWRK, N*N + 2*N )
MAXWRK = MAX( MAXWRK, HSWORK )
MAXWRK = MAX( MAXWRK, N + ( N - 1 )*<a name="ILAENV.297"></a><a href="hfy-index.html#ILAENV">ILAENV</a>( 1, <span class="string">'<a name="CUNGHR.297"></a><a href="cunghr.f.html#CUNGHR.1">CUNGHR</a>'</span>,
$ <span class="string">' '</span>, N, 1, N, -1 ) )
IF( .NOT.( WNTSNN .OR. WNTSNE ) )
$ MAXWRK = MAX( MAXWRK, N*N + 2*N )
MAXWRK = MAX( MAXWRK, 2*N )
END IF
MAXWRK = MAX( MAXWRK, MINWRK )
END IF
WORK( 1 ) = MAXWRK
<span class="comment">*</span><span class="comment">
</span> IF( LWORK.LT.MINWRK .AND. .NOT.LQUERY ) THEN
INFO = -20
END IF
END IF
<span class="comment">*</span><span class="comment">
</span> IF( INFO.NE.0 ) THEN
CALL <a name="XERBLA.313"></a><a href="xerbla.f.html#XERBLA.1">XERBLA</a>( <span class="string">'<a name="CGEEVX.313"></a><a href="cgeevx.f.html#CGEEVX.1">CGEEVX</a>'</span>, -INFO )
RETURN
ELSE IF( LQUERY ) THEN
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"> Get machine constants
</span><span class="comment">*</span><span class="comment">
</span> EPS = <a name="SLAMCH.326"></a><a href="slamch.f.html#SLAMCH.1">SLAMCH</a>( <span class="string">'P'</span> )
SMLNUM = <a name="SLAMCH.327"></a><a href="slamch.f.html#SLAMCH.1">SLAMCH</a>( <span class="string">'S'</span> )
BIGNUM = ONE / SMLNUM
CALL <a name="SLABAD.329"></a><a href="slabad.f.html#SLABAD.1">SLABAD</a>( SMLNUM, BIGNUM )
SMLNUM = SQRT( SMLNUM ) / EPS
BIGNUM = ONE / SMLNUM
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> Scale A if max element outside range [SMLNUM,BIGNUM]
</span><span class="comment">*</span><span class="comment">
</span> ICOND = 0
ANRM = <a name="CLANGE.336"></a><a href="clange.f.html#CLANGE.1">CLANGE</a>( <span class="string">'M'</span>, N, N, A, LDA, DUM )
SCALEA = .FALSE.
IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN
SCALEA = .TRUE.
CSCALE = SMLNUM
ELSE IF( ANRM.GT.BIGNUM ) THEN
SCALEA = .TRUE.
CSCALE = BIGNUM
END IF
IF( SCALEA )
$ CALL <a name="CLASCL.346"></a><a href="clascl.f.html#CLASCL.1">CLASCL</a>( <span class="string">'G'</span>, 0, 0, ANRM, CSCALE, N, N, A, LDA, IERR )
<span class="comment">*</span><span class="comment">
</span><span class="comment">*</span><span class="comment"> Balance the matrix and compute ABNRM
</span><span class="comment">*</span><span class="comment">
</span> CALL <a name="CGEBAL.350"></a><a href="cgebal.f.html#CGEBAL.1">CGEBAL</a>( BALANC, N, A, LDA, ILO, IHI, SCALE, IERR )
ABNRM = <a name="CLANGE.351"></a><a href="clange.f.html#CLANGE.1">CLANGE</a>( <span class="string">'1'</span>, N, N, A, LDA, DUM )
IF( SCALEA ) THEN
DUM( 1 ) = ABNRM
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?