Statistiques
| Révision :

root / src / blas / dzasum.f @ 7

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

1 1 equemene
      DOUBLE PRECISION FUNCTION DZASUM(N,ZX,INCX)
2 1 equemene
*     .. Scalar Arguments ..
3 1 equemene
      INTEGER INCX,N
4 1 equemene
*     ..
5 1 equemene
*     .. Array Arguments ..
6 1 equemene
      DOUBLE COMPLEX ZX(*)
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
*     jack dongarra, 3/11/78.
14 1 equemene
*     modified 3/93 to return if incx .le. 0.
15 1 equemene
*     modified 12/3/93, array(1) declarations changed to array(*)
16 1 equemene
*
17 1 equemene
*
18 1 equemene
*     .. Local Scalars ..
19 1 equemene
      DOUBLE PRECISION STEMP
20 1 equemene
      INTEGER I,IX
21 1 equemene
*     ..
22 1 equemene
*     .. External Functions ..
23 1 equemene
      DOUBLE PRECISION DCABS1
24 1 equemene
      EXTERNAL DCABS1
25 1 equemene
*     ..
26 1 equemene
      DZASUM = 0.0d0
27 1 equemene
      STEMP = 0.0d0
28 1 equemene
      IF (N.LE.0 .OR. INCX.LE.0) RETURN
29 1 equemene
      IF (INCX.EQ.1) GO TO 20
30 1 equemene
*
31 1 equemene
*        code for increment not equal to 1
32 1 equemene
*
33 1 equemene
      IX = 1
34 1 equemene
      DO 10 I = 1,N
35 1 equemene
          STEMP = STEMP + DCABS1(ZX(IX))
36 1 equemene
          IX = IX + INCX
37 1 equemene
   10 CONTINUE
38 1 equemene
      DZASUM = STEMP
39 1 equemene
      RETURN
40 1 equemene
*
41 1 equemene
*        code for increment equal to 1
42 1 equemene
*
43 1 equemene
   20 DO 30 I = 1,N
44 1 equemene
          STEMP = STEMP + DCABS1(ZX(I))
45 1 equemene
   30 CONTINUE
46 1 equemene
      DZASUM = STEMP
47 1 equemene
      RETURN
48 1 equemene
      END