comparison libcruft/arpack/util/iswap.f @ 12274:9f5d2ef078e8 release-3-4-x

import ARPACK sources to libcruft from Debian package libarpack2 2.1+parpack96.dfsg-3+b1
author John W. Eaton <jwe@octave.org>
date Fri, 28 Jan 2011 14:04:33 -0500
parents
children
comparison
equal deleted inserted replaced
12273:83133b5bf392 12274:9f5d2ef078e8
1 subroutine iswap (n,sx,incx,sy,incy)
2 c
3 c interchanges two vectors.
4 c uses unrolled loops for increments equal to 1.
5 c jack dongarra, linpack, 3/11/78.
6 c
7 integer sx(1),sy(1),stemp
8 integer i,incx,incy,ix,iy,m,mp1,n
9 c
10 if(n.le.0)return
11 if(incx.eq.1.and.incy.eq.1)go to 20
12 c
13 c code for unequal increments or equal increments not equal
14 c to 1
15 c
16 ix = 1
17 iy = 1
18 if(incx.lt.0)ix = (-n+1)*incx + 1
19 if(incy.lt.0)iy = (-n+1)*incy + 1
20 do 10 i = 1,n
21 stemp = sx(ix)
22 sx(ix) = sy(iy)
23 sy(iy) = stemp
24 ix = ix + incx
25 iy = iy + incy
26 10 continue
27 return
28 c
29 c code for both increments equal to 1
30 c
31 c
32 c clean-up loop
33 c
34 20 m = mod(n,3)
35 if( m .eq. 0 ) go to 40
36 do 30 i = 1,m
37 stemp = sx(i)
38 sx(i) = sy(i)
39 sy(i) = stemp
40 30 continue
41 if( n .lt. 3 ) return
42 40 mp1 = m + 1
43 do 50 i = mp1,n,3
44 stemp = sx(i)
45 sx(i) = sy(i)
46 sy(i) = stemp
47 stemp = sx(i + 1)
48 sx(i + 1) = sy(i + 1)
49 sy(i + 1) = stemp
50 stemp = sx(i + 2)
51 sx(i + 2) = sy(i + 2)
52 sy(i + 2) = stemp
53 50 continue
54 return
55 end