BLAS/SRC/dasum.f

   1 *> \brief \b DASUM
   2 *
   3 *  =========== DOCUMENTATION ===========
   4 *
   5 * Online html documentation available at
   6 *            http://www.netlib.org/lapack/explore-html/
   7 *
   8 *  Definition:
   9 *  ===========
  10 *
  11 *       DOUBLE PRECISION FUNCTION DASUM(N,DX,INCX)
  12 *
  13 *       .. Scalar Arguments ..
  14 *       INTEGER INCX,N
  15 *       ..
  16 *       .. Array Arguments ..
  17 *       DOUBLE PRECISION DX(*)
  18 *       ..
  19 *
  20 *
  21 *> \par Purpose:
  22 *  =============
  23 *>
  24 *> \verbatim
  25 *>
  26 *>    DASUM takes the sum of the absolute values.
  27 *> \endverbatim
  28 *
  29 *  Authors:
  30 *  ========
  31 *
  32 *> \author Univ. of Tennessee
  33 *> \author Univ. of California Berkeley
  34 *> \author Univ. of Colorado Denver
  35 *> \author NAG Ltd.
  36 *
  37 *> \date November 2011
  38 *
  39 *> \ingroup double_blas_level1
  40 *
  41 *> \par Further Details:
  42 *  =====================
  43 *>
  44 *> \verbatim
  45 *>
  46 *>     jack dongarra, linpack, 3/11/78.
  47 *>     modified 3/93 to return if incx .le. 0.
  48 *>     modified 12/3/93, array(1) declarations changed to array(*)
  49 *> \endverbatim
  50 *>
  51 *  =====================================================================
  52       DOUBLE PRECISION FUNCTION DASUM(N,DX,INCX)
  53 *
  54 *  -- Reference BLAS level1 routine (version 3.4.0) --
  55 *  -- Reference BLAS is a software package provided by Univ. of Tennessee,    --
  56 *  -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  57 *     November 2011
  58 *
  59 *     .. Scalar Arguments ..
  60       INTEGER INCX,N
  61 *     ..
  62 *     .. Array Arguments ..
  63       DOUBLE PRECISION DX(*)
  64 *     ..
  65 *
  66 *  =====================================================================
  67 *
  68 *     .. Local Scalars ..
  69       DOUBLE PRECISION DTEMP
  70       INTEGER I,M,MP1,NINCX
  71 *     ..
  72 *     .. Intrinsic Functions ..
  73       INTRINSIC DABS,MOD
  74 *     ..
  75       DASUM = 0.0d0
  76       DTEMP = 0.0d0
  77       IF (N.LE.0 .OR. INCX.LE.0) RETURN
  78       IF (INCX.EQ.1) THEN
  79 *        code for increment equal to 1
  80 *
  81 *
  82 *        clean-up loop
  83 *
  84          M = MOD(N,6)
  85          IF (M.NE.0) THEN
  86             DO I = 1,M
  87                DTEMP = DTEMP + DABS(DX(I))
  88             END DO
  89             IF (N.LT.6) THEN
  90                DASUM = DTEMP
  91                RETURN
  92             END IF
  93          END IF
  94          MP1 = M + 1
  95          DO I = MP1,N,6
  96             DTEMP = DTEMP + DABS(DX(I)) + DABS(DX(I+1)) +
  97      $              DABS(DX(I+2)) + DABS(DX(I+3)) +
  98      $              DABS(DX(I+4)) + DABS(DX(I+5))
  99          END DO
 100       ELSE
 101 *
 102 *        code for increment not equal to 1
 103 *
 104          NINCX = N*INCX
 105          DO I = 1,NINCX,INCX
 106             DTEMP = DTEMP + DABS(DX(I))
 107          END DO
 108       END IF
 109       DASUM = DTEMP
 110       RETURN
 111       END