zdotc.c
Go to the documentation of this file.
00001 /* zdotc.f -- translated by f2c (version 20061008).
00002    You must link the resulting object file with libf2c:
00003         on Microsoft Windows system, link with libf2c.lib;
00004         on Linux or Unix systems, link with .../path/to/libf2c.a -lm
00005         or, if you install libf2c.a in a standard place, with -lf2c -lm
00006         -- in that order, at the end of the command line, as in
00007                 cc *.o -lf2c -lm
00008         Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
00009 
00010                 http://www.netlib.org/f2c/libf2c.zip
00011 */
00012 
00013 #include "f2c.h"
00014 #include "blaswrap.h"
00015 
00016 /* Double Complex */ VOID zdotc_(doublecomplex * ret_val, integer *n, 
00017         doublecomplex *zx, integer *incx, doublecomplex *zy, integer *incy)
00018 {
00019     /* System generated locals */
00020     integer i__1, i__2;
00021     doublecomplex z__1, z__2, z__3;
00022 
00023     /* Builtin functions */
00024     void d_cnjg(doublecomplex *, doublecomplex *);
00025 
00026     /* Local variables */
00027     integer i__, ix, iy;
00028     doublecomplex ztemp;
00029 
00030 /*     .. Scalar Arguments .. */
00031 /*     .. */
00032 /*     .. Array Arguments .. */
00033 /*     .. */
00034 
00035 /*  Purpose */
00036 /*  ======= */
00037 
00038 /*  ZDOTC forms the dot product of a vector. */
00039 
00040 /*  Further Details */
00041 /*  =============== */
00042 
00043 /*     jack dongarra, 3/11/78. */
00044 /*     modified 12/3/93, array(1) declarations changed to array(*) */
00045 
00046 /*     .. Local Scalars .. */
00047 /*     .. */
00048 /*     .. Intrinsic Functions .. */
00049 /*     .. */
00050     /* Parameter adjustments */
00051     --zy;
00052     --zx;
00053 
00054     /* Function Body */
00055     ztemp.r = 0., ztemp.i = 0.;
00056      ret_val->r = 0.,  ret_val->i = 0.;
00057     if (*n <= 0) {
00058         return ;
00059     }
00060     if (*incx == 1 && *incy == 1) {
00061         goto L20;
00062     }
00063 
00064 /*        code for unequal increments or equal increments */
00065 /*          not equal to 1 */
00066 
00067     ix = 1;
00068     iy = 1;
00069     if (*incx < 0) {
00070         ix = (-(*n) + 1) * *incx + 1;
00071     }
00072     if (*incy < 0) {
00073         iy = (-(*n) + 1) * *incy + 1;
00074     }
00075     i__1 = *n;
00076     for (i__ = 1; i__ <= i__1; ++i__) {
00077         d_cnjg(&z__3, &zx[ix]);
00078         i__2 = iy;
00079         z__2.r = z__3.r * zy[i__2].r - z__3.i * zy[i__2].i, z__2.i = z__3.r * 
00080                 zy[i__2].i + z__3.i * zy[i__2].r;
00081         z__1.r = ztemp.r + z__2.r, z__1.i = ztemp.i + z__2.i;
00082         ztemp.r = z__1.r, ztemp.i = z__1.i;
00083         ix += *incx;
00084         iy += *incy;
00085 /* L10: */
00086     }
00087      ret_val->r = ztemp.r,  ret_val->i = ztemp.i;
00088     return ;
00089 
00090 /*        code for both increments equal to 1 */
00091 
00092 L20:
00093     i__1 = *n;
00094     for (i__ = 1; i__ <= i__1; ++i__) {
00095         d_cnjg(&z__3, &zx[i__]);
00096         i__2 = i__;
00097         z__2.r = z__3.r * zy[i__2].r - z__3.i * zy[i__2].i, z__2.i = z__3.r * 
00098                 zy[i__2].i + z__3.i * zy[i__2].r;
00099         z__1.r = ztemp.r + z__2.r, z__1.i = ztemp.i + z__2.i;
00100         ztemp.r = z__1.r, ztemp.i = z__1.i;
00101 /* L30: */
00102     }
00103      ret_val->r = ztemp.r,  ret_val->i = ztemp.i;
00104     return ;
00105 } /* zdotc_ */


swiftnav
Author(s):
autogenerated on Sat Jun 8 2019 18:56:21