Skip to content

Commit 77a97c4

Browse files
thijssteelthijssteel
authored
Merge pull request #1 from weslleyspereira/try-dggev-with-multishift-aed
Try new routine DGLAQZ0 in DGGEV
2 parents 93fd62f + 6c434e7 commit 77a97c4

File tree

4 files changed

+73
-45
lines changed

4 files changed

+73
-45
lines changed

‎SRC/cggev.f‎

Lines changed: 14 additions & 10 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 SHGEQZ,
201-
*> =N+2: error return from STGEVC.
200+
*> > N: =N+1: other then QZ iteration failed in CLAQZ0.
201+
*> =N+2: error return from CTGEVC.
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, CGGHRD, CHGEQZ, CLACPY,
259+
EXTERNAL CGEQRF, CGGBAK, CGGBAL, CGGHD3, CLAQZ0, CLACPY,
260260
$ CLASCL, CLASET, CTGEVC, CUNGQR, CUNMQR, SLABAD,
261261
$ XERBLA
262262
* ..
@@ -332,13 +332,16 @@ 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+
*
335336
LWKOPT = MAX( 1, N + N*ILAENV( 1, 'CGEQRF', ' ', N, 1, N, 0 ) )
336337
LWKOPT = MAX( LWKOPT, N +
337338
$ N*ILAENV( 1, 'CUNMQR', ' ', N, 1, N, 0 ) )
338339
IF( ILVL ) THEN
339340
LWKOPT = MAX( LWKOPT, N +
340341
$ N*ILAENV( 1, 'CUNGQR', ' ', N, 1, N, -1 ) )
341342
END IF
343+
LWKOPT = MAX( LWKOPT, 6*N *
344+
$ ILAENV( 1, 'CGGHD3', ' ', N, 1, N, 0 ) )
342345
WORK( 1 ) = LWKOPT
343346
*
344347
IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY )
@@ -444,31 +447,32 @@ SUBROUTINE CGGEV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA,
444447
*
445448
* Reduce to generalized Hessenberg form
446449
*
450+
IWRK = 1
447451
IF( ILV ) THEN
448452
*
449453
* Eigenvectors requested -- work on whole matrix.
450454
*
451-
CALL CGGHRD( JOBVL, JOBVR, N, ILO, IHI, A, LDA, B, LDB, VL,
452-
$ LDVL, VR, LDVR, IERR )
455+
CALL CGGHD3( JOBVL, JOBVR, N, ILO, IHI, A, LDA, B, LDB, VL,
456+
$ LDVL, VR, LDVR, WORK( IWRK ), LWORK+1-IWRK, IERR )
453457
ELSE
454-
CALL CGGHRD( 'N', 'N', IROWS, 1, IROWS, A( ILO, ILO ), LDA,
455-
$ B( ILO, ILO ), LDB, VL, LDVL, VR, LDVR, IERR )
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 )
456461
END IF
457462
*
458463
* Perform QZ algorithm (Compute eigenvalues, and optionally, the
459464
* Schur form and Schur vectors)
460465
* (Complex Workspace: need N)
461466
* (Real Workspace: need N)
462467
*
463-
IWRK = ITAU
464468
IF( ILV ) THEN
465469
CHTEMP = 'S'
466470
ELSE
467471
CHTEMP = 'E'
468472
END IF
469-
CALL CHGEQZ( CHTEMP, JOBVL, JOBVR, N, ILO, IHI, A, LDA, B, LDB,
473+
CALL CLAQZ0( CHTEMP, JOBVL, JOBVR, N, ILO, IHI, A, LDA, B, LDB,
470474
$ ALPHA, BETA, VL, LDVL, VR, LDVR, WORK( IWRK ),
471-
$ LWORK+1-IWRK, RWORK( IRWRK ), IERR )
475+
$ LWORK+1-IWRK, RWORK( IRWRK ), 0, IERR )
472476
IF( IERR.NE.0 ) THEN
473477
IF( IERR.GT.0 .AND. IERR.LE.N ) THEN
474478
INFO = IERR

‎SRC/dggev.f‎

Lines changed: 22 additions & 12 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 DHGEQZ.
209+
*> > N: =N+1: other than QZ iteration failed in DLAQZ0.
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, DGGHRD, DHGEQZ, DLABAD,
263+
EXTERNAL DGEQRF, DGGBAK, DGGBAL, DGGHD3, DLAQZ0, DLABAD,
264264
$ DLACPY,DLASCL, DLASET, DORGQR, DORMQR, DTGEVC,
265265
$ XERBLA
266266
* ..
@@ -330,13 +330,21 @@ 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-
MAXWRK = MAX( 1, N*( 7 +
333+
*
334+
MAXWRK = MAX( MINWRK, N*( 3 +
334335
$ ILAENV( 1, 'DGEQRF', ' ', N, 1, N, 0 ) ) )
335-
MAXWRK = MAX( MAXWRK, N*( 7 +
336+
MAXWRK = MAX( MAXWRK, N*( 3 +
336337
$ ILAENV( 1, 'DORMQR', ' ', N, 1, N, 0 ) ) )
337338
IF( ILVL ) THEN
338-
MAXWRK = MAX( MAXWRK, N*( 7 +
339+
MAXWRK = MAX( MAXWRK, N*( 3 +
339340
$ 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 ) )
340348
END IF
341349
WORK( 1 ) = MAXWRK
342350
*
@@ -448,26 +456,28 @@ SUBROUTINE DGGEV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, ALPHAI,
448456
*
449457
* Eigenvectors requested -- work on whole matrix.
450458
*
451-
CALL DGGHRD( JOBVL, JOBVR, N, ILO, IHI, A, LDA, B, LDB, VL,
452-
$ LDVL, VR, LDVR, IERR )
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 )
453462
ELSE
454-
CALL DGGHRD( 'N', 'N', IROWS, 1, IROWS, A( ILO, ILO ), LDA,
455-
$ B( ILO, ILO ), LDB, VL, LDVL, VR, LDVR, IERR )
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 )
456467
END IF
457468
*
458469
* Perform QZ algorithm (Compute eigenvalues, and optionally, the
459470
* Schur forms and Schur vectors)
460471
* (Workspace: need N)
461472
*
462-
IWRK = ITAU
463473
IF( ILV ) THEN
464474
CHTEMP = 'S'
465475
ELSE
466476
CHTEMP = 'E'
467477
END IF
468-
CALL DHGEQZ( CHTEMP, JOBVL, JOBVR, N, ILO, IHI, A, LDA, B, LDB,
478+
CALL DLAQZ0( CHTEMP, JOBVL, JOBVR, N, ILO, IHI, A, LDA, B, LDB,
469479
$ ALPHAR, ALPHAI, BETA, VL, LDVL, VR, LDVR,
470-
$ WORK( IWRK ), LWORK+1-IWRK, IERR )
480+
$ WORK( IWRK ), LWORK+1-IWRK, 0, IERR )
471481
IF( IERR.NE.0 ) THEN
472482
IF( IERR.GT.0 .AND. IERR.LE.N ) THEN
473483
INFO = IERR

‎SRC/sggev.f‎

Lines changed: 22 additions & 12 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 SHGEQZ.
209+
*> > N: =N+1: other than QZ iteration failed in SLAQZ0.
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, SGGHRD, SHGEQZ, SLABAD,
263+
EXTERNAL SGEQRF, SGGBAK, SGGBAL, SGGHD3, SLAQZ0, SLABAD,
264264
$ SLACPY, SLASCL, SLASET, SORGQR, SORMQR, STGEVC,
265265
$ XERBLA
266266
* ..
@@ -330,13 +330,21 @@ 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-
MAXWRK = MAX( 1, N*( 7 +
333+
*
334+
MAXWRK = MAX( MINWRK, N*( 3 +
334335
$ ILAENV( 1, 'SGEQRF', ' ', N, 1, N, 0 ) ) )
335-
MAXWRK = MAX( MAXWRK, N*( 7 +
336+
MAXWRK = MAX( MAXWRK, N*( 3 +
336337
$ ILAENV( 1, 'SORMQR', ' ', N, 1, N, 0 ) ) )
337338
IF( ILVL ) THEN
338-
MAXWRK = MAX( MAXWRK, N*( 7 +
339+
MAXWRK = MAX( MAXWRK, N*( 3 +
339340
$ 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 ) )
340348
END IF
341349
WORK( 1 ) = MAXWRK
342350
*
@@ -448,26 +456,28 @@ SUBROUTINE SGGEV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHAR, ALPHAI,
448456
*
449457
* Eigenvectors requested -- work on whole matrix.
450458
*
451-
CALL SGGHRD( JOBVL, JOBVR, N, ILO, IHI, A, LDA, B, LDB, VL,
452-
$ LDVL, VR, LDVR, IERR )
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 )
453462
ELSE
454-
CALL SGGHRD( 'N', 'N', IROWS, 1, IROWS, A( ILO, ILO ), LDA,
455-
$ B( ILO, ILO ), LDB, VL, LDVL, VR, LDVR, IERR )
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 )
456467
END IF
457468
*
458469
* Perform QZ algorithm (Compute eigenvalues, and optionally, the
459470
* Schur forms and Schur vectors)
460471
* (Workspace: need N)
461472
*
462-
IWRK = ITAU
463473
IF( ILV ) THEN
464474
CHTEMP = 'S'
465475
ELSE
466476
CHTEMP = 'E'
467477
END IF
468-
CALL SHGEQZ( CHTEMP, JOBVL, JOBVR, N, ILO, IHI, A, LDA, B, LDB,
478+
CALL SLAQZ0( CHTEMP, JOBVL, JOBVR, N, ILO, IHI, A, LDA, B, LDB,
469479
$ ALPHAR, ALPHAI, BETA, VL, LDVL, VR, LDVR,
470-
$ WORK( IWRK ), LWORK+1-IWRK, IERR )
480+
$ WORK( IWRK ), LWORK+1-IWRK, 0, IERR )
471481
IF( IERR.NE.0 ) THEN
472482
IF( IERR.GT.0 .AND. IERR.LE.N ) THEN
473483
INFO = IERR

‎SRC/zggev.f‎

Lines changed: 15 additions & 11 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 DHGEQZ,
201-
*> =N+2: error return from DTGEVC.
200+
*> > N: =N+1: other then QZ iteration failed in ZLAQZ0.
201+
*> =N+2: error return from ZTGEVC.
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, ZGGHRD,
260-
$ ZHGEQZ, ZLACPY, ZLASCL, ZLASET, ZTGEVC, ZUNGQR,
259+
EXTERNAL DLABAD, XERBLA, ZGEQRF, ZGGBAK, ZGGBAL, ZGGHD3,
260+
$ ZLAQZ0, ZLACPY, ZLASCL, ZLASET, ZTGEVC, ZUNGQR,
261261
$ ZUNMQR
262262
* ..
263263
* .. External Functions ..
@@ -332,13 +332,16 @@ 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+
*
335336
LWKOPT = MAX( 1, N + N*ILAENV( 1, 'ZGEQRF', ' ', N, 1, N, 0 ) )
336337
LWKOPT = MAX( LWKOPT, N +
337338
$ N*ILAENV( 1, 'ZUNMQR', ' ', N, 1, N, 0 ) )
338339
IF( ILVL ) THEN
339340
LWKOPT = MAX( LWKOPT, N +
340341
$ N*ILAENV( 1, 'ZUNGQR', ' ', N, 1, N, -1 ) )
341342
END IF
343+
LWKOPT = MAX( LWKOPT, 6*N *
344+
$ ILAENV( 1, 'ZGGHD3', ' ', N, 1, N, 0 ) )
342345
WORK( 1 ) = LWKOPT
343346
*
344347
IF( LWORK.LT.LWKMIN .AND. .NOT.LQUERY )
@@ -444,31 +447,32 @@ SUBROUTINE ZGGEV( JOBVL, JOBVR, N, A, LDA, B, LDB, ALPHA, BETA,
444447
*
445448
* Reduce to generalized Hessenberg form
446449
*
450+
IWRK = 1
447451
IF( ILV ) THEN
448452
*
449453
* Eigenvectors requested -- work on whole matrix.
450454
*
451-
CALL ZGGHRD( JOBVL, JOBVR, N, ILO, IHI, A, LDA, B, LDB, VL,
452-
$ LDVL, VR, LDVR, IERR )
455+
CALL ZGGHD3( JOBVL, JOBVR, N, ILO, IHI, A, LDA, B, LDB, VL,
456+
$ LDVL, VR, LDVR, WORK( IWRK ), LWORK+1-IWRK, IERR )
453457
ELSE
454-
CALL ZGGHRD( 'N', 'N', IROWS, 1, IROWS, A( ILO, ILO ), LDA,
455-
$ B( ILO, ILO ), LDB, VL, LDVL, VR, LDVR, IERR )
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 )
456461
END IF
457462
*
458463
* Perform QZ algorithm (Compute eigenvalues, and optionally, the
459464
* Schur form and Schur vectors)
460465
* (Complex Workspace: need N)
461466
* (Real Workspace: need N)
462467
*
463-
IWRK = ITAU
464468
IF( ILV ) THEN
465469
CHTEMP = 'S'
466470
ELSE
467471
CHTEMP = 'E'
468472
END IF
469-
CALL ZHGEQZ( CHTEMP, JOBVL, JOBVR, N, ILO, IHI, A, LDA, B, LDB,
473+
CALL ZLAQZ0( CHTEMP, JOBVL, JOBVR, N, ILO, IHI, A, LDA, B, LDB,
470474
$ ALPHA, BETA, VL, LDVL, VR, LDVR, WORK( IWRK ),
471-
$ LWORK+1-IWRK, RWORK( IRWRK ), IERR )
475+
$ LWORK+1-IWRK, RWORK( IRWRK ), 0, IERR )
472476
IF( IERR.NE.0 ) THEN
473477
IF( IERR.GT.0 .AND. IERR.LE.N ) THEN
474478
INFO = IERR

0 commit comments

Comments
 (0)