Free cookie consent management tool by TermsFeed Policy Generator

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

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

#2789 added Finbarr O'Sullivan smoothing spline code

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