01:       SUBROUTINE CLARTV( N, X, INCX, Y, INCY, C, S, INCC )
02: *
03: *  -- LAPACK auxiliary routine (version 3.2) --
04: *  -- LAPACK is a software package provided by Univ. of Tennessee,    --
05: *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
06: *     November 2006
07: *
08: *     .. Scalar Arguments ..
09:       INTEGER            INCC, INCX, INCY, N
10: *     ..
11: *     .. Array Arguments ..
12:       REAL               C( * )
13:       COMPLEX            S( * ), X( * ), Y( * )
14: *     ..
15: *
16: *  Purpose
17: *  =======
18: *
19: *  CLARTV applies a vector of complex plane rotations with real cosines
20: *  to elements of the complex vectors x and y. For i = 1,2,...,n
21: *
22: *     ( x(i) ) := (        c(i)   s(i) ) ( x(i) )
23: *     ( y(i) )    ( -conjg(s(i))  c(i) ) ( y(i) )
24: *
25: *  Arguments
26: *  =========
27: *
28: *  N       (input) INTEGER
29: *          The number of plane rotations to be applied.
30: *
31: *  X       (input/output) COMPLEX array, dimension (1+(N-1)*INCX)
32: *          The vector x.
33: *
34: *  INCX    (input) INTEGER
35: *          The increment between elements of X. INCX > 0.
36: *
37: *  Y       (input/output) COMPLEX array, dimension (1+(N-1)*INCY)
38: *          The vector y.
39: *
40: *  INCY    (input) INTEGER
41: *          The increment between elements of Y. INCY > 0.
42: *
43: *  C       (input) REAL array, dimension (1+(N-1)*INCC)
44: *          The cosines of the plane rotations.
45: *
46: *  S       (input) COMPLEX array, dimension (1+(N-1)*INCC)
47: *          The sines of the plane rotations.
48: *
49: *  INCC    (input) INTEGER
50: *          The increment between elements of C and S. INCC > 0.
51: *
52: *  =====================================================================
53: *
54: *     .. Local Scalars ..
55:       INTEGER            I, IC, IX, IY
56:       COMPLEX            XI, YI
57: *     ..
58: *     .. Intrinsic Functions ..
59:       INTRINSIC          CONJG
60: *     ..
61: *     .. Executable Statements ..
62: *
63:       IX = 1
64:       IY = 1
65:       IC = 1
66:       DO 10 I = 1, N
67:          XI = X( IX )
68:          YI = Y( IY )
69:          X( IX ) = C( IC )*XI + S( IC )*YI
70:          Y( IY ) = C( IC )*YI - CONJG( S( IC ) )*XI
71:          IX = IX + INCX
72:          IY = IY + INCY
73:          IC = IC + INCC
74:    10 CONTINUE
75:       RETURN
76: *
77: *     End of CLARTV
78: *
79:       END
80: