Annotation of rpl/lapack/lapack/zlassq.f, revision 1.18
1.11 bertrand 1: *> \brief \b ZLASSQ updates a sum of squares represented in scaled form.
1.8 bertrand 2: *
3: * =========== DOCUMENTATION ===========
4: *
1.15 bertrand 5: * Online html documentation available at
6: * http://www.netlib.org/lapack/explore-html/
1.8 bertrand 7: *
8: *> \htmlonly
1.15 bertrand 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">
1.8 bertrand 15: *> [TXT]</a>
1.15 bertrand 16: *> \endhtmlonly
1.8 bertrand 17: *
18: * Definition:
19: * ===========
20: *
21: * SUBROUTINE ZLASSQ( N, X, INCX, SCALE, SUMSQ )
1.15 bertrand 22: *
1.8 bertrand 23: * .. Scalar Arguments ..
24: * INTEGER INCX, N
25: * DOUBLE PRECISION SCALE, SUMSQ
26: * ..
27: * .. Array Arguments ..
28: * COMPLEX*16 X( * )
29: * ..
1.15 bertrand 30: *
1.8 bertrand 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: *>
1.18 ! bertrand 44: *> 1.0 <= ssq <= ( sumsq + 2*n ).
1.8 bertrand 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
1.18 ! bertrand 68: *> X is COMPLEX*16 array, dimension (1+(N-1)*INCX)
1.8 bertrand 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: *
1.15 bertrand 97: *> \author Univ. of Tennessee
98: *> \author Univ. of California Berkeley
99: *> \author Univ. of Colorado Denver
100: *> \author NAG Ltd.
1.8 bertrand 101: *
1.15 bertrand 102: *> \date December 2016
1.8 bertrand 103: *
104: *> \ingroup complex16OTHERauxiliary
105: *
106: * =====================================================================
1.1 bertrand 107: SUBROUTINE ZLASSQ( N, X, INCX, SCALE, SUMSQ )
108: *
1.15 bertrand 109: * -- LAPACK auxiliary routine (version 3.7.0) --
1.1 bertrand 110: * -- LAPACK is a software package provided by Univ. of Tennessee, --
111: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
1.15 bertrand 112: * December 2016
1.1 bertrand 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: * ..
1.11 bertrand 132: * .. External Functions ..
133: LOGICAL DISNAN
134: EXTERNAL DISNAN
135: * ..
1.1 bertrand 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
1.11 bertrand 143: TEMP1 = ABS( DBLE( X( IX ) ) )
144: IF( TEMP1.GT.ZERO.OR.DISNAN( TEMP1 ) ) THEN
1.1 bertrand 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
1.11 bertrand 152: TEMP1 = ABS( DIMAG( X( IX ) ) )
153: IF( TEMP1.GT.ZERO.OR.DISNAN( TEMP1 ) ) THEN
1.1 bertrand 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
CVSweb interface <joel.bertrand@systella.fr>
![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to zlassq.f CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [local] / rpl / lapack / lapack