--- rpl/lapack/lapack/zlassq.f 2012/08/22 09:48:37 1.10 +++ rpl/lapack/lapack/zlassq.f 2012/12/14 12:30:33 1.11 @@ -1,4 +1,4 @@ -*> \brief \b ZLASSQ +*> \brief \b ZLASSQ updates a sum of squares represented in scaled form. * * =========== DOCUMENTATION =========== * @@ -99,17 +99,17 @@ *> \author Univ. of Colorado Denver *> \author NAG Ltd. * -*> \date November 2011 +*> \date September 2012 * *> \ingroup complex16OTHERauxiliary * * ===================================================================== SUBROUTINE ZLASSQ( N, X, INCX, SCALE, SUMSQ ) * -* -- LAPACK auxiliary routine (version 3.4.0) -- +* -- LAPACK auxiliary routine (version 3.4.2) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* September 2012 * * .. Scalar Arguments .. INTEGER INCX, N @@ -129,6 +129,10 @@ INTEGER IX DOUBLE PRECISION TEMP1 * .. +* .. External Functions .. + LOGICAL DISNAN + EXTERNAL DISNAN +* .. * .. Intrinsic Functions .. INTRINSIC ABS, DBLE, DIMAG * .. @@ -136,8 +140,8 @@ * IF( N.GT.0 ) THEN DO 10 IX = 1, 1 + ( N-1 )*INCX, INCX - IF( DBLE( X( IX ) ).NE.ZERO ) THEN - TEMP1 = ABS( DBLE( X( IX ) ) ) + TEMP1 = ABS( DBLE( X( IX ) ) ) + IF( TEMP1.GT.ZERO.OR.DISNAN( TEMP1 ) ) THEN IF( SCALE.LT.TEMP1 ) THEN SUMSQ = 1 + SUMSQ*( SCALE / TEMP1 )**2 SCALE = TEMP1 @@ -145,8 +149,8 @@ SUMSQ = SUMSQ + ( TEMP1 / SCALE )**2 END IF END IF - IF( DIMAG( X( IX ) ).NE.ZERO ) THEN - TEMP1 = ABS( DIMAG( X( IX ) ) ) + TEMP1 = ABS( DIMAG( X( IX ) ) ) + IF( TEMP1.GT.ZERO.OR.DISNAN( TEMP1 ) ) THEN IF( SCALE.LT.TEMP1 ) THEN SUMSQ = 1 + SUMSQ*( SCALE / TEMP1 )**2 SCALE = TEMP1