--- rpl/lapack/lapack/zlassq.f 2011/11/21 20:43:17 1.8 +++ rpl/lapack/lapack/zlassq.f 2020/05/21 21:46:09 1.18 @@ -1,25 +1,25 @@ -*> \brief \b ZLASSQ +*> \brief \b ZLASSQ updates a sum of squares represented in scaled form. * * =========== DOCUMENTATION =========== * -* Online html documentation available at -* http://www.netlib.org/lapack/explore-html/ +* Online html documentation available at +* http://www.netlib.org/lapack/explore-html/ * *> \htmlonly -*> Download ZLASSQ + dependencies -*> -*> [TGZ] -*> -*> [ZIP] -*> +*> Download ZLASSQ + dependencies +*> +*> [TGZ] +*> +*> [ZIP] +*> *> [TXT] -*> \endhtmlonly +*> \endhtmlonly * * Definition: * =========== * * SUBROUTINE ZLASSQ( N, X, INCX, SCALE, SUMSQ ) -* +* * .. Scalar Arguments .. * INTEGER INCX, N * DOUBLE PRECISION SCALE, SUMSQ @@ -27,7 +27,7 @@ * .. Array Arguments .. * COMPLEX*16 X( * ) * .. -* +* * *> \par Purpose: * ============= @@ -41,7 +41,7 @@ *> where x( i ) = abs( X( 1 + ( i - 1 )*INCX ) ). The value of sumsq is *> assumed to be at least unity and the value of ssq will then satisfy *> -*> 1.0 .le. ssq .le. ( sumsq + 2*n ). +*> 1.0 <= ssq <= ( sumsq + 2*n ). *> *> scale is assumed to be non-negative and scl returns the value *> @@ -65,7 +65,7 @@ *> *> \param[in] X *> \verbatim -*> X is COMPLEX*16 array, dimension (N) +*> X is COMPLEX*16 array, dimension (1+(N-1)*INCX) *> The vector x as described above. *> x( i ) = X( 1 + ( i - 1 )*INCX ), 1 <= i <= n. *> \endverbatim @@ -94,22 +94,22 @@ * Authors: * ======== * -*> \author Univ. of Tennessee -*> \author Univ. of California Berkeley -*> \author Univ. of Colorado Denver -*> \author NAG Ltd. +*> \author Univ. of Tennessee +*> \author Univ. of California Berkeley +*> \author Univ. of Colorado Denver +*> \author NAG Ltd. * -*> \date November 2011 +*> \date December 2016 * *> \ingroup complex16OTHERauxiliary * * ===================================================================== SUBROUTINE ZLASSQ( N, X, INCX, SCALE, SUMSQ ) * -* -- LAPACK auxiliary routine (version 3.4.0) -- +* -- LAPACK auxiliary routine (version 3.7.0) -- * -- LAPACK is a software package provided by Univ. of Tennessee, -- * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- -* November 2011 +* December 2016 * * .. 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