1 SUBROUTINE DLARGV( N, X, INCX, Y, INCY, C, INCC )
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 INCC, INCX, INCY, N
10 * ..
11 * .. Array Arguments ..
12 DOUBLE PRECISION C( * ), X( * ), Y( * )
13 * ..
14 *
15 * Purpose
16 * =======
17 *
18 * DLARGV generates a vector of real plane rotations, determined by
19 * elements of the real vectors x and y. For i = 1,2,...,n
20 *
21 * ( c(i) s(i) ) ( x(i) ) = ( a(i) )
22 * ( -s(i) c(i) ) ( y(i) ) = ( 0 )
23 *
24 * Arguments
25 * =========
26 *
27 * N (input) INTEGER
28 * The number of plane rotations to be generated.
29 *
30 * X (input/output) DOUBLE PRECISION array,
31 * dimension (1+(N-1)*INCX)
32 * On entry, the vector x.
33 * On exit, x(i) is overwritten by a(i), for i = 1,...,n.
34 *
35 * INCX (input) INTEGER
36 * The increment between elements of X. INCX > 0.
37 *
38 * Y (input/output) DOUBLE PRECISION array,
39 * dimension (1+(N-1)*INCY)
40 * On entry, the vector y.
41 * On exit, the sines of the plane rotations.
42 *
43 * INCY (input) INTEGER
44 * The increment between elements of Y. INCY > 0.
45 *
46 * C (output) DOUBLE PRECISION array, dimension (1+(N-1)*INCC)
47 * The cosines of the plane rotations.
48 *
49 * INCC (input) INTEGER
50 * The increment between elements of C. INCC > 0.
51 *
52 * =====================================================================
53 *
54 * .. Parameters ..
55 DOUBLE PRECISION ZERO, ONE
56 PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
57 * ..
58 * .. Local Scalars ..
59 INTEGER I, IC, IX, IY
60 DOUBLE PRECISION F, G, T, TT
61 * ..
62 * .. Intrinsic Functions ..
63 INTRINSIC ABS, SQRT
64 * ..
65 * .. Executable Statements ..
66 *
67 IX = 1
68 IY = 1
69 IC = 1
70 DO 10 I = 1, N
71 F = X( IX )
72 G = Y( IY )
73 IF( G.EQ.ZERO ) THEN
74 C( IC ) = ONE
75 ELSE IF( F.EQ.ZERO ) THEN
76 C( IC ) = ZERO
77 Y( IY ) = ONE
78 X( IX ) = G
79 ELSE IF( ABS( F ).GT.ABS( G ) ) THEN
80 T = G / F
81 TT = SQRT( ONE+T*T )
82 C( IC ) = ONE / TT
83 Y( IY ) = T*C( IC )
84 X( IX ) = F*TT
85 ELSE
86 T = F / G
87 TT = SQRT( ONE+T*T )
88 Y( IY ) = ONE / TT
89 C( IC ) = T*Y( IY )
90 X( IX ) = G*TT
91 END IF
92 IC = IC + INCC
93 IY = IY + INCY
94 IX = IX + INCX
95 10 CONTINUE
96 RETURN
97 *
98 * End of DLARGV
99 *
100 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 INCC, INCX, INCY, N
10 * ..
11 * .. Array Arguments ..
12 DOUBLE PRECISION C( * ), X( * ), Y( * )
13 * ..
14 *
15 * Purpose
16 * =======
17 *
18 * DLARGV generates a vector of real plane rotations, determined by
19 * elements of the real vectors x and y. For i = 1,2,...,n
20 *
21 * ( c(i) s(i) ) ( x(i) ) = ( a(i) )
22 * ( -s(i) c(i) ) ( y(i) ) = ( 0 )
23 *
24 * Arguments
25 * =========
26 *
27 * N (input) INTEGER
28 * The number of plane rotations to be generated.
29 *
30 * X (input/output) DOUBLE PRECISION array,
31 * dimension (1+(N-1)*INCX)
32 * On entry, the vector x.
33 * On exit, x(i) is overwritten by a(i), for i = 1,...,n.
34 *
35 * INCX (input) INTEGER
36 * The increment between elements of X. INCX > 0.
37 *
38 * Y (input/output) DOUBLE PRECISION array,
39 * dimension (1+(N-1)*INCY)
40 * On entry, the vector y.
41 * On exit, the sines of the plane rotations.
42 *
43 * INCY (input) INTEGER
44 * The increment between elements of Y. INCY > 0.
45 *
46 * C (output) DOUBLE PRECISION array, dimension (1+(N-1)*INCC)
47 * The cosines of the plane rotations.
48 *
49 * INCC (input) INTEGER
50 * The increment between elements of C. INCC > 0.
51 *
52 * =====================================================================
53 *
54 * .. Parameters ..
55 DOUBLE PRECISION ZERO, ONE
56 PARAMETER ( ZERO = 0.0D+0, ONE = 1.0D+0 )
57 * ..
58 * .. Local Scalars ..
59 INTEGER I, IC, IX, IY
60 DOUBLE PRECISION F, G, T, TT
61 * ..
62 * .. Intrinsic Functions ..
63 INTRINSIC ABS, SQRT
64 * ..
65 * .. Executable Statements ..
66 *
67 IX = 1
68 IY = 1
69 IC = 1
70 DO 10 I = 1, N
71 F = X( IX )
72 G = Y( IY )
73 IF( G.EQ.ZERO ) THEN
74 C( IC ) = ONE
75 ELSE IF( F.EQ.ZERO ) THEN
76 C( IC ) = ZERO
77 Y( IY ) = ONE
78 X( IX ) = G
79 ELSE IF( ABS( F ).GT.ABS( G ) ) THEN
80 T = G / F
81 TT = SQRT( ONE+T*T )
82 C( IC ) = ONE / TT
83 Y( IY ) = T*C( IC )
84 X( IX ) = F*TT
85 ELSE
86 T = F / G
87 TT = SQRT( ONE+T*T )
88 Y( IY ) = ONE / TT
89 C( IC ) = T*Y( IY )
90 X( IX ) = G*TT
91 END IF
92 IC = IC + INCC
93 IY = IY + INCY
94 IX = IX + INCX
95 10 CONTINUE
96 RETURN
97 *
98 * End of DLARGV
99 *
100 END