Mercurial > hg > qm-dsp
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_ */ |