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); }