1: *> \brief \b DLASSQ updates a sum of squares represented in scaled form.
2: *
3: * =========== DOCUMENTATION ===========
4: *
5: * Online html documentation available at
6: * http://www.netlib.org/lapack/explore-html/
7: *
8: *> \htmlonly
9: *> Download DLASSQ + dependencies
10: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/dlassq.f">
11: *> [TGZ]</a>
12: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/dlassq.f">
13: *> [ZIP]</a>
14: *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/dlassq.f">
15: *> [TXT]</a>
16: *> \endhtmlonly
17: *
18: * Definition:
19: * ===========
20: *
21: * SUBROUTINE DLASSQ( N, X, INCX, SCALE, SUMSQ )
22: *
23: * .. Scalar Arguments ..
24: * INTEGER INCX, N
25: * DOUBLE PRECISION SCALE, SUMSQ
26: * ..
27: * .. Array Arguments ..
28: * DOUBLE PRECISION X( * )
29: * ..
30: *
31: *
32: *> \par Purpose:
33: * =============
34: *>
35: *> \verbatim
36: *>
37: *> DLASSQ returns the values scl and smsq such that
38: *>
39: *> ( scl**2 )*smsq = x( 1 )**2 +...+ x( n )**2 + ( scale**2 )*sumsq,
40: *>
41: *> where x( i ) = X( 1 + ( i - 1 )*INCX ). The value of sumsq is
42: *> assumed to be non-negative and scl returns the value
43: *>
44: *> scl = max( scale, abs( x( i ) ) ).
45: *>
46: *> scale and sumsq must be supplied in SCALE and SUMSQ and
47: *> scl and smsq are overwritten on SCALE and SUMSQ respectively.
48: *>
49: *> The routine makes only one pass through the vector x.
50: *> \endverbatim
51: *
52: * Arguments:
53: * ==========
54: *
55: *> \param[in] N
56: *> \verbatim
57: *> N is INTEGER
58: *> The number of elements to be used from the vector X.
59: *> \endverbatim
60: *>
61: *> \param[in] X
62: *> \verbatim
63: *> X is DOUBLE PRECISION array, dimension (N)
64: *> The vector for which a scaled sum of squares is computed.
65: *> x( i ) = X( 1 + ( i - 1 )*INCX ), 1 <= i <= n.
66: *> \endverbatim
67: *>
68: *> \param[in] INCX
69: *> \verbatim
70: *> INCX is INTEGER
71: *> The increment between successive values of the vector X.
72: *> INCX > 0.
73: *> \endverbatim
74: *>
75: *> \param[in,out] SCALE
76: *> \verbatim
77: *> SCALE is DOUBLE PRECISION
78: *> On entry, the value scale in the equation above.
79: *> On exit, SCALE is overwritten with scl , the scaling factor
80: *> for the sum of squares.
81: *> \endverbatim
82: *>
83: *> \param[in,out] SUMSQ
84: *> \verbatim
85: *> SUMSQ is DOUBLE PRECISION
86: *> On entry, the value sumsq in the equation above.
87: *> On exit, SUMSQ is overwritten with smsq , the basic sum of
88: *> squares from which scl has been factored out.
89: *> \endverbatim
90: *
91: * Authors:
92: * ========
93: *
94: *> \author Univ. of Tennessee
95: *> \author Univ. of California Berkeley
96: *> \author Univ. of Colorado Denver
97: *> \author NAG Ltd.
98: *
99: *> \date December 2016
100: *
101: *> \ingroup OTHERauxiliary
102: *
103: * =====================================================================
104: SUBROUTINE DLASSQ( N, X, INCX, SCALE, SUMSQ )
105: *
106: * -- LAPACK auxiliary routine (version 3.7.0) --
107: * -- LAPACK is a software package provided by Univ. of Tennessee, --
108: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
109: * December 2016
110: *
111: * .. Scalar Arguments ..
112: INTEGER INCX, N
113: DOUBLE PRECISION SCALE, SUMSQ
114: * ..
115: * .. Array Arguments ..
116: DOUBLE PRECISION X( * )
117: * ..
118: *
119: * =====================================================================
120: *
121: * .. Parameters ..
122: DOUBLE PRECISION ZERO
123: PARAMETER ( ZERO = 0.0D+0 )
124: * ..
125: * .. Local Scalars ..
126: INTEGER IX
127: DOUBLE PRECISION ABSXI
128: * ..
129: * .. External Functions ..
130: LOGICAL DISNAN
131: EXTERNAL DISNAN
132: * ..
133: * .. Intrinsic Functions ..
134: INTRINSIC ABS
135: * ..
136: * .. Executable Statements ..
137: *
138: IF( N.GT.0 ) THEN
139: DO 10 IX = 1, 1 + ( N-1 )*INCX, INCX
140: ABSXI = ABS( X( IX ) )
141: IF( ABSXI.GT.ZERO.OR.DISNAN( ABSXI ) ) THEN
142: IF( SCALE.LT.ABSXI ) THEN
143: SUMSQ = 1 + SUMSQ*( SCALE / ABSXI )**2
144: SCALE = ABSXI
145: ELSE
146: SUMSQ = SUMSQ + ( ABSXI / SCALE )**2
147: END IF
148: END IF
149: 10 CONTINUE
150: END IF
151: RETURN
152: *
153: * End of DLASSQ
154: *
155: END
CVSweb interface <joel.bertrand@systella.fr>