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.

sasumf.f 1.1 kB

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