blas/f2c/drotm.c

/* drotm.f -- translated by f2c (version 20100827).
   You must link the resulting object file with libf2c:
        on Microsoft Windows system, link with libf2c.lib;
        on Linux or Unix systems, link with .../path/to/libf2c.a -lm
        or, if you install libf2c.a in a standard place, with -lf2c -lm
        -- in that order, at the end of the command line, as in
                cc *.o -lf2c -lm
        Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,

                http://www.netlib.org/f2c/libf2c.zip
*/

#include "datatypes.h"

/* Subroutine */ void drotm_(integer *n, doublereal *dx, integer *incx, doublereal *dy, integer *incy,
                             doublereal *dparam) {
  /* Initialized data */

  static doublereal zero = 0.;
  static doublereal two = 2.;

  /* System generated locals */
  integer i__1, i__2;

  /* Local variables */
  integer i__;
  doublereal w, z__;
  integer kx, ky;
  doublereal dh11, dh12, dh21, dh22, dflag;
  integer nsteps;

  /*     .. Scalar Arguments .. */
  /*     .. */
  /*     .. Array Arguments .. */
  /*     .. */

  /*  Purpose */
  /*  ======= */

  /*     APPLY THE MODIFIED GIVENS TRANSFORMATION, H, TO THE 2 BY N MATRIX */

  /*     (DX**T) , WHERE **T INDICATES TRANSPOSE. THE ELEMENTS OF DX ARE IN */
  /*     (DY**T) */

  /*     DX(LX+I*INCX), I = 0 TO N-1, WHERE LX = 1 IF INCX .GE. 0, ELSE */
  /*     LX = (-INCX)*N, AND SIMILARLY FOR SY USING LY AND INCY. */
  /*     WITH DPARAM(1)=DFLAG, H HAS ONE OF THE FOLLOWING FORMS.. */

  /*     DFLAG=-1.D0     DFLAG=0.D0        DFLAG=1.D0     DFLAG=-2.D0 */

  /*       (DH11  DH12)    (1.D0  DH12)    (DH11  1.D0)    (1.D0  0.D0) */
  /*     H=(          )    (          )    (          )    (          ) */
  /*       (DH21  DH22),   (DH21  1.D0),   (-1.D0 DH22),   (0.D0  1.D0). */
  /*     SEE DROTMG FOR A DESCRIPTION OF DATA STORAGE IN DPARAM. */

  /*  Arguments */
  /*  ========= */

  /*  N      (input) INTEGER */
  /*         number of elements in input vector(s) */

  /*  DX     (input/output) DOUBLE PRECISION array, dimension N */
  /*         double precision vector with N elements */

  /*  INCX   (input) INTEGER */
  /*         storage spacing between elements of DX */

  /*  DY     (input/output) DOUBLE PRECISION array, dimension N */
  /*         double precision vector with N elements */

  /*  INCY   (input) INTEGER */
  /*         storage spacing between elements of DY */

  /*  DPARAM (input/output)  DOUBLE PRECISION array, dimension 5 */
  /*     DPARAM(1)=DFLAG */
  /*     DPARAM(2)=DH11 */
  /*     DPARAM(3)=DH21 */
  /*     DPARAM(4)=DH12 */
  /*     DPARAM(5)=DH22 */

  /*  ===================================================================== */

  /*     .. Local Scalars .. */
  /*     .. */
  /*     .. Data statements .. */
  /* Parameter adjustments */
  --dparam;
  --dy;
  --dx;

  /* Function Body */
  /*     .. */

  dflag = dparam[1];
  if (*n <= 0 || dflag + two == zero) {
    goto L140;
  }
  if (!(*incx == *incy && *incx > 0)) {
    goto L70;
  }

  nsteps = *n * *incx;
  if (dflag < 0.) {
    goto L50;
  } else if (dflag == 0) {
    goto L10;
  } else {
    goto L30;
  }
L10:
  dh12 = dparam[4];
  dh21 = dparam[3];
  i__1 = nsteps;
  i__2 = *incx;
  for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
    w = dx[i__];
    z__ = dy[i__];
    dx[i__] = w + z__ * dh12;
    dy[i__] = w * dh21 + z__;
    /* L20: */
  }
  goto L140;
L30:
  dh11 = dparam[2];
  dh22 = dparam[5];
  i__2 = nsteps;
  i__1 = *incx;
  for (i__ = 1; i__1 < 0 ? i__ >= i__2 : i__ <= i__2; i__ += i__1) {
    w = dx[i__];
    z__ = dy[i__];
    dx[i__] = w * dh11 + z__;
    dy[i__] = -w + dh22 * z__;
    /* L40: */
  }
  goto L140;
L50:
  dh11 = dparam[2];
  dh12 = dparam[4];
  dh21 = dparam[3];
  dh22 = dparam[5];
  i__1 = nsteps;
  i__2 = *incx;
  for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
    w = dx[i__];
    z__ = dy[i__];
    dx[i__] = w * dh11 + z__ * dh12;
    dy[i__] = w * dh21 + z__ * dh22;
    /* L60: */
  }
  goto L140;
L70:
  kx = 1;
  ky = 1;
  if (*incx < 0) {
    kx = (1 - *n) * *incx + 1;
  }
  if (*incy < 0) {
    ky = (1 - *n) * *incy + 1;
  }

  if (dflag < 0.) {
    goto L120;
  } else if (dflag == 0) {
    goto L80;
  } else {
    goto L100;
  }
L80:
  dh12 = dparam[4];
  dh21 = dparam[3];
  i__2 = *n;
  for (i__ = 1; i__ <= i__2; ++i__) {
    w = dx[kx];
    z__ = dy[ky];
    dx[kx] = w + z__ * dh12;
    dy[ky] = w * dh21 + z__;
    kx += *incx;
    ky += *incy;
    /* L90: */
  }
  goto L140;
L100:
  dh11 = dparam[2];
  dh22 = dparam[5];
  i__2 = *n;
  for (i__ = 1; i__ <= i__2; ++i__) {
    w = dx[kx];
    z__ = dy[ky];
    dx[kx] = w * dh11 + z__;
    dy[ky] = -w + dh22 * z__;
    kx += *incx;
    ky += *incy;
    /* L110: */
  }
  goto L140;
L120:
  dh11 = dparam[2];
  dh12 = dparam[4];
  dh21 = dparam[3];
  dh22 = dparam[5];
  i__2 = *n;
  for (i__ = 1; i__ <= i__2; ++i__) {
    w = dx[kx];
    z__ = dy[ky];
    dx[kx] = w * dh11 + z__ * dh12;
    dy[ky] = w * dh21 + z__ * dh22;
    kx += *incx;
    ky += *incy;
    /* L130: */
  }
L140:
  return;
} /* drotm_ */