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/dgeev.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/dgeev.f')
| -rw-r--r-- | SRC/dgeev.f | 33 |
1 files changed, 22 insertions, 11 deletions
diff --git a/SRC/dgeev.f b/SRC/dgeev.f index 328eaa39..1c92b7e3 100644 --- a/SRC/dgeev.f +++ b/SRC/dgeev.f @@ -188,6 +188,7 @@ * ===================================================================== SUBROUTINE DGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, VR, $ LDVR, WORK, LWORK, INFO ) + implicit none * * -- LAPACK driver routine (version 3.4.2) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -213,7 +214,7 @@ LOGICAL LQUERY, SCALEA, WANTVL, WANTVR CHARACTER SIDE INTEGER HSWORK, I, IBAL, IERR, IHI, ILO, ITAU, IWRK, K, - $ MAXWRK, MINWRK, NOUT + $ LWORK_TREVC, MAXWRK, MINWRK, NOUT DOUBLE PRECISION ANRM, BIGNUM, CS, CSCALE, EPS, R, SCL, SMLNUM, $ SN * .. @@ -223,7 +224,7 @@ * .. * .. External Subroutines .. EXTERNAL DGEBAK, DGEBAL, DGEHRD, DHSEQR, DLABAD, DLACPY, - $ DLARTG, DLASCL, DORGHR, DROT, DSCAL, DTREVC, + $ DLARTG, DLASCL, DORGHR, DROT, DSCAL, DTREVC3, $ XERBLA * .. * .. External Functions .. @@ -279,24 +280,34 @@ MAXWRK = MAX( MAXWRK, 2*N + ( N - 1 )*ILAENV( 1, $ 'DORGHR', ' ', N, 1, N, -1 ) ) CALL DHSEQR( 'S', 'V', N, 1, N, A, LDA, WR, WI, VL, LDVL, - $ WORK, -1, INFO ) - HSWORK = WORK( 1 ) + $ WORK, -1, INFO ) + HSWORK = INT( WORK(1) ) MAXWRK = MAX( MAXWRK, N + 1, N + HSWORK ) + 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 ) MAXWRK = MAX( MAXWRK, 4*N ) ELSE IF( WANTVR ) THEN MINWRK = 4*N MAXWRK = MAX( MAXWRK, 2*N + ( N - 1 )*ILAENV( 1, $ 'DORGHR', ' ', N, 1, N, -1 ) ) CALL DHSEQR( 'S', 'V', N, 1, N, A, LDA, WR, WI, VR, LDVR, - $ WORK, -1, INFO ) - HSWORK = WORK( 1 ) + $ WORK, -1, INFO ) + HSWORK = INT( WORK(1) ) MAXWRK = MAX( MAXWRK, N + 1, N + HSWORK ) + 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 ) MAXWRK = MAX( MAXWRK, 4*N ) ELSE MINWRK = 3*N CALL DHSEQR( 'E', 'N', N, 1, N, A, LDA, WR, WI, VR, LDVR, - $ WORK, -1, INFO ) - HSWORK = WORK( 1 ) + $ WORK, -1, INFO ) + HSWORK = INT( WORK(1) ) MAXWRK = MAX( MAXWRK, N + 1, N + HSWORK ) END IF MAXWRK = MAX( MAXWRK, MINWRK ) @@ -426,10 +437,10 @@ IF( WANTVL .OR. WANTVR ) THEN * * Compute left and/or right eigenvectors -* (Workspace: need 4*N) +* (Workspace: need 4*N, prefer N + 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 * IF( WANTVL ) THEN |