void lmmin( int n_par, double *par, int m_dat, const void *data, void (*evaluate) (const double *par, int m_dat, const void *data, double *fvec, int *info), const lm_control_struct *control, lm_status_struct *status, void (*printout) (int n_par, const double *par, int m_dat, const void *data, const double *fvec, int printflags, int iflag, int iter, int nfev) ) { /*** allocate work space. ***/ double *fvec, *diag, *fjac, *qtf, *wa1, *wa2, *wa3, *wa4; int *ipvt, j; int n = n_par; int m = m_dat; /* One malloc call to allocate several arrays (Frank Polchow, 2013) */ fvec = (double *) malloc( (2*m+5*n+n*m)*sizeof(double) + n*sizeof(int)); if (NULL==fvec) {//fail in allocation status->info = 9; return; } diag = (double *) &fvec[m]; qtf = (double *) &diag[n]; fjac = (double *) &qtf[n]; wa1 = (double *) &fjac[n*m]; wa2 = (double *) &wa1[n]; wa3 = (double *) &wa2[n]; wa4 = (double *) &wa3[n]; ipvt = (int *) &wa4[m]; /* default diagonal */ if( ! control->scale_diag ) for( j=0; j<n_par; ++j ) diag[j] = 1; /*** perform fit. ***/ status->info = 0; /* this goes through the modified legacy interface: */ lm_lmdif( m, n, par, fvec, control->ftol, control->xtol, control->gtol, control->maxcall * (n+1), control->epsilon, diag, ( control->scale_diag ? 1 : 2 ), control->stepbound, &(status->info), &(status->nfev), fjac, ipvt, qtf, wa1, wa2, wa3, wa4, evaluate, printout, control->printflags, data ); if ( printout ) (*printout)( n, par, m, data, fvec, control->printflags, -1, 0, status->nfev ); status->fnorm = lm_enorm(m, fvec); if ( status->info < 0 ) status->info = 11; /*** clean up. ***/ free(fvec); } /*** lmmin. ***/
void lm_minimize(int m_dat, int n_par, double *par, lm_evaluate_ftype * evaluate, lm_print_ftype * printout, void *data, lm_control_type * control) { /*** allocate work space. ***/ double *fvec, *diag, *fjac, *qtf, *wa1, *wa2, *wa3, *wa4; int *ipvt; int n = n_par; int m = m_dat; if (!(fvec = (double *) malloc(m * sizeof(double))) || !(diag = (double *) malloc(n * sizeof(double))) || !(qtf = (double *) malloc(n * sizeof(double))) || !(fjac = (double *) malloc(n * m * sizeof(double))) || !(wa1 = (double *) malloc(n * sizeof(double))) || !(wa2 = (double *) malloc(n * sizeof(double))) || !(wa3 = (double *) malloc(n * sizeof(double))) || !(wa4 = (double *) malloc(m * sizeof(double))) || !(ipvt = (int *) malloc(n * sizeof(int)))) { control->info = 9; return; } /*** perform fit. ***/ control->info = 0; control->nfev = 0; /* this goes through the modified legacy interface: */ lm_lmdif(m, n, par, fvec, control->ftol, control->xtol, control->gtol, control->maxcall * (n + 1), control->epsilon, diag, 1, control->stepbound, &(control->info), &(control->nfev), fjac, ipvt, qtf, wa1, wa2, wa3, wa4, evaluate, printout, data); (*printout) (n, par, m, fvec, data, -1, 0, control->nfev); control->fnorm = lm_enorm(m, fvec); if (control->info < 0) control->info = 10; /*** clean up. ***/ free(fvec); free(diag); free(qtf); free(fjac); free(wa1); free(wa2); free(wa3); free(wa4); free(ipvt); } /*** lm_minimize. ***/
void lmmin( int n_par, double *par, int m_dat, const void *data, void (*evaluate) (const double *par, int m_dat, const void *data, double *fvec, int *info), const lm_control_struct *control, lm_status_struct *status, void (*printout) (int n_par, const double *par, int m_dat, const void *data, const double *fvec, int printflags, int iflag, int iter, int nfev) ) { /*** allocate work space. ***/ double *fvec, *diag, *fjac, *qtf, *wa1, *wa2, *wa3, *wa4; int *ipvt; int n = n_par; int m = m_dat; if ( (fvec = (double *) malloc(m * sizeof(double))) == NULL || (diag = (double *) malloc(n * sizeof(double))) == NULL || (qtf = (double *) malloc(n * sizeof(double))) == NULL || (fjac = (double *) malloc(n*m*sizeof(double))) == NULL || (wa1 = (double *) malloc(n * sizeof(double))) == NULL || (wa2 = (double *) malloc(n * sizeof(double))) == NULL || (wa3 = (double *) malloc(n * sizeof(double))) == NULL || (wa4 = (double *) malloc(m * sizeof(double))) == NULL || (ipvt = (int *) malloc(n * sizeof(int) )) == NULL ) { status->info = 9; return; } int j; if( ! control->scale_diag ) for( j=0; j<n_par; ++j ) diag[j] = 1; /*** perform fit. ***/ status->info = 0; /* this goes through the modified legacy interface: */ lm_lmdif( m, n, par, fvec, control->ftol, control->xtol, control->gtol, control->maxcall * (n + 1), control->epsilon, diag, ( control->scale_diag ? 1 : 2 ), control->stepbound, &(status->info), &(status->nfev), fjac, ipvt, qtf, wa1, wa2, wa3, wa4, evaluate, printout, control->printflags, data ); if ( printout ) (*printout)( n, par, m, data, fvec, control->printflags, -1, 0, status->nfev ); status->fnorm = lm_enorm(m, fvec); if ( status->info < 0 ) status->info = 11; /*** clean up. ***/ free(fvec); free(diag); free(qtf); free(fjac); free(wa1); free(wa2); free(wa3); free(wa4); free(ipvt); } /*** lm_minimize. ***/