summaryrefslogtreecommitdiff
path: root/2.3-1/src/fortran/blas/daxpy.f
diff options
context:
space:
mode:
Diffstat (limited to '2.3-1/src/fortran/blas/daxpy.f')
-rw-r--r--2.3-1/src/fortran/blas/daxpy.f48
1 files changed, 48 insertions, 0 deletions
diff --git a/2.3-1/src/fortran/blas/daxpy.f b/2.3-1/src/fortran/blas/daxpy.f
new file mode 100644
index 00000000..91daa3c6
--- /dev/null
+++ b/2.3-1/src/fortran/blas/daxpy.f
@@ -0,0 +1,48 @@
+ subroutine daxpy(n,da,dx,incx,dy,incy)
+c
+c constant times a vector plus a vector.
+c uses unrolled loops for increments equal to one.
+c jack dongarra, linpack, 3/11/78.
+c modified 12/3/93, array(1) declarations changed to array(*)
+c
+ double precision dx(*),dy(*),da
+ integer i,incx,incy,ix,iy,m,mp1,n
+c
+ if(n.le.0)return
+ if (da .eq. 0.0d0) return
+ if(incx.eq.1.and.incy.eq.1)go to 20
+c
+c code for unequal increments or equal increments
+c not equal 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
+ dy(iy) = dy(iy) + da*dx(ix)
+ 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,4)
+ if( m .eq. 0 ) go to 40
+ do 30 i = 1,m
+ dy(i) = dy(i) + da*dx(i)
+ 30 continue
+ if( n .lt. 4 ) return
+ 40 mp1 = m + 1
+ do 50 i = mp1,n,4
+ dy(i) = dy(i) + da*dx(i)
+ dy(i + 1) = dy(i + 1) + da*dx(i + 1)
+ dy(i + 2) = dy(i + 2) + da*dx(i + 2)
+ dy(i + 3) = dy(i + 3) + da*dx(i + 3)
+ 50 continue
+ return
+ end