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.

scasum.f 2.2 kB

12345678910111213141516171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576777879808182838485868788899091929394959697
  1. *> \brief \b SCASUM
  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 SCASUM(N,CX,INCX)
  12. *
  13. * .. Scalar Arguments ..
  14. * INTEGER INCX,N
  15. * ..
  16. * .. Array Arguments ..
  17. * COMPLEX CX(*)
  18. * ..
  19. *
  20. *
  21. *> \par Purpose:
  22. * =============
  23. *>
  24. *> \verbatim
  25. *>
  26. *> SCASUM takes the sum of the (|Re(.)| + |Im(.)|)'s of a complex vector and
  27. *> returns a single precision result.
  28. *> \endverbatim
  29. *
  30. * Authors:
  31. * ========
  32. *
  33. *> \author Univ. of Tennessee
  34. *> \author Univ. of California Berkeley
  35. *> \author Univ. of Colorado Denver
  36. *> \author NAG Ltd.
  37. *
  38. *> \date November 2015
  39. *
  40. *> \ingroup single_blas_level1
  41. *
  42. *> \par Further Details:
  43. * =====================
  44. *>
  45. *> \verbatim
  46. *>
  47. *> jack dongarra, linpack, 3/11/78.
  48. *> modified 3/93 to return if incx .le. 0.
  49. *> modified 12/3/93, array(1) declarations changed to array(*)
  50. *> \endverbatim
  51. *>
  52. * =====================================================================
  53. REAL FUNCTION SCASUM(N,CX,INCX)
  54. *
  55. * -- Reference BLAS level1 routine (version 3.6.0) --
  56. * -- Reference BLAS is a software package provided by Univ. of Tennessee, --
  57. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  58. * November 2015
  59. *
  60. * .. Scalar Arguments ..
  61. INTEGER INCX,N
  62. * ..
  63. * .. Array Arguments ..
  64. COMPLEX CX(*)
  65. * ..
  66. *
  67. * =====================================================================
  68. *
  69. * .. Local Scalars ..
  70. REAL STEMP
  71. INTEGER I,NINCX
  72. * ..
  73. * .. Intrinsic Functions ..
  74. INTRINSIC ABS,AIMAG,REAL
  75. * ..
  76. SCASUM = 0.0e0
  77. STEMP = 0.0e0
  78. IF (N.LE.0 .OR. INCX.LE.0) RETURN
  79. IF (INCX.EQ.1) THEN
  80. *
  81. * code for increment equal to 1
  82. *
  83. DO I = 1,N
  84. STEMP = STEMP + ABS(REAL(CX(I))) + ABS(AIMAG(CX(I)))
  85. END DO
  86. ELSE
  87. *
  88. * code for increment not equal to 1
  89. *
  90. NINCX = N*INCX
  91. DO I = 1,NINCX,INCX
  92. STEMP = STEMP + ABS(REAL(CX(I))) + ABS(AIMAG(CX(I)))
  93. END DO
  94. END IF
  95. SCASUM = STEMP
  96. RETURN
  97. END