Skip to content

Commit 3bbb3e8

Browse files
Revert "Merge pull request #1 from weslleyspereira/try-dggev-with-multishift-aed"
This reverts commit 77a97c4, reversing changes made to 93fd62f.
1 parent 0b8015e commit 3bbb3e8

File tree

4 files changed

+45
-73
lines changed

4 files changed

+45
-73
lines changed

SRC/cggev.f

Lines changed: 10 additions & 14 deletions
Original file line numberDiff line numberDiff line change
@@ -197,8 +197,8 @@
197197
*> The QZ iteration failed. No eigenvectors have been
198198
*> calculated, but ALPHA(j) and BETA(j) should be
199199
*> correct for j=INFO+1,...,N.
200-
*> > N: =N+1: other then QZ iteration failed in CLAQZ0.
201-
*> =N+2: error return from CTGEVC.
200+
*> > N: =N+1: other then QZ iteration failed in SHGEQZ,
201+
*> =N+2: error return from STGEVC.
202202
*> \endverbatim
203203
*
204204
* Authors:
@@ -256,7 +256,7 @@ SUBROUTINE CGGEV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA,
256256
LOGICAL LDUMMA( 1 )
257257
* ..
258258
* .. External Subroutines ..
259-
EXTERNAL CGEQRF, CGGBAK, CGGBAL, CGGHD3, CLAQZ0, CLACPY,
259+
EXTERNAL CGEQRF, CGGBAK, CGGBAL, CGGHRD, CHGEQZ, CLACPY,
260260
$ CLASCL, CLASET, CTGEVC, CUNGQR, CUNMQR, SLABAD,
261261
$ XERBLA
262262
* ..
@@ -332,16 +332,13 @@ SUBROUTINE CGGEV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA,
332332
*
333333
IF( INFO.EQ.0 ) THEN
334334
LWKMIN = MAX( 1, 2*N )
335-
*
336335
LWKOPT = MAX( 1, N + N*ILAENV( 1, 'CGEQRF', ' ', N, 1, N, 0 ) )
337336
LWKOPT = MAX( LWKOPT, N +
338337
$ N*ILAENV( 1, 'CUNMQR', ' ', N, 1, N, 0 ) )
339338
IF( ILVL ) THEN
340339
LWKOPT = MAX( LWKOPT, N +
341340
$ N*ILAENV( 1, 'CUNGQR', ' ', N, 1, N, -1 ) )
342341
END IF
343-
LWKOPT = MAX( LWKOPT, 6*N *
344-
$ ILAENV( 1, 'CGGHD3', ' ', N, 1, N, 0 ) )
345342
WORK( 1 ) = LWKOPT
346343
*
347344
IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY )
@@ -447,32 +444,31 @@ SUBROUTINE CGGEV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA,
447444
*
448445
* Reduce to generalized Hessenberg form
449446
*
450-
IWRK = 1
451447
IF( ILV ) THEN
452448
*
453449
* Eigenvectors requested -- work on whole matrix.
454450
*
455-
CALL CGGHD3( JOBVL, JOBVR, N, ILO, IHI, A, LDA, B, LDB, VL,
456-
$ LDVL, VR, LDVR, WORK( IWRK ), LWORK+1-IWRK, IERR )
451+
CALL CGGHRD( JOBVL, JOBVR, N, ILO, IHI, A, LDA, B, LDB, VL,
452+
$ LDVL, VR, LDVR, IERR )
457453
ELSE
458-
CALL CGGHD3( 'N', 'N', IROWS, 1, IROWS, A( ILO, ILO ), LDA,
459-
$ B( ILO, ILO ), LDB, VL, LDVL, VR, LDVR,
460-
$ WORK( IWRK ), LWORK+1-IWRK, IERR )
454+
CALL CGGHRD( 'N', 'N', IROWS, 1, IROWS, A( ILO, ILO ), LDA,
455+
$ B( ILO, ILO ), LDB, VL, LDVL, VR, LDVR, IERR )
461456
END IF
462457
*
463458
* Perform QZ algorithm (Compute eigenvalues, and optionally, the
464459
* Schur form and Schur vectors)
465460
* (Complex Workspace: need N)
466461
* (Real Workspace: need N)
467462
*
463+
IWRK = ITAU
468464
IF( ILV ) THEN
469465
CHTEMP = 'S'
470466
ELSE
471467
CHTEMP = 'E'
472468
END IF
473-
CALL CLAQZ0( CHTEMP, JOBVL, JOBVR, N, ILO, IHI, A, LDA, B, LDB,
469+
CALL CHGEQZ( CHTEMP, JOBVL, JOBVR, N, ILO, IHI, A, LDA, B, LDB,
474470
$ ALPHA, BETA, VL, LDVL, VR, LDVR, WORK( IWRK ),
475-
$ LWORK+1-IWRK, RWORK( IRWRK ), 0, IERR )
471+
$ LWORK+1-IWRK, RWORK( IRWRK ), IERR )
476472
IF( IERR.NE.0 ) THEN
477473
IF( IERR.GT.0 .AND. IERR.LE.N ) THEN
478474
INFO = IERR

