3rdparty/lapack/srot.c

   1 /* srot.f -- translated by f2c (version 20061008).
   2    You must link the resulting object file with libf2c:
   3         on Microsoft Windows system, link with libf2c.lib;
   4         on Linux or Unix systems, link with .../path/to/libf2c.a -lm
   5         or, if you install libf2c.a in a standard place, with -lf2c -lm
   6         -- in that order, at the end of the command line, as in
   7                 cc *.o -lf2c -lm
   8         Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
   9
  10                 http://www.netlib.org/f2c/libf2c.zip
  11 */
  12
  13 #include "clapack.h"
  14
  15
  16 /* Subroutine */ int srot_(integer *n, real *sx, integer *incx, real *sy,
  17         integer *incy, real *c__, real *s)
  18 {
  19     /* System generated locals */
  20     integer i__1;
  21
  22     /* Local variables */
  23     integer i__, ix, iy;
  24     real stemp;
  25
  26 /*     .. Scalar Arguments .. */
  27 /*     .. */
  28 /*     .. Array Arguments .. */
  29 /*     .. */
  30
  31 /*  Purpose */
  32 /*  ======= */
  33
  34 /*     applies a plane rotation. */
  35
  36 /*  Further Details */
  37 /*  =============== */
  38
  39 /*     jack dongarra, linpack, 3/11/78. */
  40 /*     modified 12/3/93, array(1) declarations changed to array(*) */
  41
  42
  43 /*     .. Local Scalars .. */
  44 /*     .. */
  45     /* Parameter adjustments */
  46     --sy;
  47     --sx;
  48
  49     /* Function Body */
  50     if (*n <= 0) {
  51         return 0;
  52     }
  53     if (*incx == 1 && *incy == 1) {
  54         goto L20;
  55     }
  56
  57 /*       code for unequal increments or equal increments not equal */
  58 /*         to 1 */
  59
  60     ix = 1;
  61     iy = 1;
  62     if (*incx < 0) {
  63         ix = (-(*n) + 1) * *incx + 1;
  64     }
  65     if (*incy < 0) {
  66         iy = (-(*n) + 1) * *incy + 1;
  67     }
  68     i__1 = *n;
  69     for (i__ = 1; i__ <= i__1; ++i__) {
  70         stemp = *c__ * sx[ix] + *s * sy[iy];
  71         sy[iy] = *c__ * sy[iy] - *s * sx[ix];
  72         sx[ix] = stemp;
  73         ix += *incx;
  74         iy += *incy;
  75 /* L10: */
  76     }
  77     return 0;
  78
  79 /*       code for both increments equal to 1 */
  80
  81 L20:
  82     i__1 = *n;
  83     for (i__ = 1; i__ <= i__1; ++i__) {
  84         stemp = *c__ * sx[i__] + *s * sy[i__];
  85         sy[i__] = *c__ * sy[i__] - *s * sx[i__];
  86         sx[i__] = stemp;
  87 /* L30: */
  88     }
  89     return 0;
  90 } /* srot_ */