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_ */
|