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


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