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/zgeevx.f | |
| parent | f22614a1a00c722ee0c570a4e3d36af4f1cb2cb6 (diff) | |
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/zgeevx.f')
| -rw-r--r-- | SRC/zgeevx.f | 26 |
1 files changed, 19 insertions, 7 deletions
diff --git a/SRC/zgeevx.f b/SRC/zgeevx.f index e68165e2..cb750650 100644 --- a/SRC/zgeevx.f +++ b/SRC/zgeevx.f @@ -284,6 +284,7 @@ SUBROUTINE ZGEEVX( BALANC, JOBVL, JOBVR, SENSE, N, A, LDA, W, VL, $ LDVL, VR, LDVR, ILO, IHI, SCALE, ABNRM, RCONDE, $ RCONDV, WORK, LWORK, RWORK, INFO ) + implicit none * * -- LAPACK driver routine (version 3.4.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -312,8 +313,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, CSCALE, EPS, SCL, SMLNUM COMPLEX*16 TMP * .. @@ -323,7 +324,7 @@ * .. * .. External Subroutines .. EXTERNAL DLABAD, DLASCL, XERBLA, ZDSCAL, ZGEBAK, ZGEBAL, - $ ZGEHRD, ZHSEQR, ZLACPY, ZLASCL, ZSCAL, ZTREVC, + $ ZGEHRD, ZHSEQR, ZLACPY, ZLASCL, ZSCAL, ZTREVC3, $ ZTRSNA, ZUNGHR * .. * .. External Functions .. @@ -387,9 +388,19 @@ MAXWRK = N + N*ILAENV( 1, 'ZGEHRD', ' ', N, 1, N, 0 ) * IF( WANTVL ) THEN + CALL ZTREVC3( 'L', 'B', SELECT, N, A, LDA, + $ VL, LDVL, VR, LDVR, + $ N, NOUT, WORK, -1, RWORK, -1, IERR ) + LWORK_TREVC = INT( WORK(1) ) + MAXWRK = MAX( MAXWRK, LWORK_TREVC ) CALL ZHSEQR( 'S', 'V', N, 1, N, A, LDA, W, VL, LDVL, $ WORK, -1, INFO ) ELSE IF( WANTVR ) THEN + CALL ZTREVC3( 'R', 'B', SELECT, N, A, LDA, + $ VL, LDVL, VR, LDVR, + $ N, NOUT, WORK, -1, RWORK, -1, IERR ) + LWORK_TREVC = INT( WORK(1) ) + MAXWRK = MAX( MAXWRK, LWORK_TREVC ) CALL ZHSEQR( 'S', 'V', N, 1, N, A, LDA, W, VR, LDVR, $ WORK, -1, INFO ) ELSE @@ -401,7 +412,7 @@ $ WORK, -1, INFO ) END IF END IF - HSWORK = WORK( 1 ) + HSWORK = INT( WORK(1) ) * IF( ( .NOT.WANTVL ) .AND. ( .NOT.WANTVR ) ) THEN MINWRK = 2*N @@ -567,11 +578,12 @@ IF( WANTVL .OR. WANTVR ) THEN * * Compute left and/or right eigenvectors -* (CWorkspace: need 2*N) +* (CWorkspace: need 2*N, prefer N + 2*N*NB) * (RWorkspace: need N) * - CALL ZTREVC( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, LDVR, - $ N, NOUT, WORK( IWRK ), RWORK, IERR ) + CALL ZTREVC3( SIDE, 'B', SELECT, N, A, LDA, VL, LDVL, VR, LDVR, + $ N, NOUT, WORK( IWRK ), LWORK-IWRK+1, + $ RWORK, N, IERR ) END IF * * Compute condition numbers if desired |