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