LAPACK  3.5.0
LAPACK: Linear Algebra PACKage
 All Classes Files Functions Variables Typedefs Macros
slassq.f
Go to the documentation of this file.
1 *> \brief \b SLASSQ 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 SLASSQ + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/slassq.f">
11 *> [TGZ]</a>
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/slassq.f">
13 *> [ZIP]</a>
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/slassq.f">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 * Definition:
19 * ===========
20 *
21 * SUBROUTINE SLASSQ( N, X, INCX, SCALE, SUMSQ )
22 *
23 * .. Scalar Arguments ..
24 * INTEGER INCX, N
25 * REAL SCALE, SUMSQ
26 * ..
27 * .. Array Arguments ..
28 * REAL X( * )
29 * ..
30 *
31 *
32 *> \par Purpose:
33 * =============
34 *>
35 *> \verbatim
36 *>
37 *> SLASSQ 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 REAL 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 REAL
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 REAL
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 September 2012
100 *
101 *> \ingroup auxOTHERauxiliary
102 *
103 * =====================================================================
104  SUBROUTINE slassq( N, X, INCX, SCALE, SUMSQ )
105 *
106 * -- LAPACK auxiliary routine (version 3.4.2) --
107 * -- LAPACK is a software package provided by Univ. of Tennessee, --
108 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
109 * September 2012
110 *
111 * .. Scalar Arguments ..
112  INTEGER incx, n
113  REAL scale, sumsq
114 * ..
115 * .. Array Arguments ..
116  REAL x( * )
117 * ..
118 *
119 * =====================================================================
120 *
121 * .. Parameters ..
122  REAL zero
123  parameter( zero = 0.0e+0 )
124 * ..
125 * .. Local Scalars ..
126  INTEGER ix
127  REAL absxi
128 * ..
129 * .. External Functions ..
130  LOGICAL sisnan
131  EXTERNAL sisnan
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.sisnan( 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 SLASSQ
154 *
155  END