Statistiques
| Révision :

root / src / blas / drot.f @ 7

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

1 1 equemene
      SUBROUTINE DROT(N,DX,INCX,DY,INCY,C,S)
2 1 equemene
*     .. Scalar Arguments ..
3 1 equemene
      DOUBLE PRECISION C,S
4 1 equemene
      INTEGER INCX,INCY,N
5 1 equemene
*     ..
6 1 equemene
*     .. Array Arguments ..
7 1 equemene
      DOUBLE PRECISION DX(*),DY(*)
8 1 equemene
*     ..
9 1 equemene
*
10 1 equemene
*  Purpose
11 1 equemene
*  =======
12 1 equemene
*
13 1 equemene
*     applies a plane rotation.
14 1 equemene
*     jack dongarra, linpack, 3/11/78.
15 1 equemene
*     modified 12/3/93, array(1) declarations changed to array(*)
16 1 equemene
*
17 1 equemene
*
18 1 equemene
*     .. Local Scalars ..
19 1 equemene
      DOUBLE PRECISION DTEMP
20 1 equemene
      INTEGER I,IX,IY
21 1 equemene
*     ..
22 1 equemene
      IF (N.LE.0) RETURN
23 1 equemene
      IF (INCX.EQ.1 .AND. INCY.EQ.1) GO TO 20
24 1 equemene
*
25 1 equemene
*       code for unequal increments or equal increments not equal
26 1 equemene
*         to 1
27 1 equemene
*
28 1 equemene
      IX = 1
29 1 equemene
      IY = 1
30 1 equemene
      IF (INCX.LT.0) IX = (-N+1)*INCX + 1
31 1 equemene
      IF (INCY.LT.0) IY = (-N+1)*INCY + 1
32 1 equemene
      DO 10 I = 1,N
33 1 equemene
          DTEMP = C*DX(IX) + S*DY(IY)
34 1 equemene
          DY(IY) = C*DY(IY) - S*DX(IX)
35 1 equemene
          DX(IX) = DTEMP
36 1 equemene
          IX = IX + INCX
37 1 equemene
          IY = IY + INCY
38 1 equemene
   10 CONTINUE
39 1 equemene
      RETURN
40 1 equemene
*
41 1 equemene
*       code for both increments equal to 1
42 1 equemene
*
43 1 equemene
   20 DO 30 I = 1,N
44 1 equemene
          DTEMP = C*DX(I) + S*DY(I)
45 1 equemene
          DY(I) = C*DY(I) - S*DX(I)
46 1 equemene
          DX(I) = DTEMP
47 1 equemene
   30 CONTINUE
48 1 equemene
      RETURN
49 1 equemene
      END