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
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