Statistiques
| Révision :

root / src / blas / csrot.f @ 7

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

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