Statistiques
| Révision :

root / src / blas / drot.f @ 11

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

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