drotm.c
Go to the documentation of this file.
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  }
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 
int drotm_(integer *n, doublereal *dx, integer *incx, doublereal *dy, integer *incy, doublereal *dparam)
Definition: drotm.c:15
RealScalar RealScalar int * incx
EIGEN_DONT_INLINE Scalar zero()
Definition: svd_common.h:296
int n
RowVector3d w
double doublereal
Definition: datatypes.h:11
int integer
Definition: datatypes.h:8
int RealScalar int RealScalar int * incy


gtsam
Author(s):
autogenerated on Tue Jul 4 2023 02:34:11