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.

sdsdot.f 4.2 kB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163
  1. *> \brief \b SDSDOT
  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 SDSDOT(N,SB,SX,INCX,SY,INCY)
  12. *
  13. * .. Scalar Arguments ..
  14. * REAL SB
  15. * INTEGER INCX,INCY,N
  16. * ..
  17. * .. Array Arguments ..
  18. * REAL SX(*),SY(*)
  19. * ..
  20. *
  21. *> \par Purpose:
  22. * =============
  23. *>
  24. *> \verbatim
  25. *>
  26. *> Compute the inner product of two vectors with extended
  27. *> precision accumulation.
  28. *>
  29. *> Returns S.P. result with dot product accumulated in D.P.
  30. *> SDSDOT = SB + sum for I = 0 to N-1 of SX(LX+I*INCX)*SY(LY+I*INCY),
  31. *> where LX = 1 if INCX .GE. 0, else LX = 1+(1-N)*INCX, and LY is
  32. *> defined in a similar way using INCY.
  33. *> \endverbatim
  34. *
  35. * Arguments:
  36. * ==========
  37. *
  38. *> \param[in] N
  39. *> \verbatim
  40. *> N is INTEGER
  41. *> number of elements in input vector(s)
  42. *> \endverbatim
  43. *>
  44. *> \param[in] SB
  45. *> \verbatim
  46. *> SB is REAL
  47. *> single precision scalar to be added to inner product
  48. *> \endverbatim
  49. *>
  50. *> \param[in] SX
  51. *> \verbatim
  52. *> SX is REAL array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
  53. *> single precision vector with N elements
  54. *> \endverbatim
  55. *>
  56. *> \param[in] INCX
  57. *> \verbatim
  58. *> INCX is INTEGER
  59. *> storage spacing between elements of SX
  60. *> \endverbatim
  61. *>
  62. *> \param[in] SY
  63. *> \verbatim
  64. *> SY is REAL array, dimension ( 1 + ( N - 1 )*abs( INCX ) )
  65. *> single precision vector with N elements
  66. *> \endverbatim
  67. *>
  68. *> \param[in] INCY
  69. *> \verbatim
  70. *> INCY is INTEGER
  71. *> storage spacing between elements of SY
  72. *> \endverbatim
  73. *
  74. * Authors:
  75. * ========
  76. *
  77. *> \author Lawson, C. L., (JPL), Hanson, R. J., (SNLA),
  78. *> \author Kincaid, D. R., (U. of Texas), Krogh, F. T., (JPL)
  79. *
  80. *> \author Univ. of Tennessee
  81. *> \author Univ. of California Berkeley
  82. *> \author Univ. of Colorado Denver
  83. *> \author NAG Ltd.
  84. *
  85. *> \date November 2017
  86. *
  87. *> \ingroup single_blas_level1
  88. *
  89. *> \par Further Details:
  90. * =====================
  91. *>
  92. *> \verbatim
  93. *>
  94. *> REFERENCES
  95. *>
  96. *> C. L. Lawson, R. J. Hanson, D. R. Kincaid and F. T.
  97. *> Krogh, Basic linear algebra subprograms for Fortran
  98. *> usage, Algorithm No. 539, Transactions on Mathematical
  99. *> Software 5, 3 (September 1979), pp. 308-323.
  100. *>
  101. *> REVISION HISTORY (YYMMDD)
  102. *>
  103. *> 791001 DATE WRITTEN
  104. *> 890531 Changed all specific intrinsics to generic. (WRB)
  105. *> 890831 Modified array declarations. (WRB)
  106. *> 890831 REVISION DATE from Version 3.2
  107. *> 891214 Prologue converted to Version 4.0 format. (BAB)
  108. *> 920310 Corrected definition of LX in DESCRIPTION. (WRB)
  109. *> 920501 Reformatted the REFERENCES section. (WRB)
  110. *> 070118 Reformat to LAPACK coding style
  111. *> \endverbatim
  112. *>
  113. * =====================================================================
  114. REAL FUNCTION SDSDOT(N,SB,SX,INCX,SY,INCY)
  115. *
  116. * -- Reference BLAS level1 routine (version 3.8.0) --
  117. * -- Reference BLAS is a software package provided by Univ. of Tennessee, --
  118. * -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..--
  119. * November 2017
  120. *
  121. * .. Scalar Arguments ..
  122. REAL SB
  123. INTEGER INCX,INCY,N
  124. * ..
  125. * .. Array Arguments ..
  126. REAL SX(*),SY(*)
  127. * .. Local Scalars ..
  128. DOUBLE PRECISION DSDOT
  129. INTEGER I,KX,KY,NS
  130. * ..
  131. * .. Intrinsic Functions ..
  132. INTRINSIC DBLE
  133. * ..
  134. DSDOT = SB
  135. IF (N.LE.0) THEN
  136. SDSDOT = DSDOT
  137. RETURN
  138. END IF
  139. IF (INCX.EQ.INCY .AND. INCX.GT.0) THEN
  140. *
  141. * Code for equal and positive increments.
  142. *
  143. NS = N*INCX
  144. DO I = 1,NS,INCX
  145. DSDOT = DSDOT + DBLE(SX(I))*DBLE(SY(I))
  146. END DO
  147. ELSE
  148. *
  149. * Code for unequal or nonpositive increments.
  150. *
  151. KX = 1
  152. KY = 1
  153. IF (INCX.LT.0) KX = 1 + (1-N)*INCX
  154. IF (INCY.LT.0) KY = 1 + (1-N)*INCY
  155. DO I = 1,N
  156. DSDOT = DSDOT + DBLE(SX(KX))*DBLE(SY(KY))
  157. KX = KX + INCX
  158. KY = KY + INCY
  159. END DO
  160. END IF
  161. SDSDOT = DSDOT
  162. RETURN
  163. END