interface/rotm.c

   1 #include "common.h"
   2 #ifdef FUNCTION_PROFILE
   3 #include "functable.h"
   4 #endif
   5
   6 #ifndef CBLAS
   7
   8 void NAME(blasint *N, FLOAT *dx, blasint *INCX, FLOAT *dy, blasint *INCY, FLOAT *dparam){
   9
  10   blasint n = *N;
  11   blasint incx = *INCX;
  12   blasint incy = *INCY;
  13
  14 #else
  15
  16 void CNAME(blasint n, FLOAT *dx, blasint incx, FLOAT *dy, blasint incy, FLOAT *dparam){
  17
  18 #endif
  19
  20   blasint i__1, i__2;
  21
  22   blasint i__;
  23   FLOAT w, z__;
  24   blasint kx, ky;
  25   FLOAT dh11, dh12, dh22, dh21, dflag;
  26   blasint nsteps;
  27
  28 #ifndef CBLAS
  29   PRINT_DEBUG_CNAME;
  30 #else
  31   PRINT_DEBUG_CNAME;
  32 #endif
  33
  34   --dparam;
  35   --dy;
  36   --dx;
  37
  38   dflag = dparam[1];
  39     if (n <= 0 || dflag == - 2.0) goto L140;
  40
  41     if (! (incx == incy && incx > 0)) goto L70;
  42
  43     nsteps = n * incx;
  44     if (dflag < 0.) {
  45         goto L50;
  46     } else if (dflag == 0) {
  47         goto L10;
  48     } else {
  49         goto L30;
  50     }
  51 L10:
  52     dh12 = dparam[4];
  53     dh21 = dparam[3];
  54     i__1 = nsteps;
  55     i__2 = incx;
  56     for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
  57         w = dx[i__];
  58         z__ = dy[i__];
  59         dx[i__] = w + z__ * dh12;
  60         dy[i__] = w * dh21 + z__;
  61 /* L20: */
  62     }
  63     goto L140;
  64 L30:
  65     dh11 = dparam[2];
  66     dh22 = dparam[5];
  67     i__2 = nsteps;
  68     i__1 = incx;
  69     for (i__ = 1; i__1 < 0 ? i__ >= i__2 : i__ <= i__2; i__ += i__1) {
  70         w = dx[i__];
  71         z__ = dy[i__];
  72         dx[i__] = w * dh11 + z__;
  73         dy[i__] = -w + dh22 * z__;
  74 /* L40: */
  75     }
  76     goto L140;
  77 L50:
  78     dh11 = dparam[2];
  79     dh12 = dparam[4];
  80     dh21 = dparam[3];
  81     dh22 = dparam[5];
  82     i__1 = nsteps;
  83     i__2 = incx;
  84     for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
  85         w = dx[i__];
  86         z__ = dy[i__];
  87         dx[i__] = w * dh11 + z__ * dh12;
  88         dy[i__] = w * dh21 + z__ * dh22;
  89 /* L60: */
  90     }
  91     goto L140;
  92 L70:
  93     kx = 1;
  94     ky = 1;
  95     if (incx < 0) {
  96         kx = (1 - n) * incx + 1;
  97     }
  98     if (incy < 0) {
  99         ky = (1 - n) * incy + 1;
 100     }
 101
 102     if (dflag < 0.) {
 103         goto L120;
 104     } else if (dflag == 0) {
 105         goto L80;
 106     } else {
 107         goto L100;
 108     }
 109 L80:
 110     dh12 = dparam[4];
 111     dh21 = dparam[3];
 112     i__2 = n;
 113     for (i__ = 1; i__ <= i__2; ++i__) {
 114         w = dx[kx];
 115         z__ = dy[ky];
 116         dx[kx] = w + z__ * dh12;
 117         dy[ky] = w * dh21 + z__;
 118         kx += incx;
 119         ky += incy;
 120 /* L90: */
 121     }
 122     goto L140;
 123 L100:
 124     dh11 = dparam[2];
 125     dh22 = dparam[5];
 126     i__2 = n;
 127     for (i__ = 1; i__ <= i__2; ++i__) {
 128         w = dx[kx];
 129         z__ = dy[ky];
 130         dx[kx] = w * dh11 + z__;
 131         dy[ky] = -w + dh22 * z__;
 132         kx += incx;
 133         ky += incy;
 134 /* L110: */
 135     }
 136     goto L140;
 137 L120:
 138     dh11 = dparam[2];
 139     dh12 = dparam[4];
 140     dh21 = dparam[3];
 141     dh22 = dparam[5];
 142     i__2 = n;
 143     for (i__ = 1; i__ <= i__2; ++i__) {
 144         w = dx[kx];
 145         z__ = dy[ky];
 146         dx[kx] = w * dh11 + z__ * dh12;
 147         dy[ky] = w * dh21 + z__ * dh22;
 148         kx += incx;
 149         ky += incy;
 150 /* L130: */
 151     }
 152 L140:
 153     return;
 154 }
 155