zgeevx.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) DOUBLE PRECISION 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> DOUBLE PRECISION ZERO, ONE
PARAMETER ( ZERO = 0.0D0, ONE = 1.0D0 )
<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
DOUBLE PRECISION ANRM, BIGNUM, CSCALE, EPS, SCL, SMLNUM
COMPLEX*16 TMP
<span class="comment">*</span><span class="comment"> ..
</span><span class="comment">*</span><span class="comment"> .. Local Arrays ..
</span> LOGICAL SELECT( 1 )
DOUBLE PRECISION DUM( 1 )
<span class="comment">*</span><span class="comment"> ..
</span><span class="comment">*</span><span class="comment"> .. External Subroutines ..
</span> EXTERNAL <a name="DLABAD.204"></a><a href="dlabad.f.html#DLABAD.1">DLABAD</a>, <a name="DLASCL.204"></a><a href="dlascl.f.html#DLASCL.1">DLASCL</a>, <a name="XERBLA.204"></a><a href="xerbla.f.html#XERBLA.1">XERBLA</a>, ZDSCAL, <a name="ZGEBAK.204"></a><a href="zgebak.f.html#ZGEBAK.1">ZGEBAK</a>, <a name="ZGEBAL.204"></a><a href="zgebal.f.html#ZGEBAL.1">ZGEBAL</a>,
$ <a name="ZGEHRD.205"></a><a href="zgehrd.f.html#ZGEHRD.1">ZGEHRD</a>, <a name="ZHSEQR.205"></a><a href="zhseqr.f.html#ZHSEQR.1">ZHSEQR</a>, <a name="ZLACPY.205"></a><a href="zlacpy.f.html#ZLACPY.1">ZLACPY</a>, <a name="ZLASCL.205"></a><a href="zlascl.f.html#ZLASCL.1">ZLASCL</a>, ZSCAL, <a name="ZTREVC.205"></a><a href="ztrevc.f.html#ZTREVC.1">ZTREVC</a>,
$ <a name="ZTRSNA.206"></a><a href="ztrsna.f.html#ZTRSNA.1">ZTRSNA</a>, <a name="ZUNGHR.206"></a><a href="zunghr.f.html#ZUNGHR.1">ZUNGHR</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 IDAMAX, <a name="ILAENV.210"></a><a href="hfy-index.html#ILAENV">ILAENV</a>
DOUBLE PRECISION <a name="DLAMCH.211"></a><a href="dlamch.f.html#DLAMCH.1">DLAMCH</a>, DZNRM2, <a name="ZLANGE.211"></a><a href="zlange.f.html#ZLANGE.1">ZLANGE</a>
EXTERNAL <a name="LSAME.212"></a><a href="lsame.f.html#LSAME.1">LSAME</a>, IDAMAX, <a name="ILAENV.212"></a><a href="hfy-index.html#ILAENV">ILAENV</a>, <a name="DLAMCH.212"></a><a href="dlamch.f.html#DLAMCH.1">DLAMCH</a>, DZNRM2, <a name="ZLANGE.212"></a><a href="zlange.f.html#ZLANGE.1">ZLANGE</a>
<span class="comment">*</span><span class="comment"> ..
</span><span class="comment">*</span><span class="comment"> .. Intrinsic Functions ..
</span> INTRINSIC DBLE, DCMPLX, DCONJG, DIMAG, MAX, 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="ZHSEQR.257"></a><a href="zhseqr.f.html#ZHSEQR.1">ZHSEQR</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="ZGEHRD.266"></a><a href="zgehrd.f.html#ZGEHRD.1">ZGEHRD</a>'</span>, <span class="string">' '</span>, N, 1, N, 0 )
<span class="comment">*</span><span class="comment">
</span> IF( WANTVL ) THEN
CALL <a name="ZHSEQR.269"></a><a href="zhseqr.f.html#ZHSEQR.1">ZHSEQR</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="ZHSEQR.272"></a><a href="zhseqr.f.html#ZHSEQR.1">ZHSEQR</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="ZHSEQR.276"></a><a href="zhseqr.f.html#ZHSEQR.1">ZHSEQR</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="ZHSEQR.279"></a><a href="zhseqr.f.html#ZHSEQR.1">ZHSEQR</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="ZUNGHR.297"></a><a href="zunghr.f.html#ZUNGHR.1">ZUNGHR</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="ZGEEVX.313"></a><a href="zgeevx.f.html#ZGEEVX.1">ZGEEVX</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="DLAMCH.326"></a><a href="dlamch.f.html#DLAMCH.1">DLAMCH</a>( <span class="string">'P'</span> )
SMLNUM = <a name="DLAMCH.327"></a><a href="dlamch.f.html#DLAMCH.1">DLAMCH</a>( <span class="string">'S'</span> )
BIGNUM = ONE / SMLNUM
CALL <a name="DLABAD.329"></a><a href="dlabad.f.html#DLABAD.1">DLABAD</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="ZLANGE.336"></a><a href="zlange.f.html#ZLANGE.1">ZLANGE</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="ZLASCL.346"></a><a href="zlascl.f.html#ZLASCL.1">ZLASCL</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="ZGEBAL.350"></a><a href="zgebal.f.html#ZGEBAL.1">ZGEBAL</a>( BALANC, N, A, LDA, ILO, IHI, SCALE, IERR )
ABNRM = <a name="ZLANGE.351"></a><a href="zlange.f.html#ZLANGE.1">ZLANGE</a>( <span class="string">'1'</span>, N, N, A, LDA, DUM )
IF( SCALEA ) THEN
DUM( 1 ) = ABNRM
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?