From f3f5fd9116e41a1d6b7a766ee998c34bd0fd7bd0 Mon Sep 17 00:00:00 2001 From: Martin Kroeker Date: Sun, 5 Jul 2026 17:43:58 +0200 Subject: [PATCH] Avoid intermediate overflow (Reference-LAPACK PR 1290) --- lapack-netlib/SRC/dlarfgp.f | 10 +++++++--- lapack-netlib/SRC/slarfgp.f | 7 ++++++- 2 files changed, 13 insertions(+), 4 deletions(-) diff --git a/lapack-netlib/SRC/dlarfgp.f b/lapack-netlib/SRC/dlarfgp.f index a8cf1b31e3..fe66139977 100644 --- a/lapack-netlib/SRC/dlarfgp.f +++ b/lapack-netlib/SRC/dlarfgp.f @@ -5,7 +5,6 @@ * Online html documentation available at * http://www.netlib.org/lapack/explore-html/ * -*> \htmlonly *> Download DLARFGP + dependencies *> *> [TGZ] @@ -13,7 +12,6 @@ *> [ZIP] *> *> [TXT] -*> \endhtmlonly * * Definition: * =========== @@ -101,6 +99,7 @@ * * ===================================================================== SUBROUTINE DLARFGP( N, ALPHA, X, INCX, TAU ) + IMPLICIT NONE * * -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- @@ -221,7 +220,12 @@ SUBROUTINE DLARFGP( N, ALPHA, X, INCX, TAU ) * * This is the general case. * - CALL DSCAL( N-1, ONE / ALPHA, X, INCX ) + IF( ABS( ALPHA ).LT.SMLNUM ) THEN + CALL DSCAL( N-1, ONE / SMLNUM, X, INCX ) + CALL DSCAL( N-1, SMLNUM / ALPHA, X, INCX ) + ELSE + CALL DSCAL( N-1, ONE / ALPHA, X, INCX ) + END IF * END IF * diff --git a/lapack-netlib/SRC/slarfgp.f b/lapack-netlib/SRC/slarfgp.f index c28274c2c4..ab297f485a 100644 --- a/lapack-netlib/SRC/slarfgp.f +++ b/lapack-netlib/SRC/slarfgp.f @@ -221,7 +221,12 @@ SUBROUTINE SLARFGP( N, ALPHA, X, INCX, TAU ) * * This is the general case. * - CALL SSCAL( N-1, ONE / ALPHA, X, INCX ) + IF( ABS( ALPHA ).LT.SMLNUM ) THEN + CALL SSCAL( N-1, ONE / SMLNUM, X, INCX ) + CALL SSCAL( N-1, SMLNUM / ALPHA, X, INCX ) + ELSE + CALL SSCAL( N-1, ONE / ALPHA, X, INCX ) + END IF * END IF *