summaryrefslogtreecommitdiff
path: root/BLAS/SRC/dscal.f
diff options
context:
space:
mode:
authorjason <jason@8a072113-8704-0410-8d35-dd094bca7971>2008-10-28 01:38:50 +0000
committerjason <jason@8a072113-8704-0410-8d35-dd094bca7971>2008-10-28 01:38:50 +0000
commitbaba851215b44ac3b60b9248eb02bcce7eb76247 (patch)
tree8c0f5c006875532a30d4409f5e94b0f310ff00a7 /BLAS/SRC/dscal.f
downloadlapack-baba851215b44ac3b60b9248eb02bcce7eb76247.tar.gz
lapack-baba851215b44ac3b60b9248eb02bcce7eb76247.tar.bz2
lapack-baba851215b44ac3b60b9248eb02bcce7eb76247.zip
Move LAPACK trunk into position.
Diffstat (limited to 'BLAS/SRC/dscal.f')
-rw-r--r--BLAS/SRC/dscal.f57
1 files changed, 57 insertions, 0 deletions
diff --git a/BLAS/SRC/dscal.f b/BLAS/SRC/dscal.f
new file mode 100644
index 00000000..0b423cf2
--- /dev/null
+++ b/BLAS/SRC/dscal.f
@@ -0,0 +1,57 @@
+ SUBROUTINE DSCAL(N,DA,DX,INCX)
+* .. Scalar Arguments ..
+ DOUBLE PRECISION DA
+ INTEGER INCX,N
+* ..
+* .. Array Arguments ..
+ DOUBLE PRECISION DX(*)
+* ..
+*
+* Purpose
+* =======
+**
+* scales a vector by a constant.
+* uses unrolled loops for increment equal to one.
+* jack dongarra, linpack, 3/11/78.
+* modified 3/93 to return if incx .le. 0.
+* modified 12/3/93, array(1) declarations changed to array(*)
+*
+*
+* .. Local Scalars ..
+ INTEGER I,M,MP1,NINCX
+* ..
+* .. Intrinsic Functions ..
+ INTRINSIC MOD
+* ..
+ IF (N.LE.0 .OR. INCX.LE.0) RETURN
+ IF (INCX.EQ.1) GO TO 20
+*
+* code for increment not equal to 1
+*
+ NINCX = N*INCX
+ DO 10 I = 1,NINCX,INCX
+ DX(I) = DA*DX(I)
+ 10 CONTINUE
+ RETURN
+*
+* code for increment equal to 1
+*
+*
+* clean-up loop
+*
+ 20 M = MOD(N,5)
+ IF (M.EQ.0) GO TO 40
+ DO 30 I = 1,M
+ DX(I) = DA*DX(I)
+ 30 CONTINUE
+ IF (N.LT.5) RETURN
+ 40 MP1 = M + 1
+ DO 50 I = MP1,N,5
+ DX(I) = DA*DX(I)
+ DX(I+1) = DA*DX(I+1)
+ DX(I+2) = DA*DX(I+2)
+ DX(I+3) = DA*DX(I+3)
+ DX(I+4) = DA*DX(I+4)
+ 50 CONTINUE
+ RETURN
+ END