Ejemplo n.º 1
0
/* Subroutine */ int PASTEF77(cs,rot)(const bla_integer *n, bla_scomplex *cx, const bla_integer *incx, bla_scomplex *cy, const bla_integer *incy, const bla_real *c__, const bla_real *s)
{
    /* System generated locals */
    bla_integer i__1, i__2, i__3, i__4;
    bla_scomplex q__1, q__2, q__3;

    /* Local variables */
    bla_integer i__;
    bla_scomplex ctemp;
    bla_integer ix, iy;


/*     applies a plane rotation, where the cos and sin (c and s) are bla_real */
/*     and the vectors cx and cy are complex. */
/*     jack dongarra, linpack, 3/11/78. */


    /* Parameter adjustments */
    --cy;
    --cx;

    /* Function Body */
    if (*n <= 0) {
	return 0;
    }
    if (*incx == 1 && *incy == 1) {
	goto L20;
    }

/*       code for unequal increments or equal increments not equal */
/*         to 1 */

    ix = 1;
    iy = 1;
    if (*incx < 0) {
	ix = (-(*n) + 1) * *incx + 1;
    }
    if (*incy < 0) {
	iy = (-(*n) + 1) * *incy + 1;
    }
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	i__2 = ix;
	bli_csets( (*c__ * bli_creal(cx[i__2])), (*c__ * bli_cimag(cx[i__2])), q__2 );
	i__3 = iy;
	bli_csets( (*s * bli_creal(cy[i__3])), (*s * bli_cimag(cy[i__3])), q__3 );
	bli_csets( (bli_creal(q__2) + bli_creal(q__3)), (bli_cimag(q__2) + bli_cimag(q__3)), q__1 );
	bli_csets( (bli_creal(q__1)), (bli_cimag(q__1)), ctemp );
	i__2 = iy;
	i__3 = iy;
	bli_csets( (*c__ * bli_creal(cy[i__3])), (*c__ * bli_cimag(cy[i__3])), q__2 );
	i__4 = ix;
	bli_csets( (*s * bli_creal(cx[i__4])), (*s * bli_cimag(cx[i__4])), q__3 );
	bli_csets( (bli_creal(q__2) - bli_creal(q__3)), (bli_cimag(q__2) - bli_cimag(q__3)), q__1 );
	bli_csets( (bli_creal(q__1)), (bli_cimag(q__1)), cy[i__2] );
	i__2 = ix;
	bli_csets( (bli_creal(ctemp)), (bli_cimag(ctemp)), cx[i__2] );
	ix += *incx;
	iy += *incy;
/* L10: */
    }
    return 0;

/*       code for both increments equal to 1 */

L20:
    i__1 = *n;
    for (i__ = 1; i__ <= i__1; ++i__) {
	i__2 = i__;
	bli_csets( (*c__ * bli_creal(cx[i__2])), (*c__ * bli_cimag(cx[i__2])), q__2 );
	i__3 = i__;
	bli_csets( (*s * bli_creal(cy[i__3])), (*s * bli_cimag(cy[i__3])), q__3 );
	bli_csets( (bli_creal(q__2) + bli_creal(q__3)), (bli_cimag(q__2) + bli_cimag(q__3)), q__1 );
	bli_csets( (bli_creal(q__1)), (bli_cimag(q__1)), ctemp );
	i__2 = i__;
	i__3 = i__;
	bli_csets( (*c__ * bli_creal(cy[i__3])), (*c__ * bli_cimag(cy[i__3])), q__2 );
	i__4 = i__;
	bli_csets( (*s * bli_creal(cx[i__4])), (*s * bli_cimag(cx[i__4])), q__3 );
	bli_csets( (bli_creal(q__2) - bli_creal(q__3)), (bli_cimag(q__2) - bli_cimag(q__3)), q__1 );
	bli_csets( (bli_creal(q__1)), (bli_cimag(q__1)), cy[i__2] );
	i__2 = i__;
	bli_csets( (bli_creal(ctemp)), (bli_cimag(ctemp)), cx[i__2] );
/* L30: */
    }
    return 0;
} /* csrot_ */
Ejemplo n.º 2
0
/* Subroutine */ int PASTEF77(c,rotg)(singlecomplex *ca, singlecomplex *cb, real *c__, singlecomplex *s)
{
    /* System generated locals */
    real r__1, r__2;
    singlecomplex q__1, q__2, q__3;

    /* Builtin functions */
    double bla_c_abs(singlecomplex *), sqrt(doublereal);
    void bla_r_cnjg(singlecomplex *, singlecomplex *);

    /* Local variables */
    real norm;
    singlecomplex alpha;
    real scale;

    if (bla_c_abs(ca) != 0.f) {
	goto L10;
    }
    *c__ = 0.f;
    bli_csets( 1.f, 0.f, *s );
    bli_csets( bli_creal(*cb), bli_cimag(*cb), *ca );
    goto L20;
L10:
    scale = bla_c_abs(ca) + bla_c_abs(cb);
    bli_csets( (bli_creal(*ca) / scale), (bli_cimag(*ca) / scale), q__1 );
/* Computing 2nd power */
    r__1 = bla_c_abs(&q__1);
    bli_csets( (bli_creal(*cb) / scale), (bli_cimag(*cb) / scale), q__2 );
/* Computing 2nd power */
    r__2 = bla_c_abs(&q__2);
    norm = scale * sqrt(r__1 * r__1 + r__2 * r__2);
    r__1 = bla_c_abs(ca);
    bli_csets( (bli_creal(*ca) / r__1), (bli_cimag(*ca) / r__1), q__1 );
    bli_csets( (bli_creal(q__1)), (bli_cimag(q__1)), alpha );
    *c__ = bla_c_abs(ca) / norm;
    bla_r_cnjg(&q__3, cb);
    bli_csets( (bli_creal(alpha) * bli_creal(q__3) - bli_cimag(alpha) * bli_cimag(q__3)), (bli_creal(alpha) * bli_cimag(q__3) + bli_cimag(alpha) * bli_creal(q__3)), q__2 );
    bli_csets( (bli_creal(q__2) / norm), (bli_cimag(q__2) / norm), q__1 );
    bli_csets( bli_creal(q__1), bli_cimag(q__1), *s );
    bli_csets( (norm * bli_creal(alpha)), (norm * bli_cimag(alpha)), q__1 );
    bli_csets( bli_creal(q__1), bli_cimag(q__1), *ca );
L20:
    return 0;
} /* crotg_ */