Statistiques
| Révision :

root / src / blas / scasum.f @ 5

Historique | Voir | Annoter | Télécharger (1,07 ko)

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