|
|
1.1 ! root 1: subroutine sswap (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: real 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
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.