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); }