summaryrefslogtreecommitdiff
path: root/2.3-1/src/fortran/blas/dswap.f
diff options
context:
space:
mode:
Diffstat (limited to '2.3-1/src/fortran/blas/dswap.f')
-rw-r--r--2.3-1/src/fortran/blas/dswap.f56
1 files changed, 56 insertions, 0 deletions
diff --git a/2.3-1/src/fortran/blas/dswap.f b/2.3-1/src/fortran/blas/dswap.f
new file mode 100644
index 00000000..7f7d1fbb
--- /dev/null
+++ b/2.3-1/src/fortran/blas/dswap.f
@@ -0,0 +1,56 @@
+ subroutine dswap (n,dx,incx,dy,incy)
+c
+c interchanges two vectors.
+c uses unrolled loops for increments equal one.
+c jack dongarra, linpack, 3/11/78.
+c modified 12/3/93, array(1) declarations changed to array(*)
+c
+ double precision dx(*),dy(*),dtemp
+ integer i,incx,incy,ix,iy,m,mp1,n
+c
+ if(n.le.0)return
+ if(incx.eq.1.and.incy.eq.1)go to 20
+c
+c code for unequal increments or equal increments not equal
+c to 1
+c
+ ix = 1
+ iy = 1
+ if(incx.lt.0)ix = (-n+1)*incx + 1
+ if(incy.lt.0)iy = (-n+1)*incy + 1
+ do 10 i = 1,n
+ dtemp = dx(ix)
+ dx(ix) = dy(iy)
+ dy(iy) = dtemp
+ ix = ix + incx
+ iy = iy + incy
+ 10 continue
+ return
+c
+c code for both increments equal to 1
+c
+c
+c clean-up loop
+c
+ 20 m = mod(n,3)
+ if( m .eq. 0 ) go to 40
+ do 30 i = 1,m
+ dtemp = dx(i)
+ dx(i) = dy(i)
+ dy(i) = dtemp
+ 30 continue
+ if( n .lt. 3 ) return
+ 40 mp1 = m + 1
+ do 50 i = mp1,n,3
+ dtemp = dx(i)
+ dx(i) = dy(i)
+ dy(i) = dtemp
+ dtemp = dx(i + 1)
+ dx(i + 1) = dy(i + 1)
+ dy(i + 1) = dtemp
+ dtemp = dx(i + 2)
+ dx(i + 2) = dy(i + 2)
+ dy(i + 2) = dtemp
+ 50 continue
+ return
+ end