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.

sasum.f 2.9 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132
  1. *> \brief \b SASUM
  2. *
  3. * =========== DOCUMENTATION ===========
  4. *
  5. * Online html documentation available at
  6. * http://www.netlib.org/lapack/explore-html/
  7. *
  8. * Definition:
  9. * ===========
  10. *
  11. * REAL FUNCTION SASUM(N,SX,INCX)
  12. *
  13. * .. Scalar Arguments ..
  14. * INTEGER INCX,N
  15. * ..
  16. * .. Array Arguments ..
  17. * REAL SX(*)
  18. * ..
  19. *
  20. *
  21. *> \par Purpose:
  22. * =============
  23. *>
  24. *> \verbatim
  25. *>
  26. *> SASUM takes the sum of the absolute values.
  27. *> uses unrolled loops for increment equal to one.
  28. *> \endverbatim
  29. *
  30. * Arguments:
  31. * ==========
  32. *
  33. *> \param[in] N
  34. *> \verbatim
  35. *> N is INTEGER
  36. *> number of elements in input vector(s)
  37. *> \endverbatim
  38. *>
  39. *> \param[in] SX
  40. *> \verbatim
  41. *> SX is REAL array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
  42. *> \endverbatim
  43. *>
  44. *> \param[in] INCX
  45. *> \verbatim
  46. *> INCX is INTEGER
  47. *> storage spacing between elements of SX
  48. *> \endverbatim
  49. *
  50. * Authors:
  51. * ========
  52. *
  53. *> \author Univ. of Tennessee
  54. *> \author Univ. of California Berkeley
  55. *> \author Univ. of Colorado Denver
  56. *> \author NAG Ltd.
  57. *
  58. *> \date November 2017
  59. *
  60. *> \ingroup single_blas_level1
  61. *
  62. *> \par Further Details:
  63. * =====================
  64. *>
  65. *> \verbatim
  66. *>
  67. *> jack dongarra, linpack, 3/11/78.
  68. *> modified 3/93 to return if incx .le. 0.
  69. *> modified 12/3/93, array(1) declarations changed to array(*)
  70. *> \endverbatim
  71. *>
  72. * =====================================================================
  73. REAL FUNCTION SASUM(N,SX,INCX)
  74. *
  75. * -- Reference BLAS level1 routine (version 3.8.0) --
  76. * -- Reference BLAS is a software package provided by Univ. of Tennessee, --
  77. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  78. * November 2017
  79. *
  80. * .. Scalar Arguments ..
  81. INTEGER INCX,N
  82. * ..
  83. * .. Array Arguments ..
  84. REAL SX(*)
  85. * ..
  86. *
  87. * =====================================================================
  88. *
  89. * .. Local Scalars ..
  90. REAL STEMP
  91. INTEGER I,M,MP1,NINCX
  92. * ..
  93. * .. Intrinsic Functions ..
  94. INTRINSIC ABS,MOD
  95. * ..
  96. SASUM = 0.0e0
  97. STEMP = 0.0e0
  98. IF (N.LE.0 .OR. INCX.LE.0) RETURN
  99. IF (INCX.EQ.1) THEN
  100. * code for increment equal to 1
  101. *
  102. *
  103. * clean-up loop
  104. *
  105. M = MOD(N,6)
  106. IF (M.NE.0) THEN
  107. DO I = 1,M
  108. STEMP = STEMP + ABS(SX(I))
  109. END DO
  110. IF (N.LT.6) THEN
  111. SASUM = STEMP
  112. RETURN
  113. END IF
  114. END IF
  115. MP1 = M + 1
  116. DO I = MP1,N,6
  117. STEMP = STEMP + ABS(SX(I)) + ABS(SX(I+1)) +
  118. $ ABS(SX(I+2)) + ABS(SX(I+3)) +
  119. $ ABS(SX(I+4)) + ABS(SX(I+5))
  120. END DO
  121. ELSE
  122. *
  123. * code for increment not equal to 1
  124. *
  125. NINCX = N*INCX
  126. DO I = 1,NINCX,INCX
  127. STEMP = STEMP + ABS(SX(I))
  128. END DO
  129. END IF
  130. SASUM = STEMP
  131. RETURN
  132. END