void fcn(const int *m, const int *n, const real *x, real *fvec, int *iflag)
{
/* ********** */
/* the calling sequence of fcn should be identical to the */
/* calling sequence of the function subroutine in the nonlinear */
/* least-squares solver. fcn should only call the testing */
/* function and jacobian subroutines ssqfcn and ssqjac with */
/* the appropriate value of problem number (nprob). */
/* subprograms called */
/* minpack-supplied ... ssqfcn,ssqjac */
/* argonne national laboratory. minpack project. march 1980. */
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
/* ********** */
ssqfcn(*m,*n,x,fvec,lmdiftest.nprob);
if (*iflag == 1) {
lmdiftest.nfev++;
}
if (*iflag == 2) {
lmdiftest.njev++;
}
} /* fcn_ */
int fcn(void *p, int m, int n, const real *x, real *fvec, real *fjrow, int iflag)
{
/* Local variables */
int j;
/* ********** */
/* the calling sequence of fcn should be identical to the */
/* calling sequence of the function subroutine in the nonlinear */
/* least squares solver. if iflag = 1, fcn should only call the */
/* testing function subroutine ssqfcn. if iflag = i, i .ge. 2, */
/* fcn should only call subroutine ssqjac to calculate the */
/* (i-1)-st row of the jacobian. (the ssqjac subroutine provided */
/* here for testing purposes calculates the entire jacobian */
/* matrix and is therefore called only when iflag = 2.) each */
/* call to ssqfcn or ssqjac should specify the appropriate */
/* value of problem number (nprob). */
/* subprograms called */
/* minpack-supplied ... ssqfcn,ssqjac */
/* argonne national laboratory. minpack project. march 1980. */
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
/* ********** */
struct refnum *lmstrtest = (struct refnum *)p;
if (iflag == 1) {
ssqfcn(m,n,x,fvec,lmstrtest->nprob);
lmstrtest->nfev++;
}
if (iflag >= 2) {
if (iflag == 2) {
ssqjac(m,n,x,temp,65,lmstrtest->nprob);
lmstrtest->njev++;
}
for (j = 0; j < n; ++j) {
fjrow[j] = temp[(iflag - 2) + j * 65];
}
}
return 0;
} /* fcn_ */
/* Main program */
int main(int argc, char **argv)
{
int i,ic,k,m,n,ntries;
int info;
int ma[60];
int na[60];
int nf[60];
int nj[60];
int np[60];
int nx[60];
real factor,fnorm1,fnorm2,tol;
real fnm[60];
real fvec[65];
real x[40];
int iwa[40];
real wa[65*40+5*40+65];
const int lwa = 65*40+5*40+65;
const int i1 = 1;
tol = sqrt(__minpack_func__(dpmpar)(&i1));
ic = 0;
for (;;) {
scanf("%5d%5d%5d%5d\n", &lmdiftest.nprob, &n, &m, &ntries);
/*
read (nread,50) nprob,n,m,ntries
50 format (4i5)
*/
if (lmdiftest.nprob <= 0.)
break;
factor = 1.;
for (k = 0; k < ntries; ++k, ++ic) {
lmdipt(n,x,lmdiftest.nprob,factor);
ssqfcn(m,n,x,fvec,lmdiftest.nprob);
fnorm1 = __minpack_func__(enorm)(&m,fvec);
printf("\n\n\n\n problem%5d dimensions%5d%5d\n\n", lmdiftest.nprob, n, m);
/*
write (nwrite,60) nprob,n,m
60 format ( //// 5x, 8h problem, i5, 5x, 11h dimensions, 2i5, 5x //
* )
*/
lmdiftest.nfev = 0;
lmdiftest.njev = 0;
__minpack_func__(lmdif1)(fcn,&m,&n,x,fvec,&tol,&info,iwa,wa,&lwa);
ssqfcn(m,n,x,fvec,lmdiftest.nprob);
fnorm2 = __minpack_func__(enorm)(&m,fvec);
np[ic] = lmdiftest.nprob;
na[ic] = n;
ma[ic] = m;
nf[ic] = lmdiftest.nfev;
lmdiftest.njev /= n;
nj[ic] = lmdiftest.njev;
nx[ic] = info;
fnm[ic] = fnorm2;
printf("\n initial l2 norm of the residuals%15.7e\n"
"\n final l2 norm of the residuals %15.7e\n"
"\n number of function evaluations %10d\n"
"\n number of Jacobian evaluations %10d\n"
"\n exit parameter %10d\n"
"\n final approximate solution\n\n",
(double)fnorm1, (double)fnorm2, lmdiftest.nfev, lmdiftest.njev, info);
printvec(n, x);
/*
write (nwrite,70)
* fnorm1,fnorm2,nfev,njev,info,(x(i), i = 1, n)
70 format (5x, 33h initial l2 norm of the residuals, d15.7 // 5x,
* 33h final l2 norm of the residuals , d15.7 // 5x,
* 33h number of function evaluations , i10 // 5x,
* 33h number of jacobian evaluations , i10 // 5x,
* 15h exit parameter, 18x, i10 // 5x,
* 27h final approximate solution // (5x, 5d15.7))
*/
factor *= 10.;
}
}
printf("\f summary of %d calls to lmdif1: \n\n", ic);
/*
write (nwrite,80) ic
80 format (12h1summary of , i3, 16h calls to lmdif1 /)
*/
printf("\n\n nprob n m nfev njev info final L2 norm \n\n");
/*
write (nwrite,90)
90 format (49h nprob n m nfev njev info final l2 norm /)
*/
for (i = 0; i < ic; ++i) {
printf("%5d%5d%5d%6d%6d%6d%16.7e\n",
np[i], na[i], ma[i], nf[i], nj[i], nx[i], (double)fnm[i]);
/*
write (nwrite,100) np(i),na(i),ma(i),nf(i),nj(i),nx(i),fnm(i)
100 format (3i5, 3i6, 1x, d15.7)
*/
}
exit(0);
}
