GitHub-Proxy/eigen
1
0
Fork 0
mirror of https://gitlab.com/libeigen/eigen.git synced 2025-06-20 11:56:17 +08:00
Code Issues Packages Projects Releases Wiki Activity

cleaning a little bit the f2c mess for chkder

Browse Source
This commit is contained in:
Thomas Capricelli 2009-08-20 23:07:16 +02:00
parent b09ebe01da
commit 2e3fa34b9f
1 changed files with 46 additions and 70 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

116
unsupported/Eigen/src/NonLinear/chkder.h
View File

@ -4,18 +4,17 @@
/* Table of constant values */ /* Table of constant values */
template<typename Scalar> template<typename Scalar>
void chkder_template(int m, int n, const Scalar *x, void chkder_template(int m, int n, const Scalar *x,
Scalar *fvec, Scalar *fjac, int ldfjac, Scalar *xp, Scalar *fvec, Scalar *fjac, int ldfjac, Scalar *xp,
Scalar *fvecp, int mode, Scalar *err) Scalar *fvecp, int mode, Scalar *err)
{ {
/* System generated locals */ /* System generated locals */
int fjac_dim1, fjac_offset, i__1, i__2; int fjac_offset;
/* Local variables */ /* Local variables */
int i__, j; int i__, j;
Scalar eps, epsf, temp; Scalar temp;
Scalar epslog;
/* Parameter adjustments */ /* Parameter adjustments */
--err; --err;
@ -23,79 +22,56 @@ void chkder_template(int m, int n, const Scalar *x,
--fvec; --fvec;
--xp; --xp;
--x; --x;
fjac_dim1 = ldfjac; fjac_offset = 1 + ldfjac;
fjac_offset = 1 + fjac_dim1 * 1;
fjac -= fjac_offset; fjac -= fjac_offset;
/* Function Body */ /* Function Body */
eps = ei_sqrt(epsilon<Scalar>()); const Scalar eps = ei_sqrt(epsilon<Scalar>());
if (mode == 2) { if (mode != 2) {
goto L20; /* mode = 1. */
for (j = 1; j <= n; ++j) {
temp = eps * fabs(x[j]);
if (temp == 0.) {
temp = eps;
}
xp[j] = x[j] + temp;
}
return;
} }
/* mode = 1. */ /* mode = 2. */
const Scalar epsf = chkder_factor * epsilon<Scalar>();
i__1 = n; const Scalar epslog = chkder_log10e * log(eps);
for (j = 1; j <= i__1; ++j) { for (i__ = 1; i__ <= m; ++i__) {
temp = eps * fabs(x[j]); err[i__] = 0.;
if (temp == 0.) {
temp = eps;
}
xp[j] = x[j] + temp;
/* L10: */
} }
/* goto L70; */ for (j = 1; j <= n; ++j) {
return; temp = fabs(x[j]);
L20: if (temp == 0.) {
temp = 1.;
/* mode = 2. */ }
for (i__ = 1; i__ <= m; ++i__) {
epsf = chkder_factor * epsilon<Scalar>(); err[i__] += temp * fjac[i__ + j * ldfjac];
epslog = chkder_log10e * log(eps); }
i__1 = m;
for (i__ = 1; i__ <= i__1; ++i__) {
err[i__] = 0.;
/* L30: */
} }
i__1 = n; for (i__ = 1; i__ <= m; ++i__) {
for (j = 1; j <= i__1; ++j) { temp = 1.;
temp = fabs(x[j]); if (fvec[i__] != 0. && fvecp[i__] != 0. && fabs(fvecp[i__] -
if (temp == 0.) { fvec[i__]) >= epsf * fabs(fvec[i__]))
temp = 1.; {
} temp = eps * fabs((fvecp[i__] - fvec[i__]) / eps - err[i__])
i__2 = m; / (fabs(fvec[i__]) +
for (i__ = 1; i__ <= i__2; ++i__) { fabs(fvecp[i__]));
err[i__] += temp * fjac[i__ + j * fjac_dim1]; }
/* L40: */ err[i__] = 1.;
} if (temp > epsilon<Scalar>() && temp < eps) {
/* L50: */ err[i__] = (chkder_log10e * log(temp) - epslog) / epslog;
}
if (temp >= eps) {
err[i__] = 0.;
}
} }
i__1 = m;
for (i__ = 1; i__ <= i__1; ++i__) {
temp = 1.;
if (fvec[i__] != 0. && fvecp[i__] != 0. && fabs(fvecp[i__] -
fvec[i__]) >= epsf * fabs(fvec[i__]))
{
temp = eps * fabs((fvecp[i__] - fvec[i__]) / eps - err[i__])
/ (fabs(fvec[i__]) +
fabs(fvecp[i__]));
}
err[i__] = 1.;
if (temp > epsilon<Scalar>() && temp < eps) {
err[i__] = (chkder_log10e * log(temp) - epslog) / epslog;
}
if (temp >= eps) {
err[i__] = 0.;
}
/* L60: */
}
/* L70: */
/* return 0; */
/* last card of subroutine chkder. */
} /* chkder_ */ } /* chkder_ */