Statistiques
| Révision :

root / src / blas / zcopy.f @ 4

Historique | Voir | Annoter | Télécharger (933 octet)

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