3rdparty/lapack/ddot.c

   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 "clapack.h"
  14
  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_ */