int main(int argc, string argv[])
{
string prog, itags[MaxBodyFields];
stream xstr, ostr;
int nold = -1;
initparam(argv, defv);
exprs[0] = getparam("group");
prog = mktemp((string) copxstr("/tmp/sm_XXXXXX", sizeof(char)));
buildmap(prog, names, exprs, types, NULL, Precision, NDIM, TRUE);
xstr = execmap(prog);
if (get_tag_ok(xstr, "History"))
skip_item(xstr);
get_history(xstr);
ostr = stropen(getparam("out"), "w");
put_history(ostr);
new_field(&GroupField, IntType, "Group");
new_field(&GroupField + 1, NULL, NULL);
layout_body(btags, Precision, NDIM);
while (get_snap(xstr, &bodytab, &nbody, &tbody, itags, FALSE)) {
snaptrak();
put_snap(ostr, &traktab, &ntrak, &tbody, otags);
if (ntrak != nold)
eprintf("[%s: wrote %d groups at t = %f]\n",
getprog(), ntrak, tbody);
nold = ntrak;
}
strclose(ostr);
if (unlink(prog) != 0)
error("%s: can't unlink %s\n", getprog(), prog);
return (0);
}
real vnpick(real (*fun)(real), real xmin, real xmax, real fmax, string name)
{
int ncyc;
bool warn;
real fr, fx, x;
ncyc = 0;
warn = FALSE;
fr = 1.0;
fx = 0.0;
while (fr > fx) {
x = xrandom(xmin, xmax);
fx = (*fun)(x);
fr = xrandom(0.0, 1.1 * fmax);
if (fx > 1.01 * fmax && ! warn) {
eprintf("[%s.vnpick: %s(%g) = %g > %s_max = %g]\n",
getprog(), name, x, fx, name, fmax);
warn = TRUE;
}
if (fx > 1.1 * fmax)
error("%s.vnpick: %s(x) out of bounds\n", getprog(), name);
ncyc++;
if (ncyc % NCYC == 0)
eprintf("[%s.vnpick: %d cycles picking %s(x)]\n",getprog(), ncyc, name);
}
return (x);
}
void polyscale(void)
{
double r_henon, m_henon, p_henon, scl_r, scl_m, scl_v;
int i;
r_henon = (4*mpol + 6) / (3*mpol - npol + 5);
m_henon = 1.0;
p_henon = m_henon / r_henon;
scl_r = r_henon / rad1;
scl_m = m_henon / mtot;
scl_v = rsqrt(scl_m / scl_r);
for (i = 0; i < nstep; i++) {
rtab[i] = scl_r * rtab[i];
mtab[i] = scl_m * mtab[i];
ptab[i] = rsqr(scl_v) * ptab[i] - p_henon;
if (i > 0 && mtab[i-1] >= mtab[i])
error("%s: mass not monotonic! mtab[%d:%d] = %f,%f\n", getprog(),
i-1, i, mtab[i-1], mtab[i]);
}
rad1 = scl_r * rad1;
mtot = scl_m * mtot;
phi1 = rsqr(scl_v) * phi1 - p_henon; // == - p_henon by def
Kprime = Kprime * scl_m / rqbe(scl_r * scl_v);
eprintf("[%s.polyscale: Kprime = %f]\n", getprog(), Kprime);
}
void restorestate(string file)
{
stream str;
string program, version;
str = stropen(file, "r"); // open state input file
program = get_string(str, "program");
version = get_string(str, "version");
if (! streq(program, getprog()) || // check program, version
! streq(version, getversion()))
eprintf("[%s: warning: state file may be outdated]\n", getprog());
headline = get_string(str, "headline"); // read control parameters
get_data(str, "dtime", RealType, &dtime, 0);
get_data(str, "nstatic", IntType, &nstatic, 0);
#if !defined(QUICKSCAN)
get_data(str, "theta", RealType, &theta, 0);
#endif
get_data(str, "usequad", BoolType, &usequad, 0);
get_data(str, "eps", RealType, &eps, 0);
options = get_string(str, "options");
outputs = get_string(str, "outputs");
get_data(str, "tstop", RealType, &tstop, 0);
get_data(str, "dtout", RealType, &dtout, 0);
get_data(str, "tnow", RealType, &tnow, 0); // read state variables
get_data(str, "tout", RealType, &tout, 0);
get_data(str, "nstep", IntType, &nstep, 0);
get_data(str, "rsize", RealType, &rsize, 0);
get_data(str, "nbody", IntType, &nbody, 0);
get_data(str, "timesteps", IntType, &nbody, 0);
bodytab = (bodyptr) allocate(nbody * sizeof(body));
get_data(str, "bodytab", AnyType, bodytab, nbody, sizeof(body), 0);
strclose(str);
}
local void walktree(nodeptr *aptr, nodeptr *nptr, cellptr cptr, cellptr bptr,
nodeptr p, real psize, vector pmid)
{
nodeptr *np, *ap, q;
int actsafe;
matrix trQM;
if (Update(p)) { // new forces needed in node?
np = nptr; // start new active list
actsafe = actmax - NSUB; // leave room for NSUB more
for (ap = aptr; ap < nptr; ap++) { // loop over active nodes
if (Type(*ap) == CELL) { // is this node a cell?
if (accept(*ap, psize, pmid)) { // does it pass the test?
if (Mass(*ap) > 0.0) { // and contribute to field?
Mass(cptr) = Mass(*ap); // copy to interaction list
SETV(Pos(cptr), Pos(*ap));
#if defined(SOFTCORR)
TRACEM(Trace(cptr), Quad(*ap)); // save trace in copy
SETMI(trQM);
MULMS(trQM, trQM, Trace(cptr)/3);
SUBM(Quad(cptr), Quad(*ap), trQM); // store traceless moment
#else
SETM(Quad(cptr), Quad(*ap)); // copy traceless moment
#endif
cptr++; // and bump cell array ptr
}
} else { // this cell fails the test
if (np - active >= actsafe) // make sure list has room
fatal("%s.walktree: active list overflow\n", getprog());
for (q = More(*ap); q != Next(*ap); q = Next(q))
// loop over all subcells
*np++= q; // put them on active list
}
} else // else this node is a body
if (*ap != p && Mass(*ap) > 0.0) { // not self-interaction?
--bptr; // bump body array ptr
Mass(bptr) = Mass(*ap); // and copy data to array
SETV(Pos(bptr), Pos(*ap));
}
}
acttot = MAX(acttot, np - active); // keep track of max active
if (np != nptr) { // if new actives were added
walksub(nptr, np, cptr, bptr, p, psize, pmid);
// then visit next level
} else { // else no actives left
if (Type(p) != BODY) // make sure we got a body
fatal("%s.walktree: recursion terminated with cell\n"
" p = 0x%x psize = %.8f Mass(p) = %g\n"
" pmid = (%.8f,%.8f,%.8f)\n Pos(p) = (%.8f,%.8f,%.8f)\n",
getprog(), (int) p, psize, Mass(p),
pmid[0], pmid[1], pmid[2], Pos(p)[0], Pos(p)[1], Pos(p)[2]);
gravsum((bodyptr) p, cptr, bptr); // sum force on this body
}
}
}
int main(int argc, string argv[])
{
string prog, coords, itags[MaxBodyFields], otags[MaxBodyFields];
stream xstr, ostr;
bodyptr btab = NULL, bp;
int nbody;
real tnow;
vector cmpos, cmvel, cmacc;
initparam(argv, defv);
exprs[0] = getparam("weight");
prog = mktemp((string) copxstr("/tmp/sm_XXXXXX", sizeof(char)));
buildmap(prog, names, exprs, types, NULL, Precision, NDIM, TRUE);
xstr = execmap(prog);
if (get_tag_ok(xstr, "History"))
skip_item(xstr);
get_history(xstr);
ostr = stropen(getparam("out"), "w");
put_history(ostr);
coords = getparam("coords");
new_field(&WeightField, RealType, "Weight");
new_field(&WeightField + 1, NULL, NULL);
while (get_snap(xstr, &btab, &nbody, &tnow, itags, TRUE, NULL)) {
if (scanopt(coords, PosTag) && set_member(itags, PosTag)) {
snapcmpos(cmpos, btab, nbody, WeightField.offset);
for (bp = btab; bp < NthBody(btab, nbody); bp = NextBody(bp)) {
SUBV(Pos(bp), Pos(bp), cmpos);
}
eprintf("[%s: centroid position: %f,%f,%f]\n", getprog(),
cmpos[0], cmpos[1], cmpos[2]);
}
if (scanopt(coords, VelTag) && set_member(itags, VelTag)) {
snapcmvel(cmvel, btab, nbody, WeightField.offset);
for (bp = btab; bp < NthBody(btab, nbody); bp = NextBody(bp)) {
SUBV(Vel(bp), Vel(bp), cmvel);
}
eprintf("[%s: centroid velocity: %f,%f,%f]\n", getprog(),
cmvel[0], cmvel[1], cmvel[2]);
}
if (scanopt(coords, AccTag) && set_member(itags, AccTag)) {
snapcmacc(cmacc, btab, nbody, WeightField.offset);
for (bp = btab; bp < NthBody(btab, nbody); bp = NextBody(bp)) {
SUBV(Acc(bp), Acc(bp), cmacc);
}
eprintf("[%s: cen. acceleration: %f,%f,%f]\n", getprog(),
cmacc[0], cmacc[1], cmacc[2]);
}
del_tag(otags, itags, "Weight");
put_snap(ostr, &btab, &nbody, &tnow, otags);
}
strclose(ostr);
if (unlink(prog) != 0)
error("%s: can't unlink %s\n", getprog(), prog);
return (0);
}
void polysolve(double hstep, bool listmodel)
{
double h, rpmw[4], w1, w2, t;
gsl_odeiv2_system sys = { diffrpmw, NULL, 4, NULL };
gsl_odeiv2_driver *drv;
int stat;
if (npol <= 0.5 || mpol <= -1.0)
error("%s: illegal value for n or m\n", getprog());
if (npol >= 3*mpol + 5)
error("%s: model would have infinite radius\n", getprog());
Kprime = K * (mpol+1) * pow(PI, -1.5) * pow(2.0, - (mpol+1.5)) *
exp(lgamma(mpol+npol+1) - lgamma(mpol+2) - lgamma(npol-0.5));
h = hstep;
do {
drv = gsl_odeiv2_driver_alloc_y_new(&sys, gsl_odeiv2_step_rk4,
h, 1.0, 1.0);
rpmw[0] = 0.0; // initialize radius
rpmw[1] = PHI0; // initialize potential
rpmw[2] = 0.0; // initialize enclosed mass
rpmw[3] = 0.0; // initialize binding energy
nstep = 0;
storestep(rpmw);
asmpstep(rpmw, h); // use asymp. approximation
storestep(rpmw);
while (rpmw[1] < 0.0) { // while potential is neg.
stat = gsl_odeiv2_driver_apply_fixed_step(drv, &t, h, 1, rpmw);
if (stat)
eprintf("[%s.polysolve: stat = %d]\n", getprog(), stat);
storestep(rpmw);
}
fixsurface();
w1 = rpmw[3] - 0.5 * rsqr(mtot) / rad1;
w2 = - (2*mpol + 3) / (3*mpol - npol + 5) * rsqr(mtot) / rad1;
eprintf("[%s.polysolve: nstep = %3d W = %f error = %f]\n",
getprog(), nstep, w2, (w1 - w2)/w2);
gsl_odeiv2_driver_free(drv);
h = 0.5 * h; // refine step-size by 2
} while (nstep < MAXSTEP/4);
polyscale();
pmspline = gsl_spline_alloc(gsl_interp_cspline, nstep);
gsl_spline_init(pmspline, rtab, ptab, nstep);
if (listmodel) {
printf("#%11s %11s %11s\n", "radius", "mass", "potential");
for (int i = 0; i < nstep - 1; i++)
printf(" %11.6f %11.6f %11.6f\n", rtab[i], mtab[i], ptab[i]);
printf(" %11.6f %11.6f %11.6f\n", rad1, mtot, phi1);
}
}
int main(int argc, string argv[])
{
string *mdtab, *names, *exprs, prog;
int nexp = 0, i, j;
initparam(argv, defv);
mdtab = getmapdefs(); // get list of mapping vars
for (i = 0; mdtab[i] != NULL; i += 2)
if (getparamstat(mdtab[i]) & ARGPARAM) // if var has assigned value
nexp++;
eprintf("[%s: %scounted %d variable assignments]\n", getprog(),
nexp > 0 ? "" : "warning: ", nexp);
names = (string *) allocate(sizeof(string *) * (nexp + 1));
exprs = (string *) allocate(sizeof(string *) * (nexp + 1));
for (i = j = 0; mdtab[i] != NULL; i += 2)
if (getparamstat(mdtab[i]) & ARGPARAM) { // if var has assigned value
exprs[j] = getparam(mdtab[i]); // list value given as expr
names[j] = mdtab[i+1]; // and name of access macro
j++;
}
exprs[j] = names[j] = NULL;
prog = mktemp((string) copxstr("/tmp/sm_XXXXXX", sizeof(char)));
buildmap(prog, names, exprs, NULL,
strnull(getparam("t")) ? NULL : getparam("t"),
Precision, NDIM, TRUE);
execmap(prog);
if (unlink(prog) != 0)
error("%s: can't unlink %s\n", getargv0(), prog);
return (0);
}
int main(int argc, string *argv)
{
initparam(argv, defv);
printf("program %s:\n", getprog());
printf(" input = \"%s\" [%o]\n", getparam("input"),
getparamstat("input"));
printf(" output = \"%s\" [%o]\n", getparam("output"),
getparamstat("output"));
printf(" answer = %d [%o]\n", getiparam("answer"),
getparamstat("answer"));
printf(" value = %g [%o]\n", getdparam("value"),
getparamstat("value"));
printf(" flag = %s [%o]\n", getbparam("flag") ? "TRUE" : "FALSE",
getparamstat("flag"));
printf(" foobar = \"%s\" [%o]\n", getparam("foobar"),
getparamstat("foobar"));
printf(" VERSION = \"%s\" [%o]\n", getversion(),
getparamstat("VERSION"));
if (getbparam("flag")) {
printf("getparamstat(\"junk\") = %o\n", getparamstat("junk"));
printf("calling getparam(\"junk\")\n");
(void) getparam("junk");
}
return (0);
}
int main(int argc, string argv[])
{
stream outstr;
int nmodel;
real tzero = 0.0;
initparam(argv, defv);
layout_body(bodyfields, Precision, NDIM);
nbody = getiparam("nbody");
nmodel = getiparam("nmodel");
if (nbody < 1 || nmodel < 1)
error("%s: absurd value for nbody or nmodel\n", getprog());
btab = (bodyptr) allocate(nbody * SizeofBody);
init_random(getiparam("seed"));
outstr = stropen(getparam("out"), "w");
put_history(outstr);
while (--nmodel >= 0) {
plummodel(getdparam("mfrac"));
if (getbparam("besort"))
qsort(btab, nbody, SizeofBody, berank);
if (getbparam("zerocm"))
snapcenter(btab, nbody, MassField.offset);
put_snap(outstr, &btab, &nbody, &tzero, bodyfields);
fflush(outstr);
}
return (0);
}
void savestate(string pattern)
{
char namebuf[256];
stream str;
sprintf(namebuf, pattern, nstep & 1); // construct alternate name
str = stropen(namebuf, "w!"); // open state output file
put_string(str, "program", getprog());
put_string(str, "version", getversion());
put_string(str, "headline", headline); // save control parameters
put_data(str, "dtime", RealType, &dtime, 0);
put_data(str, "nstatic", IntType, &nstatic, 0);
#if !defined(QUICKSCAN)
put_data(str, "theta", RealType, &theta, 0);
#endif
put_data(str, "usequad", BoolType, &usequad, 0);
put_data(str, "eps", RealType, &eps, 0);
put_string(str, "options", options);
put_string(str, "outputs", outputs);
put_data(str, "tstop", RealType, &tstop, 0);
put_data(str, "dtout", RealType, &dtout, 0);
put_data(str, "tnow", RealType, &tnow, 0); // save state variables
put_data(str, "tout", RealType, &tout, 0);
put_data(str, "nstep", IntType, &nstep, 0);
put_data(str, "rsize", RealType, &rsize, 0);
put_data(str, "nbody", IntType, &nbody, 0);
put_data(str, "timesteps", IntType, &nbody, 0);
put_data(str, "bodytab", AnyType, bodytab, nbody, sizeof(body), 0);
strclose(str);
}
int main(int argc, string argv[])
{
real rrange[2], rmax;
int np;
double lgrs;
gsprof *gsp;
stream ostr;
initparam(argv, defv);
setrange(rrange, getparam("rrange"));
np = getiparam("npoint");
rmax = pow(2.0, floor(log2(32.0 / getdparam("alpha"))));
if (rmax < rrange[1] && getbparam("smartrange")) {
lgrs = log2(rrange[1] / rrange[0]) / (np - 1);
np = 1 + log2(rmax / rrange[0]) / lgrs;
eprintf("[%s: warning: npoint = %d -> %d rrange[1] = %f -> %f]\n",
getprog(), getiparam("npoint"), np, rrange[1], rmax);
rrange[1] = rmax;
}
gsp = gsp_expd(getdparam("mtot"), getdparam("alpha"), getdparam("zdisk"),
np, rrange[0], rrange[1]);
ostr = stropen(getparam("out"), "w");
put_history(ostr);
gsp_write(ostr, gsp);
fflush(NULL);
return 0;
}
int main(int argc, string argv[])
{
stream istr, ostr;
string times, *vecs, *produce, iotags[MaxBodyFields];
bool expand;
snapshot snap = { NULL, 0, 0.0 };
initparam(argv, defv);
istr = stropen(getparam("in"), "r");
get_history(istr);
ostr = stropen(getparam("out"), "w");
put_history(ostr);
times = getparam("times");
vecs = burststring(getparam("vectors"), ", ");
expand = streq(getparam("produce"), "*");
if (! expand) {
produce = burststring(getparam("produce"), ", ");
layout_body(produce, Precision, NDIM);
}
while (get_snapshot_timed(istr, snap, iotags, expand, times)) {
eprintf("[%s: rotating time %f]\n", getprog(), snap.time);
snaprotate(&snap, iotags, vecs, getparam("order"), getbparam("invert"),
getdparam("thetax"), getdparam("thetay"), getdparam("thetaz"));
put_snapshot(ostr, snap, iotags);
skip_history(istr);
}
strclose(ostr);
return (0);
}
void fit_params(void)
{
if (radius_tab[0] != 0.0)
alpha = rlog10(density_tab[1] / density_tab[0]) /
rlog10(radius_tab[1] / radius_tab[0]);
else
alpha = 0.0;
beta = rlog10(density_tab[ntab-2] / density_tab[ntab-1]) /
rlog10(radius_tab[ntab-2] / radius_tab[ntab-1]);
if (beta > -3.0)
error("%s: total mass diverges (beta = %f)\n", getprog(), beta);
mtot = mass_tab[ntab-1] -
(4 * M_PI / (3 + beta)) *
gsl_pow_3(radius_tab[ntab-1]) * density_tab[ntab-1];
eprintf("[%s: alpha = %f beta = %f mtot = %f]\n", getprog(),
alpha, beta, mtot);
}
double cputime(void)
{
struct tms buffer;
if (times(&buffer) == -1)
error("%s.cputime: times() call failed\n", getprog());
return ((buffer.tms_utime + buffer.tms_stime) / (60.0 * HZ));
}
double cputime(void)
{
struct rusage buf;
if (getrusage(RUSAGE_SELF, &buf) == -1)
error("%s.cputime: getrusage() call failed\n", getprog());
return ((buf.ru_utime.tv_sec + buf.ru_utime.tv_usec / 1000000.0 +
buf.ru_stime.tv_sec + buf.ru_stime.tv_usec / 1000000.0) / 60.0);
}
void storestep(double rpmw[])
{
if (nstep >= MAXSTEP)
error("%s.storestep: too many steps\n", getprog());
rtab[nstep] = rpmw[0];
ptab[nstep] = rpmw[1];
mtab[nstep] = rpmw[2];
nstep++;
}
void setprof(int model, double alpha, double rcut)
{
int j;
double r, x;
rdtab[0] = mdtab[0] = vctab[0] = 0.0;
for (j = 1; j < NTAB; j++) {
r = rcut * pow(((double) j) / (NTAB - 1), 2.0);
rdtab[j] = r;
x = alpha * r;
switch (model) {
case -3:
mdtab[j] = gsl_pow_4(r / rcut);
break;
case -2:
mdtab[j] = gsl_pow_3(r / rcut);
break;
case -1:
mdtab[j] = gsl_pow_2(r / rcut);
break;
case 0:
mdtab[j] = 1 - exp(-x) - x * exp(-x);
break;
case 1:
mdtab[j] = (2 - 2 * exp(-x) - (2*x + x*x) * exp(-x)) / 2;
break;
case 2:
mdtab[j] = (6 - 6 * exp(-x) - (6*x + 3*x*x + x*x*x) * exp(-x)) / 6;
break;
default:
error("%s: bad choice for model\n", getprog());
}
vctab[j] = sqrt(gsp_mass(spheroid, r) / r);
}
if (model > -1)
eprintf("[%s: rcut = %8.4f/alpha M(rcut) = %8.6f*mdisk]\n",
getprog(), rdtab[NTAB-1] * alpha, mdtab[NTAB-1]);
if ((mdtab[0] == mdtab[1]) || (mdtab[NTAB-2] == mdtab[NTAB-1]))
error("%s: disk mass table is degenerate\n", getprog());
rm_spline = gsl_interp_alloc(gsl_interp_akima, NTAB);
gsl_interp_init(rm_spline, mdtab, rdtab, NTAB);
vr_spline = gsl_interp_alloc(gsl_interp_akima, NTAB);
gsl_interp_init(vr_spline, rdtab, vctab, NTAB);
}
local typeinfo *find_name(string name)
{
typeinfo *tp;
for (tp = typetable; tp->type != NULL; tp++)
if (streq(tp->name, name))
return (tp);
error("%s.find_name: type %s unknown\n", getprog(), name);
return (NULL);
}
local typeinfo *find_type(string type)
{
typeinfo *tp;
for (tp = typetable; tp->type != NULL; tp++)
if (tp->type[0] == type[0])
return (tp);
error("%s.find_type: type %c unknown\n", getprog(), type[0]);
return (NULL);
}
stream execmap(string prog)
{
int handle[2];
char handbuf[32], produce[512];
pipe(handle);
if (fork() == 0) { // if this is child process
close(handle[0]);
sprintf(handbuf, "-%d", handle[1]);
sprintf(produce, "%s,Weight", getparam("produce"));
execl(prog, getprog(), getparam("in"), handbuf, getparam("times"),
getparam("require"), produce, getparam("passall"),
getparam("seed"), NULL);
error("%s: execl %s failed\n", getprog(), prog);
}
close(handle[1]);
sprintf(handbuf, "-%d", handle[0]);
return (stropen(handbuf, "r"));
}
stream execmap(string prog)
{
int handle[2];
char handbuf[32];
pipe(handle);
if (fork() == 0) { // if this is child process
close(handle[0]);
sprintf(handbuf, "-%d", handle[1]);
execl(prog, getprog(), getparam("in"), handbuf, getparam("times"),
MassTag "," PosTag "," VelTag,
MassTag "," PosTag "," VelTag ",Group",
"true", getparam("seed"), NULL);
error("%s: execl %s failed\n", getprog(), prog);
}
close(handle[1]);
sprintf(handbuf, "-%d", handle[0]);
return (stropen(handbuf, "r"));
}
void inputdata(void)
{
stream instr;
string intags[MaxBodyFields];
bodyptr p;
bodytab = NULL; // request new input data
instr = stropen(infile, "r"); // open input stream
get_history(instr); // read file history data
if (! get_snap(instr, &bodytab, &nbody, &tnow, intags, FALSE))
error("%s.inputdata: no data in input file\n", getprog());
strclose(instr); // close input stream
if (! set_member(intags, MassTag) || ! set_member(intags, PosTag) ||
! set_member(intags, VelTag))
error("%s.inputdata: essential data missing\n", getprog());
if (scanopt(options, "reset-time")) // reset starting time?
tnow = 0.0;
for (p = bodytab; p < bodytab+nbody; p++) // loop over new bodies
Type(p) = BODY; // initializing body type
}
void snaptrak(void)
{
bodyptr bp, gp;
int nzero;
if (traktab == NULL) {
ntrak = 0;
for (bp = bodytab; bp < NthBody(bodytab, nbody); bp = NextBody(bp))
ntrak = MAX(ntrak, Group(bp));
eprintf("[%s: allocating %d groups]\n", getprog(), ntrak);
traktab = (bodyptr) allocate(ntrak * SizeofBody);
}
for (gp = traktab; gp < NthBody(traktab, ntrak); gp = NextBody(gp)) {
Mass(gp) = 0.0;
CLRV(Pos(gp));
CLRV(Vel(gp));
Key(gp) = 0;
}
for (bp = bodytab; bp < NthBody(bodytab, nbody); bp = NextBody(bp)) {
if (Group(bp) > ntrak)
error("snaptrak: cant expand group array\n");
if (Group(bp) > 0) {
gp = NthBody(traktab, Group(bp) - 1);
Mass(gp) += Mass(bp);
ADDMULVS(Pos(gp), Pos(bp), Mass(bp));
ADDMULVS(Vel(gp), Vel(bp), Mass(bp));
Key(gp)++;
}
}
nzero = 0;
for (gp = traktab; gp < NthBody(traktab, ntrak); gp = NextBody(gp))
if (Mass(gp) != 0.0) {
DIVVS(Pos(gp), Pos(gp), Mass(gp));
DIVVS(Vel(gp), Vel(gp), Mass(gp));
} else
nzero++;
if (nzero > 0)
eprintf("[%s: %d groups have zero mass]\n", getprog(), nzero);
}
local void hqmforces(bodyptr btab, int nbody, real M, real a, real b,
real tol)
{
bodyptr bp;
double r, mr3i, params[4], phi0, aR0, az0, abserr[3];
static gsl_integration_workspace *wksp = NULL;
gsl_function FPhi, F_aR, F_az;
static double maxerr = 0.0;
int stat[3];
if (a == b) { // spherical case is easy!
for (bp = btab; bp < NthBody(btab, nbody); bp = NextBody(bp)) {
r = absv(Pos(bp));
Phi(bp) = - M / (a + r);
mr3i = M * rsqr(r / (a + r)) / rqbe(r);
MULVS(Acc(bp), Pos(bp), - mr3i);
}
} else { // flattened case is harder
if (wksp == NULL) { // on first call, initialze
wksp = gsl_integration_workspace_alloc(1000);
gsl_set_error_handler_off(); // handle errors below
}
FPhi.function = &intPhi;
F_aR.function = &int_aR;
F_az.function = &int_az;
FPhi.params = F_aR.params = F_az.params = params;
a2(params) = rsqr(a);
b2(params) = rsqr(b);
for (bp = btab; bp < NthBody(btab, nbody); bp = NextBody(bp)) {
R(params) = rsqrt(rsqr(Pos(bp)[0]) + rsqr(Pos(bp)[1]));
z(params) = Pos(bp)[2];
stat[0] = gsl_integration_qagiu(&FPhi, 0.0, tol, 0.0,
1000, wksp, &phi0, &abserr[0]);
stat[1] = gsl_integration_qagiu(&F_aR, 0.0, tol, 0.0,
1000, wksp, &aR0, &abserr[1]);
stat[2] = gsl_integration_qagiu(&F_az, 0.0, tol, 0.0,
1000, wksp, &az0, &abserr[2]);
if (stat[0] || stat[1] || stat[2]) // any errors reported?
for (int i = 0; i < 3; i++)
if (stat[i] != 0 && abserr[i] > maxerr) {
eprintf("[%s.hqmforces: warning: %s abserr[%d] = %g]\n",
getprog(), gsl_strerror(stat[i]), i+1, abserr[i]);
maxerr = abserr[i]; // adjust reporting threshold
}
Phi(bp) = - M * phi0;
Acc(bp)[0] = - M * (Pos(bp)[0] / R(params)) * aR0;
Acc(bp)[1] = - M * (Pos(bp)[1] / R(params)) * aR0;
Acc(bp)[2] = - M * az0;
}
}
}
void integ_mass(bool update)
{
double *dmdr_tab = (double *) allocate(ntab * sizeof(double));
gsl_spline *spl_dmdr = gsl_spline_alloc(gsl_interp_cspline, ntab);
gsl_interp_accel *acc_dmdr = gsl_interp_accel_alloc();
int i, stat;
double alpha, mass_int, del_mass, mass_end = mass_tab[ntab - 1];
for (i = 0; i < ntab; i++)
dmdr_tab[i] = 4 * M_PI * gsl_pow_2(radius_tab[i]) * density_tab[i];
gsl_spline_init(spl_dmdr, radius_tab, dmdr_tab, ntab);
if (radius_tab[0] > 0.0) {
alpha = rlog10(density_tab[1] / density_tab[0]) /
rlog10(radius_tab[1] / radius_tab[0]);
mass_int = (4 * M_PI / (alpha + 3)) *
gsl_pow_3(radius_tab[0]) * density_tab[0];
} else
mass_int = 0.0;
if (update)
mass_tab[0] = mass_int;
for (i = 1; i < ntab; i++) {
stat = gsl_spline_eval_integ_e(spl_dmdr, radius_tab[i-1], radius_tab[i],
acc_dmdr, &del_mass);
if (stat != 0)
error("%s: spline error: %s\n", getprog(), gsl_strerror(stat));
mass_int = mass_int + del_mass;
if (update)
mass_tab[i] = mass_int;
}
gsl_interp_accel_free(acc_dmdr);
gsl_spline_free(spl_dmdr);
free(dmdr_tab);
eprintf("[%s: mass[] = %e:%e]\n",
getprog(), mass_tab[0], mass_tab[ntab - 1]);
if (mass_int < 0.99 * mass_end || mass_int > 1.01 * mass_end)
eprintf("[%s: WARNING: final mass = %e integ mass = %e]\n",
getprog(), mass_end, mass_int);
}
void fixsurface(void)
{
double f;
while (mtab[nstep-2] == mtab[nstep-1]) {
eprintf("[%s.fixsurface: reducing nstep to %d]\n", getprog(), nstep-1);
ptab[nstep-2] = ptab[nstep-1];
rtab[nstep-2] = rtab[nstep-1];
nstep--;
}
f = -ptab[nstep-2] / (ptab[nstep-1] - ptab[nstep-2]);
rad1 = f * rtab[nstep-1] + (1 - f) * rtab[nstep-2];
mtot = f * mtab[nstep-1] + (1 - f) * mtab[nstep-2];
phi1 = 0.0; // fixed by definition
}
int main(int argc, char *argv[])
{
lua_State *L;
argv[0] = getprog();
if (argv[0]==NULL) fatal("srlua","cannot locate this executable");
L=luaL_newstate();
if (L==NULL) fatal(argv[0],"not enough memory for state");
lua_pushcfunction(L,&pmain);
lua_pushinteger(L,argc);
lua_pushlightuserdata(L,argv);
if (lua_pcall(L,2,0,0)!=0) fatal(argv[0],lua_tostring(L,-1));
lua_close(L);
return EXIT_SUCCESS;
}
static void dump_code(unsigned int pc, unsigned int max, int annotate) {
int dbl = 0, sngl = 0;
printf("ADDR OPCODE MNEMONIC%s\n\n", annotate?"\t\tComment":"");
do {
char instr[16];
const opcode op = getprog(pc);
const char *p = prt(op, instr);
int i;
if (isDBL(op)) {
dbl++;
printf("%04x: %04x %04x ", pc, op & 0xffff, (op >> 16)&0xffff);
} else {
sngl++;
printf("%04x: %04x ", pc, op);
}
//printf("%04x: %04x ", pc, op);
if (op == RARG(RARG_ALPHA, ' '))
strcpy(instr+2, "[space]");
while (*p != '\0') {
char c = *p++;
const char *q = pretty(c);
if (q == NULL) putchar(c);
else if (strcmp("narrow-space", q) == 0 && *p == c) {
printf(" ");
p++;
} else printf("[%s]", q);
}
if (annotate) {
extern const unsigned short int xrom_targets[];
for (i=0; i<num_xrom_entry_points; i++)
if (addrXROM(xrom_entry_points[i].address) == pc)
printf("\t\t\tXLBL %s", xrom_entry_points[i].name);
for (i=0; i<num_xrom_labels; i++)
if (xrom_labels[i].op == op)
printf("\t\t\t%s", xrom_labels[i].name);
if (RARG_CMD(op) == RARG_SKIP || RARG_CMD(op) == RARG_BSF)
printf("\t\t-> %04x", pc + (op & 0xff) + 1);
else if (RARG_CMD(op) == RARG_BACK || RARG_CMD(op) == RARG_BSB)
printf("\t\t-> %04x", pc - (op & 0xff));
else if (RARG_CMD(op) == RARG_XEQ || RARG_CMD(op) == RARG_GTO)
printf("\t\t\t-> %04x", addrXROM(0) + xrom_targets[op & RARG_MASK]);
}
putchar('\n');
pc = do_inc(pc, 0);
} while (! PcWrapped);
void read_table(string in, bool smooth)
{
stream instr = stropen(in, "r");
char inbuf[129];
double radius, rho0, rho1, mass;
if (fscanf(instr, "#%128[^\n]\n", inbuf) != 1)
error("%s: can't read first line\n", getprog());
eprintf("[%s: \"#%s\"]\n", getprog(), inbuf);
if (fscanf(instr, "#%128[^\n]\n", inbuf) != 1)
error("%s: can't read second line\n", getprog());
if (fscanf(instr, "%128[^\n]\n", inbuf) != 1)
error("%s: can't read third line\n", getprog());
if (sscanf(inbuf, "%lf Infinity %lf %lf %*s", &radius, &mass, &rho1) == 3) {
eprintf("[%s: skipping third line; radius = %f]\n", getprog(), radius);
ntab = 0;
} else if (sscanf(inbuf, "%lf %lf %lf %lf %*s",
&radius, &rho0, &mass, &rho1) == 4) {
radius_tab[0] = radius;
density_tab[0] = (smooth ? rho1 : rho0);
mass_tab[0] = mass;
ntab = 1;
} else
error("%s: can't interpret third line\n", getprog());
while (fscanf(instr, "%lf %lf %lf %lf %*s\n",
&radius, &rho0, &mass, &rho1) == 4) {
if (ntab < nmax) {
radius_tab[ntab] = radius;
density_tab[ntab] = (smooth ? rho1 : rho0);
mass_tab[ntab] = mass;
}
ntab++;
}
if (ntab > nmax) {
eprintf("[%s: warning: truncating table to %d values]\n", getprog(), nmax);
ntab = nmax;
}
eprintf("[%s: radius[] = %e:%e (%d values)\n", getprog(),
radius_tab[0], radius_tab[ntab-1], ntab);
}
