sdot.f 2.8 KB

1234567891011121314151617181920212223242526272829303132333435363738394041424344454647484950515253545556575859606162636465666768697071727374757677787980818283848586878889
  1. *DECK SDOT
  2. REAL FUNCTION SDOT (N, SX, INCX, SY, INCY)
  3. C***BEGIN PROLOGUE SDOT
  4. C***PURPOSE Compute the inner product of two vectors.
  5. C***LIBRARY SLATEC (BLAS)
  6. C***CATEGORY D1A4
  7. C***TYPE SINGLE PRECISION (SDOT-S, DDOT-D, CDOTU-C)
  8. C***KEYWORDS BLAS, INNER PRODUCT, LINEAR ALGEBRA, VECTOR
  9. C***AUTHOR Lawson, C. L., (JPL)
  10. C Hanson, R. J., (SNLA)
  11. C Kincaid, D. R., (U. of Texas)
  12. C Krogh, F. T., (JPL)
  13. C***DESCRIPTION
  14. C
  15. C B L A S Subprogram
  16. C Description of Parameters
  17. C
  18. C --Input--
  19. C N number of elements in input vector(s)
  20. C SX single precision vector with N elements
  21. C INCX storage spacing between elements of SX
  22. C SY single precision vector with N elements
  23. C INCY storage spacing between elements of SY
  24. C
  25. C --Output--
  26. C SDOT single precision dot product (zero if N .LE. 0)
  27. C
  28. C Returns the dot product of single precision SX and SY.
  29. C SDOT = sum for I = 0 to N-1 of SX(LX+I*INCX) * SY(LY+I*INCY),
  30. C where LX = 1 if INCX .GE. 0, else LX = 1+(1-N)*INCX, and LY is
  31. C defined in a similar way using INCY.
  32. C
  33. C***REFERENCES C. L. Lawson, R. J. Hanson, D. R. Kincaid and F. T.
  34. C Krogh, Basic linear algebra subprograms for Fortran
  35. C usage, Algorithm No. 539, Transactions on Mathematical
  36. C Software 5, 3 (September 1979), pp. 308-323.
  37. C***ROUTINES CALLED (NONE)
  38. C***REVISION HISTORY (YYMMDD)
  39. C 791001 DATE WRITTEN
  40. C 890831 Modified array declarations. (WRB)
  41. C 890831 REVISION DATE from Version 3.2
  42. C 891214 Prologue converted to Version 4.0 format. (BAB)
  43. C 920310 Corrected definition of LX in DESCRIPTION. (WRB)
  44. C 920501 Reformatted the REFERENCES section. (WRB)
  45. C***END PROLOGUE SDOT
  46. REAL SX(*), SY(*)
  47. C***FIRST EXECUTABLE STATEMENT SDOT
  48. SDOT = 0.0E0
  49. IF (N .LE. 0) RETURN
  50. IF (INCX .EQ. INCY) IF (INCX-1) 5,20,60
  51. C
  52. C Code for unequal or nonpositive increments.
  53. C
  54. 5 IX = 1
  55. IY = 1
  56. IF (INCX .LT. 0) IX = (-N+1)*INCX + 1
  57. IF (INCY .LT. 0) IY = (-N+1)*INCY + 1
  58. DO 10 I = 1,N
  59. SDOT = SDOT + SX(IX)*SY(IY)
  60. IX = IX + INCX
  61. IY = IY + INCY
  62. 10 CONTINUE
  63. RETURN
  64. C
  65. C Code for both increments equal to 1.
  66. C
  67. C Clean-up loop so remaining vector length is a multiple of 5.
  68. C
  69. 20 M = MOD(N,5)
  70. IF (M .EQ. 0) GO TO 40
  71. DO 30 I = 1,M
  72. SDOT = SDOT + SX(I)*SY(I)
  73. 30 CONTINUE
  74. IF (N .LT. 5) RETURN
  75. 40 MP1 = M + 1
  76. DO 50 I = MP1,N,5
  77. SDOT = SDOT + SX(I)*SY(I) + SX(I+1)*SY(I+1) + SX(I+2)*SY(I+2) +
  78. 1 SX(I+3)*SY(I+3) + SX(I+4)*SY(I+4)
  79. 50 CONTINUE
  80. RETURN
  81. C
  82. C Code for equal, positive, non-unit increments.
  83. C
  84. 60 NS = N*INCX
  85. DO 70 I = 1,NS,INCX
  86. SDOT = SDOT + SX(I)*SY(I)
  87. 70 CONTINUE
  88. RETURN
  89. END