GitHub-Proxy/eigen
1
0
Fork 0
mirror of https://gitlab.com/libeigen/eigen.git synced 2025-08-14 04:35:57 +08:00
Code Issues Packages Projects Releases Wiki Activity

keep on cleaning f2c mess

Browse Source
This commit is contained in:
Thomas Capricelli 2009-08-22 07:27:17 +02:00
parent a35586504e
commit bb6ffafdb9
2 changed files with 43 additions and 87 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

60
unsupported/Eigen/src/NonLinear/dogleg.h
View File

@ -4,12 +4,8 @@ void ei_dogleg(int n, const Scalar *r__, int /* lr*/ ,
const Scalar *diag, const Scalar *qtb, Scalar delta, Scalar *x, const Scalar *diag, const Scalar *qtb, Scalar delta, Scalar *x,
Scalar *wa1, Scalar *wa2) Scalar *wa1, Scalar *wa2)
{ {
/* System generated locals */
int i__1, i__2;
Scalar d__1, d__2, d__3, d__4;
/* Local variables */ /* Local variables */
int i__, j, k, l, jj, jp1; int i, j, k, l, jj, jp1;
Scalar sum, temp, alpha, bnorm; Scalar sum, temp, alpha, bnorm;
Scalar gnorm, qnorm, epsmch; Scalar gnorm, qnorm, epsmch;
Scalar sgnorm; Scalar sgnorm;
@ -31,8 +27,7 @@ void ei_dogleg(int n, const Scalar *r__, int /* lr*/ ,
/* first, calculate the gauss-newton direction. */ /* first, calculate the gauss-newton direction. */
jj = n * (n + 1) / 2 + 1; jj = n * (n + 1) / 2 + 1;
i__1 = n; for (k = 1; k <= n; ++k) {
for (k = 1; k <= i__1; ++k) {
j = n - k + 1; j = n - k + 1;
jp1 = j + 1; jp1 = j + 1;
jj -= k; jj -= k;
@ -41,9 +36,8 @@ void ei_dogleg(int n, const Scalar *r__, int /* lr*/ ,
if (n < jp1) { if (n < jp1) {
goto L20; goto L20;
} }
i__2 = n; for (i = jp1; i <= n; ++i) {
for (i__ = jp1; i__ <= i__2; ++i__) { sum += r__[l] * x[i];
sum += r__[l] * x[i__];
++l; ++l;
/* L10: */ /* L10: */
} }
@ -53,12 +47,10 @@ L20:
goto L40; goto L40;
} }
l = j; l = j;
i__2 = j; for (i = 1; i <= j; ++i) {
for (i__ = 1; i__ <= i__2; ++i__) {
/* Computing MAX */ /* Computing MAX */
d__2 = temp, d__3 = fabs(r__[l]); temp = std::max(temp,ei_abs(r__[l]));
temp = std::max(d__2,d__3); l = l + n - i;
l = l + n - i__;
/* L30: */ /* L30: */
} }
temp = epsmch * temp; temp = epsmch * temp;
@ -72,8 +64,7 @@ L40:
/* test whether the gauss-newton direction is acceptable. */ /* test whether the gauss-newton direction is acceptable. */
i__1 = n; for (j = 1; j <= n; ++j) {
for (j = 1; j <= i__1; ++j) {
wa1[j] = 0.; wa1[j] = 0.;
wa2[j] = diag[j] * x[j]; wa2[j] = diag[j] * x[j];
/* L60: */ /* L60: */
@ -88,12 +79,10 @@ L40:
/* next, calculate the scaled gradient direction. */ /* next, calculate the scaled gradient direction. */
l = 1; l = 1;
i__1 = n; for (j = 1; j <= n; ++j) {
for (j = 1; j <= i__1; ++j) {
temp = qtb[j]; temp = qtb[j];
i__2 = n; for (i = j; i <= n; ++i) {
for (i__ = j; i__ <= i__2; ++i__) { wa1[i] += r__[l] * temp;
wa1[i__] += r__[l] * temp;
++l; ++l;
/* L70: */ /* L70: */
} }
@ -114,18 +103,15 @@ L40:
/* calculate the point along the scaled gradient */ /* calculate the point along the scaled gradient */
/* at which the quadratic is minimized. */ /* at which the quadratic is minimized. */
i__1 = n; for (j = 1; j <= n; ++j) {
for (j = 1; j <= i__1; ++j) {
wa1[j] = wa1[j] / gnorm / diag[j]; wa1[j] = wa1[j] / gnorm / diag[j];
/* L90: */ /* L90: */
} }
l = 1; l = 1;
i__1 = n; for (j = 1; j <= n; ++j) {
for (j = 1; j <= i__1; ++j) {
sum = 0.; sum = 0.;
i__2 = n; for (i = j; i <= n; ++i) {
for (i__ = j; i__ <= i__2; ++i__) { sum += r__[l] * wa1[i];
sum += r__[l] * wa1[i__];
++l; ++l;
/* L100: */ /* L100: */
} }
@ -149,26 +135,16 @@ L40:
bnorm = Map< Matrix< Scalar, Dynamic, 1 > >(&qtb[1],n).stableNorm(); bnorm = Map< Matrix< Scalar, Dynamic, 1 > >(&qtb[1],n).stableNorm();
temp = bnorm / gnorm * (bnorm / qnorm) * (sgnorm / delta); temp = bnorm / gnorm * (bnorm / qnorm) * (sgnorm / delta);
/* Computing 2nd power */ /* Computing 2nd power */
d__1 = sgnorm / delta; temp = temp - delta / qnorm * ei_abs2(sgnorm / delta) + ei_sqrt(ei_abs2(temp - delta / qnorm) + (1.-ei_abs2(delta / qnorm)) * (1.-ei_abs2(sgnorm / delta)));
/* Computing 2nd power */ /* Computing 2nd power */
d__2 = temp - delta / qnorm; alpha = delta / qnorm * (1. - ei_abs2(sgnorm / delta)) / temp;
/* Computing 2nd power */
d__3 = delta / qnorm;
/* Computing 2nd power */
d__4 = sgnorm / delta;
temp = temp - delta / qnorm * (d__1 * d__1) + sqrt(d__2 * d__2 + (1. -
d__3 * d__3) * (1. - d__4 * d__4));
/* Computing 2nd power */
d__1 = sgnorm / delta;
alpha = delta / qnorm * (1. - d__1 * d__1) / temp;
L120: L120:
/* form appropriate convex combination of the gauss-newton */ /* form appropriate convex combination of the gauss-newton */
/* direction and the scaled gradient direction. */ /* direction and the scaled gradient direction. */
temp = (1. - alpha) * std::min(sgnorm,delta); temp = (1. - alpha) * std::min(sgnorm,delta);
i__1 = n; for (j = 1; j <= n; ++j) {
for (j = 1; j <= i__1; ++j) {
x[j] = temp * wa1[j] + alpha * x[j]; x[j] = temp * wa1[j] + alpha * x[j];
/* L130: */ /* L130: */
} }

70
unsupported/Eigen/src/NonLinear/lmpar.h
View File

@ -5,17 +5,12 @@ void ei_lmpar(int n, Scalar *r__, int ldr,
Scalar *par, Scalar *x, Scalar *sdiag, Scalar *wa1, Scalar *par, Scalar *x, Scalar *sdiag, Scalar *wa1,
Scalar *wa2) Scalar *wa2)
{ {
/* Initialized data */
#define p1 .1
#define p001 .001
/* System generated locals */ /* System generated locals */
int r_dim1, r_offset, i__1, i__2; int r_dim1, r_offset;
Scalar d__1, d__2; Scalar d__1, d__2;
/* Local variables */ /* Local variables */
int i__, j, k, l; int i, j, k, l;
Scalar fp; Scalar fp;
int jm1, jp1; int jm1, jp1;
Scalar sum, parc, parl; Scalar sum, parc, parl;
@ -47,8 +42,7 @@ void ei_lmpar(int n, Scalar *r__, int ldr,
/* jacobian is rank-deficient, obtain a least squares solution. */ /* jacobian is rank-deficient, obtain a least squares solution. */
nsing = n; nsing = n;
i__1 = n; for (j = 1; j <= n; ++j) {
for (j = 1; j <= i__1; ++j) {
wa1[j] = qtb[j]; wa1[j] = qtb[j];
if (r__[j + j * r_dim1] == 0. && nsing == n) { if (r__[j + j * r_dim1] == 0. && nsing == n) {
nsing = j - 1; nsing = j - 1;
@ -61,8 +55,7 @@ void ei_lmpar(int n, Scalar *r__, int ldr,
if (nsing < 1) { if (nsing < 1) {
goto L50; goto L50;
} }
i__1 = nsing; for (k = 1; k <= nsing; ++k) {
for (k = 1; k <= i__1; ++k) {
j = nsing - k + 1; j = nsing - k + 1;
wa1[j] /= r__[j + j * r_dim1]; wa1[j] /= r__[j + j * r_dim1];
temp = wa1[j]; temp = wa1[j];
@ -70,9 +63,8 @@ void ei_lmpar(int n, Scalar *r__, int ldr,
if (jm1 < 1) { if (jm1 < 1) {
goto L30; goto L30;
} }
i__2 = jm1; for (i = 1; i <= jm1; ++i) {
for (i__ = 1; i__ <= i__2; ++i__) { wa1[i] -= r__[i + j * r_dim1] * temp;
wa1[i__] -= r__[i__ + j * r_dim1] * temp;
/* L20: */ /* L20: */
} }
L30: L30:
@ -80,8 +72,7 @@ L30:
; ;
} }
L50: L50:
i__1 = n; for (j = 1; j <= n; ++j) {
for (j = 1; j <= i__1; ++j) {
l = ipvt[j]; l = ipvt[j];
x[l] = wa1[j]; x[l] = wa1[j];
/* L60: */ /* L60: */
@ -92,14 +83,13 @@ L50:
/* for acceptance of the gauss-newton direction. */ /* for acceptance of the gauss-newton direction. */
iter = 0; iter = 0;
i__1 = n; for (j = 1; j <= n; ++j) {
for (j = 1; j <= i__1; ++j) {
wa2[j] = diag[j] * x[j]; wa2[j] = diag[j] * x[j];
/* L70: */ /* L70: */
} }
dxnorm = Map< Matrix< Scalar, Dynamic, 1 > >(&wa2[1],n).blueNorm(); dxnorm = Map< Matrix< Scalar, Dynamic, 1 > >(&wa2[1],n).blueNorm();
fp = dxnorm - delta; fp = dxnorm - delta;
if (fp <= p1 * delta) { if (fp <= Scalar(0.1) * delta) {
goto L220; goto L220;
} }
@ -111,22 +101,19 @@ L50:
if (nsing < n) { if (nsing < n) {
goto L120; goto L120;
} }
i__1 = n; for (j = 1; j <= n; ++j) {
for (j = 1; j <= i__1; ++j) {
l = ipvt[j]; l = ipvt[j];
wa1[j] = diag[l] * (wa2[l] / dxnorm); wa1[j] = diag[l] * (wa2[l] / dxnorm);
/* L80: */ /* L80: */
} }
i__1 = n; for (j = 1; j <= n; ++j) {
for (j = 1; j <= i__1; ++j) {
sum = 0.; sum = 0.;
jm1 = j - 1; jm1 = j - 1;
if (jm1 < 1) { if (jm1 < 1) {
goto L100; goto L100;
} }
i__2 = jm1; for (i = 1; i <= jm1; ++i) {
for (i__ = 1; i__ <= i__2; ++i__) { sum += r__[i + j * r_dim1] * wa1[i];
sum += r__[i__ + j * r_dim1] * wa1[i__];
/* L90: */ /* L90: */
} }
L100: L100:
@ -139,12 +126,10 @@ L120:
/* calculate an upper bound, paru, for the zero of the function. */ /* calculate an upper bound, paru, for the zero of the function. */
i__1 = n; for (j = 1; j <= n; ++j) {
for (j = 1; j <= i__1; ++j) {
sum = 0.; sum = 0.;
i__2 = j; for (i = 1; i <= j; ++i) {
for (i__ = 1; i__ <= i__2; ++i__) { sum += r__[i + j * r_dim1] * qtb[i];
sum += r__[i__ + j * r_dim1] * qtb[i__];
/* L130: */ /* L130: */
} }
l = ipvt[j]; l = ipvt[j];
@ -154,7 +139,7 @@ L120:
gnorm = Map< Matrix< Scalar, Dynamic, 1 > >(&wa1[1],n).stableNorm(); gnorm = Map< Matrix< Scalar, Dynamic, 1 > >(&wa1[1],n).stableNorm();
paru = gnorm / delta; paru = gnorm / delta;
if (paru == 0.) { if (paru == 0.) {
paru = dwarf / std::min(delta,p1); paru = dwarf / std::min(delta,Scalar(0.1));
} }
/* if the input par lies outside of the interval (parl,paru), */ /* if the input par lies outside of the interval (parl,paru), */
@ -175,18 +160,16 @@ L150:
if (*par == 0.) { if (*par == 0.) {
/* Computing MAX */ /* Computing MAX */
d__1 = dwarf, d__2 = p001 * paru; d__1 = dwarf, d__2 = Scalar(.001) * paru;
*par = std::max(d__1,d__2); *par = std::max(d__1,d__2);
} }
temp = ei_sqrt(*par); temp = ei_sqrt(*par);
i__1 = n; for (j = 1; j <= n; ++j) {
for (j = 1; j <= i__1; ++j) {
wa1[j] = temp * diag[j]; wa1[j] = temp * diag[j];
/* L160: */ /* L160: */
} }
ei_qrsolv<Scalar>(n, &r__[r_offset], ldr, &ipvt[1], &wa1[1], &qtb[1], &x[1], &sdiag[1], &wa2[1]); ei_qrsolv<Scalar>(n, &r__[r_offset], ldr, &ipvt[1], &wa1[1], &qtb[1], &x[1], &sdiag[1], &wa2[1]);
i__1 = n; for (j = 1; j <= n; ++j) {
for (j = 1; j <= i__1; ++j) {
wa2[j] = diag[j] * x[j]; wa2[j] = diag[j] * x[j];
/* L170: */ /* L170: */
} }
@ -198,30 +181,27 @@ L150:
/* of par. also test for the exceptional cases where parl */ /* of par. also test for the exceptional cases where parl */
/* is zero or the number of iterations has reached 10. */ /* is zero or the number of iterations has reached 10. */
if (ei_abs(fp) <= p1 * delta || (parl == 0. && fp <= temp && temp < 0.) || if (ei_abs(fp) <= Scalar(0.1) * delta || (parl == 0. && fp <= temp && temp < 0.) ||
iter == 10) { iter == 10) {
goto L220; goto L220;
} }
/* compute the newton correction. */ /* compute the newton correction. */
i__1 = n; for (j = 1; j <= n; ++j) {
for (j = 1; j <= i__1; ++j) {
l = ipvt[j]; l = ipvt[j];
wa1[j] = diag[l] * (wa2[l] / dxnorm); wa1[j] = diag[l] * (wa2[l] / dxnorm);
/* L180: */ /* L180: */
} }
i__1 = n; for (j = 1; j <= n; ++j) {
for (j = 1; j <= i__1; ++j) {
wa1[j] /= sdiag[j]; wa1[j] /= sdiag[j];
temp = wa1[j]; temp = wa1[j];
jp1 = j + 1; jp1 = j + 1;
if (n < jp1) { if (n < jp1) {
goto L200; goto L200;
} }
i__2 = n; for (i = jp1; i <= n; ++i) {
for (i__ = jp1; i__ <= i__2; ++i__) { wa1[i] -= r__[i + j * r_dim1] * temp;
wa1[i__] -= r__[i__ + j * r_dim1] * temp;
/* L190: */ /* L190: */
} }
L200: L200: