whitespace fixes
This commit is contained in:
Axel Kohlmeyer
@ -1,13 +1,13 @@
|
||||
/* fortran/dlasv2.f -- translated by f2c (version 20200916).
|
||||
You must link the resulting object file with libf2c:
|
||||
on Microsoft Windows system, link with libf2c.lib;
|
||||
on Linux or Unix systems, link with .../path/to/libf2c.a -lm
|
||||
or, if you install libf2c.a in a standard place, with -lf2c -lm
|
||||
-- in that order, at the end of the command line, as in
|
||||
cc *.o -lf2c -lm
|
||||
Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
|
||||
on Microsoft Windows system, link with libf2c.lib;
|
||||
on Linux or Unix systems, link with .../path/to/libf2c.a -lm
|
||||
or, if you install libf2c.a in a standard place, with -lf2c -lm
|
||||
-- in that order, at the end of the command line, as in
|
||||
cc *.o -lf2c -lm
|
||||
Source for libf2c is in /netlib/f2c/libf2c.zip, e.g.,
|
||||
|
||||
http://www.netlib.org/f2c/libf2c.zip
|
||||
http://www.netlib.org/f2c/libf2c.zip
|
||||
*/
|
||||
|
||||
#ifdef __cplusplus
|
||||
@ -159,9 +159,9 @@ f"> */
|
||||
/* > \endverbatim */
|
||||
/* > */
|
||||
/* ===================================================================== */
|
||||
/* Subroutine */ int dlasv2_(doublereal *f, doublereal *g, doublereal *h__,
|
||||
doublereal *ssmin, doublereal *ssmax, doublereal *snr, doublereal *
|
||||
csr, doublereal *snl, doublereal *csl)
|
||||
/* Subroutine */ int dlasv2_(doublereal *f, doublereal *g, doublereal *h__,
|
||||
doublereal *ssmin, doublereal *ssmax, doublereal *snr, doublereal *
|
||||
csr, doublereal *snl, doublereal *csl)
|
||||
{
|
||||
/* System generated locals */
|
||||
doublereal d__1;
|
||||
@ -170,8 +170,8 @@ f"> */
|
||||
double sqrt(doublereal), d_sign(doublereal *, doublereal *);
|
||||
|
||||
/* Local variables */
|
||||
doublereal a, d__, l, m, r__, s, t, fa, ga, ha, ft, gt, ht, mm, tt, clt,
|
||||
crt, slt, srt;
|
||||
doublereal a, d__, l, m, r__, s, t, fa, ga, ha, ft, gt, ht, mm, tt, clt,
|
||||
crt, slt, srt;
|
||||
integer pmax;
|
||||
doublereal temp;
|
||||
logical swap;
|
||||
@ -212,13 +212,13 @@ f"> */
|
||||
pmax = 1;
|
||||
swap = ha > fa;
|
||||
if (swap) {
|
||||
pmax = 3;
|
||||
temp = ft;
|
||||
ft = ht;
|
||||
ht = temp;
|
||||
temp = fa;
|
||||
fa = ha;
|
||||
ha = temp;
|
||||
pmax = 3;
|
||||
temp = ft;
|
||||
ft = ht;
|
||||
ht = temp;
|
||||
temp = fa;
|
||||
fa = ha;
|
||||
ha = temp;
|
||||
|
||||
/* Now FA .ge. HA */
|
||||
|
||||
@ -229,118 +229,118 @@ f"> */
|
||||
|
||||
/* Diagonal matrix */
|
||||
|
||||
*ssmin = ha;
|
||||
*ssmax = fa;
|
||||
clt = 1.;
|
||||
crt = 1.;
|
||||
slt = 0.;
|
||||
srt = 0.;
|
||||
*ssmin = ha;
|
||||
*ssmax = fa;
|
||||
clt = 1.;
|
||||
crt = 1.;
|
||||
slt = 0.;
|
||||
srt = 0.;
|
||||
} else {
|
||||
gasmal = TRUE_;
|
||||
if (ga > fa) {
|
||||
pmax = 2;
|
||||
if (fa / ga < dlamch_((char *)"EPS", (ftnlen)3)) {
|
||||
gasmal = TRUE_;
|
||||
if (ga > fa) {
|
||||
pmax = 2;
|
||||
if (fa / ga < dlamch_((char *)"EPS", (ftnlen)3)) {
|
||||
|
||||
/* Case of very large GA */
|
||||
|
||||
gasmal = FALSE_;
|
||||
*ssmax = ga;
|
||||
if (ha > 1.) {
|
||||
*ssmin = fa / (ga / ha);
|
||||
} else {
|
||||
*ssmin = fa / ga * ha;
|
||||
}
|
||||
clt = 1.;
|
||||
slt = ht / gt;
|
||||
srt = 1.;
|
||||
crt = ft / gt;
|
||||
}
|
||||
}
|
||||
if (gasmal) {
|
||||
gasmal = FALSE_;
|
||||
*ssmax = ga;
|
||||
if (ha > 1.) {
|
||||
*ssmin = fa / (ga / ha);
|
||||
} else {
|
||||
*ssmin = fa / ga * ha;
|
||||
}
|
||||
clt = 1.;
|
||||
slt = ht / gt;
|
||||
srt = 1.;
|
||||
crt = ft / gt;
|
||||
}
|
||||
}
|
||||
if (gasmal) {
|
||||
|
||||
/* Normal case */
|
||||
|
||||
d__ = fa - ha;
|
||||
if (d__ == fa) {
|
||||
d__ = fa - ha;
|
||||
if (d__ == fa) {
|
||||
|
||||
/* Copes with infinite F or H */
|
||||
|
||||
l = 1.;
|
||||
} else {
|
||||
l = d__ / fa;
|
||||
}
|
||||
l = 1.;
|
||||
} else {
|
||||
l = d__ / fa;
|
||||
}
|
||||
|
||||
/* Note that 0 .le. L .le. 1 */
|
||||
|
||||
m = gt / ft;
|
||||
m = gt / ft;
|
||||
|
||||
/* Note that abs(M) .le. 1/macheps */
|
||||
|
||||
t = 2. - l;
|
||||
t = 2. - l;
|
||||
|
||||
/* Note that T .ge. 1 */
|
||||
|
||||
mm = m * m;
|
||||
tt = t * t;
|
||||
s = sqrt(tt + mm);
|
||||
mm = m * m;
|
||||
tt = t * t;
|
||||
s = sqrt(tt + mm);
|
||||
|
||||
/* Note that 1 .le. S .le. 1 + 1/macheps */
|
||||
|
||||
if (l == 0.) {
|
||||
r__ = abs(m);
|
||||
} else {
|
||||
r__ = sqrt(l * l + mm);
|
||||
}
|
||||
if (l == 0.) {
|
||||
r__ = abs(m);
|
||||
} else {
|
||||
r__ = sqrt(l * l + mm);
|
||||
}
|
||||
|
||||
/* Note that 0 .le. R .le. 1 + 1/macheps */
|
||||
|
||||
a = (s + r__) * .5;
|
||||
a = (s + r__) * .5;
|
||||
|
||||
/* Note that 1 .le. A .le. 1 + abs(M) */
|
||||
|
||||
*ssmin = ha / a;
|
||||
*ssmax = fa * a;
|
||||
if (mm == 0.) {
|
||||
*ssmin = ha / a;
|
||||
*ssmax = fa * a;
|
||||
if (mm == 0.) {
|
||||
|
||||
/* Note that M is very tiny */
|
||||
|
||||
if (l == 0.) {
|
||||
t = d_sign(&c_b3, &ft) * d_sign(&c_b4, >);
|
||||
} else {
|
||||
t = gt / d_sign(&d__, &ft) + m / t;
|
||||
}
|
||||
} else {
|
||||
t = (m / (s + t) + m / (r__ + l)) * (a + 1.);
|
||||
}
|
||||
l = sqrt(t * t + 4.);
|
||||
crt = 2. / l;
|
||||
srt = t / l;
|
||||
clt = (crt + srt * m) / a;
|
||||
slt = ht / ft * srt / a;
|
||||
}
|
||||
if (l == 0.) {
|
||||
t = d_sign(&c_b3, &ft) * d_sign(&c_b4, >);
|
||||
} else {
|
||||
t = gt / d_sign(&d__, &ft) + m / t;
|
||||
}
|
||||
} else {
|
||||
t = (m / (s + t) + m / (r__ + l)) * (a + 1.);
|
||||
}
|
||||
l = sqrt(t * t + 4.);
|
||||
crt = 2. / l;
|
||||
srt = t / l;
|
||||
clt = (crt + srt * m) / a;
|
||||
slt = ht / ft * srt / a;
|
||||
}
|
||||
}
|
||||
if (swap) {
|
||||
*csl = srt;
|
||||
*snl = crt;
|
||||
*csr = slt;
|
||||
*snr = clt;
|
||||
*csl = srt;
|
||||
*snl = crt;
|
||||
*csr = slt;
|
||||
*snr = clt;
|
||||
} else {
|
||||
*csl = clt;
|
||||
*snl = slt;
|
||||
*csr = crt;
|
||||
*snr = srt;
|
||||
*csl = clt;
|
||||
*snl = slt;
|
||||
*csr = crt;
|
||||
*snr = srt;
|
||||
}
|
||||
|
||||
/* Correct signs of SSMAX and SSMIN */
|
||||
|
||||
if (pmax == 1) {
|
||||
tsign = d_sign(&c_b4, csr) * d_sign(&c_b4, csl) * d_sign(&c_b4, f);
|
||||
tsign = d_sign(&c_b4, csr) * d_sign(&c_b4, csl) * d_sign(&c_b4, f);
|
||||
}
|
||||
if (pmax == 2) {
|
||||
tsign = d_sign(&c_b4, snr) * d_sign(&c_b4, csl) * d_sign(&c_b4, g);
|
||||
tsign = d_sign(&c_b4, snr) * d_sign(&c_b4, csl) * d_sign(&c_b4, g);
|
||||
}
|
||||
if (pmax == 3) {
|
||||
tsign = d_sign(&c_b4, snr) * d_sign(&c_b4, snl) * d_sign(&c_b4, h__);
|
||||
tsign = d_sign(&c_b4, snr) * d_sign(&c_b4, snl) * d_sign(&c_b4, h__);
|
||||
}
|
||||
*ssmax = d_sign(ssmax, &tsign);
|
||||
d__1 = tsign * d_sign(&c_b4, f) * d_sign(&c_b4, h__);
|
||||
@ -352,5 +352,5 @@ f"> */
|
||||
} /* dlasv2_ */
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
}
|
||||
#endif
|
||||
|
||||
Reference in New Issue
Block a user