de/d05/dasum_8f_source.html

00001       DOUBLE PRECISION FUNCTION DASUM(N,DX,INCX)
00002 *     .. Scalar Arguments ..
00003       INTEGER INCX,N
00004 *     ..
00005 *     .. Array Arguments ..
00006       DOUBLE PRECISION DX(*)
00007 *     ..
00008 *
00009 *  Purpose
00010 *  =======
00011 *
00012 *     DASUM takes the sum of the absolute values.
00013 *
00014 *  Further Details
00015 *  ===============
00016 *
00017 *     jack dongarra, linpack, 3/11/78.
00018 *     modified 3/93 to return if incx .le. 0.
00019 *     modified 12/3/93, array(1) declarations changed to array(*)
00020 *
00021 *  =====================================================================
00022 *
00023 *     .. Local Scalars ..
00024       DOUBLE PRECISION DTEMP
00025       INTEGER I,M,MP1,NINCX
00026 *     ..
00027 *     .. Intrinsic Functions ..
00028       INTRINSIC DABS,MOD
00029 *     ..
00030       DASUM = 0.0d0
00031       DTEMP = 0.0d0
00032       IF (N.LE.0 .OR. INCX.LE.0) RETURN
00033       IF (INCX.EQ.1) GO TO 20
00034 *
00035 *        code for increment not equal to 1
00036 *
00037       NINCX = N*INCX
00038       DO 10 I = 1,NINCX,INCX
00039           DTEMP = DTEMP + DABS(DX(I))
00040    10 CONTINUE
00041       DASUM = DTEMP
00042       RETURN
00043 *
00044 *        code for increment equal to 1
00045 *
00046 *
00047 *        clean-up loop
00048 *
00049    20 M = MOD(N,6)
00050       IF (M.EQ.0) GO TO 40
00051       DO 30 I = 1,M
00052           DTEMP = DTEMP + DABS(DX(I))
00053    30 CONTINUE
00054       IF (N.LT.6) GO TO 60
00055    40 MP1 = M + 1
00056       DO 50 I = MP1,N,6
00057           DTEMP = DTEMP + DABS(DX(I)) + DABS(DX(I+1)) + DABS(DX(I+2)) +
00058      +            DABS(DX(I+3)) + DABS(DX(I+4)) + DABS(DX(I+5))
00059    50 CONTINUE
00060    60 DASUM = DTEMP
00061       RETURN
00062       END