static void eval_proc(GVarType type, GVarData vardata, void *udata) { unsigned int i; DArray *da; char buf[64]; switch (type) { case GVarNil: stufftext("(nil)\n"); break; case GVarNum: sprintf(buf, "%g\n", vardata.num); stufftext(buf); break; case GVarBool: stufftext(vardata.boolval ? "true":"false"); stufftext("\n"); break; case GVarArr: da = vardata.arr; stufftext("{"); for (i = 0; da && i < da->size; i++) { sprintf(buf, " %g ", da->x[i]); stufftext(buf); } stufftext("}\n"); break; case GVarStr: stufftext(vardata.str); stufftext("\n"); break; default: errmsg("unknown data type"); break; } }
void echomsg(char *msg) { stufftext(msg); stufftext("\n"); }
/* * TODO, lots of declared, but unused variables here */ static void do_netcdfquery_proc(Widget, XtPointer, XtPointer) { int setno, src; char xvar[256], yvar[256]; char buf[256], fname[512]; XmString xms; XmString *s, cs; int *pos_list; int i, j, pos_cnt, cnt; char *cstr; int cdfid; /* netCDF id */ int ndims, nvars, ngatts, recdim; int var_id; long start[2]; long count[2]; char varname[256]; nc_type datatype = 0; int dim[100], natts; long dimlen[100]; long len; int x_id, y_id; nc_type xdatatype = 0; nc_type ydatatype = 0; int xndims, xdim[10], xnatts; int yndims, ydim[10], ynatts; long nx, ny; int atlen; char attname[256]; char atcharval[256]; extern int ncopts; ncopts = 0; /* no crash on error */ set_wait_cursor(); strcpy(fname, xv_getstr(netcdf_file_item)); if ((cdfid = ncopen(fname, NC_NOWRITE)) == -1) { errwin("Can't open file."); goto out2; } if (XmListGetSelectedPos(netcdf_listx_item, &pos_list, &pos_cnt)) { XtVaGetValues(netcdf_listx_item, XmNselectedItemCount, &cnt, XmNselectedItems, &s, NULL); cs = XmStringCopy(*s); if (XmStringGetLtoR(cs, charset, &cstr)) { strcpy(xvar, cstr); XtFree(cstr); } XmStringFree(cs); } else { errwin("Need to select X, either variable name or INDEX"); goto out1; } if (XmListGetSelectedPos(netcdf_listy_item, &pos_list, &pos_cnt)) { XtVaGetValues(netcdf_listy_item, XmNselectedItemCount, &cnt, XmNselectedItems, &s, NULL); cs = XmStringCopy(*s); if (XmStringGetLtoR(cs, charset, &cstr)) { strcpy(yvar, cstr); XtFree(cstr); } XmStringFree(cs); } else { errwin("Need to select Y"); goto out1; } if (strcmp(xvar, "INDEX") == 0) { stufftext("X is the index of the Y variable\n", STUFF_START); } else { if ((x_id = ncvarid(cdfid, xvar)) == -1) { char ebuf[256]; sprintf(ebuf, "do_query(): No such variable %s for X", xvar); errwin(ebuf); goto out1; } ncvarinq(cdfid, x_id, NULL, &xdatatype, &xndims, xdim, &xnatts); ncdiminq(cdfid, xdim[0], NULL, &nx); sprintf(buf, "X is %s, data type %s \t length [%d]\n", xvar, getcdf_type(xdatatype), nx); stufftext(buf, STUFF_TEXT); sprintf(buf, "\t%d Attributes:\n", xnatts); stufftext(buf, STUFF_TEXT); for (i = 0; i < xnatts; i++) { atcharval[0] = 0; ncattname(cdfid, x_id, i, attname); ncattinq(cdfid, x_id, attname, &datatype, &atlen); switch (datatype) { case NC_CHAR: ncattget(cdfid, x_id, attname, (void *)atcharval); break; } sprintf(buf, "\t\t%s: %s\n", attname, atcharval); stufftext(buf, STUFF_TEXT); } } if ((y_id = ncvarid(cdfid, yvar)) == -1) { char ebuf[256]; sprintf(ebuf, "do_query(): No such variable %s for Y", yvar); errwin(ebuf); goto out1; } ncvarinq(cdfid, y_id, NULL, &ydatatype, &yndims, ydim, &ynatts); ncdiminq(cdfid, ydim[0], NULL, &ny); sprintf(buf, "Y is %s, data type %s \t length [%d]\n", yvar, getcdf_type(ydatatype), ny); stufftext(buf, STUFF_TEXT); sprintf(buf, "\t%d Attributes:\n", ynatts); stufftext(buf, STUFF_TEXT); for (i = 0; i < ynatts; i++) { atcharval[0] = 0; ncattname(cdfid, y_id, i, attname); ncattinq(cdfid, y_id, attname, &datatype, &atlen); switch (datatype) { case NC_CHAR: ncattget(cdfid, y_id, attname, (void *)atcharval); break; } sprintf(buf, "\t\t%s: %s\n", attname, atcharval); stufftext(buf, STUFF_TEXT); } out1: ; ncclose(cdfid); out2: ; stufftext("\n", STUFF_STOP); unset_wait_cursor(); }
/* ARGSUSED */ static void do_nonl_proc(Widget, XtPointer, XtPointer) { int i, setno, loadset, loadto, graphto, npar, info; double tol, a[MAXPARM]; char fstr[256]; double *y, *yp; set_wait_cursor(); curset = setno = (int)GetChoice(nonl_set_item); loadto = (int)GetChoice(nonl_load_item); graphto = (int)GetChoice(nonl_loadgraph_item) - 1; tol = atof((char *)xv_getstr(nonl_tol_item)); if (graphto < 0) { graphto = cg; } npar = atoi((char *)xv_getstr(nonl_nparm_item)); strcpy(fstr, (char *)xv_getstr(nonl_formula_item)); for (i = 0; i < MAXPARM; i++) { a[i] = 0.0; strcpy(buf, (char *)xv_getstr(nonl_initial_item[i])); sscanf(buf, "%lf", &a[i]); } yp = (double *)calloc(getsetlength(cg, setno), sizeof(double)); if (yp == NULL) { errwin("Memory allocation error, operation cancelled"); unset_wait_cursor(); return; } y = gety(cg, setno); for (i = 0; i < getsetlength(cg, setno); i++) { yp[i] = y[i]; } sprintf(buf, "Fitting: %s\n", fstr); stufftext(buf, 0); sprintf(buf, "Initial guess:\n"); stufftext(buf, 0); for (i = 0; i < npar; i++) { sprintf(buf, "\ta%1d = %.9lf\n", i, a[i]); stufftext(buf, 0); } sprintf(buf, "Tolerance = %.9lf\n", tol); stufftext(buf, 0); lmfit(fstr, getsetlength(cg, setno), getx(cg, setno), yp, y, npar, a, tol, &info); for (i = 0; i < getsetlength(cg, setno); i++) { y[i] = yp[i]; } free(yp); for (i = 0; i < MAXPARM; i++) { sprintf(buf, "%.9lf", a[i]); xv_setstr(nonl_computed_item[i], buf); nonl_parms[i] = a[i]; } if (info > 0 && info < 4) { sprintf(buf, "Computed values:\n"); stufftext(buf, 0); for (i = 0; i < npar; i++) { sprintf(buf, "\ta%1d = %.9lf\n", i, a[i]); stufftext(buf, 0); } loadset = nextset(cg); if (loadset != -1) { do_copyset(cg, setno, cg, loadset); } else { unset_wait_cursor(); return; } switch (loadto) { case 0: sprintf(buf, "Evaluating function and loading result to set %d:\n", loadset); stufftext(buf, 0); do_compute(loadset, 0, graphto, fstr); break; case 1: sprintf(buf, "Evaluating function and loading residuals to set %d:\n", loadset); stufftext(buf, 0); do_compute(loadset, 0, graphto, fstr); break; case 2: sprintf(buf, "Computed function not evaluated\n"); stufftext(buf, 0); break; } } /* if (info >= 4) { do_compute(setno, 1, graphto, fstr); } */ if (info >= 0 && info <= 7) { char *s; switch (info) { case 0: s = (char *)"Improper input parameters.\n"; break; case 1: s = (char *)"Relative error in the sum of squares is at most tol.\n"; break; case 2: s = (char *)"Relative error between A and the solution is at most tol.\n"; break; case 3: s = (char *)"Relative error in the sum of squares and A and the solution is at most tol.\n"; break; case 4: s = (char *)"Fvec is orthogonal to the columns of the jacobian to machine precision.\n"; break; case 5: s = (char *)"Number of calls to fcn has reached or exceeded 200*(n+1).\n"; break; case 6: s = (char *)"Tol is too small. No further reduction in the sum of squares is possible.\n"; break; case 7: s = (char *)"Tol is too small. No further improvement in the approximate solution A is possible.\n"; break; } stufftext(s, 0); stufftext((char *)"\n", 0); } unset_wait_cursor(); }
/* ARGSUSED */ static void do_nonl_proc(Widget w, XtPointer client_data, XtPointer call_data) { int i, npts = 0, info; double delx, *xfit, *y, *yfit; int nsteps = (int) client_data; set_wait_cursor(); curset = nlsetno = GetSelectedSet(nonl_set_item); if (curset == SET_SELECT_ERROR) { errmsg("No set selected"); unset_wait_cursor(); return; } nonl_opts.tolerance = atof((char *) xv_getstr(nonl_tol_item)); nonl_opts.parnum = GetChoice(nonl_nparm_item); strcpy(nonl_opts.formula, (char *) xv_getstr(nonl_formula_item)); for (i = 0; i < nonl_opts.parnum; i++) { strcpy(buf, (char *) xv_getstr(nonl_value_item[i])); if (sscanf(buf, "%lf", &nonl_parms[i].value) != 1) { errmsg("Invalid input in parameter field"); unset_wait_cursor(); return; } nonl_parms[i].constr = XmToggleButtonGetState(nonl_constr_item[i]); if (nonl_parms[i].constr) { strcpy(buf, (char *) xv_getstr(nonl_lowb_item[i])); if (sscanf(buf, "%lf", &nonl_parms[i].min) != 1) { errmsg("Invalid input in low-bound field"); unset_wait_cursor(); return; } strcpy(buf, (char *) xv_getstr(nonl_uppb_item[i])); if (sscanf(buf, "%lf", &nonl_parms[i].max) != 1) { errmsg("Invalid input in upper-bound field"); unset_wait_cursor(); return; } if ((nonl_parms[i].value < nonl_parms[i].min) || (nonl_parms[i].value > nonl_parms[i].max)) { errmsg("Initial values must be within bounds"); unset_wait_cursor(); return; } } } nonl_prefs.autoload = XmToggleButtonGetState(nonl_autol_item); for (i = 0; i < 3; i++) { if (XmToggleButtonGetState(nonl_load_item[i])) { nonl_prefs.load = i; break; } } if (nonl_prefs.load == LOAD_FUNCTION) { strcpy(buf, (char *) xv_getstr(nonl_start_item)); if (sscanf(buf, "%lf", &nonl_prefs.start) != 1) { errmsg("Invalid input in start field"); unset_wait_cursor(); return; } strcpy(buf, (char *) xv_getstr(nonl_stop_item)); if (sscanf(buf, "%lf", &nonl_prefs.stop) != 1) { errmsg("Invalid input in stop field"); unset_wait_cursor(); return; } strcpy(buf, (char *) xv_getstr(nonl_npts_item)); if (sscanf(buf, "%d", &nonl_prefs.npoints) != 1) { errmsg("Invalid input in start field"); unset_wait_cursor(); return; } } if (nsteps) { /* we are asked to fit */ sprintf(buf, "Fitting with formula: %s\n", nonl_opts.formula); stufftext(buf, 0); sprintf(buf, "Initial guesses:\n"); stufftext(buf, 0); for (i = 0; i < nonl_opts.parnum; i++) { sprintf(buf, "\ta%1d = %g\n", i, nonl_parms[i].value); stufftext(buf, 0); } sprintf(buf, "Tolerance = %g\n", nonl_opts.tolerance); stufftext(buf, 0); /* * The fit itself! */ info = do_nonlfit(cg, nlsetno, nsteps); if (info == -1) { errmsg("Memory allocation error in do_nonlfit()"); unset_wait_cursor(); return; } for (i = 0; i < nonl_opts.parnum; i++) { sprintf(buf, "%g", nonl_parms[i].value); xv_setstr(nonl_value_item[i], buf); } if ((info > 0 && info < 4) || (info == 5)) { sprintf(buf, "Computed values:\n"); stufftext(buf, 0); for (i = 0; i < nonl_opts.parnum; i++) { sprintf(buf, "\ta%1d = %g\n", i, nonl_parms[i].value); stufftext(buf, 0); } } if (info >= 0 && info <= 7) { char *s; switch (info) { case 0: s = "Improper input parameters.\n"; break; case 1: s = "Relative error in the sum of squares is at most tol.\n"; break; case 2: s = "Relative error between A and the solution is at most tol.\n"; break; case 3: s = "Relative error in the sum of squares and A and the solution is at most tol.\n"; break; case 4: s = "Fvec is orthogonal to the columns of the jacobian to machine precision.\n"; break; case 5: s = "\n"; break; case 6: s = "Tol is too small. No further reduction in the sum of squares is possible.\n"; break; case 7: s = "Tol is too small. No further improvement in the approximate solution A is possible.\n"; break; default: s = "\n"; errmsg("Internal error in do_nonl_proc(), please report"); break; } stufftext(s, 0); stufftext("\n", 0); } } /* endif (nsteps) */ /* * Select & activate a set to load results to */ if (!nsteps || nonl_prefs.autoload) { /* check if the set is already allocated */ if ((nlloadset == -1) || (nlloadset == nlsetno) || !getsetlength(cg, nlloadset)) { nlloadset = nextset(cg); if (nlloadset == -1) { errmsg("No more sets!"); unset_wait_cursor(); return; } else { activateset(cg, nlloadset); setlength(cg, nlloadset, 1); } } switch (nonl_prefs.load) { case LOAD_VALUES: sprintf(buf, "Evaluating fitted values and loading result to set %d:\n", nlloadset); stufftext(buf, 0); npts = getsetlength(cg, nlsetno); setlength(cg, nlloadset, npts); copycol2(cg, nlsetno, cg, nlloadset, 0); break; case LOAD_RESIDUALS: sprintf(buf, "Evaluating fitted values and loading residuals to set %d:\n", nlloadset); stufftext(buf, 0); npts = getsetlength(cg, nlsetno); setlength(cg, nlloadset, npts); copycol2(cg, nlsetno, cg, nlloadset, 0); break; case LOAD_FUNCTION: sprintf(buf, "Computing fitting function and loading result to set %d:\n", nlloadset); stufftext(buf, 0); npts = nonl_prefs.npoints; if (npts <= 1) { errmsg("Number of points must be > 1"); unset_wait_cursor(); return; } setlength(cg, nlloadset, npts); delx = (nonl_prefs.stop - nonl_prefs.start)/(npts - 1); xfit = getx(cg, nlloadset); for (i = 0; i < npts; i++) { xfit[i] = nonl_prefs.start + i * delx; } break; } setcomment(cg, nlloadset, nonl_opts.formula); do_compute(nlloadset, 0, cg, nonl_opts.formula); if (nonl_prefs.load == LOAD_RESIDUALS) { /* load residuals */ y = gety(cg, nlsetno); yfit = gety(cg, nlloadset); for (i = 0; i < npts; i++) { yfit[i] -= y[i]; } } update_set_lists(cg); drawgraph(); } unset_wait_cursor(); }