1: SUBROUTINE ZLASSQ( N, X, INCX, SCALE, SUMSQ )
2: *
3: * -- LAPACK auxiliary routine (version 3.2) --
4: * -- LAPACK is a software package provided by Univ. of Tennessee, --
5: * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
6: * November 2006
7: *
8: * .. Scalar Arguments ..
9: INTEGER INCX, N
10: DOUBLE PRECISION SCALE, SUMSQ
11: * ..
12: * .. Array Arguments ..
13: COMPLEX*16 X( * )
14: * ..
15: *
16: * Purpose
17: * =======
18: *
19: * ZLASSQ returns the values scl and ssq such that
20: *
21: * ( scl**2 )*ssq = x( 1 )**2 +...+ x( n )**2 + ( scale**2 )*sumsq,
22: *
23: * where x( i ) = abs( X( 1 + ( i - 1 )*INCX ) ). The value of sumsq is
24: * assumed to be at least unity and the value of ssq will then satisfy
25: *
26: * 1.0 .le. ssq .le. ( sumsq + 2*n ).
27: *
28: * scale is assumed to be non-negative and scl returns the value
29: *
30: * scl = max( scale, abs( real( x( i ) ) ), abs( aimag( x( i ) ) ) ),
31: * i
32: *
33: * scale and sumsq must be supplied in SCALE and SUMSQ respectively.
34: * SCALE and SUMSQ are overwritten by scl and ssq respectively.
35: *
36: * The routine makes only one pass through the vector X.
37: *
38: * Arguments
39: * =========
40: *
41: * N (input) INTEGER
42: * The number of elements to be used from the vector X.
43: *
44: * X (input) COMPLEX*16 array, dimension (N)
45: * The vector x as described above.
46: * x( i ) = X( 1 + ( i - 1 )*INCX ), 1 <= i <= n.
47: *
48: * INCX (input) INTEGER
49: * The increment between successive values of the vector X.
50: * INCX > 0.
51: *
52: * SCALE (input/output) DOUBLE PRECISION
53: * On entry, the value scale in the equation above.
54: * On exit, SCALE is overwritten with the value scl .
55: *
56: * SUMSQ (input/output) DOUBLE PRECISION
57: * On entry, the value sumsq in the equation above.
58: * On exit, SUMSQ is overwritten with the value ssq .
59: *
60: * =====================================================================
61: *
62: * .. Parameters ..
63: DOUBLE PRECISION ZERO
64: PARAMETER ( ZERO = 0.0D+0 )
65: * ..
66: * .. Local Scalars ..
67: INTEGER IX
68: DOUBLE PRECISION TEMP1
69: * ..
70: * .. Intrinsic Functions ..
71: INTRINSIC ABS, DBLE, DIMAG
72: * ..
73: * .. Executable Statements ..
74: *
75: IF( N.GT.0 ) THEN
76: DO 10 IX = 1, 1 + ( N-1 )*INCX, INCX
77: IF( DBLE( X( IX ) ).NE.ZERO ) THEN
78: TEMP1 = ABS( DBLE( X( IX ) ) )
79: IF( SCALE.LT.TEMP1 ) THEN
80: SUMSQ = 1 + SUMSQ*( SCALE / TEMP1 )**2
81: SCALE = TEMP1
82: ELSE
83: SUMSQ = SUMSQ + ( TEMP1 / SCALE )**2
84: END IF
85: END IF
86: IF( DIMAG( X( IX ) ).NE.ZERO ) THEN
87: TEMP1 = ABS( DIMAG( X( IX ) ) )
88: IF( SCALE.LT.TEMP1 ) THEN
89: SUMSQ = 1 + SUMSQ*( SCALE / TEMP1 )**2
90: SCALE = TEMP1
91: ELSE
92: SUMSQ = SUMSQ + ( TEMP1 / SCALE )**2
93: END IF
94: END IF
95: 10 CONTINUE
96: END IF
97: *
98: RETURN
99: *
100: * End of ZLASSQ
101: *
102: END
CVSweb interface <joel.bertrand@systella.fr>