whitespace fixes
This commit is contained in:
Axel Kohlmeyer
@ -1,13 +1,13 @@
|
||||
/* fortran/dlasq4.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
|
||||
@ -167,10 +167,10 @@ f"> */
|
||||
/* > \endverbatim */
|
||||
/* > */
|
||||
/* ===================================================================== */
|
||||
/* Subroutine */ int dlasq4_(integer *i0, integer *n0, doublereal *z__,
|
||||
integer *pp, integer *n0in, doublereal *dmin__, doublereal *dmin1,
|
||||
doublereal *dmin2, doublereal *dn, doublereal *dn1, doublereal *dn2,
|
||||
doublereal *tau, integer *ttype, doublereal *g)
|
||||
/* Subroutine */ int dlasq4_(integer *i0, integer *n0, doublereal *z__,
|
||||
integer *pp, integer *n0in, doublereal *dmin__, doublereal *dmin1,
|
||||
doublereal *dmin2, doublereal *dn, doublereal *dn1, doublereal *dn2,
|
||||
doublereal *tau, integer *ttype, doublereal *g)
|
||||
{
|
||||
/* System generated locals */
|
||||
integer i__1;
|
||||
@ -212,9 +212,9 @@ f"> */
|
||||
|
||||
/* Function Body */
|
||||
if (*dmin__ <= 0.) {
|
||||
*tau = -(*dmin__);
|
||||
*ttype = -1;
|
||||
return 0;
|
||||
*tau = -(*dmin__);
|
||||
*ttype = -1;
|
||||
return 0;
|
||||
}
|
||||
|
||||
nn = (*n0 << 2) + *pp;
|
||||
@ -222,215 +222,215 @@ f"> */
|
||||
|
||||
/* No eigenvalues deflated. */
|
||||
|
||||
if (*dmin__ == *dn || *dmin__ == *dn1) {
|
||||
if (*dmin__ == *dn || *dmin__ == *dn1) {
|
||||
|
||||
b1 = sqrt(z__[nn - 3]) * sqrt(z__[nn - 5]);
|
||||
b2 = sqrt(z__[nn - 7]) * sqrt(z__[nn - 9]);
|
||||
a2 = z__[nn - 7] + z__[nn - 5];
|
||||
b1 = sqrt(z__[nn - 3]) * sqrt(z__[nn - 5]);
|
||||
b2 = sqrt(z__[nn - 7]) * sqrt(z__[nn - 9]);
|
||||
a2 = z__[nn - 7] + z__[nn - 5];
|
||||
|
||||
/* Cases 2 and 3. */
|
||||
|
||||
if (*dmin__ == *dn && *dmin1 == *dn1) {
|
||||
gap2 = *dmin2 - a2 - *dmin2 * .25;
|
||||
if (gap2 > 0. && gap2 > b2) {
|
||||
gap1 = a2 - *dn - b2 / gap2 * b2;
|
||||
} else {
|
||||
gap1 = a2 - *dn - (b1 + b2);
|
||||
}
|
||||
if (gap1 > 0. && gap1 > b1) {
|
||||
if (*dmin__ == *dn && *dmin1 == *dn1) {
|
||||
gap2 = *dmin2 - a2 - *dmin2 * .25;
|
||||
if (gap2 > 0. && gap2 > b2) {
|
||||
gap1 = a2 - *dn - b2 / gap2 * b2;
|
||||
} else {
|
||||
gap1 = a2 - *dn - (b1 + b2);
|
||||
}
|
||||
if (gap1 > 0. && gap1 > b1) {
|
||||
/* Computing MAX */
|
||||
d__1 = *dn - b1 / gap1 * b1, d__2 = *dmin__ * .5;
|
||||
s = max(d__1,d__2);
|
||||
*ttype = -2;
|
||||
} else {
|
||||
s = 0.;
|
||||
if (*dn > b1) {
|
||||
s = *dn - b1;
|
||||
}
|
||||
if (a2 > b1 + b2) {
|
||||
d__1 = *dn - b1 / gap1 * b1, d__2 = *dmin__ * .5;
|
||||
s = max(d__1,d__2);
|
||||
*ttype = -2;
|
||||
} else {
|
||||
s = 0.;
|
||||
if (*dn > b1) {
|
||||
s = *dn - b1;
|
||||
}
|
||||
if (a2 > b1 + b2) {
|
||||
/* Computing MIN */
|
||||
d__1 = s, d__2 = a2 - (b1 + b2);
|
||||
s = min(d__1,d__2);
|
||||
}
|
||||
d__1 = s, d__2 = a2 - (b1 + b2);
|
||||
s = min(d__1,d__2);
|
||||
}
|
||||
/* Computing MAX */
|
||||
d__1 = s, d__2 = *dmin__ * .333;
|
||||
s = max(d__1,d__2);
|
||||
*ttype = -3;
|
||||
}
|
||||
} else {
|
||||
d__1 = s, d__2 = *dmin__ * .333;
|
||||
s = max(d__1,d__2);
|
||||
*ttype = -3;
|
||||
}
|
||||
} else {
|
||||
|
||||
/* Case 4. */
|
||||
|
||||
*ttype = -4;
|
||||
s = *dmin__ * .25;
|
||||
if (*dmin__ == *dn) {
|
||||
gam = *dn;
|
||||
a2 = 0.;
|
||||
if (z__[nn - 5] > z__[nn - 7]) {
|
||||
return 0;
|
||||
}
|
||||
b2 = z__[nn - 5] / z__[nn - 7];
|
||||
np = nn - 9;
|
||||
} else {
|
||||
np = nn - (*pp << 1);
|
||||
gam = *dn1;
|
||||
if (z__[np - 4] > z__[np - 2]) {
|
||||
return 0;
|
||||
}
|
||||
a2 = z__[np - 4] / z__[np - 2];
|
||||
if (z__[nn - 9] > z__[nn - 11]) {
|
||||
return 0;
|
||||
}
|
||||
b2 = z__[nn - 9] / z__[nn - 11];
|
||||
np = nn - 13;
|
||||
}
|
||||
*ttype = -4;
|
||||
s = *dmin__ * .25;
|
||||
if (*dmin__ == *dn) {
|
||||
gam = *dn;
|
||||
a2 = 0.;
|
||||
if (z__[nn - 5] > z__[nn - 7]) {
|
||||
return 0;
|
||||
}
|
||||
b2 = z__[nn - 5] / z__[nn - 7];
|
||||
np = nn - 9;
|
||||
} else {
|
||||
np = nn - (*pp << 1);
|
||||
gam = *dn1;
|
||||
if (z__[np - 4] > z__[np - 2]) {
|
||||
return 0;
|
||||
}
|
||||
a2 = z__[np - 4] / z__[np - 2];
|
||||
if (z__[nn - 9] > z__[nn - 11]) {
|
||||
return 0;
|
||||
}
|
||||
b2 = z__[nn - 9] / z__[nn - 11];
|
||||
np = nn - 13;
|
||||
}
|
||||
|
||||
/* Approximate contribution to norm squared from I < NN-1. */
|
||||
|
||||
a2 += b2;
|
||||
i__1 = (*i0 << 2) - 1 + *pp;
|
||||
for (i4 = np; i4 >= i__1; i4 += -4) {
|
||||
if (b2 == 0.) {
|
||||
goto L20;
|
||||
}
|
||||
b1 = b2;
|
||||
if (z__[i4] > z__[i4 - 2]) {
|
||||
return 0;
|
||||
}
|
||||
b2 *= z__[i4] / z__[i4 - 2];
|
||||
a2 += b2;
|
||||
if (max(b2,b1) * 100. < a2 || .563 < a2) {
|
||||
goto L20;
|
||||
}
|
||||
a2 += b2;
|
||||
i__1 = (*i0 << 2) - 1 + *pp;
|
||||
for (i4 = np; i4 >= i__1; i4 += -4) {
|
||||
if (b2 == 0.) {
|
||||
goto L20;
|
||||
}
|
||||
b1 = b2;
|
||||
if (z__[i4] > z__[i4 - 2]) {
|
||||
return 0;
|
||||
}
|
||||
b2 *= z__[i4] / z__[i4 - 2];
|
||||
a2 += b2;
|
||||
if (max(b2,b1) * 100. < a2 || .563 < a2) {
|
||||
goto L20;
|
||||
}
|
||||
/* L10: */
|
||||
}
|
||||
}
|
||||
L20:
|
||||
a2 *= 1.05;
|
||||
a2 *= 1.05;
|
||||
|
||||
/* Rayleigh quotient residual bound. */
|
||||
|
||||
if (a2 < .563) {
|
||||
s = gam * (1. - sqrt(a2)) / (a2 + 1.);
|
||||
}
|
||||
}
|
||||
} else if (*dmin__ == *dn2) {
|
||||
if (a2 < .563) {
|
||||
s = gam * (1. - sqrt(a2)) / (a2 + 1.);
|
||||
}
|
||||
}
|
||||
} else if (*dmin__ == *dn2) {
|
||||
|
||||
/* Case 5. */
|
||||
|
||||
*ttype = -5;
|
||||
s = *dmin__ * .25;
|
||||
*ttype = -5;
|
||||
s = *dmin__ * .25;
|
||||
|
||||
/* Compute contribution to norm squared from I > NN-2. */
|
||||
|
||||
np = nn - (*pp << 1);
|
||||
b1 = z__[np - 2];
|
||||
b2 = z__[np - 6];
|
||||
gam = *dn2;
|
||||
if (z__[np - 8] > b2 || z__[np - 4] > b1) {
|
||||
return 0;
|
||||
}
|
||||
a2 = z__[np - 8] / b2 * (z__[np - 4] / b1 + 1.);
|
||||
np = nn - (*pp << 1);
|
||||
b1 = z__[np - 2];
|
||||
b2 = z__[np - 6];
|
||||
gam = *dn2;
|
||||
if (z__[np - 8] > b2 || z__[np - 4] > b1) {
|
||||
return 0;
|
||||
}
|
||||
a2 = z__[np - 8] / b2 * (z__[np - 4] / b1 + 1.);
|
||||
|
||||
/* Approximate contribution to norm squared from I < NN-2. */
|
||||
|
||||
if (*n0 - *i0 > 2) {
|
||||
b2 = z__[nn - 13] / z__[nn - 15];
|
||||
a2 += b2;
|
||||
i__1 = (*i0 << 2) - 1 + *pp;
|
||||
for (i4 = nn - 17; i4 >= i__1; i4 += -4) {
|
||||
if (b2 == 0.) {
|
||||
goto L40;
|
||||
}
|
||||
b1 = b2;
|
||||
if (z__[i4] > z__[i4 - 2]) {
|
||||
return 0;
|
||||
}
|
||||
b2 *= z__[i4] / z__[i4 - 2];
|
||||
a2 += b2;
|
||||
if (max(b2,b1) * 100. < a2 || .563 < a2) {
|
||||
goto L40;
|
||||
}
|
||||
if (*n0 - *i0 > 2) {
|
||||
b2 = z__[nn - 13] / z__[nn - 15];
|
||||
a2 += b2;
|
||||
i__1 = (*i0 << 2) - 1 + *pp;
|
||||
for (i4 = nn - 17; i4 >= i__1; i4 += -4) {
|
||||
if (b2 == 0.) {
|
||||
goto L40;
|
||||
}
|
||||
b1 = b2;
|
||||
if (z__[i4] > z__[i4 - 2]) {
|
||||
return 0;
|
||||
}
|
||||
b2 *= z__[i4] / z__[i4 - 2];
|
||||
a2 += b2;
|
||||
if (max(b2,b1) * 100. < a2 || .563 < a2) {
|
||||
goto L40;
|
||||
}
|
||||
/* L30: */
|
||||
}
|
||||
}
|
||||
L40:
|
||||
a2 *= 1.05;
|
||||
}
|
||||
a2 *= 1.05;
|
||||
}
|
||||
|
||||
if (a2 < .563) {
|
||||
s = gam * (1. - sqrt(a2)) / (a2 + 1.);
|
||||
}
|
||||
} else {
|
||||
if (a2 < .563) {
|
||||
s = gam * (1. - sqrt(a2)) / (a2 + 1.);
|
||||
}
|
||||
} else {
|
||||
|
||||
/* Case 6, no information to guide us. */
|
||||
|
||||
if (*ttype == -6) {
|
||||
*g += (1. - *g) * .333;
|
||||
} else if (*ttype == -18) {
|
||||
*g = .083250000000000005;
|
||||
} else {
|
||||
*g = .25;
|
||||
}
|
||||
s = *g * *dmin__;
|
||||
*ttype = -6;
|
||||
}
|
||||
if (*ttype == -6) {
|
||||
*g += (1. - *g) * .333;
|
||||
} else if (*ttype == -18) {
|
||||
*g = .083250000000000005;
|
||||
} else {
|
||||
*g = .25;
|
||||
}
|
||||
s = *g * *dmin__;
|
||||
*ttype = -6;
|
||||
}
|
||||
|
||||
} else if (*n0in == *n0 + 1) {
|
||||
|
||||
/* One eigenvalue just deflated. Use DMIN1, DN1 for DMIN and DN. */
|
||||
|
||||
if (*dmin1 == *dn1 && *dmin2 == *dn2) {
|
||||
if (*dmin1 == *dn1 && *dmin2 == *dn2) {
|
||||
|
||||
/* Cases 7 and 8. */
|
||||
|
||||
*ttype = -7;
|
||||
s = *dmin1 * .333;
|
||||
if (z__[nn - 5] > z__[nn - 7]) {
|
||||
return 0;
|
||||
}
|
||||
b1 = z__[nn - 5] / z__[nn - 7];
|
||||
b2 = b1;
|
||||
if (b2 == 0.) {
|
||||
goto L60;
|
||||
}
|
||||
i__1 = (*i0 << 2) - 1 + *pp;
|
||||
for (i4 = (*n0 << 2) - 9 + *pp; i4 >= i__1; i4 += -4) {
|
||||
a2 = b1;
|
||||
if (z__[i4] > z__[i4 - 2]) {
|
||||
return 0;
|
||||
}
|
||||
b1 *= z__[i4] / z__[i4 - 2];
|
||||
b2 += b1;
|
||||
if (max(b1,a2) * 100. < b2) {
|
||||
goto L60;
|
||||
}
|
||||
*ttype = -7;
|
||||
s = *dmin1 * .333;
|
||||
if (z__[nn - 5] > z__[nn - 7]) {
|
||||
return 0;
|
||||
}
|
||||
b1 = z__[nn - 5] / z__[nn - 7];
|
||||
b2 = b1;
|
||||
if (b2 == 0.) {
|
||||
goto L60;
|
||||
}
|
||||
i__1 = (*i0 << 2) - 1 + *pp;
|
||||
for (i4 = (*n0 << 2) - 9 + *pp; i4 >= i__1; i4 += -4) {
|
||||
a2 = b1;
|
||||
if (z__[i4] > z__[i4 - 2]) {
|
||||
return 0;
|
||||
}
|
||||
b1 *= z__[i4] / z__[i4 - 2];
|
||||
b2 += b1;
|
||||
if (max(b1,a2) * 100. < b2) {
|
||||
goto L60;
|
||||
}
|
||||
/* L50: */
|
||||
}
|
||||
}
|
||||
L60:
|
||||
b2 = sqrt(b2 * 1.05);
|
||||
b2 = sqrt(b2 * 1.05);
|
||||
/* Computing 2nd power */
|
||||
d__1 = b2;
|
||||
a2 = *dmin1 / (d__1 * d__1 + 1.);
|
||||
gap2 = *dmin2 * .5 - a2;
|
||||
if (gap2 > 0. && gap2 > b2 * a2) {
|
||||
d__1 = b2;
|
||||
a2 = *dmin1 / (d__1 * d__1 + 1.);
|
||||
gap2 = *dmin2 * .5 - a2;
|
||||
if (gap2 > 0. && gap2 > b2 * a2) {
|
||||
/* Computing MAX */
|
||||
d__1 = s, d__2 = a2 * (1. - a2 * 1.01 * (b2 / gap2) * b2);
|
||||
s = max(d__1,d__2);
|
||||
} else {
|
||||
d__1 = s, d__2 = a2 * (1. - a2 * 1.01 * (b2 / gap2) * b2);
|
||||
s = max(d__1,d__2);
|
||||
} else {
|
||||
/* Computing MAX */
|
||||
d__1 = s, d__2 = a2 * (1. - b2 * 1.01);
|
||||
s = max(d__1,d__2);
|
||||
*ttype = -8;
|
||||
}
|
||||
} else {
|
||||
d__1 = s, d__2 = a2 * (1. - b2 * 1.01);
|
||||
s = max(d__1,d__2);
|
||||
*ttype = -8;
|
||||
}
|
||||
} else {
|
||||
|
||||
/* Case 9. */
|
||||
|
||||
s = *dmin1 * .25;
|
||||
if (*dmin1 == *dn1) {
|
||||
s = *dmin1 * .5;
|
||||
}
|
||||
*ttype = -9;
|
||||
}
|
||||
s = *dmin1 * .25;
|
||||
if (*dmin1 == *dn1) {
|
||||
s = *dmin1 * .5;
|
||||
}
|
||||
*ttype = -9;
|
||||
}
|
||||
|
||||
} else if (*n0in == *n0 + 2) {
|
||||
|
||||
@ -438,55 +438,55 @@ L60:
|
||||
|
||||
/* Cases 10 and 11. */
|
||||
|
||||
if (*dmin2 == *dn2 && z__[nn - 5] * 2. < z__[nn - 7]) {
|
||||
*ttype = -10;
|
||||
s = *dmin2 * .333;
|
||||
if (z__[nn - 5] > z__[nn - 7]) {
|
||||
return 0;
|
||||
}
|
||||
b1 = z__[nn - 5] / z__[nn - 7];
|
||||
b2 = b1;
|
||||
if (b2 == 0.) {
|
||||
goto L80;
|
||||
}
|
||||
i__1 = (*i0 << 2) - 1 + *pp;
|
||||
for (i4 = (*n0 << 2) - 9 + *pp; i4 >= i__1; i4 += -4) {
|
||||
if (z__[i4] > z__[i4 - 2]) {
|
||||
return 0;
|
||||
}
|
||||
b1 *= z__[i4] / z__[i4 - 2];
|
||||
b2 += b1;
|
||||
if (b1 * 100. < b2) {
|
||||
goto L80;
|
||||
}
|
||||
if (*dmin2 == *dn2 && z__[nn - 5] * 2. < z__[nn - 7]) {
|
||||
*ttype = -10;
|
||||
s = *dmin2 * .333;
|
||||
if (z__[nn - 5] > z__[nn - 7]) {
|
||||
return 0;
|
||||
}
|
||||
b1 = z__[nn - 5] / z__[nn - 7];
|
||||
b2 = b1;
|
||||
if (b2 == 0.) {
|
||||
goto L80;
|
||||
}
|
||||
i__1 = (*i0 << 2) - 1 + *pp;
|
||||
for (i4 = (*n0 << 2) - 9 + *pp; i4 >= i__1; i4 += -4) {
|
||||
if (z__[i4] > z__[i4 - 2]) {
|
||||
return 0;
|
||||
}
|
||||
b1 *= z__[i4] / z__[i4 - 2];
|
||||
b2 += b1;
|
||||
if (b1 * 100. < b2) {
|
||||
goto L80;
|
||||
}
|
||||
/* L70: */
|
||||
}
|
||||
}
|
||||
L80:
|
||||
b2 = sqrt(b2 * 1.05);
|
||||
b2 = sqrt(b2 * 1.05);
|
||||
/* Computing 2nd power */
|
||||
d__1 = b2;
|
||||
a2 = *dmin2 / (d__1 * d__1 + 1.);
|
||||
gap2 = z__[nn - 7] + z__[nn - 9] - sqrt(z__[nn - 11]) * sqrt(z__[
|
||||
nn - 9]) - a2;
|
||||
if (gap2 > 0. && gap2 > b2 * a2) {
|
||||
d__1 = b2;
|
||||
a2 = *dmin2 / (d__1 * d__1 + 1.);
|
||||
gap2 = z__[nn - 7] + z__[nn - 9] - sqrt(z__[nn - 11]) * sqrt(z__[
|
||||
nn - 9]) - a2;
|
||||
if (gap2 > 0. && gap2 > b2 * a2) {
|
||||
/* Computing MAX */
|
||||
d__1 = s, d__2 = a2 * (1. - a2 * 1.01 * (b2 / gap2) * b2);
|
||||
s = max(d__1,d__2);
|
||||
} else {
|
||||
d__1 = s, d__2 = a2 * (1. - a2 * 1.01 * (b2 / gap2) * b2);
|
||||
s = max(d__1,d__2);
|
||||
} else {
|
||||
/* Computing MAX */
|
||||
d__1 = s, d__2 = a2 * (1. - b2 * 1.01);
|
||||
s = max(d__1,d__2);
|
||||
}
|
||||
} else {
|
||||
s = *dmin2 * .25;
|
||||
*ttype = -11;
|
||||
}
|
||||
d__1 = s, d__2 = a2 * (1. - b2 * 1.01);
|
||||
s = max(d__1,d__2);
|
||||
}
|
||||
} else {
|
||||
s = *dmin2 * .25;
|
||||
*ttype = -11;
|
||||
}
|
||||
} else if (*n0in > *n0 + 2) {
|
||||
|
||||
/* Case 12, more than two eigenvalues deflated. No information. */
|
||||
|
||||
s = 0.;
|
||||
*ttype = -12;
|
||||
s = 0.;
|
||||
*ttype = -12;
|
||||
}
|
||||
|
||||
*tau = s;
|
||||
@ -497,5 +497,5 @@ L80:
|
||||
} /* dlasq4_ */
|
||||
|
||||
#ifdef __cplusplus
|
||||
}
|
||||
}
|
||||
#endif
|
||||
|
||||
Reference in New Issue
Block a user