You can not select more than 25 topics Topics must start with a chinese character,a letter or number, can include dashes ('-') and can be up to 35 characters long.

dasumf.f 1.1 kB

12345678910111213141516171819202122232425262728293031323334353637383940414243
  1. double precision function dasumf(n,dx,incx)
  2. c
  3. c takes the sum of the absolute values.
  4. c jack dongarra, linpack, 3/11/78.
  5. c modified 3/93 to return if incx .le. 0.
  6. c modified 12/3/93, array(1) declarations changed to array(*)
  7. c
  8. double precision dx(*),dtemp
  9. integer i,incx,m,mp1,n,nincx
  10. c
  11. dasumf = 0.0d0
  12. dtemp = 0.0d0
  13. if( n.le.0 .or. incx.le.0 )return
  14. if(incx.eq.1)go to 20
  15. c
  16. c code for increment not equal to 1
  17. c
  18. nincx = n*incx
  19. do 10 i = 1,nincx,incx
  20. dtemp = dtemp + dabs(dx(i))
  21. 10 continue
  22. dasumf = dtemp
  23. return
  24. c
  25. c code for increment equal to 1
  26. c
  27. c
  28. c clean-up loop
  29. c
  30. 20 m = mod(n,6)
  31. if( m .eq. 0 ) go to 40
  32. do 30 i = 1,m
  33. dtemp = dtemp + dabs(dx(i))
  34. 30 continue
  35. if( n .lt. 6 ) go to 60
  36. 40 mp1 = m + 1
  37. do 50 i = mp1,n,6
  38. dtemp = dtemp + dabs(dx(i)) + dabs(dx(i + 1)) + dabs(dx(i + 2))
  39. * + dabs(dx(i + 3)) + dabs(dx(i + 4)) + dabs(dx(i + 5))
  40. 50 continue
  41. 60 dasumf = dtemp
  42. return
  43. end