Statistiques
| Révision :

root / src / blas / zdrot.f @ 10

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

1 
      SUBROUTINE ZDROT( N, CX, INCX, CY, INCY, C, S )
2 
*
3 
*     .. Scalar Arguments ..
4 
      INTEGER            INCX, INCY, N
5 
      DOUBLE PRECISION   C, S
6 
*     ..
7 
*     .. Array Arguments ..
8 
      COMPLEX*16         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*16 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*16 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) DOUBLE PRECISION
49 
*           On entry, C specifies the cosine, cos.
50 
*           Unchanged on exit.
51 
*
52 
*  S        (input) DOUBLE PRECISION
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*16         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 CONTINUE
90 
      DO 30 I = 1, N
91 
         CTEMP = C*CX( I ) + S*CY( I )
92 
         CY( I ) = C*CY( I ) - S*CX( I )
93 
         CX( I ) = CTEMP
94 
   30 CONTINUE
95 
      RETURN
96 
      END