home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / octave-1.1.1p1-src.tgz / tar.out / fsf / octave / libcruft / blas / dasum.f next >
Text File  |  1996-09-28  |  934b  |  42 lines
  1.       DOUBLE PRECISION FUNCTION DASUM(N,DX,INCX)
  2. C
  3. C     TAKES THE SUM OF THE ABSOLUTE VALUES.
  4. C     JACK DONGARRA, LINPACK, 3/11/78.
  5. C
  6.       DOUBLE PRECISION DX(1),DTEMP
  7.       INTEGER I,INCX,M,MP1,N,NINCX
  8. C
  9.       DASUM = 0.0D0
  10.       DTEMP = 0.0D0
  11.       IF(N.LE.0)RETURN
  12.       IF(INCX.EQ.1)GO TO 20
  13. C
  14. C        CODE FOR INCREMENT NOT EQUAL TO 1
  15. C
  16.       NINCX = N*INCX
  17.       DO 10 I = 1,NINCX,INCX
  18.         DTEMP = DTEMP + DABS(DX(I))
  19.    10 CONTINUE
  20.       DASUM = DTEMP
  21.       RETURN
  22. C
  23. C        CODE FOR INCREMENT EQUAL TO 1
  24. C
  25. C
  26. C        CLEAN-UP LOOP
  27. C
  28.    20 M = MOD(N,6)
  29.       IF( M .EQ. 0 ) GO TO 40
  30.       DO 30 I = 1,M
  31.         DTEMP = DTEMP + DABS(DX(I))
  32.    30 CONTINUE
  33.       IF( N .LT. 6 ) GO TO 60
  34.    40 MP1 = M + 1
  35.       DO 50 I = MP1,N,6
  36.         DTEMP = DTEMP + DABS(DX(I)) + DABS(DX(I + 1)) + DABS(DX(I + 2))
  37.      *  + DABS(DX(I + 3)) + DABS(DX(I + 4)) + DABS(DX(I + 5))
  38.    50 CONTINUE
  39.    60 DASUM = DTEMP
  40.       RETURN
  41.       END
  42.