annotate ext/cblas/src/ddot.c @ 209:ccd2019190bf msvc

Some MSVC fixes, including (temporarily, probably) renaming the FFT source file to avoid getting it mixed up with the Vamp SDK one in our object dir
author Chris Cannam
date Thu, 01 Feb 2018 16:34:08 +0000
parents 45330e0d2819
children
rev   line source
Chris@202 1 /* ddot.f -- translated by f2c (version 20061008).
Chris@202 2 You must link the resulting object file with libf2c:
Chris@202 3 on Microsoft Windows system, link with libf2c.lib;
Chris@202 4 on Linux or Unix systems, link with .../path/to/libf2c.a -lm
Chris@202 5 or, if you install libf2c.a in a standard place, with -lf2c -lm
Chris@202 6 -- in that order, at the end of the command line, as in
Chris@202 7 cc *.o -lf2c -lm
Chris@202 8 Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
Chris@202 9
Chris@202 10 http://www.netlib.org/f2c/libf2c.zip
Chris@202 11 */
Chris@202 12
Chris@202 13 #include "f2c.h"
Chris@202 14 #include "blaswrap.h"
Chris@202 15
Chris@202 16 doublereal ddot_(integer *n, doublereal *dx, integer *incx, doublereal *dy,
Chris@202 17 integer *incy)
Chris@202 18 {
Chris@202 19 /* System generated locals */
Chris@202 20 integer i__1;
Chris@202 21 doublereal ret_val;
Chris@202 22
Chris@202 23 /* Local variables */
Chris@202 24 integer i__, m, ix, iy, mp1;
Chris@202 25 doublereal dtemp;
Chris@202 26
Chris@202 27 /* .. Scalar Arguments .. */
Chris@202 28 /* .. */
Chris@202 29 /* .. Array Arguments .. */
Chris@202 30 /* .. */
Chris@202 31
Chris@202 32 /* Purpose */
Chris@202 33 /* ======= */
Chris@202 34
Chris@202 35 /* forms the dot product of two vectors. */
Chris@202 36 /* uses unrolled loops for increments equal to one. */
Chris@202 37 /* jack dongarra, linpack, 3/11/78. */
Chris@202 38 /* modified 12/3/93, array(1) declarations changed to array(*) */
Chris@202 39
Chris@202 40
Chris@202 41 /* .. Local Scalars .. */
Chris@202 42 /* .. */
Chris@202 43 /* .. Intrinsic Functions .. */
Chris@202 44 /* .. */
Chris@202 45 /* Parameter adjustments */
Chris@202 46 --dy;
Chris@202 47 --dx;
Chris@202 48
Chris@202 49 /* Function Body */
Chris@202 50 ret_val = 0.;
Chris@202 51 dtemp = 0.;
Chris@202 52 if (*n <= 0) {
Chris@202 53 return ret_val;
Chris@202 54 }
Chris@202 55 if (*incx == 1 && *incy == 1) {
Chris@202 56 goto L20;
Chris@202 57 }
Chris@202 58
Chris@202 59 /* code for unequal increments or equal increments */
Chris@202 60 /* not equal to 1 */
Chris@202 61
Chris@202 62 ix = 1;
Chris@202 63 iy = 1;
Chris@202 64 if (*incx < 0) {
Chris@202 65 ix = (-(*n) + 1) * *incx + 1;
Chris@202 66 }
Chris@202 67 if (*incy < 0) {
Chris@202 68 iy = (-(*n) + 1) * *incy + 1;
Chris@202 69 }
Chris@202 70 i__1 = *n;
Chris@202 71 for (i__ = 1; i__ <= i__1; ++i__) {
Chris@202 72 dtemp += dx[ix] * dy[iy];
Chris@202 73 ix += *incx;
Chris@202 74 iy += *incy;
Chris@202 75 /* L10: */
Chris@202 76 }
Chris@202 77 ret_val = dtemp;
Chris@202 78 return ret_val;
Chris@202 79
Chris@202 80 /* code for both increments equal to 1 */
Chris@202 81
Chris@202 82
Chris@202 83 /* clean-up loop */
Chris@202 84
Chris@202 85 L20:
Chris@202 86 m = *n % 5;
Chris@202 87 if (m == 0) {
Chris@202 88 goto L40;
Chris@202 89 }
Chris@202 90 i__1 = m;
Chris@202 91 for (i__ = 1; i__ <= i__1; ++i__) {
Chris@202 92 dtemp += dx[i__] * dy[i__];
Chris@202 93 /* L30: */
Chris@202 94 }
Chris@202 95 if (*n < 5) {
Chris@202 96 goto L60;
Chris@202 97 }
Chris@202 98 L40:
Chris@202 99 mp1 = m + 1;
Chris@202 100 i__1 = *n;
Chris@202 101 for (i__ = mp1; i__ <= i__1; i__ += 5) {
Chris@202 102 dtemp = dtemp + dx[i__] * dy[i__] + dx[i__ + 1] * dy[i__ + 1] + dx[
Chris@202 103 i__ + 2] * dy[i__ + 2] + dx[i__ + 3] * dy[i__ + 3] + dx[i__ +
Chris@202 104 4] * dy[i__ + 4];
Chris@202 105 /* L50: */
Chris@202 106 }
Chris@202 107 L60:
Chris@202 108 ret_val = dtemp;
Chris@202 109 return ret_val;
Chris@202 110 } /* ddot_ */