srotm.c
Go to the documentation of this file.
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  }
112 L10:
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;
125 L30:
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;
138 L50:
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;
153 L70:
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  }
170 L80:
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;
184 L100:
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;
198 L120:
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  }
213 L140:
214  return 0;
215 } /* srotm_ */
216 
RealScalar RealScalar int * incx
EIGEN_DONT_INLINE Scalar zero()
Definition: svd_common.h:296
int n
int srotm_(integer *n, real *sx, integer *incx, real *sy, integer *incy, real *sparam)
Definition: srotm.c:15
Definition: main.h:100
Point2(* f)(const Point3 &, OptionalJacobian< 2, 3 >)
RowVector3d w
int integer
Definition: datatypes.h:8
int RealScalar int RealScalar int * incy


gtsam
Author(s):
autogenerated on Tue Jul 4 2023 02:36:19