int tn_general_driver(TRUNCATED_NEWTON_STORAGE * p, void * pParam, double * x, double *x_up, double *x_low,
double * fit, double *st_err,
double * max_diff, char * message) {
if(!p) return 0;
if(p->err) return 0;
if(!pParam) return 0;
FCN_PARAMS params;
params.pData = p;
params.pFcnParams = pParam;
*fit = -1;
*max_diff = -1;
for(int i=0; i<p->n; i++) st_err[i] = -1;
memcpy(p->x, x, sizeof(double)*p->n);
memcpy(p->up, x_up, sizeof(double)*p->n);
memcpy(p->low, x_low, sizeof(double)*p->n);
/*p->x[0]=8.450000;
p->x[1]=10.230000;
p->x[2]=3.000000;
p->x[3]=1441.249987;
p->x[4]=-37.460175;
p->x[5]=1228.875079;
p->x[6]=-0.502384;
p->x[7]=0.413681;
p->x[8]=-4.928084;
for(int i=0; i<p->n; i++) fprintf(stderr,"limits %e %e\n", p->low[i], p->up[i]);
fprintf(stderr,"p->n=%d\n", p->n);
for(int i=0; i<p->n; i++) {
fprintf(stderr,"p->x[%d]=%lf\n", i, p->x[i]);
fprintf(stderr,"p->low[%d]=%le\n", i, p->low[i]);
fprintf(stderr,"p->up[%d]=%le\n", i, p->up[i]);
}
fprintf(stderr,"p->j=%lf\n", p->f);
fprintf(stderr,"p->lw=%d\n", p->lw);
fprintf(stderr,"p->msglvl=%d\n", p->msglvl);
fprintf(stderr,"p->maxit=%d\n", p->maxit);
fprintf(stderr,"p->maxfun=%d\n", p->maxfev);
fprintf(stderr,"p->eta=%lf\n", p->eta);
fprintf(stderr,"p->stepmx=%lf\n", p->stepmx);
fprintf(stderr,"p->accrcy=%le\n", p->accrcy);
fprintf(stderr,"p->xtol=%le\n", p->xtol);
*/
lmqnbc_(&p->ifail, &p->n, p->x, &p->f, p->g, p->w, &p->lw, p->sfun,
p->low, p->up, p->ipivot, &p->msglvl, &p->maxit, &p->maxfev, &p->eta, &p->stepmx,
&p->accrcy, &p->xtol, ¶ms);
*fit = sqrt(p->f/(p->n_data - p->n));
*max_diff = fabs(p->T_synt[0]);
for(int i=0; i<p->n_data; i++) {
double t_abs = fabs(p->T_synt[i]);
if(*max_diff < t_abs) * max_diff = t_abs;
}
switch(p->ifail) {
case 0:
strcpy(message, "TN: NORMAL RETURN"); break;
case 2:
strcpy(message, "TN: MORE THAN MAXFUN EVALUATIONS OR CANCELED"); break;
case 3:
strcpy(message, "TN: LINE SEARCH FAILED TO FIND LOWER POINT (MAY NOT BE SERIOUS)"); break;
default:
strcpy(message,"TN: ERROR IN INPUT PARAMETERS");
}
memcpy(x, p->x, sizeof(double)*p->n);
return 1;
}
int/* Main program */ MAIN__()
{
/* Format strings */
static char fmt_800[] = "(//,\002 ERROR CODE =\002,i3,/)";
static char fmt_810[] = "(10x,\002CURRENT SOLUTION IS \002,/14x,\002I\
\002,11x,\002X(I)\002)";
static char fmt_820[] = "(10x,i5,2x,1pd22.15)";
/* System generated locals */
integer i__1;
/* Builtin functions */
double sqrt(doublereal);
integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe();
/* Subroutine */ int s_stop(char *, ftnlen);
/* Local variables */
extern /* Subroutine */ int sfun_(integer*, doublereal *, doublereal *, doublereal *);
doublereal xtol, f, g[50];
integer i__, n;
doublereal w[700], x[50];
integer maxit, lw;
doublereal accrcy, up[50];
extern /* Subroutine */ int lmqnbc_(integer *, integer *, doublereal *,
doublereal *, doublereal *, doublereal *, integer *, U_fp,
doublereal *, doublereal *, integer *, integer *, integer *,
integer *, doublereal *, doublereal *, doublereal *, doublereal *)
;
integer maxfun, ierror, msglvl, ipivot[50];
doublereal stepmx, eta, low[50];
/* Fortran I/O blocks */
static cilist io___19 = { 0, 6, 0, fmt_800, 0 };
static cilist io___20 = { 0, 6, 0, fmt_810, 0 };
static cilist io___21 = { 0, 6, 0, fmt_820, 0 };
/* SET UP FUNCTION AND VARIABLE INFORMATION */
/* N - NUMBER OF VARIABLES */
/* X - INITIAL ESTIMATE OF THE SOLUTION */
/* LOW - LOWER BOUNDS */
/* UP - UPPER BOUNDS */
/* F - ROUGH ESTIMATE OF FUNCTION VALUE AT SOLUTION */
/* LW - DECLARED LENGTH OF THE ARRAY W */
n = 10;
i__1 = n;
for (i__ = 1; i__ <= i__1; ++i__) {
x[i__ - 1] = i__ / (real) (n + 1);
low[i__ - 1] = 0.;
up[i__ - 1] = 6.;
/* L10: */
}
f = 1.;
lw = 700;
/* SET UP CUSTOMIZING PARAMETERS */
/* ETA - SEVERITY OF THE LINESEARCH */
/* MAXFUN - MAXIMUM ALLOWABLE NUMBER OF FUNCTION EVALUATIONS */
/* XTOL - DESIRED ACCURACY FOR THE SOLUTION X* */
/* STEPMX - MAXIMUM ALLOWABLE STEP IN THE LINESEARCH */
/* ACCRCY - ACCURACY OF COMPUTED FUNCTION VALUES */
/* MSGLVL - DETERMINES QUANTITY OF PRINTED OUTPUT */
/* 0 = NONE, 1 = ONE LINE PER MAJOR ITERATION. */
/* MAXIT - MAXIMUM NUMBER OF INNER ITERATIONS PER STEP */
maxit = n / 2;
maxfun = n * 150;
eta = .25;
stepmx = 10.;
accrcy = 1e-15;
xtol = sqrt(accrcy);
msglvl = 1;
/* MINIMIZE THE FUNCTION */
lmqnbc_(&ierror, &n, x, &f, g, w, &lw, (U_fp)sfun_, low, up, ipivot, &
msglvl, &maxit, &maxfun, &eta, &stepmx, &accrcy, &xtol);
/* PRINT THE RESULTS */
if (ierror != 0) {
s_wsfe(&io___19);
do_fio(&c__1, (char *)&ierror, (ftnlen)sizeof(integer));
e_wsfe();
}
if (msglvl >= 1) {
s_wsfe(&io___20);
e_wsfe();
}
if (msglvl >= 1) {
s_wsfe(&io___21);
i__1 = n;
for (i__ = 1; i__ <= i__1; ++i__) {
do_fio(&c__1, (char *)&i__, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&x[i__ - 1], (ftnlen)sizeof(doublereal));
}
e_wsfe();
}
s_stop("", (ftnlen)0);
return 0;
} /* MAIN__ */
