LAPACK  3.6.1
LAPACK: Linear Algebra PACKage
classq.f
Go to the documentation of this file.
1 *> \brief \b CLASSQ 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 CLASSQ + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/classq.f">
11 *> [TGZ]</a>
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/classq.f">
13 *> [ZIP]</a>
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/classq.f">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 * Definition:
19 * ===========
20 *
21 * SUBROUTINE CLASSQ( N, X, INCX, SCALE, SUMSQ )
22 *
23 * .. Scalar Arguments ..
24 * INTEGER INCX, N
25 * REAL SCALE, SUMSQ
26 * ..
27 * .. Array Arguments ..
28 * COMPLEX X( * )
29 * ..
30 *
31 *
32 *> \par Purpose:
33 * =============
34 *>
35 *> \verbatim
36 *>
37 *> CLASSQ returns the values scl and ssq such that
38 *>
39 *> ( scl**2 )*ssq = x( 1 )**2 +...+ x( n )**2 + ( scale**2 )*sumsq,
40 *>
41 *> where x( i ) = abs( X( 1 + ( i - 1 )*INCX ) ). The value of sumsq is
42 *> assumed to be at least unity and the value of ssq will then satisfy
43 *>
44 *> 1.0 .le. ssq .le. ( sumsq + 2*n ).
45 *>
46 *> scale is assumed to be non-negative and scl returns the value
47 *>
48 *> scl = max( scale, abs( real( x( i ) ) ), abs( aimag( x( i ) ) ) ),
49 *> i
50 *>
51 *> scale and sumsq must be supplied in SCALE and SUMSQ respectively.
52 *> SCALE and SUMSQ are overwritten by scl and ssq respectively.
53 *>
54 *> The routine makes only one pass through the vector X.
55 *> \endverbatim
56 *
57 * Arguments:
58 * ==========
59 *
60 *> \param[in] N
61 *> \verbatim
62 *> N is INTEGER
63 *> The number of elements to be used from the vector X.
64 *> \endverbatim
65 *>
66 *> \param[in] X
67 *> \verbatim
68 *> X is COMPLEX array, dimension (N)
69 *> The vector x as described above.
70 *> x( i ) = X( 1 + ( i - 1 )*INCX ), 1 <= i <= n.
71 *> \endverbatim
72 *>
73 *> \param[in] INCX
74 *> \verbatim
75 *> INCX is INTEGER
76 *> The increment between successive values of the vector X.
77 *> INCX > 0.
78 *> \endverbatim
79 *>
80 *> \param[in,out] SCALE
81 *> \verbatim
82 *> SCALE is REAL
83 *> On entry, the value scale in the equation above.
84 *> On exit, SCALE is overwritten with the value scl .
85 *> \endverbatim
86 *>
87 *> \param[in,out] SUMSQ
88 *> \verbatim
89 *> SUMSQ is REAL
90 *> On entry, the value sumsq in the equation above.
91 *> On exit, SUMSQ is overwritten with the value ssq .
92 *> \endverbatim
93 *
94 * Authors:
95 * ========
96 *
97 *> \author Univ. of Tennessee
98 *> \author Univ. of California Berkeley
99 *> \author Univ. of Colorado Denver
100 *> \author NAG Ltd.
101 *
102 *> \date September 2012
103 *
104 *> \ingroup complexOTHERauxiliary
105 *
106 * =====================================================================
107  SUBROUTINE classq( N, X, INCX, SCALE, SUMSQ )
108 *
109 * -- LAPACK auxiliary routine (version 3.4.2) --
110 * -- LAPACK is a software package provided by Univ. of Tennessee, --
111 * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
112 * September 2012
113 *
114 * .. Scalar Arguments ..
115  INTEGER INCX, N
116  REAL SCALE, SUMSQ
117 * ..
118 * .. Array Arguments ..
119  COMPLEX X( * )
120 * ..
121 *
122 * =====================================================================
123 *
124 * .. Parameters ..
125  REAL ZERO
126  parameter ( zero = 0.0e+0 )
127 * ..
128 * .. Local Scalars ..
129  INTEGER IX
130  REAL TEMP1
131 * ..
132 * .. External Functions ..
133  LOGICAL SISNAN
134  EXTERNAL sisnan
135 * ..
136 * .. Intrinsic Functions ..
137  INTRINSIC abs, aimag, real
138 * ..
139 * .. Executable Statements ..
140 *
141  IF( n.GT.0 ) THEN
142  DO 10 ix = 1, 1 + ( n-1 )*incx, incx
143  temp1 = abs( REAL( X( IX ) ) )
144  IF( temp1.GT.zero.OR.sisnan( temp1 ) ) THEN
145  IF( scale.LT.temp1 ) THEN
146  sumsq = 1 + sumsq*( scale / temp1 )**2
147  scale = temp1
148  ELSE
149  sumsq = sumsq + ( temp1 / scale )**2
150  END IF
151  END IF
152  temp1 = abs( aimag( x( ix ) ) )
153  IF( temp1.GT.zero.OR.sisnan( temp1 ) ) THEN
154  IF( scale.LT.temp1 .OR. sisnan( temp1 ) ) THEN
155  sumsq = 1 + sumsq*( scale / temp1 )**2
156  scale = temp1
157  ELSE
158  sumsq = sumsq + ( temp1 / scale )**2
159  END IF
160  END IF
161  10 CONTINUE
162  END IF
163 *
164  RETURN
165 *
166 * End of CLASSQ
167 *
168  END
subroutine classq(N, X, INCX, SCALE, SUMSQ)
CLASSQ updates a sum of squares represented in scaled form.
Definition: classq.f:108