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) 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,57 +22,41 @@ 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) {
goto L20;
}
if (mode != 2) {
/* mode = 1. */ /* mode = 1. */
for (j = 1; j <= n; ++j) {
i__1 = n;
for (j = 1; j <= i__1; ++j) {
temp = eps * fabs(x[j]); temp = eps * fabs(x[j]);
if (temp == 0.) { if (temp == 0.) {
temp = eps; temp = eps;
} }
xp[j] = x[j] + temp; xp[j] = x[j] + temp;
/* L10: */
} }
/* goto L70; */
return; return;
L20: }
/* mode = 2. */ /* mode = 2. */
const Scalar epsf = chkder_factor * epsilon<Scalar>();
epsf = chkder_factor * epsilon<Scalar>(); const Scalar epslog = chkder_log10e * log(eps);
epslog = chkder_log10e * log(eps); for (i__ = 1; i__ <= m; ++i__) {
i__1 = m;
for (i__ = 1; i__ <= i__1; ++i__) {
err[i__] = 0.; err[i__] = 0.;
/* L30: */
} }
i__1 = n; for (j = 1; j <= n; ++j) {
for (j = 1; j <= i__1; ++j) {
temp = fabs(x[j]); temp = fabs(x[j]);
if (temp == 0.) { if (temp == 0.) {
temp = 1.; temp = 1.;
} }
i__2 = m; for (i__ = 1; i__ <= m; ++i__) {
for (i__ = 1; i__ <= i__2; ++i__) { err[i__] += temp * fjac[i__ + j * ldfjac];
err[i__] += temp * fjac[i__ + j * fjac_dim1];
/* L40: */
} }
/* L50: */
} }
i__1 = m; for (i__ = 1; i__ <= m; ++i__) {
for (i__ = 1; i__ <= i__1; ++i__) {
temp = 1.; temp = 1.;
if (fvec[i__] != 0. && fvecp[i__] != 0. && fabs(fvecp[i__] - if (fvec[i__] != 0. && fvecp[i__] != 0. && fabs(fvecp[i__] -
fvec[i__]) >= epsf * fabs(fvec[i__])) fvec[i__]) >= epsf * fabs(fvec[i__]))
@ -89,13 +72,6 @@ L20:
if (temp >= eps) { if (temp >= eps) {
err[i__] = 0.; err[i__] = 0.;
} }
/* L60: */
} }
/* L70: */
/* return 0; */
/* last card of subroutine chkder. */
} /* chkder_ */ } /* chkder_ */