LAPACK  3.4.2
LAPACK: Linear Algebra PACKage
 All Files Functions Groups
zlassq.f
Go to the documentation of this file.
1 *> \brief \b ZLASSQ 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 ZLASSQ + dependencies
10 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zlassq.f">
11 *> [TGZ]</a>
12 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zlassq.f">
13 *> [ZIP]</a>
14 *> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zlassq.f">
15 *> [TXT]</a>
16 *> \endhtmlonly
17 *
18 * Definition:
19 * ===========
20 *
21 * SUBROUTINE ZLASSQ( N, X, INCX, SCALE, SUMSQ )
22 *
23 * .. Scalar Arguments ..
24 * INTEGER INCX, N
25 * DOUBLE PRECISION SCALE, SUMSQ
26 * ..
27 * .. Array Arguments ..
28 * COMPLEX*16 X( * )
29 * ..
30 *
31 *
32 *> \par Purpose:
33 * =============
34 *>
35 *> \verbatim
36 *>
37 *> ZLASSQ 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*16 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 DOUBLE PRECISION
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 DOUBLE PRECISION
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 complex16OTHERauxiliary
105 *
106 * =====================================================================
107  SUBROUTINE zlassq( 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  DOUBLE PRECISION scale, sumsq
117 * ..
118 * .. Array Arguments ..
119  COMPLEX*16 x( * )
120 * ..
121 *
122 * =====================================================================
123 *
124 * .. Parameters ..
125  DOUBLE PRECISION zero
126  parameter( zero = 0.0d+0 )
127 * ..
128 * .. Local Scalars ..
129  INTEGER ix
130  DOUBLE PRECISION temp1
131 * ..
132 * .. External Functions ..
133  LOGICAL disnan
134  EXTERNAL disnan
135 * ..
136 * .. Intrinsic Functions ..
137  INTRINSIC abs, dble, dimag
138 * ..
139 * .. Executable Statements ..
140 *
141  IF( n.GT.0 ) THEN
142  DO 10 ix = 1, 1 + ( n-1 )*incx, incx
143  temp1 = abs( dble( x( ix ) ) )
144  IF( temp1.GT.zero.OR.disnan( 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( dimag( x( ix ) ) )
153  IF( temp1.GT.zero.OR.disnan( temp1 ) ) THEN
154  IF( scale.LT.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 ZLASSQ
167 *
168  END