1 SUBROUTINE DCOPY(N,DX,INCX,DY,INCY)
2 * .. Scalar Arguments ..
3 INTEGER INCX,INCY,N
4 * ..
5 * .. Array Arguments ..
6 DOUBLE PRECISION DX(*),DY(*)
7 * ..
8 *
9 * Purpose
10 * =======
11 *
12 * DCOPY copies a vector, x, to a vector, y.
13 * uses unrolled loops for increments equal to one.
14 *
15 * Further Details
16 * ===============
17 *
18 * jack dongarra, linpack, 3/11/78.
19 * modified 12/3/93, array(1) declarations changed to array(*)
20 *
21 * =====================================================================
22 *
23 * .. Local Scalars ..
24 INTEGER I,IX,IY,M,MP1
25 * ..
26 * .. Intrinsic Functions ..
27 INTRINSIC MOD
28 * ..
29 IF (N.LE.0) RETURN
30 IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN
31 *
32 * code for both increments equal to 1
33 *
34 *
35 * clean-up loop
36 *
37 M = MOD(N,7)
38 IF (M.NE.0) THEN
39 DO I = 1,M
40 DY(I) = DX(I)
41 END DO
42 IF (N.LT.7) RETURN
43 END IF
44 MP1 = M + 1
45 DO I = MP1,N,7
46 DY(I) = DX(I)
47 DY(I+1) = DX(I+1)
48 DY(I+2) = DX(I+2)
49 DY(I+3) = DX(I+3)
50 DY(I+4) = DX(I+4)
51 DY(I+5) = DX(I+5)
52 DY(I+6) = DX(I+6)
53 END DO
54 ELSE
55 *
56 * code for unequal increments or equal increments
57 * not equal to 1
58 *
59 IX = 1
60 IY = 1
61 IF (INCX.LT.0) IX = (-N+1)*INCX + 1
62 IF (INCY.LT.0) IY = (-N+1)*INCY + 1
63 DO I = 1,N
64 DY(IY) = DX(IX)
65 IX = IX + INCX
66 IY = IY + INCY
67 END DO
68 END IF
69 RETURN
70 END
2 * .. Scalar Arguments ..
3 INTEGER INCX,INCY,N
4 * ..
5 * .. Array Arguments ..
6 DOUBLE PRECISION DX(*),DY(*)
7 * ..
8 *
9 * Purpose
10 * =======
11 *
12 * DCOPY copies a vector, x, to a vector, y.
13 * uses unrolled loops for increments equal to one.
14 *
15 * Further Details
16 * ===============
17 *
18 * jack dongarra, linpack, 3/11/78.
19 * modified 12/3/93, array(1) declarations changed to array(*)
20 *
21 * =====================================================================
22 *
23 * .. Local Scalars ..
24 INTEGER I,IX,IY,M,MP1
25 * ..
26 * .. Intrinsic Functions ..
27 INTRINSIC MOD
28 * ..
29 IF (N.LE.0) RETURN
30 IF (INCX.EQ.1 .AND. INCY.EQ.1) THEN
31 *
32 * code for both increments equal to 1
33 *
34 *
35 * clean-up loop
36 *
37 M = MOD(N,7)
38 IF (M.NE.0) THEN
39 DO I = 1,M
40 DY(I) = DX(I)
41 END DO
42 IF (N.LT.7) RETURN
43 END IF
44 MP1 = M + 1
45 DO I = MP1,N,7
46 DY(I) = DX(I)
47 DY(I+1) = DX(I+1)
48 DY(I+2) = DX(I+2)
49 DY(I+3) = DX(I+3)
50 DY(I+4) = DX(I+4)
51 DY(I+5) = DX(I+5)
52 DY(I+6) = DX(I+6)
53 END DO
54 ELSE
55 *
56 * code for unequal increments or equal increments
57 * not equal to 1
58 *
59 IX = 1
60 IY = 1
61 IF (INCX.LT.0) IX = (-N+1)*INCX + 1
62 IF (INCY.LT.0) IY = (-N+1)*INCY + 1
63 DO I = 1,N
64 DY(IY) = DX(IX)
65 IX = IX + INCX
66 IY = IY + INCY
67 END DO
68 END IF
69 RETURN
70 END