From 25802f27ddb2566bcbf2c56ceb7bb5c476fbc000 Mon Sep 17 00:00:00 2001 From: Julien Langou Date: Sun, 15 Jun 2025 12:05:27 -0600 Subject: [PATCH 1/2] minor: upper case, indentation --- SRC/cgeev.f | 14 +++++++------- SRC/dgeev.f | 2 +- SRC/sgeev.f | 10 +++++----- SRC/zgeev.f | 2 +- 4 files changed, 14 insertions(+), 14 deletions(-) diff --git a/SRC/cgeev.f b/SRC/cgeev.f index 753fbff0a..dd08258be 100644 --- a/SRC/cgeev.f +++ b/SRC/cgeev.f @@ -176,7 +176,7 @@ SUBROUTINE CGEEV( JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, $ LDVR, $ WORK, LWORK, RWORK, INFO ) - implicit none + IMPLICIT NONE * * -- LAPACK driver routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -187,15 +187,15 @@ SUBROUTINE CGEEV( JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, INTEGER INFO, LDA, LDVL, LDVR, LWORK, N * .. * .. Array Arguments .. - REAL RWORK( * ) - COMPLEX A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ), + REAL RWORK( * ) + COMPLEX A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ), $ W( * ), WORK( * ) * .. * * ===================================================================== * * .. Parameters .. - REAL ZERO, ONE + REAL ZERO, ONE PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 ) * .. * .. Local Scalars .. @@ -203,12 +203,12 @@ SUBROUTINE CGEEV( JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, CHARACTER SIDE INTEGER HSWORK, I, IBAL, IERR, IHI, ILO, IRWORK, ITAU, $ IWRK, K, LWORK_TREVC, MAXWRK, MINWRK, NOUT - REAL ANRM, BIGNUM, CSCALE, EPS, SCL, SMLNUM - COMPLEX TMP + REAL ANRM, BIGNUM, CSCALE, EPS, SCL, SMLNUM + COMPLEX TMP * .. * .. Local Arrays .. LOGICAL SELECT( 1 ) - REAL DUM( 1 ) + REAL DUM( 1 ) * .. * .. External Subroutines .. EXTERNAL XERBLA, CSSCAL, CGEBAK, diff --git a/SRC/dgeev.f b/SRC/dgeev.f index 9efc11499..0f32c0671 100644 --- a/SRC/dgeev.f +++ b/SRC/dgeev.f @@ -188,7 +188,7 @@ SUBROUTINE DGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, $ VR, $ LDVR, WORK, LWORK, INFO ) - implicit none + IMPLICIT NONE * * -- LAPACK driver routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- diff --git a/SRC/sgeev.f b/SRC/sgeev.f index 70783156c..fc8a93bdd 100644 --- a/SRC/sgeev.f +++ b/SRC/sgeev.f @@ -188,7 +188,7 @@ SUBROUTINE SGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, $ VR, $ LDVR, WORK, LWORK, INFO ) - implicit none + IMPLICIT NONE * * -- LAPACK driver routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -199,14 +199,14 @@ SUBROUTINE SGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, INTEGER INFO, LDA, LDVL, LDVR, LWORK, N * .. * .. Array Arguments .. - REAL A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ), + REAL A( LDA, * ), VL( LDVL, * ), VR( LDVR, * ), $ WI( * ), WORK( * ), WR( * ) * .. * * ===================================================================== * * .. Parameters .. - REAL ZERO, ONE + REAL ZERO, ONE PARAMETER ( ZERO = 0.0E0, ONE = 1.0E0 ) * .. * .. Local Scalars .. @@ -214,12 +214,12 @@ SUBROUTINE SGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, CHARACTER SIDE INTEGER HSWORK, I, IBAL, IERR, IHI, ILO, ITAU, IWRK, K, $ LWORK_TREVC, MAXWRK, MINWRK, NOUT - REAL ANRM, BIGNUM, CS, CSCALE, EPS, R, SCL, SMLNUM, + REAL ANRM, BIGNUM, CS, CSCALE, EPS, R, SCL, SMLNUM, $ SN * .. * .. Local Arrays .. LOGICAL SELECT( 1 ) - REAL DUM( 1 ) + REAL DUM( 1 ) * .. * .. External Subroutines .. EXTERNAL SGEBAK, SGEBAL, SGEHRD, diff --git a/SRC/zgeev.f b/SRC/zgeev.f index 94d8a0606..29c9ae0f2 100644 --- a/SRC/zgeev.f +++ b/SRC/zgeev.f @@ -176,7 +176,7 @@ SUBROUTINE ZGEEV( JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, $ LDVR, $ WORK, LWORK, RWORK, INFO ) - implicit none + IMPLICIT NONE * * -- LAPACK driver routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- From 0918f47cbd960fb28bbcc0ecf2110a8a89660bf9 Mon Sep 17 00:00:00 2001 From: Julien Langou Date: Sun, 15 Jun 2025 12:15:39 -0600 Subject: [PATCH 2/2] follow @angsch idea - add a check for NaN in input matrix A in geev see issue #1128 --- SRC/cgeev.f | 6 +++++- SRC/dgeev.f | 6 +++++- SRC/sgeev.f | 6 +++++- SRC/zgeev.f | 6 +++++- 4 files changed, 20 insertions(+), 4 deletions(-) diff --git a/SRC/cgeev.f b/SRC/cgeev.f index dd08258be..3adec15a1 100644 --- a/SRC/cgeev.f +++ b/SRC/cgeev.f @@ -217,7 +217,7 @@ SUBROUTINE CGEEV( JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, $ CTREVC3, CUNGHR * .. * .. External Functions .. - LOGICAL LSAME + LOGICAL LSAME, SISNAN INTEGER ISAMAX, ILAENV REAL SLAMCH, SCNRM2, CLANGE, $ SROUNDUP_LWORK @@ -335,6 +335,10 @@ SUBROUTINE CGEEV( JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, ELSE IF( ANRM.GT.BIGNUM ) THEN SCALEA = .TRUE. CSCALE = BIGNUM + ELSE IF( SISNAN( ANRM ) ) THEN + INFO = -4 + CALL XERBLA( 'CGEEV ', -INFO ) + RETURN END IF IF( SCALEA ) $ CALL CLASCL( 'G', 0, 0, ANRM, CSCALE, N, N, A, LDA, IERR ) diff --git a/SRC/dgeev.f b/SRC/dgeev.f index 0f32c0671..3e7d135c0 100644 --- a/SRC/dgeev.f +++ b/SRC/dgeev.f @@ -227,7 +227,7 @@ SUBROUTINE DGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, $ DLASCL, DORGHR, DROT, DSCAL, DTREVC3, XERBLA * .. * .. External Functions .. - LOGICAL LSAME + LOGICAL LSAME, DISNAN INTEGER IDAMAX, ILAENV DOUBLE PRECISION DLAMCH, DLANGE, DLAPY2, DNRM2 EXTERNAL LSAME, IDAMAX, ILAENV, DLAMCH, DLANGE, @@ -353,6 +353,10 @@ SUBROUTINE DGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, ELSE IF( ANRM.GT.BIGNUM ) THEN SCALEA = .TRUE. CSCALE = BIGNUM + ELSE IF( DISNAN( ANRM ) ) THEN + INFO = -4 + CALL XERBLA( 'DGEEV ', -INFO ) + RETURN END IF IF( SCALEA ) $ CALL DLASCL( 'G', 0, 0, ANRM, CSCALE, N, N, A, LDA, IERR ) diff --git a/SRC/sgeev.f b/SRC/sgeev.f index fc8a93bdd..88a1cbe24 100644 --- a/SRC/sgeev.f +++ b/SRC/sgeev.f @@ -228,7 +228,7 @@ SUBROUTINE SGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, $ SSCAL, STREVC3, XERBLA * .. * .. External Functions .. - LOGICAL LSAME + LOGICAL LSAME, SISNAN INTEGER ISAMAX, ILAENV REAL SLAMCH, SLANGE, SLAPY2, SNRM2, $ SROUNDUP_LWORK @@ -355,6 +355,10 @@ SUBROUTINE SGEEV( JOBVL, JOBVR, N, A, LDA, WR, WI, VL, LDVL, ELSE IF( ANRM.GT.BIGNUM ) THEN SCALEA = .TRUE. CSCALE = BIGNUM + ELSE IF( SISNAN( ANRM ) ) THEN + INFO = -4 + CALL XERBLA( 'SGEEV ', -INFO ) + RETURN END IF IF( SCALEA ) $ CALL SLASCL( 'G', 0, 0, ANRM, CSCALE, N, N, A, LDA, IERR ) diff --git a/SRC/zgeev.f b/SRC/zgeev.f index 29c9ae0f2..ea75b49aa 100644 --- a/SRC/zgeev.f +++ b/SRC/zgeev.f @@ -216,7 +216,7 @@ SUBROUTINE ZGEEV( JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, $ ZLACPY, ZLASCL, ZSCAL, ZTREVC3, ZUNGHR * .. * .. External Functions .. - LOGICAL LSAME + LOGICAL LSAME, DISNAN INTEGER IDAMAX, ILAENV DOUBLE PRECISION DLAMCH, DZNRM2, ZLANGE EXTERNAL LSAME, IDAMAX, ILAENV, DLAMCH, DZNRM2, @@ -332,6 +332,10 @@ SUBROUTINE ZGEEV( JOBVL, JOBVR, N, A, LDA, W, VL, LDVL, VR, ELSE IF( ANRM.GT.BIGNUM ) THEN SCALEA = .TRUE. CSCALE = BIGNUM + ELSE IF( DISNAN( ANRM ) ) THEN + INFO = -4 + CALL XERBLA( 'ZGEEV ', -INFO ) + RETURN END IF IF( SCALEA ) $ CALL ZLASCL( 'G', 0, 0, ANRM, CSCALE, N, N, A, LDA, IERR )