Free cookie consent management tool by TermsFeed Policy Generator

source: branches/2789_MathNetNumerics-Exploration/HeuristicLab.Algorithms.DataAnalysis.Experimental/sbart/sscal.f @ 17185

Last change on this file since 17185 was 15457, checked in by gkronber, 7 years ago

#2789 added Finbarr O'Sullivan smoothing spline code

File size: 1.2 KB
Line 
1      SUBROUTINE SSCAL(N,SA,SX,INCX)
2*     .. Scalar Arguments ..
3      REAL SA
4      INTEGER INCX,N
5*     ..
6*     .. Array Arguments ..
7      REAL SX(*)
8*     ..
9*
10*  Purpose
11*  =======
12*
13*     scales a vector by a constant.
14*     uses unrolled loops for increment equal to 1.
15*     jack dongarra, linpack, 3/11/78.
16*     modified 3/93 to return if incx .le. 0.
17*     modified 12/3/93, array(1) declarations changed to array(*)
18*
19*
20*     .. Local Scalars ..
21      INTEGER I,M,MP1,NINCX
22*     ..
23*     .. Intrinsic Functions ..
24      INTRINSIC MOD
25*     ..
26      IF (N.LE.0 .OR. INCX.LE.0) RETURN
27      IF (INCX.EQ.1) GO TO 20
28*
29*        code for increment not equal to 1
30*
31      NINCX = N*INCX
32      DO 10 I = 1,NINCX,INCX
33          SX(I) = SA*SX(I)
34   10 CONTINUE
35      RETURN
36*
37*        code for increment equal to 1
38*
39*
40*        clean-up loop
41*
42   20 M = MOD(N,5)
43      IF (M.EQ.0) GO TO 40
44      DO 30 I = 1,M
45          SX(I) = SA*SX(I)
46   30 CONTINUE
47      IF (N.LT.5) RETURN
48   40 MP1 = M + 1
49      DO 50 I = MP1,N,5
50          SX(I) = SA*SX(I)
51          SX(I+1) = SA*SX(I+1)
52          SX(I+2) = SA*SX(I+2)
53          SX(I+3) = SA*SX(I+3)
54          SX(I+4) = SA*SX(I+4)
55   50 CONTINUE
56      RETURN
57      END
Note: See TracBrowser for help on using the repository browser.