From 5a8f9aa8fcf38ace8f9e7945b0cd25ceeee8fd3b Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Mon, 22 Sep 2025 13:27:59 -0700 Subject: [PATCH] Remove LABAD (Reference-LAPACK PR 805) and fix infinite loop scaling Inf (PR 1158) --- lapack-netlib/SRC/csrscl.f | 14 +++++++++----- lapack-netlib/SRC/zdrscl.f | 14 +++++++++----- 2 files changed, 18 insertions(+), 10 deletions(-) diff --git a/lapack-netlib/SRC/csrscl.f b/lapack-netlib/SRC/csrscl.f index 5f27f63872..3eb059a451 100644 --- a/lapack-netlib/SRC/csrscl.f +++ b/lapack-netlib/SRC/csrscl.f @@ -5,7 +5,6 @@ * Online html documentation available at * http://www.netlib.org/lapack/explore-html/ * -*> \htmlonly *> Download CSRSCL + dependencies *> *> [TGZ] @@ -13,7 +12,6 @@ *> [ZIP] *> *> [TXT] -*> \endhtmlonly * * Definition: * =========== @@ -77,10 +75,11 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \ingroup complexOTHERauxiliary +*> \ingroup rscl * * ===================================================================== SUBROUTINE CSRSCL( N, SA, SX, INCX ) + IMPLICIT NONE * * -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -109,10 +108,11 @@ SUBROUTINE CSRSCL( N, SA, SX, INCX ) EXTERNAL SLAMCH * .. * .. External Subroutines .. - EXTERNAL CSSCAL, SLABAD + EXTERNAL CSSCAL * .. * .. Intrinsic Functions .. INTRINSIC ABS + INTRINSIC HUGE * .. * .. Executable Statements .. * @@ -120,12 +120,16 @@ SUBROUTINE CSRSCL( N, SA, SX, INCX ) * IF( N.LE.0 ) $ RETURN +* + IF( SA.GT.HUGE(SA) .OR. SA.LT.-HUGE(SA) ) THEN + CALL CSSCAL( N, SA, SX, INCX ) + RETURN + END IF * * Get machine parameters * SMLNUM = SLAMCH( 'S' ) BIGNUM = ONE / SMLNUM - CALL SLABAD( SMLNUM, BIGNUM ) * * Initialize the denominator to SA and the numerator to 1. * diff --git a/lapack-netlib/SRC/zdrscl.f b/lapack-netlib/SRC/zdrscl.f index 9e1b2ea872..6fc1830c83 100644 --- a/lapack-netlib/SRC/zdrscl.f +++ b/lapack-netlib/SRC/zdrscl.f @@ -5,7 +5,6 @@ * Online html documentation available at * http://www.netlib.org/lapack/explore-html/ * -*> \htmlonly *> Download ZDRSCL + dependencies *> *> [TGZ] @@ -13,7 +12,6 @@ *> [ZIP] *> *> [TXT] -*> \endhtmlonly * * Definition: * =========== @@ -77,10 +75,11 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \ingroup complex16OTHERauxiliary +*> \ingroup rscl * * ===================================================================== SUBROUTINE ZDRSCL( N, SA, SX, INCX ) + IMPLICIT NONE * * -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -109,10 +108,11 @@ SUBROUTINE ZDRSCL( N, SA, SX, INCX ) EXTERNAL DLAMCH * .. * .. External Subroutines .. - EXTERNAL DLABAD, ZDSCAL + EXTERNAL ZDSCAL * .. * .. Intrinsic Functions .. INTRINSIC ABS + INTRINSIC HUGE * .. * .. Executable Statements .. * @@ -120,12 +120,16 @@ SUBROUTINE ZDRSCL( N, SA, SX, INCX ) * IF( N.LE.0 ) $ RETURN +* + IF( SA.GT.HUGE(SA) .OR. SA.LT.-HUGE(SA) ) THEN + CALL ZDSCAL( N, SA, SX, INCX ) + RETURN + END IF * * Get machine parameters * SMLNUM = DLAMCH( 'S' ) BIGNUM = ONE / SMLNUM - CALL DLABAD( SMLNUM, BIGNUM ) * * Initialize the denominator to SA and the numerator to 1. *