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