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 * SCASUM takes the sum of the absolute values of a complex vector and
13 * returns a single precision result.
14 *
15 * Further Details
16 * ===============
17 *
18 * jack dongarra, linpack, 3/11/78.
19 * modified 3/93 to return if incx .le. 0.
20 * modified 12/3/93, array(1) declarations changed to array(*)
21 *
22 * =====================================================================
23 *
24 * .. Local Scalars ..
25 REAL STEMP
26 INTEGER I,NINCX
27 * ..
28 * .. Intrinsic Functions ..
29 INTRINSIC ABS,AIMAG,REAL
30 * ..
31 SCASUM = 0.0e0
32 STEMP = 0.0e0
33 IF (N.LE.0 .OR. INCX.LE.0) RETURN
34 IF (INCX.EQ.1) THEN
35 *
36 * code for increment equal to 1
37 *
38 DO I = 1,N
39 STEMP = STEMP + ABS(REAL(CX(I))) + ABS(AIMAG(CX(I)))
40 END DO
41 ELSE
42 *
43 * code for increment not equal to 1
44 *
45 NINCX = N*INCX
46 DO I = 1,NINCX,INCX
47 STEMP = STEMP + ABS(REAL(CX(I))) + ABS(AIMAG(CX(I)))
48 END DO
49 END IF
50 SCASUM = STEMP
51 RETURN
52 END
2 * .. Scalar Arguments ..
3 INTEGER INCX,N
4 * ..
5 * .. Array Arguments ..
6 COMPLEX CX(*)
7 * ..
8 *
9 * Purpose
10 * =======
11 *
12 * SCASUM takes the sum of the absolute values of a complex vector and
13 * returns a single precision result.
14 *
15 * Further Details
16 * ===============
17 *
18 * jack dongarra, linpack, 3/11/78.
19 * modified 3/93 to return if incx .le. 0.
20 * modified 12/3/93, array(1) declarations changed to array(*)
21 *
22 * =====================================================================
23 *
24 * .. Local Scalars ..
25 REAL STEMP
26 INTEGER I,NINCX
27 * ..
28 * .. Intrinsic Functions ..
29 INTRINSIC ABS,AIMAG,REAL
30 * ..
31 SCASUM = 0.0e0
32 STEMP = 0.0e0
33 IF (N.LE.0 .OR. INCX.LE.0) RETURN
34 IF (INCX.EQ.1) THEN
35 *
36 * code for increment equal to 1
37 *
38 DO I = 1,N
39 STEMP = STEMP + ABS(REAL(CX(I))) + ABS(AIMAG(CX(I)))
40 END DO
41 ELSE
42 *
43 * code for increment not equal to 1
44 *
45 NINCX = N*INCX
46 DO I = 1,NINCX,INCX
47 STEMP = STEMP + ABS(REAL(CX(I))) + ABS(AIMAG(CX(I)))
48 END DO
49 END IF
50 SCASUM = STEMP
51 RETURN
52 END