1/* srotm.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 srotm_(integer *n, real *sx, integer *incx, real *sy,
16	integer *incy, real *sparam)
17{
18    /* Initialized data */
19
20    static real zero = 0.f;
21    static real two = 2.f;
22
23    /* System generated locals */
24    integer i__1, i__2;
25
26    /* Local variables */
27    integer i__;
28    real w, z__;
29    integer kx, ky;
30    real sh11, sh12, sh21, sh22, sflag;
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/*     (SX**T) , WHERE **T INDICATES TRANSPOSE. THE ELEMENTS OF SX ARE IN */
44/*     (DX**T) */
45
46/*     SX(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 USING LY AND INCY. */
48/*     WITH SPARAM(1)=SFLAG, H HAS ONE OF THE FOLLOWING FORMS.. */
49
50/*     SFLAG=-1.E0     SFLAG=0.E0        SFLAG=1.E0     SFLAG=-2.E0 */
51
52/*       (SH11  SH12)    (1.E0  SH12)    (SH11  1.E0)    (1.E0  0.E0) */
53/*     H=(          )    (          )    (          )    (          ) */
54/*       (SH21  SH22),   (SH21  1.E0),   (-1.E0 SH22),   (0.E0  1.E0). */
55/*     SEE  SROTMG FOR A DESCRIPTION OF DATA STORAGE IN SPARAM. */
56
57
58/*  Arguments */
59/*  ========= */
60
61/*  N      (input) INTEGER */
62/*         number of elements in input vector(s) */
63
64/*  SX     (input/output) REAL array, dimension N */
65/*         double precision vector with N elements */
66
67/*  INCX   (input) INTEGER */
68/*         storage spacing between elements of SX */
69
70/*  SY     (input/output) REAL array, dimension N */
71/*         double precision vector with N elements */
72
73/*  INCY   (input) INTEGER */
74/*         storage spacing between elements of SY */
75
76/*  SPARAM (input/output)  REAL array, dimension 5 */
77/*     SPARAM(1)=SFLAG */
78/*     SPARAM(2)=SH11 */
79/*     SPARAM(3)=SH21 */
80/*     SPARAM(4)=SH12 */
81/*     SPARAM(5)=SH22 */
82
83/*  ===================================================================== */
84
85/*     .. Local Scalars .. */
86/*     .. */
87/*     .. Data statements .. */
88    /* Parameter adjustments */
89    --sparam;
90    --sy;
91    --sx;
92
93    /* Function Body */
94/*     .. */
95
96    sflag = sparam[1];
97    if (*n <= 0 || sflag + two == zero) {
98	goto L140;
99    }
100    if (! (*incx == *incy && *incx > 0)) {
101	goto L70;
102    }
103
104    nsteps = *n * *incx;
105    if (sflag < 0.f) {
106	goto L50;
107    } else if (sflag == 0) {
108	goto L10;
109    } else {
110	goto L30;
111    }
112L10:
113    sh12 = sparam[4];
114    sh21 = sparam[3];
115    i__1 = nsteps;
116    i__2 = *incx;
117    for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
118	w = sx[i__];
119	z__ = sy[i__];
120	sx[i__] = w + z__ * sh12;
121	sy[i__] = w * sh21 + z__;
122/* L20: */
123    }
124    goto L140;
125L30:
126    sh11 = sparam[2];
127    sh22 = sparam[5];
128    i__2 = nsteps;
129    i__1 = *incx;
130    for (i__ = 1; i__1 < 0 ? i__ >= i__2 : i__ <= i__2; i__ += i__1) {
131	w = sx[i__];
132	z__ = sy[i__];
133	sx[i__] = w * sh11 + z__;
134	sy[i__] = -w + sh22 * z__;
135/* L40: */
136    }
137    goto L140;
138L50:
139    sh11 = sparam[2];
140    sh12 = sparam[4];
141    sh21 = sparam[3];
142    sh22 = sparam[5];
143    i__1 = nsteps;
144    i__2 = *incx;
145    for (i__ = 1; i__2 < 0 ? i__ >= i__1 : i__ <= i__1; i__ += i__2) {
146	w = sx[i__];
147	z__ = sy[i__];
148	sx[i__] = w * sh11 + z__ * sh12;
149	sy[i__] = w * sh21 + z__ * sh22;
150/* L60: */
151    }
152    goto L140;
153L70:
154    kx = 1;
155    ky = 1;
156    if (*incx < 0) {
157	kx = (1 - *n) * *incx + 1;
158    }
159    if (*incy < 0) {
160	ky = (1 - *n) * *incy + 1;
161    }
162
163    if (sflag < 0.f) {
164	goto L120;
165    } else if (sflag == 0) {
166	goto L80;
167    } else {
168	goto L100;
169    }
170L80:
171    sh12 = sparam[4];
172    sh21 = sparam[3];
173    i__2 = *n;
174    for (i__ = 1; i__ <= i__2; ++i__) {
175	w = sx[kx];
176	z__ = sy[ky];
177	sx[kx] = w + z__ * sh12;
178	sy[ky] = w * sh21 + z__;
179	kx += *incx;
180	ky += *incy;
181/* L90: */
182    }
183    goto L140;
184L100:
185    sh11 = sparam[2];
186    sh22 = sparam[5];
187    i__2 = *n;
188    for (i__ = 1; i__ <= i__2; ++i__) {
189	w = sx[kx];
190	z__ = sy[ky];
191	sx[kx] = w * sh11 + z__;
192	sy[ky] = -w + sh22 * z__;
193	kx += *incx;
194	ky += *incy;
195/* L110: */
196    }
197    goto L140;
198L120:
199    sh11 = sparam[2];
200    sh12 = sparam[4];
201    sh21 = sparam[3];
202    sh22 = sparam[5];
203    i__2 = *n;
204    for (i__ = 1; i__ <= i__2; ++i__) {
205	w = sx[kx];
206	z__ = sy[ky];
207	sx[kx] = w * sh11 + z__ * sh12;
208	sy[ky] = w * sh21 + z__ * sh22;
209	kx += *incx;
210	ky += *incy;
211/* L130: */
212    }
213L140:
214    return 0;
215} /* srotm_ */
216
217