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
drotm_(integer * n,doublereal * dx,integer * incx,doublereal * dy,integer * incy,doublereal * dparam)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 }
111 L10:
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;
124 L30:
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;
137 L50:
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;
152 L70:
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 }
169 L80:
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;
183 L100:
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;
197 L120:
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 }
212 L140:
213 return 0;
214 } /* drotm_ */
215
216