annotate libcruft/blas/dcopy.f @ 7948:af10baa63915 ss-3-1-50

3.1.50 snapshot
author John W. Eaton <jwe@octave.org>
date Fri, 18 Jul 2008 17:42:48 -0400
parents bac14003d9bb
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
2608
bac14003d9bb [project @ 1997-01-18 00:11:48 by jwe]
jwe
parents: 2329
diff changeset
1 subroutine dcopy(n,dx,incx,dy,incy)
bac14003d9bb [project @ 1997-01-18 00:11:48 by jwe]
jwe
parents: 2329
diff changeset
2 c
bac14003d9bb [project @ 1997-01-18 00:11:48 by jwe]
jwe
parents: 2329
diff changeset
3 c copies a vector, x, to a vector, y.
bac14003d9bb [project @ 1997-01-18 00:11:48 by jwe]
jwe
parents: 2329
diff changeset
4 c uses unrolled loops for increments equal to one.
bac14003d9bb [project @ 1997-01-18 00:11:48 by jwe]
jwe
parents: 2329
diff changeset
5 c jack dongarra, linpack, 3/11/78.
bac14003d9bb [project @ 1997-01-18 00:11:48 by jwe]
jwe
parents: 2329
diff changeset
6 c modified 12/3/93, array(1) declarations changed to array(*)
bac14003d9bb [project @ 1997-01-18 00:11:48 by jwe]
jwe
parents: 2329
diff changeset
7 c
bac14003d9bb [project @ 1997-01-18 00:11:48 by jwe]
jwe
parents: 2329
diff changeset
8 double precision dx(*),dy(*)
bac14003d9bb [project @ 1997-01-18 00:11:48 by jwe]
jwe
parents: 2329
diff changeset
9 integer i,incx,incy,ix,iy,m,mp1,n
bac14003d9bb [project @ 1997-01-18 00:11:48 by jwe]
jwe
parents: 2329
diff changeset
10 c
bac14003d9bb [project @ 1997-01-18 00:11:48 by jwe]
jwe
parents: 2329
diff changeset
11 if(n.le.0)return
bac14003d9bb [project @ 1997-01-18 00:11:48 by jwe]
jwe
parents: 2329
diff changeset
12 if(incx.eq.1.and.incy.eq.1)go to 20
bac14003d9bb [project @ 1997-01-18 00:11:48 by jwe]
jwe
parents: 2329
diff changeset
13 c
bac14003d9bb [project @ 1997-01-18 00:11:48 by jwe]
jwe
parents: 2329
diff changeset
14 c code for unequal increments or equal increments
bac14003d9bb [project @ 1997-01-18 00:11:48 by jwe]
jwe
parents: 2329
diff changeset
15 c not equal to 1
bac14003d9bb [project @ 1997-01-18 00:11:48 by jwe]
jwe
parents: 2329
diff changeset
16 c
bac14003d9bb [project @ 1997-01-18 00:11:48 by jwe]
jwe
parents: 2329
diff changeset
17 ix = 1
bac14003d9bb [project @ 1997-01-18 00:11:48 by jwe]
jwe
parents: 2329
diff changeset
18 iy = 1
bac14003d9bb [project @ 1997-01-18 00:11:48 by jwe]
jwe
parents: 2329
diff changeset
19 if(incx.lt.0)ix = (-n+1)*incx + 1
bac14003d9bb [project @ 1997-01-18 00:11:48 by jwe]
jwe
parents: 2329
diff changeset
20 if(incy.lt.0)iy = (-n+1)*incy + 1
bac14003d9bb [project @ 1997-01-18 00:11:48 by jwe]
jwe
parents: 2329
diff changeset
21 do 10 i = 1,n
bac14003d9bb [project @ 1997-01-18 00:11:48 by jwe]
jwe
parents: 2329
diff changeset
22 dy(iy) = dx(ix)
bac14003d9bb [project @ 1997-01-18 00:11:48 by jwe]
jwe
parents: 2329
diff changeset
23 ix = ix + incx
bac14003d9bb [project @ 1997-01-18 00:11:48 by jwe]
jwe
parents: 2329
diff changeset
24 iy = iy + incy
bac14003d9bb [project @ 1997-01-18 00:11:48 by jwe]
jwe
parents: 2329
diff changeset
25 10 continue
bac14003d9bb [project @ 1997-01-18 00:11:48 by jwe]
jwe
parents: 2329
diff changeset
26 return
bac14003d9bb [project @ 1997-01-18 00:11:48 by jwe]
jwe
parents: 2329
diff changeset
27 c
bac14003d9bb [project @ 1997-01-18 00:11:48 by jwe]
jwe
parents: 2329
diff changeset
28 c code for both increments equal to 1
bac14003d9bb [project @ 1997-01-18 00:11:48 by jwe]
jwe
parents: 2329
diff changeset
29 c
bac14003d9bb [project @ 1997-01-18 00:11:48 by jwe]
jwe
parents: 2329
diff changeset
30 c
bac14003d9bb [project @ 1997-01-18 00:11:48 by jwe]
jwe
parents: 2329
diff changeset
31 c clean-up loop
bac14003d9bb [project @ 1997-01-18 00:11:48 by jwe]
jwe
parents: 2329
diff changeset
32 c
bac14003d9bb [project @ 1997-01-18 00:11:48 by jwe]
jwe
parents: 2329
diff changeset
33 20 m = mod(n,7)
bac14003d9bb [project @ 1997-01-18 00:11:48 by jwe]
jwe
parents: 2329
diff changeset
34 if( m .eq. 0 ) go to 40
bac14003d9bb [project @ 1997-01-18 00:11:48 by jwe]
jwe
parents: 2329
diff changeset
35 do 30 i = 1,m
bac14003d9bb [project @ 1997-01-18 00:11:48 by jwe]
jwe
parents: 2329
diff changeset
36 dy(i) = dx(i)
bac14003d9bb [project @ 1997-01-18 00:11:48 by jwe]
jwe
parents: 2329
diff changeset
37 30 continue
bac14003d9bb [project @ 1997-01-18 00:11:48 by jwe]
jwe
parents: 2329
diff changeset
38 if( n .lt. 7 ) return
bac14003d9bb [project @ 1997-01-18 00:11:48 by jwe]
jwe
parents: 2329
diff changeset
39 40 mp1 = m + 1
bac14003d9bb [project @ 1997-01-18 00:11:48 by jwe]
jwe
parents: 2329
diff changeset
40 do 50 i = mp1,n,7
bac14003d9bb [project @ 1997-01-18 00:11:48 by jwe]
jwe
parents: 2329
diff changeset
41 dy(i) = dx(i)
bac14003d9bb [project @ 1997-01-18 00:11:48 by jwe]
jwe
parents: 2329
diff changeset
42 dy(i + 1) = dx(i + 1)
bac14003d9bb [project @ 1997-01-18 00:11:48 by jwe]
jwe
parents: 2329
diff changeset
43 dy(i + 2) = dx(i + 2)
bac14003d9bb [project @ 1997-01-18 00:11:48 by jwe]
jwe
parents: 2329
diff changeset
44 dy(i + 3) = dx(i + 3)
bac14003d9bb [project @ 1997-01-18 00:11:48 by jwe]
jwe
parents: 2329
diff changeset
45 dy(i + 4) = dx(i + 4)
bac14003d9bb [project @ 1997-01-18 00:11:48 by jwe]
jwe
parents: 2329
diff changeset
46 dy(i + 5) = dx(i + 5)
bac14003d9bb [project @ 1997-01-18 00:11:48 by jwe]
jwe
parents: 2329
diff changeset
47 dy(i + 6) = dx(i + 6)
bac14003d9bb [project @ 1997-01-18 00:11:48 by jwe]
jwe
parents: 2329
diff changeset
48 50 continue
bac14003d9bb [project @ 1997-01-18 00:11:48 by jwe]
jwe
parents: 2329
diff changeset
49 return
bac14003d9bb [project @ 1997-01-18 00:11:48 by jwe]
jwe
parents: 2329
diff changeset
50 end