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