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 *