home *** CD-ROM | disk | FTP | other *** search
/ SGI Developer Toolbox 6.1 / SGI Developer Toolbox 6.1 - Disc 4.iso / lib / mathlib / libblas / src_original / dasum.f < prev    next >
Encoding:
Text File  |  1994-08-02  |  1.4 KB  |  62 lines
  1.       DOUBLE PRECISION FUNCTION DASUM( N, DX, INCX )
  2. *
  3. *     takes the sum of the absolute values.
  4. *     jack dongarra, linpack, 3/11/78.
  5. *
  6. *     .. Scalar Arguments ..
  7.       INTEGER                          INCX, N
  8. *     ..
  9. *     .. Array Arguments ..
  10.       DOUBLE PRECISION                 DX( 1 )
  11. *     ..
  12. *     .. Local Scalars ..
  13.       INTEGER                          I, IX, M, MP1, NINCX
  14.       DOUBLE PRECISION                 DTEMP
  15. *     ..
  16. *     .. Intrinsic Functions ..
  17.       INTRINSIC                        DABS, MOD
  18. *     ..
  19. *     .. Executable Statements ..
  20. *
  21.       DASUM = 0.0D0
  22.       DTEMP = 0.0D0
  23.       IF( N.LE.0 )
  24.      $   RETURN
  25.       IF( INCX.EQ.1 )
  26.      $   GO TO 20
  27. *
  28. *        code for increment not equal to 1
  29. *
  30.       IX = 1
  31.       IF( INCX.LT.0 )
  32.      $   IX = 1 - ( N-1 )*INCX
  33.       NINCX = IX + ( N-1 )*INCX
  34.       DO 10 I = IX, NINCX, INCX
  35.          DTEMP = DTEMP + DABS( DX( I ) )
  36.    10 CONTINUE
  37.       DASUM = DTEMP
  38.       RETURN
  39. *
  40. *        code for increment equal to 1
  41. *
  42. *
  43. *        clean-up loop
  44. *
  45.    20 M = MOD( N, 6 )
  46.       IF( M.EQ.0 )
  47.      $   GO TO 40
  48.       DO 30 I = 1, M
  49.          DTEMP = DTEMP + DABS( DX( I ) )
  50.    30 CONTINUE
  51.       IF( N.LT.6 )
  52.      $   GO TO 60
  53.    40 MP1 = M + 1
  54.       DO 50 I = MP1, N, 6
  55.          DTEMP = DTEMP + DABS( DX( I ) ) + DABS( DX( I+1 ) ) +
  56.      $           DABS( DX( I+2 ) ) + DABS( DX( I+3 ) ) +
  57.      $           DABS( DX( I+4 ) ) + DABS( DX( I+5 ) )
  58.    50 CONTINUE
  59.    60 DASUM = DTEMP
  60.       RETURN
  61.       END
  62.