1 |
aw0a |
1 |
C dcopy.f |
2 |
|
|
C is freely available from netlib. It is not subject to any GNU License |
3 |
|
|
C set by the authors of the ASCEND math programming system. |
4 |
|
|
C $Date: 1996/04/30 18:14:07 $ $Revision: 1.1.1.1 $ |
5 |
|
|
C |
6 |
|
|
subroutine dcopy(n,dx,incx,dy,incy) |
7 |
|
|
c |
8 |
|
|
c copies a vector, x, to a vector, y. |
9 |
|
|
c uses unrolled loops for increments equal to one. |
10 |
|
|
c jack dongarra, linpack, 3/11/78. |
11 |
|
|
c |
12 |
|
|
double precision dx(*),dy(*) |
13 |
|
|
integer i,incx,incy,ix,iy,m,mp1,n |
14 |
|
|
c |
15 |
|
|
if(n.le.0)return |
16 |
|
|
if(incx.eq.1.and.incy.eq.1)go to 20 |
17 |
|
|
c |
18 |
|
|
c code for unequal increments or equal increments |
19 |
|
|
c not equal to 1 |
20 |
|
|
c |
21 |
|
|
ix = 1 |
22 |
|
|
iy = 1 |
23 |
|
|
if(incx.lt.0)ix = (-n+1)*incx + 1 |
24 |
|
|
if(incy.lt.0)iy = (-n+1)*incy + 1 |
25 |
|
|
do 10 i = 1,n |
26 |
|
|
dy(iy) = dx(ix) |
27 |
|
|
ix = ix + incx |
28 |
|
|
iy = iy + incy |
29 |
|
|
10 continue |
30 |
|
|
return |
31 |
|
|
c |
32 |
|
|
c code for both increments equal to 1 |
33 |
|
|
c |
34 |
|
|
c |
35 |
|
|
c clean-up loop |
36 |
|
|
c |
37 |
|
|
20 m = mod(n,7) |
38 |
|
|
if( m .eq. 0 ) go to 40 |
39 |
|
|
do 30 i = 1,m |
40 |
|
|
dy(i) = dx(i) |
41 |
|
|
30 continue |
42 |
|
|
if( n .lt. 7 ) return |
43 |
|
|
40 mp1 = m + 1 |
44 |
|
|
do 50 i = mp1,n,7 |
45 |
|
|
dy(i) = dx(i) |
46 |
|
|
dy(i + 1) = dx(i + 1) |
47 |
|
|
dy(i + 2) = dx(i + 2) |
48 |
|
|
dy(i + 3) = dx(i + 3) |
49 |
|
|
dy(i + 4) = dx(i + 4) |
50 |
|
|
dy(i + 5) = dx(i + 5) |
51 |
|
|
dy(i + 6) = dx(i + 6) |
52 |
|
|
50 continue |
53 |
|
|
return |
54 |
|
|
end |
55 |
|
|
|