--- rpl/lapack/lapack/zlarfgp.f 2017/06/17 10:54:22 1.14 +++ rpl/lapack/lapack/zlarfgp.f 2023/08/07 08:39:31 1.18 @@ -97,17 +97,14 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date December 2016 -* *> \ingroup complex16OTHERauxiliary * * ===================================================================== SUBROUTINE ZLARFGP( N, ALPHA, X, INCX, TAU ) * -* -- LAPACK auxiliary routine (version 3.7.0) -- +* -- LAPACK auxiliary routine -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* December 2016 * * .. Scalar Arguments .. INTEGER INCX, N @@ -197,7 +194,7 @@ BETA = BETA*BIGNUM ALPHI = ALPHI*BIGNUM ALPHR = ALPHR*BIGNUM - IF( ABS( BETA ).LT.SMLNUM ) + IF( (ABS( BETA ).LT.SMLNUM) .AND. (KNT .LT. 20) ) $ GO TO 10 * * New BETA is at most 1, at least SMLNUM @@ -238,7 +235,7 @@ DO J = 1, N-1 X( 1 + (J-1)*INCX ) = ZERO END DO - BETA = -SAVEALPHA + BETA = DBLE( -SAVEALPHA ) END IF ELSE XNORM = DLAPY2( ALPHR, ALPHI )