cleaning a little bit the f2c mess for chkder

This commit is contained in:
Thomas Capricelli 2009-08-20 23:07:16 +02:00
parent b09ebe01da
commit 2e3fa34b9f

View File

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