void fsgen(double q[], double a[], double yfit[], double *dyda, int ndata,
int ma)
{
#include <parameters.h>
#include <cparms.h>
#include <clista.h>
#include <genpsi.h>
/* Set generating parameters equal to fit parameters */
/* constrain(a); */
(*Constrain)(FALSE, a, ntlayer, nmlayer, nrepeat, nblayer);
genshift(a, FALSE);
/* Calculate reflectivity and derivatives */
if (ndata < 2)
puts("/** Not Enough Data Points **/");
else {
int j;
/* Reflectivity */
gensderiv(q, yfit, ndata, 0);
/* Derivatives */
for (j = 0; j < mfit; j++) {
gensderiv(q, dyda, ndata, listA[j] + 1); /*ARRAY*/
dyda += ndata;
}
}
}
static void tclconstraints(int del, double a[], int nt, int nm, int nr, int nb)
{
int ret;
if (abortFit) return;
clipdepth(del,a,nt,nm,nr,nb);
if (fit_constraints) {
genshift(a,FALSE);
ret = Tcl_Eval(fit_interp, fit_constraints);
if (ret == TCL_OK) {
/* XXX FIXME XXX we can remove both this genshift and the
* genshift in fgen/fsgen */
genshift(a,TRUE);
Tcl_ResetResult(fit_interp);
} else {
if (ret == TCL_ERROR) failure = 1;
stopFit(0);
}
}
/* XXX FIXME XXX why did I want to run the event loop during constraints? */
/* flushqueue(); */
}
void exp()
{
level++;
trace("exp");
switch(current.token)
{
case lshift:match(lshift);
genshift(2);
match(lparen);
aluexp();
match(rparen);
break;
case rshift:match(rshift);
genshift(1);
match(lparen);
aluexp();
match(rparen);
break;
default: genshift(0);
aluexp();
break;
}
level--;
}
void magblocks4(void)
{
static char command[COMMANDLEN + 2];
static double undoFit[NA], undoFitUnc[NA];
int npnts, j;
double qmax, qmin;
/* Process command */
while (queryString("magblocks4% ", command, COMMANDLEN + 2) == NULL);
caps(command);
/* Spawn a command */
if (strcmp(command, "!") == 0 || strcmp(command, "!!") == 0) {
bang(command);
/* Print current directory */
} else if (strcmp(command, "PWD") == 0) {
puts(currentDir);
/* Change current directory */
} else if (strcmp(command, "CD") == 0) {
cd(command);
/* Help */
} else if (
strcmp(command, "?") == 0 ||
strcmp(command, "HE") == 0
) {
help(command + (*command == '?' ? 1 : 2));
/* Value of vacuum QCSQ */
} else if (
strcmp(command, "QCV") == 0 ||
strcmp(command, "VQC") == 0
) {
setVQCSQ(qcsq);
/* Vacuum QCMSQ */
} else if (
strcmp(command, "QMV") == 0 ||
strcmp(command, "VQM") == 0
) {
setVMQCSQ(qcmsq);
/* Value of vacuum linear absorption coefficient */
} else if (
strcmp(command, "MUV") == 0 ||
strcmp(command, "VMU") == 0
) {
setVMU(mu);
/* Enter critical Q squared */
} else if (strncmp(command, "QC", 2) == 0) {
setQCSQ(command + 2, qcsq, Dqcsq);
/* Top magnetic critical Q squared */
} else if (strncmp(command, "QM", 2) == 0) {
setMQCSQ(command + 2, qcmsq, Dqcmsq);
/* Top length absorption coefficient */
} else if (strncmp(command, "MU", 2) == 0) {
setMU(command + 2, mu, Dmu);
/* Thicknesses of magnetic layers */
} else if (strncmp(command, "DM", 2) == 0) {
setDM(command + 2, dm, Ddm);
/* Delta lambda */
} else if (strcmp(command, "DL") == 0) {
setLamdel(&lamdel);
/* Delta theta */
} else if (strcmp(command, "DT") == 0) {
setThedel(&thedel);
/* Enter chemical thickness */
} else if (command[0] == 'D') {
setD(command + 1, d, Dd);
/* Chemical roughnesses */
} else if (strncmp(command, "RO", 2) == 0) {
setRO(command + 2, rough, Drough);
/* Magnetic roughnesses of layers */
} else if (strncmp(command, "RM", 2) == 0) {
setMRO(command + 2, mrough, Dmrough);
/* Theta angle of average moment in layer */
} else if (strncmp(command, "TH", 2) == 0) {
setTHE(command + 2, the, Dthe);
/* Wavelength */
} else if (strcmp(command, "WL") == 0) {
setWavelength(&lambda);
/* Guide angle */
} else if (strcmp(command, "EPS") == 0) {
setGuideangle(&aguide);
/* Number of layers */
} else if (strcmp(command, "NL") == 0) {
if (!setNlayer(&nlayer))
/* Bug found Wed Jun 7 10:38:45 EDT 2000 by KOD */
/* since it starts at 0, correction for vacuum forces zero */
for (j = 1; j <= nlayer; j++)
/* Set all absorptions to non-zero values */
if (mu[j] < *mu) mu[j] = *mu + 1.e-20;
/* Add or remove layers */
} else if (strcmp(command, "AL") == 0 || strcmp(command, "RL") == 0) {
modifyLayers(command);
/* Copy layer */
} else if (strcmp(command, "CL") == 0) {
copyLayer(command);
/* Make superlattice */
} else if (strcmp(command, "SL") == 0) {
superLayer(command);
/* Maximum number of layers used to simulate rough interface */
} else if (strcmp(command, "NR") == 0) {
if (!setNrough(&nrough)) {
/* Generate interface profile */
if (nrough < 3) nrough = 11;
if (proftyp[0] == 'H')
gentanh(nrough, zint, rufint);
else
generf(nrough, zint, rufint);
}
/* Specify error function or hyperbolic tangent profile */
} else if (strcmp(command, "PR") == 0) {
setProfile(proftyp, PROFTYPLEN + 2);
/* Range of Q to be scanned */
} else if (strcmp(command, "QL") == 0) {
if (!setQrange(&qmin, &qmax)) {
qmina = qmin;
qmaxa = qmax;
qminb = qmin;
qmaxb = qmax;
qminc = qmin;
qmaxc = qmax;
qmind = qmin;
qmaxd = qmax;
}
/* Number of points scanned */
} else if (strcmp(command, "NP") == 0) {
if (!setNpnts(&npnts)) {
npntsa = npnts;
npntsb = npnts;
npntsc = npnts;
npntsd = npnts;
}
/* File for input data */
} else if (strcmp(command, "IF") == 0) {
setFilename(infile, INFILELEN + 2);
/* File for output data */
} else if (strcmp(command, "OF") == 0) {
setFilename(outfile, OUTFILELEN + 2);
/* File for parameters */
} else if (strcmp(command, "PF") == 0) {
setFilename(parfile, PARFILELEN + 2);
/* Polarization state */
} else if (strcmp(command, "PS") == 0) {
setPolstat(polstat, POLSTATLEN + 2);
/* Beam intensity */
} else if (strcmp(command, "BI") == 0) {
setBeamIntens(&bmintns, &Dbmintns);
/* Background intensity */
} else if (strcmp(command, "BK") == 0) {
setBackground(&bki, &Dbki);
/* Verify parameters by printing out */
} else if (strncmp(command, "VE", 2) == 0) {
printLayers(command);
/* Get data from file */
} else if (strcmp(command, "GD") == 0) {
loadData(infile, xspin);
/* Edit constraints */
} else if (strcmp(command, "EC") == 0) {
constrainFunc newmodule;
newmodule = newConstraints(constrainScript, constrainModule);
if (newmodule != NULL) Constrain = newmodule;
/* Reload constrain module */
} else if (strcmp(command, "LC") == 0) {
Constrain = loadConstrain(constrainModule);
/* Unload constrain module */
} else if (strcmp(command, "ULC") == 0) {
Constrain = loadConstrain(NULL);
/* Load parameters from parameter file */
} else if (strncmp(command, "LP", 2) == 0) {
loadParms(command, parfile, constrainScript, constrainModule);
/* Save parameters to parameter file */
} else if (strcmp(command, "SP") == 0) {
parms(qcsq, qcmsq, d, dm, rough, mrough, mu, the,
MAXLAY, &lambda, &lamdel, &thedel, &aguide,
&nlayer, &qmina, &qmaxa, &npntsa,
&qminb, &qmaxb, &npntsb, &qminc, &qmaxc, &npntsc,
&qmind, &qmaxd, &npntsd,
infile, outfile,
&bmintns, &bki, listA, &mfit, NA, &nrough, proftyp,
polstat, DA, constrainScript, parfile, TRUE);
/* List data and fit */
} else if (strcmp(command, "LID") == 0) {
listData();
/* Generate logarithm of bare (unconvoluted) reflectivity */
/* or generate reflected amplitude */
} else if (strcmp(command,"GR") == 0 || strcmp(command, "GA") == 0) {
genReflect(command);
/* Generate and display layer profile */
} else if (
strcmp(command, "GLP") == 0 ||
strncmp(command, "SLP", 3) == 0
) {
genProfile(command);
/* Save values in Q4X and YFIT to OUTFILE */
} else if (strcmp(command, "SV") == 0) {
saveTemps(outfile, xspin, y4x, n4x, FALSE);
/* Save values in Q4X and YFITA to OUTFILE */
} else if (strcmp(command, "SVA") == 0) {
saveTemps(outfile, xspin, yfita, n4x, TRUE);
/* Calculate derivative of reflectivity or spin asymmetry with respect */
/* to a fit parameter or save a fit to disk file */
} else if (
strcmp(command, "RD") == 0 ||
strcmp(command, "SRF") == 0
) {
printDerivs(command, npnts);
/* Turn off all varied parameters */
} else if (strcmp(command, "VANONE") == 0) {
clearLista(listA);
/* Specify which parameters are to be varied in the reflectivity fit */
} else if (strncmp(command, "VA", 2) == 0) {
varyParm(command);
/* Calculate chi-squared */
} else if (
strcmp(command, "CSR") == 0 ||
strcmp(command, "CS") == 0
) {
calcChiSq(command);
/* Fit reflectivity */
} else if (strncmp(command, "FR", 2) == 0) {
for (j = 0; j < NA; j++) {
undoFit[j] = A[j];
undoFitUnc[j] = DA[j];
}
fitReflec(command);
/* Undo last fit */
} else if (strcmp(command, "UF") == 0) {
for (j = 0; j < NA; j++) {
A[j] = undoFit[j];
DA[j] = undoFitUnc[j];
}
/* Exit */
} else if (
strcmp(command, "EX") == 0 ||
strcmp(command, "EXS") == 0
) {
parms(qcsq, qcmsq, d, dm, rough, mrough, mu, the,
MAXLAY, &lambda, &lamdel, &thedel, &aguide,
&nlayer, &qmina, &qmaxa, &npntsa,
&qminb, &qmaxb, &npntsb, &qminc, &qmaxc, &npntsc,
&qmind, &qmaxd, &npntsd,
infile, outfile,
&bmintns, &bki, listA, &mfit, NA, &nrough, proftyp,
polstat, DA, constrainScript, parfile, TRUE);
/* Print elapsed CPU time */
if (strcmp(command, "EXS") == 0) system("ps");
exit(0);
/* Exit without saving changes */
} else if (strcmp(command, "QU") == 0 || strcmp(command, "QUIT") == 0) {
exit(0);
/* Plot reflectivity on screen */
} else if (strncmp(command, "PRF", 3) == 0) {
plotfit(command, xspin);
/* Plot profile on screen */
} else if (strncmp(command, "PLP", 3) == 0) {
plotprofile(command, xspin);
/* Plot movie of reflectivity change from fit */
} else if (strncmp(command, "MVF", 3) == 0) {
fitMovie(command, xspin, undoFit);
/* Plot general movie from data file on screen */
} else if (strncmp(command, "MVX", 3) == 0) {
arbitraryMovie(command, xspin);
/* Plot movie of parameter on screen */
} else if (strncmp(command, "MV", 2) == 0) {
oneParmMovie(command, xspin);
/* Update constraints */
} else if (strcmp(command, "UC") == 0) {
genshift(a, TRUE);
/* constrain(a); */
(*Constrain)(FALSE, a, nlayer);
genshift(a, FALSE);
/* Determine number of points required for resolution extension */
} else if (strcmp(command, "RE") == 0) {
calcExtend(xspin);
#if 0 /* Dead code --- shadowed by "CD" command earlier */
/* Convolute input raw data set with instrumental resolution */
} else if (strcmp(command, "CD") == 0) {
calcConvolve(polstat);
#endif
/* Send data to other processes. */
} else if (strcmp(command, "SEND") == 0) {
ipc_send(command);
/* Receive data to other processes. */
} else if (strcmp(command, "RECV") == 0) {
ipc_recv(command);
/* Faulty input */
} else
ERROR("/** Unrecognized command **/");
}
void mlayer(void)
{
static char command[COMMANDLEN+2];
static double undoFit[NA], undoFitUnc[NA];
/* Process command */
while (queryString("mlayer% ", command, COMMANDLEN + 2) == NULL);
caps(command);
/* Spawn a command */
if (strcmp(command, "!") == 0 || strcmp(command, "!!") == 0) {
bang(command);
/* Print current directory */
} else if (strcmp(command, "PWD") == 0) {
puts(currentDir);
/* Change current directory */
} else if (strcmp(command, "CD") == 0) {
cd(command);
/* Help */
} else if (strcmp(command, "?") == 0
|| strcmp(command, "HE") == 0
|| strcmp(command, "HELP") == 0) {
help(command + (*command == '?' ? 1 : 2));
/* Value of vacuum QCSQ */
} else if (strcmp(command, "QCV") == 0 || strcmp(command, "VQC") == 0) {
setVQCSQ(tqcsq);
/* Value of vacuum linear absorption coefficient */
} else if (strcmp(command, "MUV") == 0 || strcmp(command, "VMU") == 0) {
setVMU(tmu);
/* Wavelength */
} else if (strcmp(command, "WL") == 0) {
double v = lambda;
if (setWavelength(&lambda)==0 && lambda != v) {
/* May need to recalculate Q for the new wavelength */
if (theta_offset != 0. && loaded) loadData(infile);
}
/* Theta offset */
} else if (strcmp(command, "TO") == 0) {
double v = theta_offset;
if (setThetaoffset(&theta_offset)==0 && theta_offset != v) {
/* May need to recalculate Q for the new theta offset */
if (loaded) loadData(infile);
}
/* Number of layers */
} else if (
strcmp(command, "NTL") == 0 ||
strcmp(command, "NML") == 0 ||
strcmp(command, "NBL") == 0
) switch (command[1]) {
case 'T':
setNLayer(&ntlayer);
break;
case 'M':
setNLayer(&nmlayer);
break;
case 'B':
setNLayer(&nblayer);
break;
/* Add or remove layers */
} else if (
strcmp(command, "ATL") == 0 ||
strcmp(command, "AML") == 0 ||
strcmp(command, "ABL") == 0 ||
strcmp(command, "RTL") == 0 ||
strcmp(command, "RML") == 0 ||
strcmp(command, "RBL") == 0
) {
modifyLayers(command);
/* Copy layer */
} else if (strcmp(command, "CL") == 0) {
copyLayer(command);
/* Maximum number of layers used to simulate rough interface */
} else if (
strcmp(command, "NR") == 0 &&
!setNRough(&nrough)
) {
/* Generate interface profile */
if (nrough < 3) nrough = 11;
if (*proftyp == 'H')
gentanh(nrough, zint, rufint);
else
generf(nrough, zint, rufint);
/* Specify error function or hyperbolic tangent profile */
} else if (strcmp(command, "PR") == 0) {
setProfile(proftyp, PROFTYPLEN + 2);
/* Number of layers in multilayer */
} else if (strcmp(command, "NMR") == 0) {
setNrepeat(&nrepeat);
/* Range of Q to be scanned */
} else if (strcmp(command, "QL") == 0) {
setQrange(&qmin, &qmax);
/* Number of points scanned */
} else if (strcmp(command, "NP") == 0) {
setNpnts();
/* File for input data */
} else if (strcmp(command, "IF") == 0) {
setFilename(infile, INFILELEN + 2);
/* File for output data */
} else if (strcmp(command, "OF") == 0) {
setFilename(outfile, OUTFILELEN + 2);
/* File for parameters */
} else if (strcmp(command, "PF") == 0) {
setFilename(parfile, PARFILELEN + 2);
/* Delta lambda */
} else if (strcmp(command, "DL") == 0) {
setLamdel(&lamdel);
/* Delta theta */
} else if (strcmp(command, "DT") == 0) {
setThedel(&thedel);
/* Beam intensity */
} else if (strcmp(command, "BI") == 0) {
setBeamIntens(&bmintns, &Dbmintns);
/* Background intensity */
} else if (strcmp(command, "BK") == 0) {
setBackground(&bki, &Dbki);
/* Verify parameters by printing out */
} else if (
strncmp(command, "TVE", 3) == 0 ||
strncmp(command, "MVE", 3) == 0 ||
strncmp(command, "BVE", 3) == 0 ||
strncmp(command, "VE", 2) == 0
) {
printLayers(command);
/* Get data from file */
} else if (strcmp(command, "GD") == 0) {
loadData(infile);
/* Edit constraints */
} else if (strcmp(command, "EC") == 0) {
constrainFunc newmodule;
newmodule = newConstraints(constrainScript, constrainModule);
if (newmodule != NULL) Constrain = newmodule;
/* Reload constrain module */
} else if (strcmp(command, "LC") == 0) {
Constrain = loadConstrain(constrainModule);
/* Unload constrain module */
} else if (strcmp(command, "ULC") == 0) {
Constrain = loadConstrain(NULL);
/* Load parameters from parameter file */
} else if (strncmp(command, "LP", 2) == 0) {
loadParms(command, &npnts, parfile, constrainScript, constrainModule);
/* Save parameters to parameter file */
} else if (strcmp(command, "SP") == 0) {
parms(tqcsq, mqcsq, bqcsq, tqcmsq, mqcmsq, bqcmsq, td, md, bd,
trough, mrough, brough, tmu, mmu, bmu,
MAXLAY, &lambda, &lamdel, &thedel, &theta_offset,
&ntlayer, &nmlayer, &nblayer, &nrepeat, &qmin, &qmax, &npnts,
infile, outfile,
&bmintns, &bki, listA, &mfit, NA, &nrough, proftyp,
DA, constrainScript, parfile, TRUE);
/* List data and fit */
} else if (strcmp(command, "LID") == 0) {
listData();
/* Generate logarithm of bare (unconvoluted) reflectivity */
} else if (strcmp(command, "GR") == 0 || strcmp(command, "SA") == 0) {
genReflect(command);
/* Generate and display layer profile used for roughness */
} else if (strcmp(command, "GLP") == 0) {
genProfile();
/* Save layer profile to OUTFILE */
} else if (
strcmp(command, "SLP") == 0 ||
strcmp(command, "SSP") == 0
) {
saveProfile(command);
/* Save values in XTEMP and YTEMP to OUTFILE */
} else if (strcmp(command, "SV") == 0) {
saveTemps(outfile);
/* Calculate derivative of reflectivity or spin asymmetry with respect
to a fit parameter or save a fit to disk file */
} else if (
strcmp(command, "RD") == 0 ||
strcmp(command, "RSD") == 0 ||
strcmp(command, "SRF") == 0 ||
strcmp(command, "SRSF") == 0
) {
printDerivs(command);
/* Turn off all varied parameters */
} else if (strcmp(command, "VANONE") == 0) {
clearLista(listA);
/* Specify which parameters are to be varied in the reflectivity fit */
} else if (strncmp(command, "VA", 2) == 0) {
varyParm(command);
/* Calculate chi-squared */
} else if (strcmp(command, "CSR") == 0 || strcmp(command, "CSRS") == 0) {
printChiSq(command);
/* Fit five-layer reflectivity */
} else if (strncmp(command, "FR", 2) == 0) {
register int n;
for (n = 0; n < NA; n++) {
undoFit[n] = A[n];
undoFitUnc[n] = DA[n];
}
fitReflec(command);
/* Undo last fit */
} else if (strcmp(command, "UF") == 0) {
register int n;
for (n = 0; n < NA; n++) {
A[n] = undoFit[n];
DA[n] = undoFitUnc[n];
}
/* Exit */
} else if (strcmp(command, "EX") == 0) {
parms(tqcsq, mqcsq, bqcsq, tqcmsq, mqcmsq, bqcmsq, td, md, bd,
trough, mrough, brough, tmu, mmu, bmu,
MAXLAY, &lambda, &lamdel, &thedel, &theta_offset,
&ntlayer, &nmlayer, &nblayer, &nrepeat, &qmin, &qmax, &npnts,
infile, outfile,
&bmintns, &bki, listA, &mfit, NA, &nrough, proftyp,
DA, constrainScript, parfile, TRUE);
exit(0);
/* Exit without saving changes */
} else if (strcmp(command, "QU") == 0 || strcmp(command, "QUIT") == 0) {
exit(0);
/***** Start new ************** */
/* Plot reflectivity on screen */
} else if (strncmp(command, "PRF", 3) == 0) {
plotfit(command);
/* Plot profile on screen */
} else if (strcmp(command, "PLP") == 0) {
/* Generate profile */
plotprofile(command);
/* Send data to other processes. */
} else if (strcmp(command, "SEND") == 0) {
ipc_send(command);
/* Receive data to other processes. */
} else if (strcmp(command, "RECV") == 0) {
ipc_recv(command);
/* Plot movie of reflectivity change from fit */
} else if (strncmp(command, "MVF", 3) == 0) {
fitMovie(command, undoFit);
/* Plot general movie from data file on screen */
} else if (strncmp(command, "MVX", 3) == 0) {
arbitraryMovie(command);
/* Plot movie of parameter on screen */
} else if (strncmp(command, "MV", 2) == 0) {
oneParmMovie(command);
/* Update constraints */
} else if (strcmp(command, "UC") == 0) {
genshift(a, TRUE);
/* constrain(a); */
(*Constrain)(FALSE, a, ntlayer, nmlayer, nrepeat, nblayer);
genshift(a, FALSE);
/* Enter critical Q squared */
/* or */
/* Top length absorption coefficient */
/* or */
/* Thicknesses of top layers */
/* or */
/* Roughnesses of top layers */
} else {
static char *paramcom[] = {"QC", "MU", "D", "RO"};
static double *top[] = { tqcsq, tmu, td, trough};
static double *mid[] = { mqcsq, mmu, md, mrough};
static double *bot[] = { bqcsq, bmu, bd, brough};
static double *Dtop[] = {Dtqcsq, Dtmu, Dtd, Dtrough};
static double *Dmid[] = {Dmqcsq, Dmmu, Dmd, Dmrough};
static double *Dbot[] = {Dbqcsq, Dbmu, Dbd, Dbrough};
static int (*store[])(int, double *, double *) = {
setQCSQ, setMU, setD, setRO
};
int param, code = -1;
for (param = 0; param < sizeof(paramcom) / sizeof(paramcom[0]); param++) {
code = fetchLayParam(command, paramcom[param], top[param],
mid[param], bot[param], Dtop[param], Dmid[param], Dbot[param],
store[param]);
if (code > -1) break;
}
if (code == -1)
ERROR("/** Unrecognized command: %s **/\n", command);
}
}
int fitReflec(char *command)
{
int failed = FALSE;
int ndata;
register int j;
double sumsq, old_sumsq;
void icp_fitupdate(void);
/* Read in data */
loadData(infile, xspin);
ndata = npntsa + npntsb + npntsc + npntsd;
/* Although mrqmin called with xdata, fgenm4 uses q4x for its source */
/* of q's when calling genderiv4 */
if (extend(q4x, n4x, lambda, lamdel, thedel) != NULL) {
/* Fit data */
if (ndata <= mfit) {
puts("/** More parameters than data points **/");
failed = TRUE;
} else {
/* genderiv temp data allocated by extend */
/* Allocate data for mrqmin */
cleanFree((void **) (&ymod));
cleanFree((void **) (&dyda));
ymod = MALLOC(sizeof(double) * ndata);
dyda = MALLOC(sizeof(double) * ndata * mfit);
if (ymod == NULL || dyda == NULL) {
cleanFree((void **) (&ymod));
cleanFree((void **) (&dyda));
puts("/** Cannot allocate temporary data for fit **/");
failed = TRUE;
} else {
FILE *unit99 = NULL, *gnuPipe = NULL;
void (*oldhandler)();
dynarray Covar, Alpha;
int sendgui = 0;
Covar.a = (double *) covar;
Covar.row = NA;
Covar.col = NA;
Alpha.a = (double *) alpha;
Alpha.row = NA;
Alpha.col = NA;
/* Setup signal handlers to interrupt fitting */
oldhandler = signal(SIGINT, stopFit);
abortFit = FALSE;
/* Transfer generating parameters to fit parameters */
genshift(a, TRUE);
/* Check for movie request */
if (command[2] == 'M') {
gnuPipe = popen("gnuplot", "w");
if (gnuPipe == NULL)
puts("/** Cannot initialize movie **/");
} else {
sendgui = (command[2] == 'G' || command[3] == 'G');
}
/* Initialize fit routine */
alamda = -1.;
sumsq = mrqmin(xdat, ydat, srvar, ndata, a, NA, listA, mfit,
Covar, Alpha, beta, NA, 0., fgenm4, &alamda, NULL);
if (sendgui) { ipc_fitupdate(); }
else printf("\n Chi-squared: %#15.7G\n", sumsq / (double) (ndata - mfit));
if (gnuPipe)
preFitFrame(command, gnuPipe, xspin, sumsq / (double) (ndata - mfit));
/* Apply MRQMIN until CHISQ changes by less than 5.e-4 */
/* on successive iterations */
old_sumsq = 2*sumsq; /* force the first step */
while (!abortFit && fabs(sumsq - old_sumsq) > 5.e-4*sumsq) {
old_sumsq = sumsq;
sumsq = mrqmin(xdat, ydat, srvar, ndata, a, NA, listA, mfit,
Covar, Alpha, beta, NA, old_sumsq, fgenm4, &alamda, unit99);
if (sumsq<old_sumsq) { /* Improvement */
chisq = sumsq; /* update assumes global variable */
if (sendgui) ipc_fitupdate();
else printf("\n Chi-squared: %#15.7G\n", sumsq / (double) (ndata - mfit));
}
if (gnuPipe)
fitFrame(gnuPipe, xspin, sumsq / (double) (ndata - mfit));
}
if (abortFit && !sendgui) puts("\nAborting the fit.");
/* Finished--calculate covariance matrix */
alamda = 0.;
mrqmin(xdat, ydat, srvar, ndata, a, NA, listA, mfit,
Covar, Alpha, beta, NA, old_sumsq, fgenm4, &alamda, unit99);
/* Restore signal handlers */
signal(SIGINT, oldhandler);
/* Close output file */
if (unit99) {
fputs("# End fit\n", unit99);
fclose(unit99);
}
/* Transfer fit parameters back to generating variables */
/* constrain(a); */
(*Constrain)(FALSE, a, nlayer);
genshift(a, FALSE);
for (j = 0; j < mfit; j++) DA[listA[j]] = sqrt(fabs(covar[j][j]));
if (!sendgui) {
for (j = 0; j < mfit; j++) {
char varName[10];
genva(listA + j, 1, varName);
printf("%5s: %#15.7G +/- %#15.7G\n", varName, a[listA[j]],
DA[listA[j]]);
}
}
/* Terminate movie */
if (gnuPipe) {
queryString("Press enter to terminate movie", NULL, 0);
fputs("quit\n", gnuPipe);
pclose(gnuPipe);
}
}
}
}
return failed;
}
static int EV_DoGenDoorSec (sector_t* sec, line_t* line, vldoor_e type, mobj_t* thing)
{
int rtn;
int door_type;
int newheight;
vldoor_t* door;
rtn = 0;
door = sec->ceilingdata;
if (door)
{
if (door->thinker.function.acp1 == (actionf_p1) T_VerticalDoor)
{
rtn = 1;
if (type >= GenDoorBase)
door_type = genshift(type,DoorKind,DoorKindShift);
else
door_type = genshift(type,LockedKind,LockedKindShift);// Locked doors only do OWC & OSO
switch (door_type)
{
case OdCDoor: // OWC
if (door->direction == -1)
{
door->direction = 1; // go back up
}
else if ((thing)&&(thing->player)) // JDC: bad guys never close doors
{
door->direction = -1; // start going down immediately
}
break;
}
}
return (rtn);
}
rtn = 1;
// new door thinker
door = get_door_block (sec);
door->type = type;
if ((line) && (line->tag))
door->line = line;
switch (genshift(type,DoorSpeed,DoorSpeedShift))
{
case 0: door->speed = VDOORSPEED/2; break;
case 1: door->speed = VDOORSPEED; break;
case 2: door->speed = VDOORSPEED * 2; break;
default:door->speed = VDOORSPEED * 4;
}
if (type >= GenDoorBase)
{
switch ((type >> DoorDelayShift) & 3)
{
case 0: door->topwait = 35 * 1; break; // 1 sec
case 1: door->topwait = 35 * 4; break; // 4 sec
case 2: door->topwait = 35 * 9; break; // 9 sec
default:door->topwait = 35 * 30; break; // 30 sec
}
door_type = genshift(type,DoorKind,DoorKindShift);
}
else
{
}
if (type >= GenDoorBase)
{
switch ((type >> DoorDelayShift) & 3)
{
case 0: door->topwait = 35 * 1; break; // 1 sec
case 1: door->topwait = 35 * 4; break; // 4 sec
case 2: door->topwait = 35 * 9; break; // 9 sec
default:door->topwait = 35 * 30; break; // 30 sec
}
door_type = genshift(type,DoorKind,DoorKindShift);
}
else
{
door_type = genshift(type,LockedKind,LockedKindShift);// Locked doors only do OWC & OSO
}
switch (door_type)
{
case OdCDoor: // OWC
door->type = normal;
// door->direction = 1;
newheight = P_FindNextHighestCeiling (sec, sec->ceilingheight);
if (newheight > sec->ceilingheight) // Returns current height if none found...
{
newheight -= 4*FRACUNIT;
if (newheight > sec->ceilingheight) // Is door going to move?
T_Makedoorsound (door);
}
door->topheight = newheight;