diff options
| author | Siddhesh Wani | 2015-05-25 14:46:31 +0530 |
|---|---|---|
| committer | Siddhesh Wani | 2015-05-25 14:46:31 +0530 |
| commit | db464f35f5a10b58d9ed1085e0b462689adee583 (patch) | |
| tree | de5cdbc71a54765d9fec33414630ae2c8904c9b8 /src/fortran/lapack/dlassq.f | |
| download | Scilab2C_fossee_old-db464f35f5a10b58d9ed1085e0b462689adee583.tar.gz Scilab2C_fossee_old-db464f35f5a10b58d9ed1085e0b462689adee583.tar.bz2 Scilab2C_fossee_old-db464f35f5a10b58d9ed1085e0b462689adee583.zip | |
Original Version
Diffstat (limited to 'src/fortran/lapack/dlassq.f')
| -rw-r--r-- | src/fortran/lapack/dlassq.f | 88 |
1 files changed, 88 insertions, 0 deletions
diff --git a/src/fortran/lapack/dlassq.f b/src/fortran/lapack/dlassq.f new file mode 100644 index 0000000..217e794 --- /dev/null +++ b/src/fortran/lapack/dlassq.f @@ -0,0 +1,88 @@ + SUBROUTINE DLASSQ( N, X, INCX, SCALE, SUMSQ ) +* +* -- LAPACK auxiliary routine (version 3.1) -- +* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. +* November 2006 +* +* .. Scalar Arguments .. + INTEGER INCX, N + DOUBLE PRECISION SCALE, SUMSQ +* .. +* .. Array Arguments .. + DOUBLE PRECISION X( * ) +* .. +* +* Purpose +* ======= +* +* DLASSQ returns the values scl and smsq such that +* +* ( scl**2 )*smsq = x( 1 )**2 +...+ x( n )**2 + ( scale**2 )*sumsq, +* +* where x( i ) = X( 1 + ( i - 1 )*INCX ). The value of sumsq is +* assumed to be non-negative and scl returns the value +* +* scl = max( scale, abs( x( i ) ) ). +* +* scale and sumsq must be supplied in SCALE and SUMSQ and +* scl and smsq are overwritten on SCALE and SUMSQ respectively. +* +* The routine makes only one pass through the vector x. +* +* Arguments +* ========= +* +* N (input) INTEGER +* The number of elements to be used from the vector X. +* +* X (input) DOUBLE PRECISION array, dimension (N) +* The vector for which a scaled sum of squares is computed. +* x( i ) = X( 1 + ( i - 1 )*INCX ), 1 <= i <= n. +* +* INCX (input) INTEGER +* The increment between successive values of the vector X. +* INCX > 0. +* +* SCALE (input/output) DOUBLE PRECISION +* On entry, the value scale in the equation above. +* On exit, SCALE is overwritten with scl , the scaling factor +* for the sum of squares. +* +* SUMSQ (input/output) DOUBLE PRECISION +* On entry, the value sumsq in the equation above. +* On exit, SUMSQ is overwritten with smsq , the basic sum of +* squares from which scl has been factored out. +* +* ===================================================================== +* +* .. Parameters .. + DOUBLE PRECISION ZERO + PARAMETER ( ZERO = 0.0D+0 ) +* .. +* .. Local Scalars .. + INTEGER IX + DOUBLE PRECISION ABSXI +* .. +* .. Intrinsic Functions .. + INTRINSIC ABS +* .. +* .. Executable Statements .. +* + IF( N.GT.0 ) THEN + DO 10 IX = 1, 1 + ( N-1 )*INCX, INCX + IF( X( IX ).NE.ZERO ) THEN + ABSXI = ABS( X( IX ) ) + IF( SCALE.LT.ABSXI ) THEN + SUMSQ = 1 + SUMSQ*( SCALE / ABSXI )**2 + SCALE = ABSXI + ELSE + SUMSQ = SUMSQ + ( ABSXI / SCALE )**2 + END IF + END IF + 10 CONTINUE + END IF + RETURN +* +* End of DLASSQ +* + END |