/*
* PROCEDURE : lmder1
*
* ENTREE :
* fcn Fonction qui calcule la fonction et le jacobien de la fonction.
* m Nombre de fonctions.
* n Nombre de variables (parametres). n <= m
* x Vecteur de taille "n" contenant en entree une estimation
* initiale de la solution.
* ldfjac Taille maximale de la matrice "fjac". ldfjac >= "m".
* tol Tolerance. La terminaison de la procedure survient quand
* l'algorithme estime que l'erreur relative dans la somme des
* carres est au moins egal a tol ou bien que l'erreur relative
* entre x et la solution est au moins egal atol.
* wa Vecteur de travail de taille "lwa".
* lwa Taille du vecteur "wa". wa >= 5 * n + m.
*
*
* SORTIE :
* x Vecteur de taille "n" contenant en sortie l'estimee finale
* de la solution.
* fvec Vecteur de taille "m" contenant les fonctions evaluee en "x".
* fjac Matrice de taille "m" x "n". La sous matrice superieure de
* taille "n" x "n" de fjac contient une matrice triangulaire
* superieure r dont les elements diagonaux, classe dans le sens
* decroissant de leur valeur, sont de la forme :
*
* T T T
* p * (jac * jac) * p = r * r
*
* Ou p est une matrice de permutation et jac est le jacobien
* final calcule.
* La colonne j de p est la colonne ipvt (j) (voir ci apres) de
* la matrice identite. La partie trapesoidale inferieure de fjac
* contient les informations genere durant le calcul de r.
* info Information de l'executionde la procedure. Lorsque la procedure
* a termine son execution, "info" est inialisee a la valeur
* (negative) de iflag. sinon elle prend les valeurs suivantes :
* info = 0 : parametres en entre non valides.
* info = 1 : estimation par l'algorithme que l'erreur relative
* de la somme des carre est egal a tol.
* info = 2 : estimation par l'algorithme que l'erreur relative
* entre x et la solution est egal a tol.
* info = 3 : conditions info = 1 et info = 2 tous deux requis.
* info = 4 : fvec est orthogonal aux colonnes du jacobien.
* info = 5 : nombre d'appels a fcn avec iflag = 1 a atteint
* 100 * (n + 1).
* info = 6 : tol est trop petit. Plus moyen de reduire de la
* somme des carres.
* info = 7 : tol est trop petit. Plus d'amelioration possible
* d' approximer la solution x.
* ipvt Vecteur de taille "n". Il definit une matrice de permutation p
* tel que jac * p = q * p, ou jac est le jacbien final calcule,
* q est orthogonal (non socke) et r est triangulaire superieur,
* avec les elements diagonaux classes en ordre decroissant de
* leur valeur. La colonne j de p est ipvt[j] de la matrice identite.
*
* DESCRIPTION :
* La procedure minimize la somme de carre de m equation non lineaire a n
* variables par une modification de l'algorithme de Levenberg - Marquardt.
* Cette procedure appele la procedure generale au moindre carre lmder.
*
* REMARQUE :
* L'utilisateur doit fournir une procedure "fcn" qui calcule la fonction et
* le jacobien.
* "fcn" doit etre declare dans une instruction externe a la procedure et doit
* etre appele comme suit :
* fcn (int m, int n, int ldfjac, double *x, double *fvec, double *fjac, int *iflag)
*
* si iflag = 1 calcul de la fonction en x et retour de ce vecteur dans fvec.
* fjac n'est pas modifie.
* si iflag = 2 calcul du jacobien en x et retour de cette matrice dans fjac.
* fvec n'est pas modifie.
*
* RETOUR :
* En cas de succes, la valeur zero est retournee.
* Sinon, la valeur -1.
*
*/
int lmder1 (void (*ptr_fcn)(int m, int n, double *xc, double *fvecc,
double *jac, int ldfjac, int iflag),
int m, int n, double *x, double *fvec, double *fjac,
int ldfjac, double tol, int *info, int *ipvt, int lwa, double *wa)
{
const double factor = 100.0;
int maxfev, mode, nfev, njev, nprint;
double ftol, gtol, xtol;
*info = 0;
/* verification des parametres en entree qui causent des erreurs */
if ((n <= 0) || (m < n) || (ldfjac < m) || (tol < 0.0) ||
(lwa < (5 * n + m)) )
{
printf("%d %d %d %d %d \n", (n <= 0) , (m < n), (ldfjac < m), (tol < 0.0) , (lwa < (5 * n + m))) ;
return (-1);
}
/* appel a lmder */
maxfev = 100 * (n + 1);
ftol = tol;
xtol = tol;
gtol = 0.0;
mode = 1;
nprint = 0;
lmder (ptr_fcn , m, n, x, fvec, fjac, ldfjac, ftol, xtol, gtol, maxfev, wa,
mode, factor, nprint, info, &nfev, &njev, ipvt, &wa[n], &wa[2 * n],
&wa[3 * n], &wa[4 * n], &wa[5 * n]);
if (*info == 8)
*info = 4;
return (0);
}
/* Subroutine */ int lmder1(minpack_funcder_mn fcn, void *p, int m, int n, double *x,
double *fvec, double *fjac, int ldfjac, double tol,
int *ipvt, double *wa, int lwa)
{
/* Initialized data */
const double factor = 100.;
/* System generated locals */
int fjac_dim1, fjac_offset;
/* Local variables */
int mode, nfev, njev;
double ftol, gtol, xtol;
int maxfev, nprint;
int info;
/* ********** */
/* subroutine lmder1 */
/* the purpose of lmder1 is to minimize the sum of the squares of */
/* m nonlinear functions in n variables by a modification of the */
/* levenberg-marquardt algorithm. this is done by using the more */
/* general least-squares solver lmder. the user must provide a */
/* subroutine which calculates the functions and the jacobian. */
/* the subroutine statement is */
/* subroutine lmder1(fcn,m,n,x,fvec,fjac,ldfjac,tol,info, */
/* ipvt,wa,lwa) */
/* where */
/* fcn is the name of the user-supplied subroutine which */
/* calculates the functions and the jacobian. fcn must */
/* be declared in an external statement in the user */
/* calling program, and should be written as follows. */
/* subroutine fcn(m,n,x,fvec,fjac,ldfjac,iflag) */
/* integer m,n,ldfjac,iflag */
/* double precision x(n),fvec(m),fjac(ldfjac,n) */
/* ---------- */
/* if iflag = 1 calculate the functions at x and */
/* return this vector in fvec. do not alter fjac. */
/* if iflag = 2 calculate the jacobian at x and */
/* return this matrix in fjac. do not alter fvec. */
/* ---------- */
/* return */
/* end */
/* the value of iflag should not be changed by fcn unless */
/* the user wants to terminate execution of lmder1. */
/* in this case set iflag to a negative integer. */
/* m is a positive integer input variable set to the number */
/* of functions. */
/* n is a positive integer input variable set to the number */
/* of variables. n must not exceed m. */
/* x is an array of length n. on input x must contain */
/* an initial estimate of the solution vector. on output x */
/* contains the final estimate of the solution vector. */
/* fvec is an output array of length m which contains */
/* the functions evaluated at the output x. */
/* fjac is an output m by n array. the upper n by n submatrix */
/* of fjac contains an upper triangular matrix r with */
/* diagonal elements of nonincreasing magnitude such that */
/* t t t */
/* p *(jac *jac)*p = r *r, */
/* where p is a permutation matrix and jac is the final */
/* calculated jacobian. column j of p is column ipvt(j) */
/* (see below) of the identity matrix. the lower trapezoidal */
/* part of fjac contains information generated during */
/* the computation of r. */
/* ldfjac is a positive integer input variable not less than m */
/* which specifies the leading dimension of the array fjac. */
/* tol is a nonnegative input variable. termination occurs */
/* when the algorithm estimates either that the relative */
/* error in the sum of squares is at most tol or that */
/* the relative error between x and the solution is at */
/* most tol. */
/* info is an integer output variable. if the user has */
/* terminated execution, info is set to the (negative) */
/* value of iflag. see description of fcn. otherwise, */
/* info is set as follows. */
/* info = 0 improper input parameters. */
/* info = 1 algorithm estimates that the relative error */
/* in the sum of squares is at most tol. */
/* info = 2 algorithm estimates that the relative error */
/* between x and the solution is at most tol. */
/* info = 3 conditions for info = 1 and info = 2 both hold. */
/* info = 4 fvec is orthogonal to the columns of the */
/* jacobian to machine precision. */
/* info = 5 number of calls to fcn with iflag = 1 has */
/* reached 100*(n+1). */
/* info = 6 tol is too small. no further reduction in */
/* the sum of squares is possible. */
/* info = 7 tol is too small. no further improvement in */
/* the approximate solution x is possible. */
/* ipvt is an integer output array of length n. ipvt */
/* defines a permutation matrix p such that jac*p = q*r, */
/* where jac is the final calculated jacobian, q is */
/* orthogonal (not stored), and r is upper triangular */
/* with diagonal elements of nonincreasing magnitude. */
/* column j of p is column ipvt(j) of the identity matrix. */
/* wa is a work array of length lwa. */
/* lwa is a positive integer input variable not less than 5*n+m. */
/* subprograms called */
/* user-supplied ...... fcn */
/* minpack-supplied ... lmder */
/* argonne national laboratory. minpack project. march 1980. */
/* burton s. garbow, kenneth e. hillstrom, jorge j. more */
/* ********** */
/* Parameter adjustments */
--fvec;
--ipvt;
--x;
fjac_dim1 = ldfjac;
fjac_offset = 1 + fjac_dim1 * 1;
fjac -= fjac_offset;
--wa;
/* Function Body */
info = 0;
/* check the input parameters for errors. */
if (n <= 0 || m < n || ldfjac < m || tol < 0. || lwa < n * 5 +
m) {
/* goto L10; */
return info;
}
/* call lmder. */
maxfev = (n + 1) * 100;
ftol = tol;
xtol = tol;
gtol = 0.;
mode = 1;
nprint = 0;
info = lmder(fcn, p, m, n, &x[1], &fvec[1], &fjac[fjac_offset], ldfjac,
ftol, xtol, gtol, maxfev, &wa[1], mode, factor, nprint,
&nfev, &njev, &ipvt[1], &wa[n + 1], &wa[(n << 1) + 1], &
wa[n * 3 + 1], &wa[(n << 2) + 1], &wa[n * 5 + 1]);
if (info == 8) {
info = 4;
}
/* L10: */
return info;
/* last card of subroutine lmder1. */
} /* lmder1_ */
