Free cookie consent management tool by TermsFeed Policy Generator

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

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

#2789 added Finbarr O'Sullivan smoothing spline code

File size: 1.1 KB
Line 
1      REAL FUNCTION SCASUM(N,CX,INCX)
2*     .. Scalar Arguments ..
3      INTEGER INCX,N
4*     ..
5*     .. Array Arguments ..
6      COMPLEX CX(*)
7*     ..
8*
9*  Purpose
10*  =======
11*
12*     takes the sum of the absolute values of a complex vector and
13*     returns a single precision result.
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*     .. Local Scalars ..
20      REAL STEMP
21      INTEGER I,NINCX
22*     ..
23*     .. Intrinsic Functions ..
24      INTRINSIC ABS,AIMAG,REAL
25*     ..
26      SCASUM = 0.0e0
27      STEMP = 0.0e0
28      IF (N.LE.0 .OR. INCX.LE.0) RETURN
29      IF (INCX.EQ.1) GO TO 20
30*
31*        code for increment not equal to 1
32*
33      NINCX = N*INCX
34      DO 10 I = 1,NINCX,INCX
35          STEMP = STEMP + ABS(REAL(CX(I))) + ABS(AIMAG(CX(I)))
36   10 CONTINUE
37      SCASUM = STEMP
38      RETURN
39*
40*        code for increment equal to 1
41*
42   20 DO 30 I = 1,N
43          STEMP = STEMP + ABS(REAL(CX(I))) + ABS(AIMAG(CX(I)))
44   30 CONTINUE
45      SCASUM = STEMP
46      RETURN
47      END
Note: See TracBrowser for help on using the repository browser.