annotate ext/cblas/src/ddot.c @ 482:cbe668c7d724

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