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
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