comparison ext/cblas/src/ddot.c @ 430:335af74a25b6

Merge from branch clapack-included
author Chris Cannam <c.cannam@qmul.ac.uk>
date Fri, 30 Sep 2016 16:24:24 +0100
parents 905e45637745
children
comparison
equal deleted inserted replaced
426:a23b9f8b4a59 430:335af74a25b6
1 /* ddot.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
10 http://www.netlib.org/f2c/libf2c.zip
11 */
12
13 #include "f2c.h"
14 #include "blaswrap.h"
15
16 doublereal ddot_(integer *n, doublereal *dx, integer *incx, doublereal *dy,
17 integer *incy)
18 {
19 /* System generated locals */
20 integer i__1;
21 doublereal ret_val;
22
23 /* Local variables */
24 integer i__, m, ix, iy, mp1;
25 doublereal dtemp;
26
27 /* .. Scalar Arguments .. */
28 /* .. */
29 /* .. Array Arguments .. */
30 /* .. */
31
32 /* Purpose */
33 /* ======= */
34
35 /* forms the dot product of two vectors. */
36 /* uses unrolled loops for increments equal to one. */
37 /* jack dongarra, linpack, 3/11/78. */
38 /* modified 12/3/93, array(1) declarations changed to array(*) */
39
40
41 /* .. Local Scalars .. */
42 /* .. */
43 /* .. Intrinsic Functions .. */
44 /* .. */
45 /* Parameter adjustments */
46 --dy;
47 --dx;
48
49 /* Function Body */
50 ret_val = 0.;
51 dtemp = 0.;
52 if (*n <= 0) {
53 return ret_val;
54 }
55 if (*incx == 1 && *incy == 1) {
56 goto L20;
57 }
58
59 /* code for unequal increments or equal increments */
60 /* not equal to 1 */
61
62 ix = 1;
63 iy = 1;
64 if (*incx < 0) {
65 ix = (-(*n) + 1) * *incx + 1;
66 }
67 if (*incy < 0) {
68 iy = (-(*n) + 1) * *incy + 1;
69 }
70 i__1 = *n;
71 for (i__ = 1; i__ <= i__1; ++i__) {
72 dtemp += dx[ix] * dy[iy];
73 ix += *incx;
74 iy += *incy;
75 /* L10: */
76 }
77 ret_val = dtemp;
78 return ret_val;
79
80 /* code for both increments equal to 1 */
81
82
83 /* clean-up loop */
84
85 L20:
86 m = *n % 5;
87 if (m == 0) {
88 goto L40;
89 }
90 i__1 = m;
91 for (i__ = 1; i__ <= i__1; ++i__) {
92 dtemp += dx[i__] * dy[i__];
93 /* L30: */
94 }
95 if (*n < 5) {
96 goto L60;
97 }
98 L40:
99 mp1 = m + 1;
100 i__1 = *n;
101 for (i__ = mp1; i__ <= i__1; i__ += 5) {
102 dtemp = dtemp + dx[i__] * dy[i__] + dx[i__ + 1] * dy[i__ + 1] + dx[
103 i__ + 2] * dy[i__ + 2] + dx[i__ + 3] * dy[i__ + 3] + dx[i__ +
104 4] * dy[i__ + 4];
105 /* L50: */
106 }
107 L60:
108 ret_val = dtemp;
109 return ret_val;
110 } /* ddot_ */