| /* 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 */ int 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 0; |
| } /* drotm_ */ |
| |