From d77d9bc920affa2f2d3e0a5479cb05c676a9246e Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Sun, 2 May 2021 11:24:50 +0200 Subject: [PATCH] Handle norm NaN value (Reference LAPACK PR471) --- lapack-netlib/SRC/cgesdd.f | 8 ++++++-- lapack-netlib/SRC/dgesdd.f | 8 ++++++-- lapack-netlib/SRC/sgesdd.f | 8 ++++++-- lapack-netlib/SRC/zgesdd.f | 8 ++++++-- 4 files changed, 24 insertions(+), 8 deletions(-) diff --git a/lapack-netlib/SRC/cgesdd.f b/lapack-netlib/SRC/cgesdd.f index 07341593f..34a80beea 100644 --- a/lapack-netlib/SRC/cgesdd.f +++ b/lapack-netlib/SRC/cgesdd.f @@ -281,9 +281,9 @@ $ CUNGQR, CUNMBR, SBDSDC, SLASCL, XERBLA * .. * .. External Functions .. - LOGICAL LSAME + LOGICAL LSAME, SISNAN REAL SLAMCH, CLANGE - EXTERNAL LSAME, SLAMCH, CLANGE + EXTERNAL LSAME, SLAMCH, CLANGE, SISNAN * .. * .. Intrinsic Functions .. INTRINSIC INT, MAX, MIN, SQRT @@ -647,6 +647,10 @@ * Scale A if max element outside range [SMLNUM,BIGNUM] * ANRM = CLANGE( 'M', M, N, A, LDA, DUM ) + IF( SISNAN ( ANRM ) ) THEN + INFO = -4 + RETURN + END IF ISCL = 0 IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN ISCL = 1 diff --git a/lapack-netlib/SRC/dgesdd.f b/lapack-netlib/SRC/dgesdd.f index 0218900d2..80d18041c 100644 --- a/lapack-netlib/SRC/dgesdd.f +++ b/lapack-netlib/SRC/dgesdd.f @@ -267,9 +267,9 @@ $ XERBLA * .. * .. External Functions .. - LOGICAL LSAME + LOGICAL LSAME, DISNAN DOUBLE PRECISION DLAMCH, DLANGE - EXTERNAL DLAMCH, DLANGE, LSAME + EXTERNAL DLAMCH, DLANGE, LSAME, DISNAN * .. * .. Intrinsic Functions .. INTRINSIC INT, MAX, MIN, SQRT @@ -599,6 +599,10 @@ * Scale A if max element outside range [SMLNUM,BIGNUM] * ANRM = DLANGE( 'M', M, N, A, LDA, DUM ) + IF( DISNAN( ANRM ) ) THEN + INFO = -4 + RETURN + END IF ISCL = 0 IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN ISCL = 1 diff --git a/lapack-netlib/SRC/sgesdd.f b/lapack-netlib/SRC/sgesdd.f index 689494dd1..89e03a002 100644 --- a/lapack-netlib/SRC/sgesdd.f +++ b/lapack-netlib/SRC/sgesdd.f @@ -267,9 +267,9 @@ $ XERBLA * .. * .. External Functions .. - LOGICAL LSAME + LOGICAL LSAME, SISNAN REAL SLAMCH, SLANGE - EXTERNAL SLAMCH, SLANGE, LSAME + EXTERNAL SLAMCH, SLANGE, LSAME, SISNAN * .. * .. Intrinsic Functions .. INTRINSIC INT, MAX, MIN, SQRT @@ -599,6 +599,10 @@ * Scale A if max element outside range [SMLNUM,BIGNUM] * ANRM = SLANGE( 'M', M, N, A, LDA, DUM ) + IF( SISNAN( ANRM ) ) THEN + INFO = -4 + RETURN + END IF ISCL = 0 IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN ISCL = 1 diff --git a/lapack-netlib/SRC/zgesdd.f b/lapack-netlib/SRC/zgesdd.f index bb9d2c26e..2209f4733 100644 --- a/lapack-netlib/SRC/zgesdd.f +++ b/lapack-netlib/SRC/zgesdd.f @@ -281,9 +281,9 @@ $ ZLASET, ZUNGBR, ZUNGLQ, ZUNGQR, ZUNMBR * .. * .. External Functions .. - LOGICAL LSAME + LOGICAL LSAME, DISNAN DOUBLE PRECISION DLAMCH, ZLANGE - EXTERNAL LSAME, DLAMCH, ZLANGE + EXTERNAL LSAME, DLAMCH, ZLANGE, DISNAN * .. * .. Intrinsic Functions .. INTRINSIC INT, MAX, MIN, SQRT @@ -647,6 +647,10 @@ * Scale A if max element outside range [SMLNUM,BIGNUM] * ANRM = ZLANGE( 'M', M, N, A, LDA, DUM ) + IF( DISNAN( ANRM ) ) THEN + INFO = -4 + RETURN + END IF ISCL = 0 IF( ANRM.GT.ZERO .AND. ANRM.LT.SMLNUM ) THEN ISCL = 1