diff options
| author | Julie <julie@cs.utk.edu> | 2016-06-12 23:21:04 -0700 |
|---|---|---|
| committer | Julie <julie@cs.utk.edu> | 2016-06-12 23:21:04 -0700 |
| commit | ed2ea1af894955ddd1ddfd0acb15e1c07d459f1e (patch) | |
| tree | 98e082131f1ca4ec697e7522ce524b2e59ca3b24 /SRC/dgeevx.f | |
| parent | f22614a1a00c722ee0c570a4e3d36af4f1cb2cb6 (diff) | |
| download | lapack-ed2ea1af894955ddd1ddfd0acb15e1c07d459f1e.tar.gz lapack-ed2ea1af894955ddd1ddfd0acb15e1c07d459f1e.tar.bz2 lapack-ed2ea1af894955ddd1ddfd0acb15e1c07d459f1e.zip | |
blocked back-transformation for the non-symmetric eigenvalue problem - Contribution from Mark Gates (UTK)
From mark:
It blocks NB gemv calls into one gemm call inside trevc. To do that, it
needs a new routine, trevc3, because unfortunately the lwork was not
passed into trevc. (I highly recommend all new routines always pass
lwork and lrwork, where applicable, to enable future upgrades & to
catch lwork bugs.)
Diffstat (limited to 'SRC/dgeevx.f')
| -rw-r--r-- | SRC/dgeevx.f | 29 |
1 files changed, 20 insertions, 9 deletions
diff --git a/SRC/dgeevx.f b/SRC/dgeevx.f index 8d80d782..d2ba08f0 100644 --- a/SRC/dgeevx.f +++ b/SRC/dgeevx.f @@ -302,6 +302,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 ) + implicit none * * -- LAPACK driver routine (version 3.4.2) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -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 @@ -580,10 +591,10 @@ 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 |