Mercurial > octave-nkf

comparison libcruft/lapack/crot.f @ 7789:82be108cc558

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
First attempt at single precision tyeps * * * corrections to qrupdate single precision routines * * * prefer demotion to single over promotion to double * * * Add single precision support to log2 function * * * Trivial PROJECT file update * * * Cache optimized hermitian/transpose methods * * * Add tests for tranpose/hermitian and ChangeLog entry for new transpose code
author David Bateman <dbateman@free.fr>
date Sun, 27 Apr 2008 22:34:17 +0200
parents
children
comparison
equal deleted inserted replaced
7788:45f5faba05a2 7789:82be108cc558
1 SUBROUTINE CROT( N, CX, INCX, CY, INCY, C, S )
2 *
3 * -- LAPACK auxiliary routine (version 3.1) --
4 * Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd..
5 * November 2006
6 *
7 * .. Scalar Arguments ..
8 INTEGER INCX, INCY, N
9 REAL C
10 COMPLEX S
11 * ..
12 * .. Array Arguments ..
13 COMPLEX CX( * ), CY( * )
14 * ..
15 *
16 * Purpose
17 * =======
18 *
19 * CROT applies a plane rotation, where the cos (C) is real and the
20 * sin (S) is complex, and the vectors CX and CY are complex.
21 *
22 * Arguments
23 * =========
24 *
25 * N (input) INTEGER
26 * The number of elements in the vectors CX and CY.
27 *
28 * CX (input/output) COMPLEX array, dimension (N)
29 * On input, the vector X.
30 * On output, CX is overwritten with C*X + S*Y.
31 *
32 * INCX (input) INTEGER
33 * The increment between successive values of CY. INCX <> 0.
34 *
35 * CY (input/output) COMPLEX array, dimension (N)
36 * On input, the vector Y.
37 * On output, CY is overwritten with -CONJG(S)*X + C*Y.
38 *
39 * INCY (input) INTEGER
40 * The increment between successive values of CY. INCX <> 0.
41 *
42 * C (input) REAL
43 * S (input) COMPLEX
44 * C and S define a rotation
45 * [ C S ]
46 * [ -conjg(S) C ]
47 * where C*C + S*CONJG(S) = 1.0.
48 *
49 * =====================================================================
50 *
51 * .. Local Scalars ..
52 INTEGER I, IX, IY
53 COMPLEX STEMP
54 * ..
55 * .. Intrinsic Functions ..
56 INTRINSIC CONJG
57 * ..
58 * .. Executable Statements ..
59 *
60 IF( N.LE.0 )
61 $ RETURN
62 IF( INCX.EQ.1 .AND. INCY.EQ.1 )
63 $ GO TO 20
64 *
65 * Code for unequal increments or equal increments not equal to 1
66 *
67 IX = 1
68 IY = 1
69 IF( INCX.LT.0 )
70 $ IX = ( -N+1 )*INCX + 1
71 IF( INCY.LT.0 )
72 $ IY = ( -N+1 )*INCY + 1
73 DO 10 I = 1, N
74 STEMP = C*CX( IX ) + S*CY( IY )
75 CY( IY ) = C*CY( IY ) - CONJG( S )*CX( IX )
76 CX( IX ) = STEMP
77 IX = IX + INCX
78 IY = IY + INCY
79 10 CONTINUE
80 RETURN
81 *
82 * Code for both increments equal to 1
83 *
84 20 CONTINUE
85 DO 30 I = 1, N
86 STEMP = C*CX( I ) + S*CY( I )
87 CY( I ) = C*CY( I ) - CONJG( S )*CX( I )
88 CX( I ) = STEMP
89 30 CONTINUE
90 RETURN
91 END