crot.c
Go to the documentation of this file.
00001 /* crot.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 crot_(integer *n, complex *cx, integer *incx, complex *
00017         cy, integer *incy, real *c__, complex *s)
00018 {
00019     /* System generated locals */
00020     integer i__1, i__2, i__3, i__4;
00021     complex q__1, q__2, q__3, q__4;
00022 
00023     /* Builtin functions */
00024     void r_cnjg(complex *, complex *);
00025 
00026     /* Local variables */
00027     integer i__, ix, iy;
00028     complex stemp;
00029 
00030 
00031 /*  -- LAPACK auxiliary routine (version 3.2) -- */
00032 /*     Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
00033 /*     November 2006 */
00034 
00035 /*     .. Scalar Arguments .. */
00036 /*     .. */
00037 /*     .. Array Arguments .. */
00038 /*     .. */
00039 
00040 /*  Purpose */
00041 /*  ======= */
00042 
00043 /*  CROT   applies a plane rotation, where the cos (C) is real and the */
00044 /*  sin (S) is complex, and the vectors CX and CY are complex. */
00045 
00046 /*  Arguments */
00047 /*  ========= */
00048 
00049 /*  N       (input) INTEGER */
00050 /*          The number of elements in the vectors CX and CY. */
00051 
00052 /*  CX      (input/output) COMPLEX array, dimension (N) */
00053 /*          On input, the vector X. */
00054 /*          On output, CX is overwritten with C*X + S*Y. */
00055 
00056 /*  INCX    (input) INTEGER */
00057 /*          The increment between successive values of CY.  INCX <> 0. */
00058 
00059 /*  CY      (input/output) COMPLEX array, dimension (N) */
00060 /*          On input, the vector Y. */
00061 /*          On output, CY is overwritten with -CONJG(S)*X + C*Y. */
00062 
00063 /*  INCY    (input) INTEGER */
00064 /*          The increment between successive values of CY.  INCX <> 0. */
00065 
00066 /*  C       (input) REAL */
00067 /*  S       (input) COMPLEX */
00068 /*          C and S define a rotation */
00069 /*             [  C          S  ] */
00070 /*             [ -conjg(S)   C  ] */
00071 /*          where C*C + S*CONJG(S) = 1.0. */
00072 
00073 /* ===================================================================== */
00074 
00075 /*     .. Local Scalars .. */
00076 /*     .. */
00077 /*     .. Intrinsic Functions .. */
00078 /*     .. */
00079 /*     .. Executable Statements .. */
00080 
00081     /* Parameter adjustments */
00082     --cy;
00083     --cx;
00084 
00085     /* Function Body */
00086     if (*n <= 0) {
00087         return 0;
00088     }
00089     if (*incx == 1 && *incy == 1) {
00090         goto L20;
00091     }
00092 
00093 /*     Code for unequal increments or equal increments not equal to 1 */
00094 
00095     ix = 1;
00096     iy = 1;
00097     if (*incx < 0) {
00098         ix = (-(*n) + 1) * *incx + 1;
00099     }
00100     if (*incy < 0) {
00101         iy = (-(*n) + 1) * *incy + 1;
00102     }
00103     i__1 = *n;
00104     for (i__ = 1; i__ <= i__1; ++i__) {
00105         i__2 = ix;
00106         q__2.r = *c__ * cx[i__2].r, q__2.i = *c__ * cx[i__2].i;
00107         i__3 = iy;
00108         q__3.r = s->r * cy[i__3].r - s->i * cy[i__3].i, q__3.i = s->r * cy[
00109                 i__3].i + s->i * cy[i__3].r;
00110         q__1.r = q__2.r + q__3.r, q__1.i = q__2.i + q__3.i;
00111         stemp.r = q__1.r, stemp.i = q__1.i;
00112         i__2 = iy;
00113         i__3 = iy;
00114         q__2.r = *c__ * cy[i__3].r, q__2.i = *c__ * cy[i__3].i;
00115         r_cnjg(&q__4, s);
00116         i__4 = ix;
00117         q__3.r = q__4.r * cx[i__4].r - q__4.i * cx[i__4].i, q__3.i = q__4.r * 
00118                 cx[i__4].i + q__4.i * cx[i__4].r;
00119         q__1.r = q__2.r - q__3.r, q__1.i = q__2.i - q__3.i;
00120         cy[i__2].r = q__1.r, cy[i__2].i = q__1.i;
00121         i__2 = ix;
00122         cx[i__2].r = stemp.r, cx[i__2].i = stemp.i;
00123         ix += *incx;
00124         iy += *incy;
00125 /* L10: */
00126     }
00127     return 0;
00128 
00129 /*     Code for both increments equal to 1 */
00130 
00131 L20:
00132     i__1 = *n;
00133     for (i__ = 1; i__ <= i__1; ++i__) {
00134         i__2 = i__;
00135         q__2.r = *c__ * cx[i__2].r, q__2.i = *c__ * cx[i__2].i;
00136         i__3 = i__;
00137         q__3.r = s->r * cy[i__3].r - s->i * cy[i__3].i, q__3.i = s->r * cy[
00138                 i__3].i + s->i * cy[i__3].r;
00139         q__1.r = q__2.r + q__3.r, q__1.i = q__2.i + q__3.i;
00140         stemp.r = q__1.r, stemp.i = q__1.i;
00141         i__2 = i__;
00142         i__3 = i__;
00143         q__2.r = *c__ * cy[i__3].r, q__2.i = *c__ * cy[i__3].i;
00144         r_cnjg(&q__4, s);
00145         i__4 = i__;
00146         q__3.r = q__4.r * cx[i__4].r - q__4.i * cx[i__4].i, q__3.i = q__4.r * 
00147                 cx[i__4].i + q__4.i * cx[i__4].r;
00148         q__1.r = q__2.r - q__3.r, q__1.i = q__2.i - q__3.i;
00149         cy[i__2].r = q__1.r, cy[i__2].i = q__1.i;
00150         i__2 = i__;
00151         cx[i__2].r = stemp.r, cx[i__2].i = stemp.i;
00152 /* L30: */
00153     }
00154     return 0;
00155 } /* crot_ */


swiftnav
Author(s):
autogenerated on Sat Jun 8 2019 18:55:33