Statistiques
| Révision :

root / src / blas / csrot.f @ 8

Historique | Voir | Annoter | Télécharger (2,58 ko)

1
      SUBROUTINE CSROT( N, CX, INCX, CY, INCY, C, S )
2
*
3
*     .. Scalar Arguments ..
4
      INTEGER           INCX, INCY, N
5
      REAL              C, S
6
*     ..
7
*     .. Array Arguments ..
8
      COMPLEX           CX( * ), CY( * )
9
*     ..
10
*
11
*  Purpose
12
*  =======
13
*
14
*  Applies a plane rotation, where the cos and sin (c and s) are real
15
*  and the vectors cx and cy are complex.
16
*  jack dongarra, linpack, 3/11/78.
17
*
18
*  Arguments
19
*  ==========
20
*
21
*  N        (input) INTEGER
22
*           On entry, N specifies the order of the vectors cx and cy.
23
*           N must be at least zero.
24
*           Unchanged on exit.
25
*
26
*  CX       (input) COMPLEX array, dimension at least
27
*           ( 1 + ( N - 1 )*abs( INCX ) ).
28
*           Before entry, the incremented array CX must contain the n
29
*           element vector cx. On exit, CX is overwritten by the updated
30
*           vector cx.
31
*
32
*  INCX     (input) INTEGER
33
*           On entry, INCX specifies the increment for the elements of
34
*           CX. INCX must not be zero.
35
*           Unchanged on exit.
36
*
37
*  CY       (input) COMPLEX array, dimension at least
38
*           ( 1 + ( N - 1 )*abs( INCY ) ).
39
*           Before entry, the incremented array CY must contain the n
40
*           element vector cy. On exit, CY is overwritten by the updated
41
*           vector cy.
42
*
43
*  INCY     (input) INTEGER
44
*           On entry, INCY specifies the increment for the elements of
45
*           CY. INCY must not be zero.
46
*           Unchanged on exit.
47
*
48
*  C        (input) REAL
49
*           On entry, C specifies the cosine, cos.
50
*           Unchanged on exit.
51
*
52
*  S        (input) REAL
53
*           On entry, S specifies the sine, sin.
54
*           Unchanged on exit.
55
*
56
*  =====================================================================
57
*
58
*     .. Local Scalars ..
59
      INTEGER           I, IX, IY
60
      COMPLEX           CTEMP
61
*     ..
62
*     .. Executable Statements ..
63
*
64
      IF( N.LE.0 )
65
     $   RETURN
66
      IF( INCX.EQ.1 .AND. INCY.EQ.1 )
67
     $   GO TO 20
68
*
69
*        code for unequal increments or equal increments not equal
70
*          to 1
71
*
72
      IX = 1
73
      IY = 1
74
      IF( INCX.LT.0 )
75
     $   IX = ( -N+1 )*INCX + 1
76
      IF( INCY.LT.0 )
77
     $   IY = ( -N+1 )*INCY + 1
78
      DO 10 I = 1, N
79
         CTEMP = C*CX( IX ) + S*CY( IY )
80
         CY( IY ) = C*CY( IY ) - S*CX( IX )
81
         CX( IX ) = CTEMP
82
         IX = IX + INCX
83
         IY = IY + INCY
84
   10 CONTINUE
85
      RETURN
86
*
87
*        code for both increments equal to 1
88
*
89
   20 DO 30 I = 1, N
90
         CTEMP = C*CX( I ) + S*CY( I )
91
         CY( I ) = C*CY( I ) - S*CX( I )
92
         CX( I ) = CTEMP
93
   30 CONTINUE
94
      RETURN
95
      END