gtsam
3rdparty
Eigen
blas
f2c
drotmg.c
Go to the documentation of this file.
1
/* drotmg.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
drotmg_
(
doublereal
*dd1,
doublereal
*dd2,
doublereal
*
16
dx1,
doublereal
*dy1,
doublereal
*dparam)
17
{
18
/* Initialized data */
19
20
static
doublereal
zero
= 0.;
21
static
doublereal
one = 1.;
22
static
doublereal
two
= 2.;
23
static
doublereal
gam = 4096.;
24
static
doublereal
gamsq = 16777216.;
25
static
doublereal
rgamsq = 5.9604645e-8;
26
27
/* Format strings */
28
static
char
fmt_120[] =
""
;
29
static
char
fmt_150[] =
""
;
30
static
char
fmt_180[] =
""
;
31
static
char
fmt_210[] =
""
;
32
33
/* System generated locals */
34
doublereal
d__1;
35
36
/* Local variables */
37
doublereal
du, dp1, dp2, dq1, dq2, dh11, dh12, dh21, dh22;
38
integer
igo;
39
doublereal
dflag, dtemp;
40
41
/* Assigned format variables */
42
static
char
*igo_fmt;
43
44
/* .. Scalar Arguments .. */
45
/* .. */
46
/* .. Array Arguments .. */
47
/* .. */
48
49
/* Purpose */
50
/* ======= */
51
52
/* CONSTRUCT THE MODIFIED GIVENS TRANSFORMATION MATRIX H WHICH ZEROS */
53
/* THE SECOND COMPONENT OF THE 2-VECTOR (DSQRT(DD1)*DX1,DSQRT(DD2)* */
54
/* DY2)**T. */
55
/* WITH DPARAM(1)=DFLAG, H HAS ONE OF THE FOLLOWING FORMS.. */
56
57
/* DFLAG=-1.D0 DFLAG=0.D0 DFLAG=1.D0 DFLAG=-2.D0 */
58
59
/* (DH11 DH12) (1.D0 DH12) (DH11 1.D0) (1.D0 0.D0) */
60
/* H=( ) ( ) ( ) ( ) */
61
/* (DH21 DH22), (DH21 1.D0), (-1.D0 DH22), (0.D0 1.D0). */
62
/* LOCATIONS 2-4 OF DPARAM CONTAIN DH11, DH21, DH12, AND DH22 */
63
/* RESPECTIVELY. (VALUES OF 1.D0, -1.D0, OR 0.D0 IMPLIED BY THE */
64
/* VALUE OF DPARAM(1) ARE NOT STORED IN DPARAM.) */
65
66
/* THE VALUES OF GAMSQ AND RGAMSQ SET IN THE DATA STATEMENT MAY BE */
67
/* INEXACT. THIS IS OK AS THEY ARE ONLY USED FOR TESTING THE SIZE */
68
/* OF DD1 AND DD2. ALL ACTUAL SCALING OF DATA IS DONE USING GAM. */
69
70
71
/* Arguments */
72
/* ========= */
73
74
/* DD1 (input/output) DOUBLE PRECISION */
75
76
/* DD2 (input/output) DOUBLE PRECISION */
77
78
/* DX1 (input/output) DOUBLE PRECISION */
79
80
/* DY1 (input) DOUBLE PRECISION */
81
82
/* DPARAM (input/output) DOUBLE PRECISION array, dimension 5 */
83
/* DPARAM(1)=DFLAG */
84
/* DPARAM(2)=DH11 */
85
/* DPARAM(3)=DH21 */
86
/* DPARAM(4)=DH12 */
87
/* DPARAM(5)=DH22 */
88
89
/* ===================================================================== */
90
91
/* .. Local Scalars .. */
92
/* .. */
93
/* .. Intrinsic Functions .. */
94
/* .. */
95
/* .. Data statements .. */
96
97
/* Parameter adjustments */
98
--dparam;
99
100
/* Function Body */
101
/* .. */
102
if
(! (*dd1 <
zero
)) {
103
goto
L10;
104
}
105
/* GO ZERO-H-D-AND-DX1.. */
106
goto
L60;
107
L10:
108
/* CASE-DD1-NONNEGATIVE */
109
dp2 = *dd2 * *dy1;
110
if
(! (dp2 ==
zero
)) {
111
goto
L20;
112
}
113
dflag = -
two
;
114
goto
L260;
115
/* REGULAR-CASE.. */
116
L20:
117
dp1 = *dd1 * *dx1;
118
dq2 = dp2 * *dy1;
119
dq1 = dp1 * *dx1;
120
121
if
(! (
abs
(dq1) >
abs
(dq2))) {
122
goto
L40;
123
}
124
dh21 = -(*dy1) / *dx1;
125
dh12 = dp2 / dp1;
126
127
du = one - dh12 * dh21;
128
129
if
(! (du <=
zero
)) {
130
goto
L30;
131
}
132
/* GO ZERO-H-D-AND-DX1.. */
133
goto
L60;
134
L30:
135
dflag =
zero
;
136
*dd1 /= du;
137
*dd2 /= du;
138
*dx1 *= du;
139
/* GO SCALE-CHECK.. */
140
goto
L100;
141
L40:
142
if
(! (dq2 <
zero
)) {
143
goto
L50;
144
}
145
/* GO ZERO-H-D-AND-DX1.. */
146
goto
L60;
147
L50:
148
dflag = one;
149
dh11 = dp1 / dp2;
150
dh22 = *dx1 / *dy1;
151
du = one + dh11 * dh22;
152
dtemp = *dd2 / du;
153
*dd2 = *dd1 / du;
154
*dd1 = dtemp;
155
*dx1 = *dy1 * du;
156
/* GO SCALE-CHECK */
157
goto
L100;
158
/* PROCEDURE..ZERO-H-D-AND-DX1.. */
159
L60:
160
dflag = -one;
161
dh11 =
zero
;
162
dh12 =
zero
;
163
dh21 =
zero
;
164
dh22 =
zero
;
165
166
*dd1 =
zero
;
167
*dd2 =
zero
;
168
*dx1 =
zero
;
169
/* RETURN.. */
170
goto
L220;
171
/* PROCEDURE..FIX-H.. */
172
L70:
173
if
(! (dflag >=
zero
)) {
174
goto
L90;
175
}
176
177
if
(! (dflag ==
zero
)) {
178
goto
L80;
179
}
180
dh11 = one;
181
dh22 = one;
182
dflag = -one;
183
goto
L90;
184
L80:
185
dh21 = -one;
186
dh12 = one;
187
dflag = -one;
188
L90:
189
switch
(igo) {
190
case
0:
goto
L120;
191
case
1:
goto
L150;
192
case
2:
goto
L180;
193
case
3:
goto
L210;
194
}
195
/* PROCEDURE..SCALE-CHECK */
196
L100:
197
L110:
198
if
(! (*dd1 <= rgamsq)) {
199
goto
L130;
200
}
201
if
(*dd1 ==
zero
) {
202
goto
L160;
203
}
204
igo = 0;
205
igo_fmt = fmt_120;
206
/* FIX-H.. */
207
goto
L70;
208
L120:
209
/* Computing 2nd power */
210
d__1 = gam;
211
*dd1 *= d__1 * d__1;
212
*dx1 /= gam;
213
dh11 /= gam;
214
dh12 /= gam;
215
goto
L110;
216
L130:
217
L140:
218
if
(! (*dd1 >= gamsq)) {
219
goto
L160;
220
}
221
igo = 1;
222
igo_fmt = fmt_150;
223
/* FIX-H.. */
224
goto
L70;
225
L150:
226
/* Computing 2nd power */
227
d__1 = gam;
228
*dd1 /= d__1 * d__1;
229
*dx1 *= gam;
230
dh11 *= gam;
231
dh12 *= gam;
232
goto
L140;
233
L160:
234
L170:
235
if
(! (
abs
(*dd2) <= rgamsq)) {
236
goto
L190;
237
}
238
if
(*dd2 ==
zero
) {
239
goto
L220;
240
}
241
igo = 2;
242
igo_fmt = fmt_180;
243
/* FIX-H.. */
244
goto
L70;
245
L180:
246
/* Computing 2nd power */
247
d__1 = gam;
248
*dd2 *= d__1 * d__1;
249
dh21 /= gam;
250
dh22 /= gam;
251
goto
L170;
252
L190:
253
L200:
254
if
(! (
abs
(*dd2) >= gamsq)) {
255
goto
L220;
256
}
257
igo = 3;
258
igo_fmt = fmt_210;
259
/* FIX-H.. */
260
goto
L70;
261
L210:
262
/* Computing 2nd power */
263
d__1 = gam;
264
*dd2 /= d__1 * d__1;
265
dh21 *= gam;
266
dh22 *= gam;
267
goto
L200;
268
L220:
269
if
(dflag < 0.) {
270
goto
L250;
271
}
else
if
(dflag == 0) {
272
goto
L230;
273
}
else
{
274
goto
L240;
275
}
276
L230:
277
dparam[3] = dh21;
278
dparam[4] = dh12;
279
goto
L260;
280
L240:
281
dparam[2] = dh11;
282
dparam[5] = dh22;
283
goto
L260;
284
L250:
285
dparam[2] = dh11;
286
dparam[3] = dh21;
287
dparam[4] = dh12;
288
dparam[5] = dh22;
289
L260:
290
dparam[1] = dflag;
291
return
0;
292
}
/* drotmg_ */
293
datatypes.h
doublereal
double doublereal
Definition:
datatypes.h:11
zero
EIGEN_DONT_INLINE Scalar zero()
Definition:
svd_common.h:296
drotmg_
int drotmg_(doublereal *dd1, doublereal *dd2, doublereal *dx1, doublereal *dy1, doublereal *dparam)
Definition:
drotmg.c:15
integer
int integer
Definition:
datatypes.h:8
abs
#define abs(x)
Definition:
datatypes.h:17
two
Definition:
testHybridBayesTree.cpp:59
gtsam
Author(s):
autogenerated on Sun Dec 22 2024 04:11:29