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.

dasum.f 3.0 kB

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