1: SUBROUTINE DLASSQ( N, X, INCX, SCALE, SUMSQ )
2: *
3: * -- LAPACK auxiliary routine (version 3.2) --
4: * -- LAPACK is a software package provided by Univ. of Tennessee, --
5: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
6: * November 2006
7: *
8: * .. Scalar Arguments ..
9: INTEGER INCX, N
10: DOUBLE PRECISION SCALE, SUMSQ
11: * ..
12: * .. Array Arguments ..
13: DOUBLE PRECISION X( * )
14: * ..
15: *
16: * Purpose
17: * =======
18: *
19: * DLASSQ returns the values scl and smsq such that
20: *
21: * ( scl**2 )*smsq = x( 1 )**2 +...+ x( n )**2 + ( scale**2 )*sumsq,
22: *
23: * where x( i ) = X( 1 + ( i - 1 )*INCX ). The value of sumsq is
24: * assumed to be non-negative and scl returns the value
25: *
26: * scl = max( scale, abs( x( i ) ) ).
27: *
28: * scale and sumsq must be supplied in SCALE and SUMSQ and
29: * scl and smsq are overwritten on SCALE and SUMSQ respectively.
30: *
31: * The routine makes only one pass through the vector x.
32: *
33: * Arguments
34: * =========
35: *
36: * N (input) INTEGER
37: * The number of elements to be used from the vector X.
38: *
39: * X (input) DOUBLE PRECISION array, dimension (N)
40: * The vector for which a scaled sum of squares is computed.
41: * x( i ) = X( 1 + ( i - 1 )*INCX ), 1 <= i <= n.
42: *
43: * INCX (input) INTEGER
44: * The increment between successive values of the vector X.
45: * INCX > 0.
46: *
47: * SCALE (input/output) DOUBLE PRECISION
48: * On entry, the value scale in the equation above.
49: * On exit, SCALE is overwritten with scl , the scaling factor
50: * for the sum of squares.
51: *
52: * SUMSQ (input/output) DOUBLE PRECISION
53: * On entry, the value sumsq in the equation above.
54: * On exit, SUMSQ is overwritten with smsq , the basic sum of
55: * squares from which scl has been factored out.
56: *
57: * =====================================================================
58: *
59: * .. Parameters ..
60: DOUBLE PRECISION ZERO
61: PARAMETER ( ZERO = 0.0D+0 )
62: * ..
63: * .. Local Scalars ..
64: INTEGER IX
65: DOUBLE PRECISION ABSXI
66: * ..
67: * .. Intrinsic Functions ..
68: INTRINSIC ABS
69: * ..
70: * .. Executable Statements ..
71: *
72: IF( N.GT.0 ) THEN
73: DO 10 IX = 1, 1 + ( N-1 )*INCX, INCX
74: IF( X( IX ).NE.ZERO ) THEN
75: ABSXI = ABS( X( IX ) )
76: IF( SCALE.LT.ABSXI ) THEN
77: SUMSQ = 1 + SUMSQ*( SCALE / ABSXI )**2
78: SCALE = ABSXI
79: ELSE
80: SUMSQ = SUMSQ + ( ABSXI / SCALE )**2
81: END IF
82: END IF
83: 10 CONTINUE
84: END IF
85: RETURN
86: *
87: * End of DLASSQ
88: *
89: END
CVSweb interface <joel.bertrand@systella.fr>