zdrot.c
Go to the documentation of this file.
00001 /* zdrot.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 /* Subroutine */ int zdrot_(integer *n, doublecomplex *cx, integer *incx, 
00017         doublecomplex *cy, integer *incy, doublereal *c__, doublereal *s)
00018 {
00019     /* System generated locals */
00020     integer i__1, i__2, i__3, i__4;
00021     doublecomplex z__1, z__2, z__3;
00022 
00023     /* Local variables */
00024     integer i__, ix, iy;
00025     doublecomplex ctemp;
00026 
00027 
00028 /*     .. Scalar Arguments .. */
00029 /*     .. */
00030 /*     .. Array Arguments .. */
00031 /*     .. */
00032 
00033 /*  Purpose */
00034 /*  ======= */
00035 
00036 /*  Applies a plane rotation, where the cos and sin (c and s) are real */
00037 /*  and the vectors cx and cy are complex. */
00038 /*  jack dongarra, linpack, 3/11/78. */
00039 
00040 /*  Arguments */
00041 /*  ========== */
00042 
00043 /*  N        (input) INTEGER */
00044 /*           On entry, N specifies the order of the vectors cx and cy. */
00045 /*           N must be at least zero. */
00046 /*           Unchanged on exit. */
00047 
00048 /*  CX       (input) COMPLEX*16 array, dimension at least */
00049 /*           ( 1 + ( N - 1 )*abs( INCX ) ). */
00050 /*           Before entry, the incremented array CX must contain the n */
00051 /*           element vector cx. On exit, CX is overwritten by the updated */
00052 /*           vector cx. */
00053 
00054 /*  INCX     (input) INTEGER */
00055 /*           On entry, INCX specifies the increment for the elements of */
00056 /*           CX. INCX must not be zero. */
00057 /*           Unchanged on exit. */
00058 
00059 /*  CY       (input) COMPLEX*16 array, dimension at least */
00060 /*           ( 1 + ( N - 1 )*abs( INCY ) ). */
00061 /*           Before entry, the incremented array CY must contain the n */
00062 /*           element vector cy. On exit, CY is overwritten by the updated */
00063 /*           vector cy. */
00064 
00065 /*  INCY     (input) INTEGER */
00066 /*           On entry, INCY specifies the increment for the elements of */
00067 /*           CY. INCY must not be zero. */
00068 /*           Unchanged on exit. */
00069 
00070 /*  C        (input) DOUBLE PRECISION */
00071 /*           On entry, C specifies the cosine, cos. */
00072 /*           Unchanged on exit. */
00073 
00074 /*  S        (input) DOUBLE PRECISION */
00075 /*           On entry, S specifies the sine, sin. */
00076 /*           Unchanged on exit. */
00077 
00078 /* ===================================================================== */
00079 
00080 /*     .. Local Scalars .. */
00081 /*     .. */
00082 /*     .. Executable Statements .. */
00083 
00084     /* Parameter adjustments */
00085     --cy;
00086     --cx;
00087 
00088     /* Function Body */
00089     if (*n <= 0) {
00090         return 0;
00091     }
00092     if (*incx == 1 && *incy == 1) {
00093         goto L20;
00094     }
00095 
00096 /*        code for unequal increments or equal increments not equal */
00097 /*          to 1 */
00098 
00099     ix = 1;
00100     iy = 1;
00101     if (*incx < 0) {
00102         ix = (-(*n) + 1) * *incx + 1;
00103     }
00104     if (*incy < 0) {
00105         iy = (-(*n) + 1) * *incy + 1;
00106     }
00107     i__1 = *n;
00108     for (i__ = 1; i__ <= i__1; ++i__) {
00109         i__2 = ix;
00110         z__2.r = *c__ * cx[i__2].r, z__2.i = *c__ * cx[i__2].i;
00111         i__3 = iy;
00112         z__3.r = *s * cy[i__3].r, z__3.i = *s * cy[i__3].i;
00113         z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
00114         ctemp.r = z__1.r, ctemp.i = z__1.i;
00115         i__2 = iy;
00116         i__3 = iy;
00117         z__2.r = *c__ * cy[i__3].r, z__2.i = *c__ * cy[i__3].i;
00118         i__4 = ix;
00119         z__3.r = *s * cx[i__4].r, z__3.i = *s * cx[i__4].i;
00120         z__1.r = z__2.r - z__3.r, z__1.i = z__2.i - z__3.i;
00121         cy[i__2].r = z__1.r, cy[i__2].i = z__1.i;
00122         i__2 = ix;
00123         cx[i__2].r = ctemp.r, cx[i__2].i = ctemp.i;
00124         ix += *incx;
00125         iy += *incy;
00126 /* L10: */
00127     }
00128     return 0;
00129 
00130 /*        code for both increments equal to 1 */
00131 
00132 L20:
00133     i__1 = *n;
00134     for (i__ = 1; i__ <= i__1; ++i__) {
00135         i__2 = i__;
00136         z__2.r = *c__ * cx[i__2].r, z__2.i = *c__ * cx[i__2].i;
00137         i__3 = i__;
00138         z__3.r = *s * cy[i__3].r, z__3.i = *s * cy[i__3].i;
00139         z__1.r = z__2.r + z__3.r, z__1.i = z__2.i + z__3.i;
00140         ctemp.r = z__1.r, ctemp.i = z__1.i;
00141         i__2 = i__;
00142         i__3 = i__;
00143         z__2.r = *c__ * cy[i__3].r, z__2.i = *c__ * cy[i__3].i;
00144         i__4 = i__;
00145         z__3.r = *s * cx[i__4].r, z__3.i = *s * cx[i__4].i;
00146         z__1.r = z__2.r - z__3.r, z__1.i = z__2.i - z__3.i;
00147         cy[i__2].r = z__1.r, cy[i__2].i = z__1.i;
00148         i__2 = i__;
00149         cx[i__2].r = ctemp.r, cx[i__2].i = ctemp.i;
00150 /* L30: */
00151     }
00152     return 0;
00153 } /* zdrot_ */


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