LAPACK 3.12.1
LAPACK: Linear Algebra PACKage
All Classes Namespaces Files Functions Variables Typedefs Enumerations Enumerator Macros Modules Pages
zrot.f
Go to the documentation of this file.
1*> \brief \b ZROT applies a plane rotation with real cosine and complex sine to a pair of complex vectors.
2*
3* =========== DOCUMENTATION ===========
4*
5* Online html documentation available at
6* http://www.netlib.org/lapack/explore-html/
7*
8*> Download ZROT + dependencies
9*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/zrot.f">
10*> [TGZ]</a>
11*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/zrot.f">
12*> [ZIP]</a>
13*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/zrot.f">
14*> [TXT]</a>
15*
16* Definition:
17* ===========
18*
19* SUBROUTINE ZROT( N, CX, INCX, CY, INCY, C, S )
20*
21* .. Scalar Arguments ..
22* INTEGER INCX, INCY, N
23* DOUBLE PRECISION C
24* COMPLEX*16 S
25* ..
26* .. Array Arguments ..
27* COMPLEX*16 CX( * ), CY( * )
28* ..
29*
30*
31*> \par Purpose:
32* =============
33*>
34*> \verbatim
35*>
36*> ZROT applies a plane rotation, where the cos (C) is real and the
37*> sin (S) is complex, and the vectors CX and CY are complex.
38*> \endverbatim
39*
40* Arguments:
41* ==========
42*
43*> \param[in] N
44*> \verbatim
45*> N is INTEGER
46*> The number of elements in the vectors CX and CY.
47*> \endverbatim
48*>
49*> \param[in,out] CX
50*> \verbatim
51*> CX is COMPLEX*16 array, dimension (N)
52*> On input, the vector X.
53*> On output, CX is overwritten with C*X + S*Y.
54*> \endverbatim
55*>
56*> \param[in] INCX
57*> \verbatim
58*> INCX is INTEGER
59*> The increment between successive values of CX. INCX <> 0.
60*> \endverbatim
61*>
62*> \param[in,out] CY
63*> \verbatim
64*> CY is COMPLEX*16 array, dimension (N)
65*> On input, the vector Y.
66*> On output, CY is overwritten with -CONJG(S)*X + C*Y.
67*> \endverbatim
68*>
69*> \param[in] INCY
70*> \verbatim
71*> INCY is INTEGER
72*> The increment between successive values of CY. INCX <> 0.
73*> \endverbatim
74*>
75*> \param[in] C
76*> \verbatim
77*> C is DOUBLE PRECISION
78*> \endverbatim
79*>
80*> \param[in] S
81*> \verbatim
82*> S is COMPLEX*16
83*> C and S define a rotation
84*> [ C S ]
85*> [ -conjg(S) C ]
86*> where C*C + S*CONJG(S) = 1.0.
87*> \endverbatim
88*
89* Authors:
90* ========
91*
92*> \author Univ. of Tennessee
93*> \author Univ. of California Berkeley
94*> \author Univ. of Colorado Denver
95*> \author NAG Ltd.
96*
97*> \ingroup rot
98*
99* =====================================================================
100 SUBROUTINE zrot( N, CX, INCX, CY, INCY, C, S )
101*
102* -- LAPACK auxiliary routine --
103* -- LAPACK is a software package provided by Univ. of Tennessee, --
104* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
105*
106* .. Scalar Arguments ..
107 INTEGER INCX, INCY, N
108 DOUBLE PRECISION C
109 COMPLEX*16 S
110* ..
111* .. Array Arguments ..
112 COMPLEX*16 CX( * ), CY( * )
113* ..
114*
115* =====================================================================
116*
117* .. Local Scalars ..
118 INTEGER I, IX, IY
119 COMPLEX*16 STEMP
120* ..
121* .. Intrinsic Functions ..
122 INTRINSIC dconjg
123* ..
124* .. Executable Statements ..
125*
126 IF( n.LE.0 )
127 $ RETURN
128 IF( incx.EQ.1 .AND. incy.EQ.1 )
129 $ GO TO 20
130*
131* Code for unequal increments or equal increments not equal to 1
132*
133 ix = 1
134 iy = 1
135 IF( incx.LT.0 )
136 $ ix = ( -n+1 )*incx + 1
137 IF( incy.LT.0 )
138 $ iy = ( -n+1 )*incy + 1
139 DO 10 i = 1, n
140 stemp = c*cx( ix ) + s*cy( iy )
141 cy( iy ) = c*cy( iy ) - dconjg( s )*cx( ix )
142 cx( ix ) = stemp
143 ix = ix + incx
144 iy = iy + incy
145 10 CONTINUE
146 RETURN
147*
148* Code for both increments equal to 1
149*
150 20 CONTINUE
151 DO 30 i = 1, n
152 stemp = c*cx( i ) + s*cy( i )
153 cy( i ) = c*cy( i ) - dconjg( s )*cx( i )
154 cx( i ) = stemp
155 30 CONTINUE
156 RETURN
157 END
subroutine zrot(n, cx, incx, cy, incy, c, s)
ZROT applies a plane rotation with real cosine and complex sine to a pair of complex vectors.
Definition zrot.f:101