--- rpl/lapack/lapack/dgeevx.f 2011/11/21 22:19:27 1.10
+++ rpl/lapack/lapack/dgeevx.f 2023/08/07 08:38:48 1.20
@@ -2,18 +2,18 @@
*
* =========== DOCUMENTATION ===========
*
-* Online html documentation available at
-* http://www.netlib.org/lapack/explore-html/
+* Online html documentation available at
+* http://www.netlib.org/lapack/explore-html/
*
*> \htmlonly
-*> Download DGEEVX + dependencies
-*>
-*> [TGZ]
-*>
-*> [ZIP]
-*>
+*> Download DGEEVX + dependencies
+*>
+*> [TGZ]
+*>
+*> [ZIP]
+*>
*> [TXT]
-*> \endhtmlonly
+*> \endhtmlonly
*
* Definition:
* ===========
@@ -21,7 +21,7 @@
* SUBROUTINE DGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, WR, WI,
* VL, LDVL, VR, LDVR, ILO, IHI, SCALE, ABNRM,
* RCONDE, RCONDV, WORK, LWORK, IWORK, INFO )
-*
+*
* .. Scalar Arguments ..
* CHARACTER BALANC, JOBVL, JOBVR, SENSE
* INTEGER IHI, ILO, INFO, LDA, LDVL, LDVR, LWORK, N
@@ -33,7 +33,7 @@
* $ SCALE( * ), VL( LDVL, * ), VR( LDVR, * ),
* $ WI( * ), WORK( * ), WR( * )
* ..
-*
+*
*
*> \par Purpose:
* =============
@@ -53,8 +53,8 @@
*> A * v(j) = lambda(j) * v(j)
*> where lambda(j) is its eigenvalue.
*> The left eigenvector u(j) of A satisfies
-*> u(j)**T * A = lambda(j) * u(j)**T
-*> where u(j)**T denotes the transpose of u(j).
+*> u(j)**H * A = lambda(j) * u(j)**H
+*> where u(j)**H denotes the conjugate-transpose of u(j).
*>
*> The computed eigenvectors are normalized to have Euclidean norm
*> equal to 1 and largest component real.
@@ -289,12 +289,13 @@
* Authors:
* ========
*
-*> \author Univ. of Tennessee
-*> \author Univ. of California Berkeley
-*> \author Univ. of Colorado Denver
-*> \author NAG Ltd.
+*> \author Univ. of Tennessee
+*> \author Univ. of California Berkeley
+*> \author Univ. of Colorado Denver
+*> \author NAG Ltd.
+*
*
-*> \date November 2011
+* @precisions fortran d -> s
*
*> \ingroup doubleGEeigen
*
@@ -302,11 +303,11 @@
SUBROUTINE DGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, WR, WI,
$ VL, LDVL, VR, LDVR, ILO, IHI, SCALE, ABNRM,
$ RCONDE, RCONDV, WORK, LWORK, IWORK, INFO )
+ implicit none
*
-* -- LAPACK driver routine (version 3.4.0) --
+* -- LAPACK driver routine --
* -- LAPACK is a software package provided by Univ. of Tennessee, --
* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
-* November 2011
*
* .. Scalar Arguments ..
CHARACTER BALANC, JOBVL, JOBVR, SENSE
@@ -330,8 +331,8 @@
LOGICAL LQUERY, SCALEA, WANTVL, WANTVR, WNTSNB, WNTSNE,
$ WNTSNN, WNTSNV
CHARACTER JOB, SIDE
- INTEGER HSWORK, I, ICOND, IERR, ITAU, IWRK, K, MAXWRK,
- $ MINWRK, NOUT
+ INTEGER HSWORK, I, ICOND, IERR, ITAU, IWRK, K,
+ $ LWORK_TREVC, MAXWRK, MINWRK, NOUT
DOUBLE PRECISION ANRM, BIGNUM, CS, CSCALE, EPS, R, SCL, SMLNUM,
$ SN
* ..
@@ -341,7 +342,7 @@
* ..
* .. External Subroutines ..
EXTERNAL DGEBAK, DGEBAL, DGEHRD, DHSEQR, DLABAD, DLACPY,
- $ DLARTG, DLASCL, DORGHR, DROT, DSCAL, DTREVC,
+ $ DLARTG, DLASCL, DORGHR, DROT, DSCAL, DTREVC3,
$ DTRSNA, XERBLA
* ..
* .. External Functions ..
@@ -366,8 +367,8 @@
WNTSNE = LSAME( SENSE, 'E' )
WNTSNV = LSAME( SENSE, 'V' )
WNTSNB = LSAME( SENSE, 'B' )
- IF( .NOT.( LSAME( BALANC, 'N' ) .OR. LSAME( BALANC,
- $ 'S' ) .OR. LSAME( BALANC, 'P' ) .OR. LSAME( BALANC, 'B' ) ) )
+ IF( .NOT.( LSAME( BALANC, 'N' ) .OR. LSAME( BALANC, 'S' )
+ $ .OR. LSAME( BALANC, 'P' ) .OR. LSAME( BALANC, 'B' ) ) )
$ THEN
INFO = -1
ELSE IF( ( .NOT.WANTVL ) .AND. ( .NOT.LSAME( JOBVL, 'N' ) ) ) THEN
@@ -406,9 +407,19 @@
MAXWRK = N + N*ILAENV( 1, 'DGEHRD', ' ', N, 1, N, 0 )
*
IF( WANTVL ) THEN
+ CALL DTREVC3( 'L', 'B', SELECT, N, A, LDA,
+ $ VL, LDVL, VR, LDVR,
+ $ N, NOUT, WORK, -1, IERR )
+ LWORK_TREVC = INT( WORK(1) )
+ MAXWRK = MAX( MAXWRK, N + LWORK_TREVC )
CALL DHSEQR( 'S', 'V', N, 1, N, A, LDA, WR, WI, VL, LDVL,
$ WORK, -1, INFO )
ELSE IF( WANTVR ) THEN
+ CALL DTREVC3( 'R', 'B', SELECT, N, A, LDA,
+ $ VL, LDVL, VR, LDVR,
+ $ N, NOUT, WORK, -1, IERR )
+ LWORK_TREVC = INT( WORK(1) )
+ MAXWRK = MAX( MAXWRK, N + LWORK_TREVC )
CALL DHSEQR( 'S', 'V', N, 1, N, A, LDA, WR, WI, VR, LDVR,
$ WORK, -1, INFO )
ELSE
@@ -420,7 +431,7 @@
$ LDVR, WORK, -1, INFO )
END IF
END IF
- HSWORK = WORK( 1 )
+ HSWORK = INT( WORK(1) )
*
IF( ( .NOT.WANTVL ) .AND. ( .NOT.WANTVR ) ) THEN
MINWRK = 2*N
@@ -572,18 +583,18 @@
$ WORK( IWRK ), LWORK-IWRK+1, INFO )
END IF
*
-* If INFO > 0 from DHSEQR, then quit
+* If INFO .NE. 0 from DHSEQR, then quit
*
- IF( INFO.GT.0 )
+ IF( INFO.NE.0 )
$ GO TO 50
*
IF( WANTVL .OR. WANTVR ) THEN
*
* Compute left and/or right eigenvectors
-* (Workspace: need 3*N)
+* (Workspace: need 3*N, prefer N + 2*N*NB)
*
- CALL DTREVC( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, LDVR,
- $ N, NOUT, WORK( IWRK ), IERR )
+ CALL DTREVC3( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, LDVR,
+ $ N, NOUT, WORK( IWRK ), LWORK-IWRK+1, IERR )
END IF
*
* Compute condition numbers if desired