SRC/dggev.f

Lines changed: 12 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -206,7 +206,7 @@
206206
*> The QZ iteration failed. No eigenvectors have been
207207
*> calculated, but ALPHAR(j), ALPHAI(j), and BETA(j)
208208
*> should be correct for j=INFO+1,...,N.
209-
*> > N: =N+1: other than QZ iteration failed in DLAQZ0.
209+
*> > N: =N+1: other than QZ iteration failed in DHGEQZ.
210210
*> =N+2: error return from DTGEVC.
211211
*> \endverbatim
212212
*
@@ -260,7 +260,7 @@ SUBROUTINE DGGEV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, ALPHAI,
260260
LOGICAL LDUMMA( 1 )
261261
* ..
262262
* .. External Subroutines ..
263-
EXTERNAL DGEQRF, DGGBAK, DGGBAL, DGGHD3, DLAQZ0, DLABAD,
263+
EXTERNAL DGEQRF, DGGBAK, DGGBAL, DGGHRD, DHGEQZ, DLABAD,
264264
$ DLACPY,DLASCL, DLASET, DORGQR, DORMQR, DTGEVC,
265265
$ XERBLA
266266
* ..
@@ -330,21 +330,13 @@ SUBROUTINE DGGEV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, ALPHAI,
330330
*
331331
IF( INFO.EQ.0 ) THEN
332332
MINWRK = MAX( 1, 8*N )
333-
*
334-
MAXWRK = MAX( MINWRK, N*( 3 +
333+
MAXWRK = MAX( 1, N*( 7 +
335334
$ ILAENV( 1, 'DGEQRF', ' ', N, 1, N, 0 ) ) )
336-
MAXWRK = MAX( MAXWRK, N*( 3 +
335+
MAXWRK = MAX( MAXWRK, N*( 7 +
337336
$ ILAENV( 1, 'DORMQR', ' ', N, 1, N, 0 ) ) )
338337
IF( ILVL ) THEN
339-
MAXWRK = MAX( MAXWRK, N*( 3 +
338+
MAXWRK = MAX( MAXWRK, N*( 7 +
340339
$ ILAENV( 1, 'DORGQR', ' ', N, 1, N, -1 ) ) )
341-
END IF
342-
IF( ILV ) THEN
343-
MAXWRK = MAX( MAXWRK, N*( 2 + 6 *
344-
$ ILAENV( 1, 'DGGHD3', ' ', N, 1, N, 0 ) ) )
345-
ELSE
346-
MAXWRK = MAX( MAXWRK, 6*N *
347-
$ ILAENV( 1, 'DGGHD3', ' ', N, 1, N, 0 ) )
348340
END IF
349341
WORK( 1 ) = MAXWRK
350342
*
@@ -456,28 +448,26 @@ SUBROUTINE DGGEV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, ALPHAI,
456448
*
457449
* Eigenvectors requested -- work on whole matrix.
458450
*
459-
IWRK = ITAU
460-
CALL DGGHD3( JOBVL, JOBVR, N, ILO, IHI, A, LDA, B, LDB, VL,
461-
$ LDVL, VR, LDVR, WORK( IWRK ), LWORK+1-IWRK, IERR )
451+
CALL DGGHRD( JOBVL, JOBVR, N, ILO, IHI, A, LDA, B, LDB, VL,
452+
$ LDVL, VR, LDVR, IERR )
462453
ELSE
463-
IWRK = 1
464-
CALL DGGHD3( 'N', 'N', IROWS, 1, IROWS, A( ILO, ILO ), LDA,
465-
$ B( ILO, ILO ), LDB, VL, LDVL, VR, LDVR,
466-
$ WORK( IWRK ), LWORK+1-IWRK, IERR )
454+
CALL DGGHRD( 'N', 'N', IROWS, 1, IROWS, A( ILO, ILO ), LDA,
455+
$ B( ILO, ILO ), LDB, VL, LDVL, VR, LDVR, IERR )
467456
END IF
468457
*
469458
* Perform QZ algorithm (Compute eigenvalues, and optionally, the
470459
* Schur forms and Schur vectors)
471460
* (Workspace: need N)
472461
*
462+
IWRK = ITAU
473463
IF( ILV ) THEN
474464
CHTEMP = 'S'
475465
ELSE
476466
CHTEMP = 'E'
477467
END IF
478-
CALL DLAQZ0( CHTEMP, JOBVL, JOBVR, N, ILO, IHI, A, LDA, B, LDB,
468+
CALL DHGEQZ( CHTEMP, JOBVL, JOBVR, N, ILO, IHI, A, LDA, B, LDB,
479469
$ ALPHAR, ALPHAI, BETA, VL, LDVL, VR, LDVR,
480-
$ WORK( IWRK ), LWORK+1-IWRK, 0, IERR )
470+
$ WORK( IWRK ), LWORK+1-IWRK, IERR )
481471
IF( IERR.NE.0 ) THEN
482472
IF( IERR.GT.0 .AND. IERR.LE.N ) THEN
483473
INFO = IERR

SRC/sggev.f

Lines changed: 12 additions & 22 deletions
Original file line numberDiff line numberDiff line change
@@ -206,7 +206,7 @@
206206
*> The QZ iteration failed. No eigenvectors have been
207207
*> calculated, but ALPHAR(j), ALPHAI(j), and BETA(j)
208208
*> should be correct for j=INFO+1,...,N.
209-
*> > N: =N+1: other than QZ iteration failed in SLAQZ0.
209+
*> > N: =N+1: other than QZ iteration failed in SHGEQZ.
210210
*> =N+2: error return from STGEVC.
211211
*> \endverbatim
212212
*
@@ -260,7 +260,7 @@ SUBROUTINE SGGEV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, ALPHAI,
260260
LOGICAL LDUMMA( 1 )
261261
* ..
262262
* .. External Subroutines ..
263-
EXTERNAL SGEQRF, SGGBAK, SGGBAL, SGGHD3, SLAQZ0, SLABAD,
263+
EXTERNAL SGEQRF, SGGBAK, SGGBAL, SGGHRD, SHGEQZ, SLABAD,
264264
$ SLACPY, SLASCL, SLASET, SORGQR, SORMQR, STGEVC,
265265
$ XERBLA
266266
* ..
@@ -330,21 +330,13 @@ SUBROUTINE SGGEV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, ALPHAI,
330330
*
331331
IF( INFO.EQ.0 ) THEN
332332
MINWRK = MAX( 1, 8*N )
333-
*
334-
MAXWRK = MAX( MINWRK, N*( 3 +
333+
MAXWRK = MAX( 1, N*( 7 +
335334
$ ILAENV( 1, 'SGEQRF', ' ', N, 1, N, 0 ) ) )
336-
MAXWRK = MAX( MAXWRK, N*( 3 +
335+
MAXWRK = MAX( MAXWRK, N*( 7 +
337336
$ ILAENV( 1, 'SORMQR', ' ', N, 1, N, 0 ) ) )
338337
IF( ILVL ) THEN
339-
MAXWRK = MAX( MAXWRK, N*( 3 +
338+
MAXWRK = MAX( MAXWRK, N*( 7 +
340339
$ ILAENV( 1, 'SORGQR', ' ', N, 1, N, -1 ) ) )
341-
END IF
342-
IF( ILV ) THEN
343-
MAXWRK = MAX( MAXWRK, N*( 2 + 6 *
344-
$ ILAENV( 1, 'SGGHD3', ' ', N, 1, N, 0 ) ) )
345-
ELSE
346-
MAXWRK = MAX( MAXWRK, 6*N *
347-
$ ILAENV( 1, 'SGGHD3', ' ', N, 1, N, 0 ) )
348340
END IF
349341
WORK( 1 ) = MAXWRK
350342
*
@@ -456,28 +448,26 @@ SUBROUTINE SGGEV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, ALPHAI,
456448
*
457449
* Eigenvectors requested -- work on whole matrix.
458450
*
459-
IWRK = ITAU
460-
CALL SGGHD3( JOBVL, JOBVR, N, ILO, IHI, A, LDA, B, LDB, VL,
461-
$ LDVL, VR, LDVR, WORK( IWRK ), LWORK+1-IWRK, IERR )
451+
CALL SGGHRD( JOBVL, JOBVR, N, ILO, IHI, A, LDA, B, LDB, VL,
452+
$ LDVL, VR, LDVR, IERR )
462453
ELSE
463-
IWRK = 1
464-
CALL SGGHD3( 'N', 'N', IROWS, 1, IROWS, A( ILO, ILO ), LDA,
465-
$ B( ILO, ILO ), LDB, VL, LDVL, VR, LDVR,
466-
$ WORK( IWRK ), LWORK+1-IWRK, IERR )
454+
CALL SGGHRD( 'N', 'N', IROWS, 1, IROWS, A( ILO, ILO ), LDA,
455+
$ B( ILO, ILO ), LDB, VL, LDVL, VR, LDVR, IERR )
467456
END IF
468457
*
469458
* Perform QZ algorithm (Compute eigenvalues, and optionally, the
470459
* Schur forms and Schur vectors)
471460
* (Workspace: need N)
472461
*
462+
IWRK = ITAU
473463
IF( ILV ) THEN
474464
CHTEMP = 'S'
475465
ELSE
476466
CHTEMP = 'E'
477467
END IF
478-
CALL SLAQZ0( CHTEMP, JOBVL, JOBVR, N, ILO, IHI, A, LDA, B, LDB,
468+
CALL SHGEQZ( CHTEMP, JOBVL, JOBVR, N, ILO, IHI, A, LDA, B, LDB,
479469
$ ALPHAR, ALPHAI, BETA, VL, LDVL, VR, LDVR,
480-
$ WORK( IWRK ), LWORK+1-IWRK, 0, IERR )
470+
$ WORK( IWRK ), LWORK+1-IWRK, IERR )
481471
IF( IERR.NE.0 ) THEN
482472
IF( IERR.GT.0 .AND. IERR.LE.N ) THEN
483473
INFO = IERR

SRC/zggev.f

Lines changed: 11 additions & 15 deletions
Original file line numberDiff line numberDiff line change
@@ -197,8 +197,8 @@
197197
*> The QZ iteration failed. No eigenvectors have been
198198
*> calculated, but ALPHA(j) and BETA(j) should be
199199
*> correct for j=INFO+1,...,N.
200-
*> > N: =N+1: other then QZ iteration failed in ZLAQZ0.
201-
*> =N+2: error return from ZTGEVC.
200+
*> > N: =N+1: other then QZ iteration failed in DHGEQZ,
201+
*> =N+2: error return from DTGEVC.
202202
*> \endverbatim
203203
*
204204
* Authors:
@@ -256,8 +256,8 @@ SUBROUTINE ZGGEV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA,
256256
LOGICAL LDUMMA( 1 )
257257
* ..
258258
* .. External Subroutines ..
259-
EXTERNAL DLABAD, XERBLA, ZGEQRF, ZGGBAK, ZGGBAL, ZGGHD3,
260-
$ ZLAQZ0, ZLACPY, ZLASCL, ZLASET, ZTGEVC, ZUNGQR,
259+
EXTERNAL DLABAD, XERBLA, ZGEQRF, ZGGBAK, ZGGBAL, ZGGHRD,
260+
$ ZHGEQZ, ZLACPY, ZLASCL, ZLASET, ZTGEVC, ZUNGQR,
261261
$ ZUNMQR
262262
* ..
263263
* .. External Functions ..
@@ -332,16 +332,13 @@ SUBROUTINE ZGGEV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA,
332332
*
333333
IF( INFO.EQ.0 ) THEN
334334
LWKMIN = MAX( 1, 2*N )
335-
*
336335
LWKOPT = MAX( 1, N + N*ILAENV( 1, 'ZGEQRF', ' ', N, 1, N, 0 ) )
337336
LWKOPT = MAX( LWKOPT, N +
338337
$ N*ILAENV( 1, 'ZUNMQR', ' ', N, 1, N, 0 ) )
339338
IF( ILVL ) THEN
340339
LWKOPT = MAX( LWKOPT, N +
341340
$ N*ILAENV( 1, 'ZUNGQR', ' ', N, 1, N, -1 ) )
342341
END IF
343-
LWKOPT = MAX( LWKOPT, 6*N *
344-
$ ILAENV( 1, 'ZGGHD3', ' ', N, 1, N, 0 ) )
345342
WORK( 1 ) = LWKOPT
346343
*
347344
IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY )
@@ -447,32 +444,31 @@ SUBROUTINE ZGGEV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA,
447444
*
448445
* Reduce to generalized Hessenberg form
449446
*
450-
IWRK = 1
451447
IF( ILV ) THEN
452448
*
453449
* Eigenvectors requested -- work on whole matrix.
454450
*
455-
CALL ZGGHD3( JOBVL, JOBVR, N, ILO, IHI, A, LDA, B, LDB, VL,
456-
$ LDVL, VR, LDVR, WORK( IWRK ), LWORK+1-IWRK, IERR )
451+
CALL ZGGHRD( JOBVL, JOBVR, N, ILO, IHI, A, LDA, B, LDB, VL,
452+
$ LDVL, VR, LDVR, IERR )
457453
ELSE
458-
CALL ZGGHD3( 'N', 'N', IROWS, 1, IROWS, A( ILO, ILO ), LDA,
459-
$ B( ILO, ILO ), LDB, VL, LDVL, VR, LDVR,
460-
$ WORK( IWRK ), LWORK+1-IWRK, IERR )
454+
CALL ZGGHRD( 'N', 'N', IROWS, 1, IROWS, A( ILO, ILO ), LDA,
455+
$ B( ILO, ILO ), LDB, VL, LDVL, VR, LDVR, IERR )
461456
END IF
462457
*
463458
* Perform QZ algorithm (Compute eigenvalues, and optionally, the
464459
* Schur form and Schur vectors)
465460
* (Complex Workspace: need N)
466461
* (Real Workspace: need N)
467462
*
463+
IWRK = ITAU
468464
IF( ILV ) THEN
469465
CHTEMP = 'S'
470466
ELSE
471467
CHTEMP = 'E'
472468
END IF
473-
CALL ZLAQZ0( CHTEMP, JOBVL, JOBVR, N, ILO, IHI, A, LDA, B, LDB,
469+
CALL ZHGEQZ( CHTEMP, JOBVL, JOBVR, N, ILO, IHI, A, LDA, B, LDB,
474470
$ ALPHA, BETA, VL, LDVL, VR, LDVR, WORK( IWRK ),
475-
$ LWORK+1-IWRK, RWORK( IRWRK ), 0, IERR )
471+
$ LWORK+1-IWRK, RWORK( IRWRK ), IERR )
476472
IF( IERR.NE.0 ) THEN
477473
IF( IERR.GT.0 .AND. IERR.LE.N ) THEN
478474
INFO = IERR

0 commit comments

Comments
 (0)