LAPACK 3.12.0
LAPACK: Linear Algebra PACKage
Loading...
Searching...
No Matches
clacrt.f
Go to the documentation of this file.
1*> \brief \b CLACRT performs a linear transformation of 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*> \htmlonly
9*> Download CLACRT + dependencies
10*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.tgz?format=tgz&filename=/lapack/lapack_routine/clacrt.f">
11*> [TGZ]</a>
12*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.zip?format=zip&filename=/lapack/lapack_routine/clacrt.f">
13*> [ZIP]</a>
14*> <a href="http://www.netlib.org/cgi-bin/netlibfiles.txt?format=txt&filename=/lapack/lapack_routine/clacrt.f">
15*> [TXT]</a>
16*> \endhtmlonly
17*
18* Definition:
19* ===========
20*
21* SUBROUTINE CLACRT( N, CX, INCX, CY, INCY, C, S )
22*
23* .. Scalar Arguments ..
24* INTEGER INCX, INCY, N
25* COMPLEX C, S
26* ..
27* .. Array Arguments ..
28* COMPLEX CX( * ), CY( * )
29* ..
30*
31*
32*> \par Purpose:
33* =============
34*>
35*> \verbatim
36*>
37*> CLACRT performs the operation
38*>
39*> ( c s )( x ) ==> ( x )
40*> ( -s c )( y ) ( y )
41*>
42*> where c and s are complex and the vectors x and y are complex.
43*> \endverbatim
44*
45* Arguments:
46* ==========
47*
48*> \param[in] N
49*> \verbatim
50*> N is INTEGER
51*> The number of elements in the vectors CX and CY.
52*> \endverbatim
53*>
54*> \param[in,out] CX
55*> \verbatim
56*> CX is COMPLEX array, dimension (N)
57*> On input, the vector x.
58*> On output, CX is overwritten with c*x + s*y.
59*> \endverbatim
60*>
61*> \param[in] INCX
62*> \verbatim
63*> INCX is INTEGER
64*> The increment between successive values of CX. INCX <> 0.
65*> \endverbatim
66*>
67*> \param[in,out] CY
68*> \verbatim
69*> CY is COMPLEX array, dimension (N)
70*> On input, the vector y.
71*> On output, CY is overwritten with -s*x + c*y.
72*> \endverbatim
73*>
74*> \param[in] INCY
75*> \verbatim
76*> INCY is INTEGER
77*> The increment between successive values of CY. INCY <> 0.
78*> \endverbatim
79*>
80*> \param[in] C
81*> \verbatim
82*> C is COMPLEX
83*> \endverbatim
84*>
85*> \param[in] S
86*> \verbatim
87*> S is COMPLEX
88*> C and S define the matrix
89*> [ C S ].
90*> [ -S C ]
91*> \endverbatim
92*
93* Authors:
94* ========
95*
96*> \author Univ. of Tennessee
97*> \author Univ. of California Berkeley
98*> \author Univ. of Colorado Denver
99*> \author NAG Ltd.
100*
101*> \ingroup lacrt
102*
103* =====================================================================
104 SUBROUTINE clacrt( N, CX, INCX, CY, INCY, C, S )
105*
106* -- LAPACK auxiliary routine --
107* -- LAPACK is a software package provided by Univ. of Tennessee, --
108* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
109*
110* .. Scalar Arguments ..
111 INTEGER INCX, INCY, N
112 COMPLEX C, S
113* ..
114* .. Array Arguments ..
115 COMPLEX CX( * ), CY( * )
116* ..
117*
118* =====================================================================
119*
120* .. Local Scalars ..
121 INTEGER I, IX, IY
122 COMPLEX CTEMP
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 ctemp = c*cx( ix ) + s*cy( iy )
141 cy( iy ) = c*cy( iy ) - s*cx( ix )
142 cx( ix ) = ctemp
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 ctemp = c*cx( i ) + s*cy( i )
153 cy( i ) = c*cy( i ) - s*cx( i )
154 cx( i ) = ctemp
155 30 CONTINUE
156 RETURN
157 END
subroutine clacrt(n, cx, incx, cy, incy, c, s)
CLACRT performs a linear transformation of a pair of complex vectors.
Definition clacrt.f:105