1/* drotm.f -- translated by f2c (version 20100827).
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 "datatypes.h"
14
15/* Subroutine */ int drotm_(integer *n, doublereal *dx, integer *incx,
16	doublereal *dy, integer *incy, doublereal *dparam)
17{
18    /* Initialized data */
19
20    static doublereal zero = 0.;
21    static doublereal two = 2.;
22
23    /* System generated locals */
24    integer i__1, i__2;
25
26    /* Local variables */
27    integer i__;
28    doublereal w, z__;
29    integer kx, ky;
30    doublereal dh11, dh12, dh21, dh22, dflag;
31    integer nsteps;
32
33/*     .. Scalar Arguments .. */
34/*     .. */
35/*     .. Array Arguments .. */
36/*     .. */
37
38/*  Purpose */
39/*  ======= */
40
41/*     APPLY THE MODIFIED GIVENS TRANSFORMATION, H, TO THE 2 BY N MATRIX */
42
43/*     (DX**T) , WHERE **T INDICATES TRANSPOSE. THE ELEMENTS OF DX ARE IN */
44/*     (DY**T) */
45
46/*     DX(LX+I*INCX), I = 0 TO N-1, WHERE LX = 1 IF INCX .GE. 0, ELSE */
47/*     LX = (-INCX)*N, AND SIMILARLY FOR SY USING LY AND INCY. */
48/*     WITH DPARAM(1)=DFLAG, H HAS ONE OF THE FOLLOWING FORMS.. */
49
50/*     DFLAG=-1.D0     DFLAG=0.D0        DFLAG=1.D0     DFLAG=-2.D0 */
51
52/*       (DH11  DH12)    (1.D0  DH12)    (DH11  1.D0)    (1.D0  0.D0) */
53/*     H=(          )    (          )    (          )    (          ) */
54/*       (DH21  DH22),   (DH21  1.D0),   (-1.D0 DH22),   (0.D0  1.D0). */
55/*     SEE DROTMG FOR A DESCRIPTION OF DATA STORAGE IN DPARAM. */
56
57/*  Arguments */
58/*  ========= */
59
60/*  N      (input) INTEGER */
61/*         number of elements in input vector(s) */
62
63/*  DX     (input/output) DOUBLE PRECISION array, dimension N */
64/*         double precision vector with N elements */
65
66/*  INCX   (input) INTEGER */
67/*         storage spacing between elements of DX */
68
69/*  DY     (input/output) DOUBLE PRECISION array, dimension N */
70/*         double precision vector with N elements */
71
72/*  INCY   (input) INTEGER */
73/*         storage spacing between elements of DY */
74
75/*  DPARAM (input/output)  DOUBLE PRECISION array, dimension 5 */
76/*     DPARAM(1)=DFLAG */
77/*     DPARAM(2)=DH11 */
78/*     DPARAM(3)=DH21 */
79/*     DPARAM(4)=DH12 */
80/*     DPARAM(5)=DH22 */
81
82/*  ===================================================================== */
83
84/*     .. Local Scalars .. */
85/*     .. */
86/*     .. Data statements .. */
87    /* Parameter adjustments */
88    --dparam;
89    --dy;
90    --dx;
91
92    /* Function Body */
93/*     .. */
94
95    dflag = dparam[1];
96    if (*n <= 0 || dflag + two == zero) {
97	goto L140;
98    }
99    if (! (*incx == *incy && *incx > 0)) {
100	goto L70;
101    }
102
103    nsteps = *n * *incx;
104    if (dflag < 0.) {
105	goto L50;
106    } else if (dflag == 0) {
107	goto L10;
108    } else {
109	goto L30;
110    }
111L10:
112    dh12 = dparam[4];
113    dh21 = dparam[3];
114    i__1 = nsteps;
115    i__2 = *incx;
116    for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
117	w = dx[i__];
118	z__ = dy[i__];
119	dx[i__] = w + z__ * dh12;
120	dy[i__] = w * dh21 + z__;
121/* L20: */
122    }
123    goto L140;
124L30:
125    dh11 = dparam[2];
126    dh22 = dparam[5];
127    i__2 = nsteps;
128    i__1 = *incx;
129    for (i__ = 1; i__1 < 0 ? i__ >= i__2 : i__ <= i__2; i__ += i__1) {
130	w = dx[i__];
131	z__ = dy[i__];
132	dx[i__] = w * dh11 + z__;
133	dy[i__] = -w + dh22 * z__;
134/* L40: */
135    }
136    goto L140;
137L50:
138    dh11 = dparam[2];
139    dh12 = dparam[4];
140    dh21 = dparam[3];
141    dh22 = dparam[5];
142    i__1 = nsteps;
143    i__2 = *incx;
144    for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
145	w = dx[i__];
146	z__ = dy[i__];
147	dx[i__] = w * dh11 + z__ * dh12;
148	dy[i__] = w * dh21 + z__ * dh22;
149/* L60: */
150    }
151    goto L140;
152L70:
153    kx = 1;
154    ky = 1;
155    if (*incx < 0) {
156	kx = (1 - *n) * *incx + 1;
157    }
158    if (*incy < 0) {
159	ky = (1 - *n) * *incy + 1;
160    }
161
162    if (dflag < 0.) {
163	goto L120;
164    } else if (dflag == 0) {
165	goto L80;
166    } else {
167	goto L100;
168    }
169L80:
170    dh12 = dparam[4];
171    dh21 = dparam[3];
172    i__2 = *n;
173    for (i__ = 1; i__ <= i__2; ++i__) {
174	w = dx[kx];
175	z__ = dy[ky];
176	dx[kx] = w + z__ * dh12;
177	dy[ky] = w * dh21 + z__;
178	kx += *incx;
179	ky += *incy;
180/* L90: */
181    }
182    goto L140;
183L100:
184    dh11 = dparam[2];
185    dh22 = dparam[5];
186    i__2 = *n;
187    for (i__ = 1; i__ <= i__2; ++i__) {
188	w = dx[kx];
189	z__ = dy[ky];
190	dx[kx] = w * dh11 + z__;
191	dy[ky] = -w + dh22 * z__;
192	kx += *incx;
193	ky += *incy;
194/* L110: */
195    }
196    goto L140;
197L120:
198    dh11 = dparam[2];
199    dh12 = dparam[4];
200    dh21 = dparam[3];
201    dh22 = dparam[5];
202    i__2 = *n;
203    for (i__ = 1; i__ <= i__2; ++i__) {
204	w = dx[kx];
205	z__ = dy[ky];
206	dx[kx] = w * dh11 + z__ * dh12;
207	dy[ky] = w * dh21 + z__ * dh22;
208	kx += *incx;
209	ky += *incy;
210/* L130: */
211    }
212L140:
213    return 0;
214} /* drotm_ */
215
216