01:       SUBROUTINE SLAR2V( N, X, Y, Z, INCX, 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, N
10: *     ..
11: *     .. Array Arguments ..
12:       REAL               C( * ), S( * ), X( * ), Y( * ), Z( * )
13: *     ..
14: *
15: *  Purpose
16: *  =======
17: *
18: *  SLAR2V applies a vector of real plane rotations from both sides to
19: *  a sequence of 2-by-2 real symmetric matrices, defined by the elements
20: *  of the vectors x, y and z. For i = 1,2,...,n
21: *
22: *     ( x(i)  z(i) ) := (  c(i)  s(i) ) ( x(i)  z(i) ) ( c(i) -s(i) )
23: *     ( z(i)  y(i) )    ( -s(i)  c(i) ) ( z(i)  y(i) ) ( s(i)  c(i) )
24: *
25: *  Arguments
26: *  =========
27: *
28: *  N       (input) INTEGER
29: *          The number of plane rotations to be applied.
30: *
31: *  X       (input/output) REAL array,
32: *                         dimension (1+(N-1)*INCX)
33: *          The vector x.
34: *
35: *  Y       (input/output) REAL array,
36: *                         dimension (1+(N-1)*INCX)
37: *          The vector y.
38: *
39: *  Z       (input/output) REAL array,
40: *                         dimension (1+(N-1)*INCX)
41: *          The vector z.
42: *
43: *  INCX    (input) INTEGER
44: *          The increment between elements of X, Y and Z. INCX > 0.
45: *
46: *  C       (input) REAL array, dimension (1+(N-1)*INCC)
47: *          The cosines of the plane rotations.
48: *
49: *  S       (input) REAL array, dimension (1+(N-1)*INCC)
50: *          The sines of the plane rotations.
51: *
52: *  INCC    (input) INTEGER
53: *          The increment between elements of C and S. INCC > 0.
54: *
55: *  =====================================================================
56: *
57: *     .. Local Scalars ..
58:       INTEGER            I, IC, IX
59:       REAL               CI, SI, T1, T2, T3, T4, T5, T6, XI, YI, ZI
60: *     ..
61: *     .. Executable Statements ..
62: *
63:       IX = 1
64:       IC = 1
65:       DO 10 I = 1, N
66:          XI = X( IX )
67:          YI = Y( IX )
68:          ZI = Z( IX )
69:          CI = C( IC )
70:          SI = S( IC )
71:          T1 = SI*ZI
72:          T2 = CI*ZI
73:          T3 = T2 - SI*XI
74:          T4 = T2 + SI*YI
75:          T5 = CI*XI + T1
76:          T6 = CI*YI - T1
77:          X( IX ) = CI*T5 + SI*T4
78:          Y( IX ) = CI*T6 - SI*T3
79:          Z( IX ) = CI*T4 - SI*T5
80:          IX = IX + INCX
81:          IC = IC + INCC
82:    10 CONTINUE
83: *
84: *     End of SLAR2V
85: *
86:       RETURN
87:       END
88: