From 1232a92fcb235c1f159380ea57fca407c4831a76 Mon Sep 17 00:00:00 2001 From: Hong Bo Peng Date: Mon, 15 Jul 2024 00:34:45 -0400 Subject: [PATCH] Fix the quick return code path for S/D/C/ZGEESX, C/ZHBEVX, S/DSBEVX, C/ZHEEVX, S/DSYEVX, C/ZHPEVX, S/DSPEVX, C/ZHPGVX. 1. set RCONDE and RCONDV in S/D/C/ZGEESX when N = 0. 2. set Q in C/ZHBEVX, S/DSBEVX when N = 1 and WANTZ. 3. set IFAIL in C/ZHBEVX, S/DSBEVX, C/ZHEEVX, S/DSYEVX, C/ZHPEVX, S/DSPEVX when N = 1 and WANTZ. 4. set M in C/ZHPGVX when N = 0. --- SRC/cgeesx.f | 2 ++ SRC/chbevx.f | 7 +++++-- SRC/cheevx.f | 6 ++++-- SRC/chpevx.f | 6 ++++-- SRC/chpgvx.f | 1 + SRC/dgeesx.f | 2 ++ SRC/dsbevx.f | 7 +++++-- SRC/dspevx.f | 6 ++++-- SRC/dsyevx.f | 6 ++++-- SRC/sgeesx.f | 2 ++ SRC/ssbevx.f | 7 +++++-- SRC/sspevx.f | 6 ++++-- SRC/ssyevx.f | 6 ++++-- SRC/zgeesx.f | 2 ++ SRC/zhbevx.f | 7 +++++-- SRC/zheevx.f | 6 ++++-- SRC/zhpevx.f | 6 ++++-- SRC/zhpgvx.f | 1 + 18 files changed, 62 insertions(+), 24 deletions(-) diff --git a/SRC/cgeesx.f b/SRC/cgeesx.f index 4d0f81e537..1f43380a39 100644 --- a/SRC/cgeesx.f +++ b/SRC/cgeesx.f @@ -373,6 +373,8 @@ SUBROUTINE CGEESX( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, * IF( N.EQ.0 ) THEN SDIM = 0 + IF (WANTSE .OR. WANTSB) RCONDE = 1.0E0 + IF (WANTSV .OR. WANTSB) RCONDV = 0.0E0 RETURN END IF * diff --git a/SRC/chbevx.f b/SRC/chbevx.f index cde356a514..79159a626f 100644 --- a/SRC/chbevx.f +++ b/SRC/chbevx.f @@ -382,8 +382,11 @@ SUBROUTINE CHBEVX( JOBZ, RANGE, UPLO, N, KD, AB, LDAB, Q, LDQ, END IF IF( M.EQ.1 ) THEN W( 1 ) = REAL( CTMP1 ) - IF( WANTZ ) - $ Z( 1, 1 ) = CONE + IF( WANTZ ) THEN + Q( 1, 1 ) = ONE + Z( 1, 1 ) = ONE + IFAIL(1) = 0 + ENDIF END IF RETURN END IF diff --git a/SRC/cheevx.f b/SRC/cheevx.f index bf2e308849..986cbf3a1e 100644 --- a/SRC/cheevx.f +++ b/SRC/cheevx.f @@ -390,8 +390,10 @@ SUBROUTINE CHEEVX( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, W( 1 ) = REAL( A( 1, 1 ) ) END IF END IF - IF( WANTZ ) - $ Z( 1, 1 ) = CONE + IF( WANTZ ) THEN + Z( 1, 1 ) = ONE + IFAIL(1) = 0 + ENDIF RETURN END IF * diff --git a/SRC/chpevx.f b/SRC/chpevx.f index 766a04fdaa..4738eb05cb 100644 --- a/SRC/chpevx.f +++ b/SRC/chpevx.f @@ -341,8 +341,10 @@ SUBROUTINE CHPEVX( JOBZ, RANGE, UPLO, N, AP, VL, VU, IL, IU, W( 1 ) = REAL( AP( 1 ) ) END IF END IF - IF( WANTZ ) - $ Z( 1, 1 ) = CONE + IF( WANTZ ) THEN + Z( 1, 1 ) = CONE + IFAIL(1) = 0 + ENDIF RETURN END IF * diff --git a/SRC/chpgvx.f b/SRC/chpgvx.f index 6b2f570865..353d64d5ce 100644 --- a/SRC/chpgvx.f +++ b/SRC/chpgvx.f @@ -355,6 +355,7 @@ SUBROUTINE CHPGVX( ITYPE, JOBZ, RANGE, UPLO, N, AP, BP, VL, VU, * * Quick return if possible * + M = 0 IF( N.EQ.0 ) $ RETURN * diff --git a/SRC/dgeesx.f b/SRC/dgeesx.f index 4d99b5ba46..8cc4e7bec6 100644 --- a/SRC/dgeesx.f +++ b/SRC/dgeesx.f @@ -421,6 +421,8 @@ SUBROUTINE DGEESX( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, * IF( N.EQ.0 ) THEN SDIM = 0 + IF (WANTSE .OR. WANTSB) RCONDE = 1.0D0 + IF (WANTSV .OR. WANTSB) RCONDV = 0.0D0 RETURN END IF * diff --git a/SRC/dsbevx.f b/SRC/dsbevx.f index f9e15f5241..a204fc5049 100644 --- a/SRC/dsbevx.f +++ b/SRC/dsbevx.f @@ -373,8 +373,11 @@ SUBROUTINE DSBEVX( JOBZ, RANGE, UPLO, N, KD, AB, LDAB, Q, LDQ, END IF IF( M.EQ.1 ) THEN W( 1 ) = TMP1 - IF( WANTZ ) - $ Z( 1, 1 ) = ONE + IF( WANTZ ) THEN + Q( 1, 1 ) = ONE + Z( 1, 1 ) = ONE + IFAIL(1) = ZERO + ENDIF END IF RETURN END IF diff --git a/SRC/dspevx.f b/SRC/dspevx.f index 1dea63e710..8e32c27a93 100644 --- a/SRC/dspevx.f +++ b/SRC/dspevx.f @@ -332,8 +332,10 @@ SUBROUTINE DSPEVX( JOBZ, RANGE, UPLO, N, AP, VL, VU, IL, IU, W( 1 ) = AP( 1 ) END IF END IF - IF( WANTZ ) - $ Z( 1, 1 ) = ONE + IF( WANTZ ) THEN + Z( 1, 1 ) = ONE + IFAIL(1) = ZERO + ENDIF RETURN END IF * diff --git a/SRC/dsyevx.f b/SRC/dsyevx.f index 1f9954850f..c1f5aa3f55 100644 --- a/SRC/dsyevx.f +++ b/SRC/dsyevx.f @@ -378,8 +378,10 @@ SUBROUTINE DSYEVX( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, W( 1 ) = A( 1, 1 ) END IF END IF - IF( WANTZ ) - $ Z( 1, 1 ) = ONE + IF( WANTZ ) THEN + Z( 1, 1 ) = ONE + IFAIL(1) = ZERO + ENDIF RETURN END IF * diff --git a/SRC/sgeesx.f b/SRC/sgeesx.f index 0a760c83c5..f0144cacca 100644 --- a/SRC/sgeesx.f +++ b/SRC/sgeesx.f @@ -422,6 +422,8 @@ SUBROUTINE SGEESX( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, * IF( N.EQ.0 ) THEN SDIM = 0 + IF (WANTSE .OR. WANTSB) RCONDE = 1.0E0 + IF (WANTSV .OR. WANTSB) RCONDV = 0.0E0 RETURN END IF * diff --git a/SRC/ssbevx.f b/SRC/ssbevx.f index 44028482b0..d13383f828 100644 --- a/SRC/ssbevx.f +++ b/SRC/ssbevx.f @@ -373,8 +373,11 @@ SUBROUTINE SSBEVX( JOBZ, RANGE, UPLO, N, KD, AB, LDAB, Q, LDQ, END IF IF( M.EQ.1 ) THEN W( 1 ) = TMP1 - IF( WANTZ ) - $ Z( 1, 1 ) = ONE + IF( WANTZ ) THEN + Q( 1, 1 ) = ONE + Z( 1, 1 ) = ONE + IFAIL(1) = ZERO + ENDIF END IF RETURN END IF diff --git a/SRC/sspevx.f b/SRC/sspevx.f index 16a2b666b8..4daeee8fa0 100644 --- a/SRC/sspevx.f +++ b/SRC/sspevx.f @@ -332,8 +332,10 @@ SUBROUTINE SSPEVX( JOBZ, RANGE, UPLO, N, AP, VL, VU, IL, IU, W( 1 ) = AP( 1 ) END IF END IF - IF( WANTZ ) - $ Z( 1, 1 ) = ONE + IF( WANTZ ) THEN + Z( 1, 1 ) = ONE + IFAIL(1) = ZERO + ENDIF RETURN END IF * diff --git a/SRC/ssyevx.f b/SRC/ssyevx.f index d898adccad..4deaa910dc 100644 --- a/SRC/ssyevx.f +++ b/SRC/ssyevx.f @@ -379,8 +379,10 @@ SUBROUTINE SSYEVX( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, W( 1 ) = A( 1, 1 ) END IF END IF - IF( WANTZ ) - $ Z( 1, 1 ) = ONE + IF( WANTZ ) THEN + Z( 1, 1 ) = ONE + IFAIL(1) = ZERO + ENDIF RETURN END IF * diff --git a/SRC/zgeesx.f b/SRC/zgeesx.f index cd297bf516..54f0f4ca3c 100644 --- a/SRC/zgeesx.f +++ b/SRC/zgeesx.f @@ -372,6 +372,8 @@ SUBROUTINE ZGEESX( JOBVS, SORT, SELECT, SENSE, N, A, LDA, SDIM, * IF( N.EQ.0 ) THEN SDIM = 0 + IF (WANTSE .OR. WANTSB) RCONDE = 1.0D0 + IF (WANTSV .OR. WANTSB) RCONDV = 0.0D0 RETURN END IF * diff --git a/SRC/zhbevx.f b/SRC/zhbevx.f index c0b9281842..9445984623 100644 --- a/SRC/zhbevx.f +++ b/SRC/zhbevx.f @@ -382,8 +382,11 @@ SUBROUTINE ZHBEVX( JOBZ, RANGE, UPLO, N, KD, AB, LDAB, Q, LDQ, END IF IF( M.EQ.1 ) THEN W( 1 ) = DBLE( CTMP1 ) - IF( WANTZ ) - $ Z( 1, 1 ) = CONE + IF( WANTZ ) THEN + Q( 1, 1 ) = ONE + Z( 1, 1 ) = ONE + IFAIL(1) = 0 + ENDIF END IF RETURN END IF diff --git a/SRC/zheevx.f b/SRC/zheevx.f index f8696e4e5b..3601254f68 100644 --- a/SRC/zheevx.f +++ b/SRC/zheevx.f @@ -389,8 +389,10 @@ SUBROUTINE ZHEEVX( JOBZ, RANGE, UPLO, N, A, LDA, VL, VU, IL, W( 1 ) = DBLE( A( 1, 1 ) ) END IF END IF - IF( WANTZ ) - $ Z( 1, 1 ) = CONE + IF( WANTZ ) THEN + Z( 1, 1 ) = ONE + IFAIL(1) = 0 + ENDIF RETURN END IF * diff --git a/SRC/zhpevx.f b/SRC/zhpevx.f index 4b797f6b04..888cb8ad02 100644 --- a/SRC/zhpevx.f +++ b/SRC/zhpevx.f @@ -341,8 +341,10 @@ SUBROUTINE ZHPEVX( JOBZ, RANGE, UPLO, N, AP, VL, VU, IL, IU, W( 1 ) = DBLE( AP( 1 ) ) END IF END IF - IF( WANTZ ) - $ Z( 1, 1 ) = CONE + IF( WANTZ ) THEN + Z( 1, 1 ) = CONE + IFAIL(1) = 0 + ENDIF RETURN END IF * diff --git a/SRC/zhpgvx.f b/SRC/zhpgvx.f index d3bbe9ad1d..b61349767d 100644 --- a/SRC/zhpgvx.f +++ b/SRC/zhpgvx.f @@ -355,6 +355,7 @@ SUBROUTINE ZHPGVX( ITYPE, JOBZ, RANGE, UPLO, N, AP, BP, VL, VU, * * Quick return if possible * + M = 0 IF( N.EQ.0 ) $ RETURN *