sdsdot.c 3.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144
  1. /* sdsdot.f -- translated by f2c (version 20061008).
  2. You must link the resulting object file with libf2c:
  3. on Microsoft Windows system, link with libf2c.lib;
  4. on Linux or Unix systems, link with .../path/to/libf2c.a -lm
  5. or, if you install libf2c.a in a standard place, with -lf2c -lm
  6. -- in that order, at the end of the command line, as in
  7. cc *.o -lf2c -lm
  8. Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
  9. http://www.netlib.org/f2c/libf2c.zip
  10. */
  11. #include "f2c.h"
  12. #include "blaswrap.h"
  13. doublereal sdsdot_(integer *n, real *sb, real *sx, integer *incx, real *sy,
  14. integer *incy)
  15. {
  16. /* System generated locals */
  17. integer i__1, i__2;
  18. real ret_val;
  19. /* Local variables */
  20. integer i__, ns, kx, ky;
  21. doublereal dsdot;
  22. /* .. Scalar Arguments .. */
  23. /* .. */
  24. /* .. Array Arguments .. */
  25. /* .. */
  26. /* PURPOSE */
  27. /* ======= */
  28. /* Compute the inner product of two vectors with extended */
  29. /* precision accumulation. */
  30. /* Returns S.P. result with dot product accumulated in D.P. */
  31. /* SDSDOT = SB + sum for I = 0 to N-1 of SX(LX+I*INCX)*SY(LY+I*INCY), */
  32. /* where LX = 1 if INCX .GE. 0, else LX = 1+(1-N)*INCX, and LY is */
  33. /* defined in a similar way using INCY. */
  34. /* AUTHOR */
  35. /* ====== */
  36. /* Lawson, C. L., (JPL), Hanson, R. J., (SNLA), */
  37. /* Kincaid, D. R., (U. of Texas), Krogh, F. T., (JPL) */
  38. /* ARGUMENTS */
  39. /* ========= */
  40. /* N (input) INTEGER */
  41. /* number of elements in input vector(s) */
  42. /* SB (input) REAL */
  43. /* single precision scalar to be added to inner product */
  44. /* SX (input) REAL array, dimension (N) */
  45. /* single precision vector with N elements */
  46. /* INCX (input) INTEGER */
  47. /* storage spacing between elements of SX */
  48. /* SY (input) REAL array, dimension (N) */
  49. /* single precision vector with N elements */
  50. /* INCY (input) INTEGER */
  51. /* storage spacing between elements of SY */
  52. /* SDSDOT (output) REAL */
  53. /* single precision dot product (SB if N .LE. 0) */
  54. /* REFERENCES */
  55. /* ========== */
  56. /* C. L. Lawson, R. J. Hanson, D. R. Kincaid and F. T. */
  57. /* Krogh, Basic linear algebra subprograms for Fortran */
  58. /* usage, Algorithm No. 539, Transactions on Mathematical */
  59. /* Software 5, 3 (September 1979), pp. 308-323. */
  60. /* REVISION HISTORY (YYMMDD) */
  61. /* ========================== */
  62. /* 791001 DATE WRITTEN */
  63. /* 890531 Changed all specific intrinsics to generic. (WRB) */
  64. /* 890831 Modified array declarations. (WRB) */
  65. /* 890831 REVISION DATE from Version 3.2 */
  66. /* 891214 Prologue converted to Version 4.0 format. (BAB) */
  67. /* 920310 Corrected definition of LX in DESCRIPTION. (WRB) */
  68. /* 920501 Reformatted the REFERENCES section. (WRB) */
  69. /* 070118 Reformat to LAPACK coding style */
  70. /* ===================================================================== */
  71. /* .. Local Scalars .. */
  72. /* .. */
  73. /* .. Intrinsic Functions .. */
  74. /* .. */
  75. /* Parameter adjustments */
  76. --sy;
  77. --sx;
  78. /* Function Body */
  79. dsdot = *sb;
  80. if (*n <= 0) {
  81. goto L30;
  82. }
  83. if (*incx == *incy && *incx > 0) {
  84. goto L40;
  85. }
  86. /* Code for unequal or nonpositive increments. */
  87. kx = 1;
  88. ky = 1;
  89. if (*incx < 0) {
  90. kx = (1 - *n) * *incx + 1;
  91. }
  92. if (*incy < 0) {
  93. ky = (1 - *n) * *incy + 1;
  94. }
  95. i__1 = *n;
  96. for (i__ = 1; i__ <= i__1; ++i__) {
  97. dsdot += (doublereal) sx[kx] * (doublereal) sy[ky];
  98. kx += *incx;
  99. ky += *incy;
  100. /* L10: */
  101. }
  102. L30:
  103. ret_val = dsdot;
  104. return ret_val;
  105. /* Code for equal and positive increments. */
  106. L40:
  107. ns = *n * *incx;
  108. i__1 = ns;
  109. i__2 = *incx;
  110. for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
  111. dsdot += (doublereal) sx[i__] * (doublereal) sy[i__];
  112. /* L50: */
  113. }
  114. ret_val = dsdot;
  115. return ret_val;
  116. } /* sdsdot_ */