Extern void EXPORT(Divonne)(ccount ndim, ccount ncomp,
Integrand integrand,
creal epsrel, creal epsabs,
cint flags, cnumber mineval, cnumber maxeval,
cint key1, cint key2, cint key3, ccount maxpass,
creal border, creal maxchisq, creal mindeviation,
cnumber ngiven, ccount ldxgiven, real *xgiven,
cnumber nextra, PeakFinder peakfinder,
int *pnregions, number *pneval, int *pfail,
real *integral, real *error, real *prob)
{
ndim_ = ndim;
ncomp_ = ncomp;
if( BadComponent(ncomp) ||
BadDimension(ndim, flags, key1) ||
BadDimension(ndim, flags, key2) ||
((key3 & -2) && BadDimension(ndim, flags, key3)) ) *pfail = -1;
else {
neval_ = neval_opt_ = neval_cut_ = 0;
integrand_ = integrand;
peakfinder_ = peakfinder;
border_.lower = border;
border_.upper = 1 - border_.lower;
ngiven_ = ngiven;
xgiven_ = NULL;
ldxgiven_ = IMax(ldxgiven, ndim_);
nextra_ = nextra;
if( ngiven + nextra ) {
cnumber nxgiven = ngiven*ldxgiven;
cnumber nxextra = nextra*ldxgiven;
cnumber nfgiven = ngiven*ncomp;
cnumber nfextra = nextra*ncomp;
Alloc(xgiven_, nxgiven + nxextra + nfgiven + nfextra);
xextra_ = xgiven_ + nxgiven;
fgiven_ = xextra_ + nxextra;
fextra_ = fgiven_ + nfgiven;
if( nxgiven ) {
phase_ = 0;
Copy(xgiven_, xgiven, nxgiven);
DoSample(ngiven_, ldxgiven_, xgiven_, fgiven_);
}
}
*pfail = Integrate(epsrel, Max(epsabs, NOTZERO),
flags, mineval, maxeval, key1, key2, key3, maxpass,
maxchisq, mindeviation,
integral, error, prob);
*pnregions = nregions_;
*pneval = neval_;
if( xgiven_ ) free(xgiven_);
}
}
void Divonne(ccount ndim, ccount ncomp, Integrand integrand,
creal epsrel, creal epsabs,
cint flags, ccount mineval, ccount maxeval,
cint key1, cint key2, cint key3, ccount maxpass,
creal border, creal maxchisq, creal mindeviation,
ccount ngiven, ccount ldxgiven, real *xgiven,
ccount nextra, PeakFinder peakfinder,
int *pnregions, int *pneval, int *pfail,
real *integral, real *error, real *prob)
{
ndim_ = ndim;
ncomp_ = ncomp;
if( ndim < MINDIM || ndim > MAXDIM ) *pfail = -1;
else {
neval_ = neval_opt_ = neval_cut_ = 0;
integrand_ = integrand;
peakfinder_ = peakfinder;
border_.lower = border;
border_.upper = 1 - border_.lower;
ngiven_ = ngiven;
xgiven_ = NULL;
ldxgiven_ = IMax(ldxgiven, ndim_);
nextra_ = nextra;
if( ngiven + nextra ) {
ccount nxgiven = ngiven*ldxgiven;
ccount nxextra = nextra*ldxgiven;
ccount nfgiven = ngiven*ncomp;
ccount nfextra = nextra*ncomp;
Allocate(xgiven_, nxgiven + nxextra + nfgiven + nfextra);
xextra_ = xgiven_ + nxgiven;
fgiven_ = xextra_ + nxextra;
fextra_ = fgiven_ + nfgiven;
if( nxgiven ) {
phase_ = 0;
Copy(xgiven_, xgiven, nxgiven);
DoSample(ngiven_, ldxgiven_, xgiven_, fgiven_);
}
}
*pfail = Integrate(epsrel, Max(epsabs, NOTZERO),
flags, mineval, maxeval, key1, key2, key3, maxpass,
maxchisq, mindeviation,
integral, error, prob);
*pnregions = nregions_;
*pneval = neval_;
if( xgiven_ ) free(xgiven_);
}
}
static inline void newcore(subroutine foo, const int flags)
{
int fd[2];
pid_t pid;
int core = nlaunched++;
assert(
socketpair(AF_LOCAL, SOCK_STREAM, 0, fd) != -1 &&
(pid = fork()) != -1 );
if( pid ) {
MASTER("forked core %d pid %d pipe %d(master) -> %d(worker) seq %llx",
core, pid, fd[0], fd[1], mem_seq);
close(fd[1]);
child[core].fd = fd[0];
child[core].seq = mem_seq;
FD_SET(fd[0], &children);
fdmax = IMax(fd[0], fdmax);
return;
}
close(fd[0]);
for( ; ; ) {
RealType res[NCOMP];
seq_t seq = mem_seq;
res[0] = res[1] = 0;
foo(res, &flags);
WORKER(core, "writing result(%ld)", sizeof res);
writesock(fd[1], res, sizeof res);
WORKER(core, "reading mem_hel(%p#%ld)", mem.h, mem.he - mem.h);
if( !readsock(fd[1], mem.h, mem.he - mem.h) ) exit(0);
WORKER(core, "seq %llx new %llx", seq, mem_seq);
seq ^= mem_seq;
if( SEQ_ANGLE(seq) ) {
WORKER(core, "reading mem_angle(%p#%ld+%p#%ld)",
mem.v, mem.ve - mem.v, mem.a, mem.ae - mem.a);
readsock(fd[1], mem.v, mem.ve - mem.v);
readsock(fd[1], mem.a, mem.ae - mem.a);
restorecache_();
}
if( SEQ_S(seq) ) {
WORKER(core, "reading mem_s(%p#%ld)", mem.s, mem.se - mem.s);
readsock(fd[1], mem.s, mem.se - mem.s);
clearcache_();
}
seq = mem_seq;
}
}
static inline void AllocGiven(This *t, creal *xgiven)
{
if( t->ngiven | t->nextra ) {
cnumber nxgiven = t->ngiven*(t->ldxgiven = IMax(t->ldxgiven, t->ndim));
cnumber nxextra = t->nextra*t->ldxgiven;
cnumber nfgiven = t->ngiven*t->ncomp;
cnumber nfextra = t->nextra*t->ncomp;
Alloc(t->xgiven, nxgiven + nxextra + nfgiven + nfextra);
t->xextra = t->xgiven + nxgiven;
t->fgiven = t->xextra + nxextra;
t->fextra = t->fgiven + nfgiven;
if( nxgiven ) {
t->phase = 0;
Copy(t->xgiven, xgiven, nxgiven);
DoSample(t, t->ngiven, t->ldxgiven, t->xgiven, t->fgiven);
}
}
}
static void Iterate(This *t, count iregion, cint depth, cint isamples,
Totals *totals)
{
csize_t regionsize = RegionSize;
Region *parent, *region;
typedef struct {
real avg, err, spread, spreadsq;
} Corr;
Vector(Corr, corr, NCOMP);
Corr *c, *C = corr + t->ncomp;
Result *res;
count ireg, mreg = iregion;
count comp, maxsplit;
int last, idest, isrc;
region = RegionPtr(iregion);
region->depth = depth;
region->next = -iregion - 1;
if( isamples < 0 ) Split(t, iregion);
else {
region->isamples = isamples;
ExploreSerial(t, iregion);
}
ireg = iregion + RegionPtr(iregion)->next;
do {
region = RegionPtr(ireg);
if( region->depth > 0 ) {
--region->depth;
FORK_ONLY(more:)
ireg = Explore(t, ireg);
if( ireg == -1 ) return;
region = RegionPtr(ireg);
}
if( region->depth < 0 ) mreg = IMax(mreg, ireg);
ireg += region->next;
} while( ireg > 0 );
static int Integrate(This *t, real *integral, real *error, real *prob)
{
StateDecl;
csize_t statesize = sizeof(State) + NCOMP*sizeof(Result);
Sized(State, state, statesize);
Array(Var, var, NDIM, 2);
Vector(char, out, 128*NCOMP + 256);
Region *anchor = NULL, *region = NULL;
Result *tot, *Tot = state->totals + t->ncomp;
Result *res, *resL, *resR;
Bounds *b, *B;
cnumber minsamples = IMax(t->nmin, MINSAMPLES);
count dim, comp;
int fail;
if( VERBOSE > 1 ) {
sprintf(out, "Suave input parameters:\n"
" ndim " COUNT "\n ncomp " COUNT "\n"
ML_NOT(" nvec " NUMBER "\n")
" epsrel " REAL "\n epsabs " REAL "\n"
" flags %d\n seed %d\n"
" mineval " NUMBER "\n maxeval " NUMBER "\n"
" nnew " NUMBER "\n nmin " NUMBER "\n"
" flatness " REAL "\n"
" statefile \"%s\"",
t->ndim, t->ncomp,
ML_NOT(t->nvec,)
SHOW(t->epsrel), SHOW(t->epsabs),
t->flags, t->seed,
t->mineval, t->maxeval,
t->nnew, t->nmin,
SHOW(t->flatness),
t->statefile);
Print(out);
}
static int Integrate(This *t, real *integral, real *error, real *prob)
{
TYPEDEFREGION;
typedef struct pool {
struct pool *next;
Region region[POOLSIZE];
} Pool;
count dim, comp, ncur, ipool, npool;
int fail;
Totals totals[NCOMP];
Pool *cur = NULL, *pool;
Region *region;
if( VERBOSE > 1 ) {
char s[256];
sprintf(s, "Cuhre input parameters:\n"
" ndim " COUNT "\n ncomp " COUNT "\n"
" epsrel " REAL "\n epsabs " REAL "\n"
" flags %d\n mineval " NUMBER "\n maxeval " NUMBER "\n"
" key " COUNT,
t->ndim, t->ncomp,
t->epsrel, t->epsabs,
t->flags, t->mineval, t->maxeval,
t->key);
Print(s);
}
if( BadComponent(t) ) return -2;
if( BadDimension(t) ) return -1;
t->epsabs = Max(t->epsabs, NOTZERO);
RuleAlloc(t);
t->mineval = IMax(t->mineval, t->rule.n + 1);
FrameAlloc(t, ShmRm(t));
ForkCores(t);
if( (fail = setjmp(t->abort)) ) goto abort;
Alloc(cur, 1);
cur->next = NULL;
ncur = 1;
region = cur->region;
region->div = 0;
for( dim = 0; dim < t->ndim; ++dim ) {
Bounds *b = ®ion->bounds[dim];
b->lower = 0;
b->upper = 1;
}
Sample(t, region);
for( comp = 0; comp < t->ncomp; ++comp ) {
Totals *tot = &totals[comp];
Result *r = ®ion->result[comp];
tot->avg = tot->lastavg = tot->guess = r->avg;
tot->err = tot->lasterr = r->err;
tot->weightsum = 1/Max(Sq(r->err), NOTZERO);
tot->avgsum = tot->weightsum*r->avg;
tot->chisq = tot->chisqsum = tot->chisum = 0;
}
for( t->nregions = 1; ; ++t->nregions ) {
count maxcomp, bisectdim;
real maxratio, maxerr;
Result result[NCOMP];
Region *regionL, *regionR;
Bounds *bL, *bR;
if( VERBOSE ) {
char s[128 + 128*NCOMP], *p = s;
p += sprintf(p, "\n"
"Iteration " COUNT ": " NUMBER " integrand evaluations so far",
t->nregions, t->neval);
for( comp = 0; comp < t->ncomp; ++comp ) {
cTotals *tot = &totals[comp];
p += sprintf(p, "\n[" COUNT "] "
REAL " +- " REAL " \tchisq " REAL " (" COUNT " df)",
comp + 1, tot->avg, tot->err, tot->chisq, t->nregions - 1);
}
Print(s);
}
maxratio = -INFTY;
maxcomp = 0;
for( comp = 0; comp < t->ncomp; ++comp ) {
creal ratio = totals[comp].err/MaxErr(totals[comp].avg);
if( ratio > maxratio ) {
maxratio = ratio;
maxcomp = comp;
}
}
if( maxratio <= 1 && t->neval >= t->mineval ) break;
if( t->neval >= t->maxeval ) {
fail = 1;
break;
}
maxerr = -INFTY;
regionL = cur->region;
npool = ncur;
for( pool = cur; pool; npool = POOLSIZE, pool = pool->next )
for( ipool = 0; ipool < npool; ++ipool ) {
Region *region = &pool->region[ipool];
creal err = region->result[maxcomp].err;
if( err > maxerr ) {
maxerr = err;
regionL = region;
}
}
if( ncur == POOLSIZE ) {
Pool *prev = cur;
Alloc(cur, 1);
cur->next = prev;
ncur = 0;
}
regionR = &cur->region[ncur++];
regionR->div = ++regionL->div;
FCopy(result, regionL->result);
XCopy(regionR->bounds, regionL->bounds);
bisectdim = result[maxcomp].bisectdim;
bL = ®ionL->bounds[bisectdim];
bR = ®ionR->bounds[bisectdim];
bL->upper = bR->lower = .5*(bL->upper + bL->lower);
Sample(t, regionL);
Sample(t, regionR);
for( comp = 0; comp < t->ncomp; ++comp ) {
cResult *r = &result[comp];
Result *rL = ®ionL->result[comp];
Result *rR = ®ionR->result[comp];
Totals *tot = &totals[comp];
real diff, err, w, avg, sigsq;
tot->lastavg += diff = rL->avg + rR->avg - r->avg;
diff = fabs(.25*diff);
err = rL->err + rR->err;
if( err > 0 ) {
creal c = 1 + 2*diff/err;
rL->err *= c;
rR->err *= c;
}
rL->err += diff;
rR->err += diff;
tot->lasterr += rL->err + rR->err - r->err;
tot->weightsum += w = 1/Max(Sq(tot->lasterr), NOTZERO);
sigsq = 1/tot->weightsum;
tot->avgsum += w*tot->lastavg;
avg = sigsq*tot->avgsum;
tot->chisum += w *= tot->lastavg - tot->guess;
tot->chisqsum += w*tot->lastavg;
tot->chisq = tot->chisqsum - avg*tot->chisum;
if( LAST ) {
tot->avg = tot->lastavg;
tot->err = tot->lasterr;
}
else {
tot->avg = avg;
tot->err = sqrt(sigsq);
}
}
}
for( comp = 0; comp < t->ncomp; ++comp ) {
cTotals *tot = &totals[comp];
integral[comp] = tot->avg;
error[comp] = tot->err;
prob[comp] = ChiSquare(tot->chisq, t->nregions - 1);
}
#ifdef MLVERSION
if( REGIONS ) {
MLPutFunction(stdlink, "List", 2);
MLPutFunction(stdlink, "List", t->nregions);
npool = ncur;
for( pool = cur; pool; npool = POOLSIZE, pool = pool->next )
for( ipool = 0; ipool < npool; ++ipool ) {
Region const *region = &pool->region[ipool];
real lower[NDIM], upper[NDIM];
for( dim = 0; dim < t->ndim; ++dim ) {
cBounds *b = ®ion->bounds[dim];
lower[dim] = b->lower;
upper[dim] = b->upper;
}
MLPutFunction(stdlink, "Cuba`Cuhre`region", 3);
MLPutRealList(stdlink, lower, t->ndim);
MLPutRealList(stdlink, upper, t->ndim);
MLPutFunction(stdlink, "List", t->ncomp);
for( comp = 0; comp < t->ncomp; ++comp ) {
cResult *r = ®ion->result[comp];
real res[] = {r->avg, r->err};
MLPutRealList(stdlink, res, Elements(res));
}
}
}
#endif
abort:
while( (pool = cur) ) {
cur = cur->next;
free(pool);
}
WaitCores(t);
FrameFree(t);
RuleFree(t);
return fail;
}
Extern void SUFFIX(cubafork)(Spin **pspin)
{
char out[128];
int cores, core;
fdpid *pfp;
Spin *spin;
VerboseInit();
EnvInit(cubaworkers_.paccel, "CUBAACCELMAX", 1000);
EnvInit(cubaworkers_.pcores, "CUBACORESMAX", 10000);
EnvInit(cubaworkers_.naccel, "CUBAACCEL", 0);
EnvInit(cubaworkers_.ncores, "CUBACORES", -sysconf(_SC_NPROCESSORS_ONLN));
#ifdef HAVE_GETLOADAVG
if( cubaworkers_.ncores < 0 ) {
static int load = uninitialized;
if( load == uninitialized ) {
double loadavg;
getloadavg(&loadavg, 1);
load = floor(loadavg);
}
cubaworkers_.ncores = IMax(-cubaworkers_.ncores - load, 0);
}
#else
cubaworkers_.ncores = abs(cubaworkers_.ncores);
#endif
cores = cubaworkers_.naccel + cubaworkers_.ncores;
if( cores < MINCORES ) {
*pspin = NULL;
return;
}
if( cubaverb_ ) {
sprintf(out, "using %d cores %d accelerators via "
#ifdef HAVE_SHMGET
"shared memory",
#else
"pipes",
#endif
cubaworkers_.ncores, cubaworkers_.naccel);
Print(out);
}
fflush(NULL); /* make sure all buffers are flushed,
or else buffered content will be written
out multiply, at each child's exit(0) */
MemAlloc(spin, sizeof *spin + cores*sizeof *spin->fp);
spin->spec = cubaworkers_;
pfp = spin->fp;
for( core = -spin->spec.naccel; core < spin->spec.ncores; ++core ) {
int fd[2];
pid_t pid;
assert(
socketpair(AF_LOCAL, SOCK_STREAM, 0, fd) != -1 &&
(pid = fork()) != -1 );
if( pid == 0 ) {
close(fd[0]);
free(spin);
Child(fd[1], core);
exit(0);
}
MASTER("forked pid %d pipe %d(master) -> %d(worker)",
pid, fd[0], fd[1]);
close(fd[1]);
pfp->fd = fd[0];
pfp->pid = pid;
++pfp;
}
*pspin = spin;
}
static int Integrate(This *t, real *integral, real *error, real *prob)
{
TYPEDEFREGION;
count dim, comp, df;
int fail;
Result totals[NCOMP];
Region *anchor = NULL, *region = NULL;
if( VERBOSE > 1 ) {
char s[256];
sprintf(s, "Suave input parameters:\n"
" ndim " COUNT "\n ncomp " COUNT "\n"
" epsrel " REAL "\n epsabs " REAL "\n"
" flags %d\n seed %d\n"
" mineval " NUMBER "\n maxeval " NUMBER "\n"
" nnew " NUMBER "\n flatness " REAL,
t->ndim, t->ncomp,
t->epsrel, t->epsabs,
t->flags, t->seed,
t->mineval, t->maxeval,
t->nnew, t->flatness);
Print(s);
}
if( BadComponent(t) ) return -2;
if( BadDimension(t) ) return -1;
if( (fail = setjmp(t->abort)) ) goto abort;
t->epsabs = Max(t->epsabs, NOTZERO);
IniRandom(t);
RegionAlloc(t, anchor, t->nnew, t->nnew);
anchor->next = NULL;
anchor->div = 0;
for( dim = 0; dim < t->ndim; ++dim ) {
Bounds *b = &anchor->bounds[dim];
b->lower = 0;
b->upper = 1;
b->mid = .5;
if( dim == 0 ) {
count bin;
/* define the initial distribution of bins */
for( bin = 0; bin < NBINS; ++bin )
b->grid[bin] = (bin + 1)/(real)NBINS;
}
else Copy(b->grid, anchor->bounds[0].grid, NBINS);
}
Sample(t, t->nnew, anchor, anchor->w,
anchor->w + t->nnew,
anchor->w + t->nnew + t->ndim*t->nnew);
df = anchor->df;
ResCopy(totals, anchor->result);
for( t->nregions = 1; ; ++t->nregions ) {
Var var[NDIM][2], *vLR;
real maxratio, maxerr, minfluct, bias, mid;
Region *regionL, *regionR, *reg, **parent, **par;
Bounds *bounds, *boundsL, *boundsR;
count maxcomp, bisectdim;
number n, nL, nR, nnewL, nnewR;
real *w, *wL, *wR, *x, *xL, *xR, *f, *fL, *fR, *wlast, *flast;
if( VERBOSE ) {
char s[128 + 128*NCOMP], *p = s;
p += sprintf(p, "\n"
"Iteration " COUNT ": " NUMBER " integrand evaluations so far",
t->nregions, t->neval);
for( comp = 0; comp < t->ncomp; ++comp ) {
cResult *tot = &totals[comp];
p += sprintf(p, "\n[" COUNT "] "
REAL " +- " REAL " \tchisq " REAL " (" COUNT " df)",
comp + 1, tot->avg, tot->err, tot->chisq, df);
}
Print(s);
}
maxratio = -INFTY;
maxcomp = 0;
for( comp = 0; comp < t->ncomp; ++comp ) {
creal ratio = totals[comp].err/MaxErr(totals[comp].avg);
if( ratio > maxratio ) {
maxratio = ratio;
maxcomp = comp;
}
}
if( maxratio <= 1 && t->neval >= t->mineval ) {
fail = 0;
break;
}
if( t->neval >= t->maxeval ) break;
maxerr = -INFTY;
parent = &anchor;
region = anchor;
for( par = &anchor; (reg = *par); par = ®->next ) {
creal err = reg->result[maxcomp].err;
if( err > maxerr ) {
maxerr = err;
parent = par;
region = reg;
}
}
Fluct(t, var[0],
region->bounds, region->w, region->n, maxcomp,
region->result[maxcomp].avg, Max(maxerr, t->epsabs));
bias = (t->epsrel < 1e-50) ? 2 :
Max(pow(2., -(real)region->div/t->ndim)/t->epsrel, 2.);
minfluct = INFTY;
bisectdim = 0;
for( dim = 0; dim < t->ndim; ++dim ) {
cBounds *b = ®ion->bounds[dim];
creal fluct = (var[dim][0].fluct + var[dim][1].fluct)*
(bias - b->upper + b->lower);
if( fluct < minfluct ) {
minfluct = fluct;
bisectdim = dim;
}
}
vLR = var[bisectdim];
minfluct = vLR[0].fluct + vLR[1].fluct;
nnewL = IMax(
(minfluct == 0) ? t->nnew/2 : (count)(vLR[0].fluct/minfluct*t->nnew),
MINSAMPLES );
nL = vLR[0].n + nnewL;
nnewR = IMax(t->nnew - nnewL, MINSAMPLES);
nR = vLR[1].n + nnewR;
RegionAlloc(t, regionL, nL, nnewL);
RegionAlloc(t, regionR, nR, nnewR);
*parent = regionL;
regionL->next = regionR;
regionR->next = region->next;
regionL->div = regionR->div = region->div + 1;
bounds = ®ion->bounds[bisectdim];
mid = bounds->mid;
n = region->n;
w = wlast = region->w; x = w + n; f = flast = x + n*t->ndim;
wL = regionL->w; xL = wL + nL; fL = xL + nL*t->ndim;
wR = regionR->w; xR = wR + nR; fR = xR + nR*t->ndim;
while( n-- ) {
cbool final = (*w < 0);
if( x[bisectdim] < mid ) {
if( final && wR > regionR->w ) *(wR - 1) = -fabs(*(wR - 1));
*wL++ = *w++;
VecCopy(xL, x);
xL += t->ndim;
ResCopy(fL, f);
fL += t->ncomp;
}
else {
if( final && wL > regionL->w ) *(wL - 1) = -fabs(*(wL - 1));
*wR++ = *w++;
VecCopy(xR, x);
xR += t->ndim;
ResCopy(fR, f);
fR += t->ncomp;
}
x += t->ndim;
f += t->ncomp;
if( n && final ) wlast = w, flast = f;
}
Reweight(t, region->bounds, wlast, flast, f, totals);
VecCopy(regionL->bounds, region->bounds);
VecCopy(regionR->bounds, region->bounds);
boundsL = ®ionL->bounds[bisectdim];
boundsR = ®ionR->bounds[bisectdim];
boundsL->mid = .5*(boundsL->lower + (boundsL->upper = mid));
boundsR->mid = .5*((boundsR->lower = mid) + boundsR->upper);
StretchGrid(bounds->grid, boundsL->grid, boundsR->grid);
Sample(t, nnewL, regionL, wL, xL, fL);
Sample(t, nnewR, regionR, wR, xR, fR);
df += regionL->df + regionR->df - region->df;
for( comp = 0; comp < t->ncomp; ++comp ) {
cResult *r = ®ion->result[comp];
Result *rL = ®ionL->result[comp];
Result *rR = ®ionR->result[comp];
Result *tot = &totals[comp];
real diff, sigsq;
tot->avg += diff = rL->avg + rR->avg - r->avg;
diff = Sq(.25*diff);
sigsq = rL->sigsq + rR->sigsq;
if( sigsq > 0 ) {
creal c = Sq(1 + sqrt(diff/sigsq));
rL->sigsq *= c;
rR->sigsq *= c;
}
rL->err = sqrt(rL->sigsq += diff);
rR->err = sqrt(rR->sigsq += diff);
tot->sigsq += rL->sigsq + rR->sigsq - r->sigsq;
tot->err = sqrt(tot->sigsq);
tot->chisq += rL->chisq + rR->chisq - r->chisq;
}
free(region);
region = NULL;
}
static int Integrate(creal epsrel, creal epsabs,
cint flags, number mineval, cnumber maxeval, ccount key,
real *integral, real *error, real *prob)
{
TYPEDEFREGION;
count dim, comp;
int fail = 1;
Rule rule;
Totals totals[NCOMP];
Region *anchor = NULL, *region = NULL;
if( VERBOSE > 1 ) {
char s[256];
sprintf(s, "Cuhre input parameters:\n"
" ndim " COUNT "\n ncomp " COUNT "\n"
" epsrel " REAL "\n epsabs " REAL "\n"
" flags %d\n mineval " NUMBER "\n maxeval " NUMBER "\n"
" key " COUNT,
ndim_, ncomp_,
epsrel, epsabs,
flags, mineval, maxeval,
key);
Print(s);
}
#ifdef MLVERSION
if( setjmp(abort_) ) goto abort;
#endif
if( key == 13 && ndim_ == 2 ) Rule13Alloc(&rule);
else if( key == 11 && ndim_ == 3 ) Rule11Alloc(&rule);
else if( key == 9 ) Rule9Alloc(&rule);
else if( key == 7 ) Rule7Alloc(&rule);
else {
if( ndim_ == 2 ) Rule13Alloc(&rule);
else if( ndim_ == 3 ) Rule11Alloc(&rule);
else Rule9Alloc(&rule);
}
Alloc(rule.x, rule.n*(ndim_ + ncomp_));
rule.f = rule.x + rule.n*ndim_;
mineval = IMax(mineval, rule.n + 1);
Alloc(anchor, 1);
anchor->next = NULL;
anchor->div = 0;
for( dim = 0; dim < ndim_; ++dim ) {
Bounds *b = &anchor->bounds[dim];
b->lower = 0;
b->upper = 1;
}
Sample(&rule, anchor, flags);
for( comp = 0; comp < ncomp_; ++comp ) {
Totals *tot = &totals[comp];
Result *r = &anchor->result[comp];
tot->avg = tot->lastavg = tot->guess = r->avg;
tot->err = tot->lasterr = r->err;
tot->weightsum = 1/Max(Sq(r->err), NOTZERO);
tot->avgsum = tot->weightsum*r->avg;
tot->chisq = tot->chisqsum = tot->chisum = 0;
}
for( nregions_ = 1; ; ++nregions_ ) {
count maxcomp, bisectdim;
real maxratio, maxerr;
Region *regionL, *regionR, *reg, **parent, **par;
Bounds *bL, *bR;
if( VERBOSE ) {
char s[128 + 128*NCOMP], *p = s;
p += sprintf(p, "\n"
"Iteration " COUNT ": " NUMBER " integrand evaluations so far",
nregions_, neval_);
for( comp = 0; comp < ncomp_; ++comp ) {
cTotals *tot = &totals[comp];
p += sprintf(p, "\n[" COUNT "] "
REAL " +- " REAL " \tchisq " REAL " (" COUNT " df)",
comp + 1, tot->avg, tot->err, tot->chisq, nregions_ - 1);
}
Print(s);
}
maxratio = -INFTY;
maxcomp = 0;
for( comp = 0; comp < ncomp_; ++comp ) {
creal ratio = totals[comp].err/MaxErr(totals[comp].avg);
if( ratio > maxratio ) {
maxratio = ratio;
maxcomp = comp;
}
}
if( maxratio <= 1 && neval_ >= mineval ) {
fail = 0;
break;
}
if( neval_ >= maxeval ) break;
maxerr = -INFTY;
parent = &anchor;
region = anchor;
for( par = &anchor; (reg = *par); par = ®->next ) {
creal err = reg->result[maxcomp].err;
if( err > maxerr ) {
maxerr = err;
parent = par;
region = reg;
}
}
Alloc(regionL, 1);
Alloc(regionR, 1);
*parent = regionL;
regionL->next = regionR;
regionR->next = region->next;
regionL->div = regionR->div = region->div + 1;
VecCopy(regionL->bounds, region->bounds);
VecCopy(regionR->bounds, region->bounds);
bisectdim = region->result[maxcomp].bisectdim;
bL = ®ionL->bounds[bisectdim];
bR = ®ionR->bounds[bisectdim];
bL->upper = bR->lower = .5*(bL->upper + bL->lower);
Sample(&rule, regionL, flags);
Sample(&rule, regionR, flags);
for( comp = 0; comp < ncomp_; ++comp ) {
cResult *r = ®ion->result[comp];
Result *rL = ®ionL->result[comp];
Result *rR = ®ionR->result[comp];
Totals *tot = &totals[comp];
real diff, err, w, avg, sigsq;
tot->lastavg += diff = rL->avg + rR->avg - r->avg;
diff = fabs(.25*diff);
err = rL->err + rR->err;
if( err > 0 ) {
creal c = 1 + 2*diff/err;
rL->err *= c;
rR->err *= c;
}
rL->err += diff;
rR->err += diff;
tot->lasterr += rL->err + rR->err - r->err;
tot->weightsum += w = 1/Max(Sq(tot->lasterr), NOTZERO);
sigsq = 1/tot->weightsum;
tot->avgsum += w*tot->lastavg;
avg = sigsq*tot->avgsum;
tot->chisum += w *= tot->lastavg - tot->guess;
tot->chisqsum += w*tot->lastavg;
tot->chisq = tot->chisqsum - avg*tot->chisum;
if( LAST ) {
tot->avg = tot->lastavg;
tot->err = tot->lasterr;
}
else {
tot->avg = avg;
tot->err = sqrt(sigsq);
}
}
free(region);
region = NULL;
}
for( comp = 0; comp < ncomp_; ++comp ) {
cTotals *tot = &totals[comp];
integral[comp] = tot->avg;
error[comp] = tot->err;
prob[comp] = ChiSquare(tot->chisq, nregions_ - 1);
}
#ifdef MLVERSION
if( REGIONS ) {
MLPutFunction(stdlink, "List", 2);
MLPutFunction(stdlink, "List", nregions_);
for( region = anchor; region; region = region->next ) {
real lower[NDIM], upper[NDIM];
for( dim = 0; dim < ndim_; ++dim ) {
cBounds *b = ®ion->bounds[dim];
lower[dim] = b->lower;
upper[dim] = b->upper;
}
MLPutFunction(stdlink, "Cuba`Cuhre`region", 3);
MLPutRealList(stdlink, lower, ndim_);
MLPutRealList(stdlink, upper, ndim_);
MLPutFunction(stdlink, "List", ncomp_);
for( comp = 0; comp < ncomp_; ++comp ) {
cResult *r = ®ion->result[comp];
real res[] = {r->avg, r->err};
MLPutRealList(stdlink, res, Elements(res));
}
}
}
#endif
#ifdef MLVERSION
abort:
#endif
if( region ) free(region);
while( (region = anchor) ) {
anchor = anchor->next;
free(region);
}
free(rule.x);
RuleFree(&rule);
return fail;
}
void InitializeSynchrotron(const double B_0, const dCVector* pEnergy,
const dCVector* pEnergyWidth,
dCVector* synchrotronLoss, DiffRate* syncRate,
string aDirTables)
/* this function calculates the synchrotron loss rate for the electron
and the synchrotron radiation spectrum for photons
The radom direction of the magnetic field requires me to do an
average over the pitch angle, and it results in an extra factor of
2/3, and slightly modifies the functional form of F(x) from the
purely perpendicular case */
/* The above comment is from the stand alone version. Compared to this version the constants seem to be fixed to correct for a perpendicular field as input. JK, 2011*/
{
const int SYNC_TABLE_SIZE = 161;
int i;
double offset; /* parameter to compute bounds correctly */
dCVector syncTable;
double x0;
double ECrit;
double EMin;
double EMax;
int jMin;
int jMax;
int j;
double xx;
double function;
int iTable;
double eLower;
double eUpper;
int num_main_bins;
num_main_bins = pEnergy->dimension;
if ((num_main_bins != pEnergyWidth->dimension) ||
(num_main_bins != syncRate->mainDimension) ||
(num_main_bins != synchrotronLoss->dimension))
{
Error("InitializeSynchrotron: inconsistent dimensions", PROGRAM_ERROR);
}
New_dCVector(&syncTable, SYNC_TABLE_SIZE);
/* read in table */
LoadSyncTable(&syncTable, aDirTables);
/* calculate the rates */
offset = BINS_PER_DECADE*(log10(ELECTRON_MASS) - MAX_ENERGY_EXP) +
num_main_bins + 0.5;
x0 = B_0*5.86667629e-4*DISTANCE_UNIT;
/* x0: eB/m_e in inverse pc */
for (i = 0; i < num_main_bins; i++)
{
/* electron loss rate */
(synchrotronLoss->vector)[i] = -B_0*B_0*(pEnergy->vector)[i]*
(pEnergy->vector)[i]*2.*4.86037e4*VOLUME_UNIT;
/* calculate the radiation spectrum */
ECrit = 3./2.*B_0/4.414034e13*(pEnergy->vector)[i]*
(pEnergy->vector)[i];
/* ECrit: critical energy in electron mass */
EMin = 2./3./((pEnergy->vector)[i]*(pEnergy->vector)[i]*
(pEnergy->vector)[i])*ECrit;
EMax = 5.*ECrit;
/* EMin/EMax: useful range for x (in electron mass) */
/* set up the range for photons -> determine bounds */
jMin = IMax((int)(BINS_PER_DECADE*log10(EMin) + offset), 0);
jMax = IMin((int)(BINS_PER_DECADE*log10(EMax) + offset),
num_main_bins - 1);
if (jMax >= 0) /* normal case */
{
(syncRate->bound)[i][0] = jMin;
(syncRate->bound)[i][1] = jMax;
for (j = (syncRate->bound)[i][0];
j <= (syncRate->bound)[i][1]; j++)
{
xx = (pEnergy->vector)[j]/ECrit;
if (log10(xx) < -7.)
{
function = pow(xx, 1./3.)*2.1809736;
/* use an approximation for x below 10^-7 */
}
else
{
/* compute F(x) at given photon energy by linear
extrapolation in logarithm */
iTable = (int)(log10(xx)*20. + 140);
eLower = (double)(iTable - 140)/20.;
eUpper = (double)(iTable - 139)/20.;
/* numbers 140, 139, and 20 are properties of table */
function = exp(log(syncTable.vector[iTable]) + (log10(xx) -
eLower)/(eUpper - eLower)*
(log(syncTable.vector[iTable+1]) -
log(syncTable.vector[iTable])));
}
(syncRate->diffRate)[i][j] = 2.756644477e-1/137.036*x0*
function/(pEnergy->vector)[j]*(pEnergyWidth->vector)[j];
/* 2.7566...: sqtr(3)/(2pi), 1/137: e^2, x0: eB/m_e */
}
}
}
Delete_dCVector(&syncTable) ;
}
void FoldDiffRate(const dCVector* pBgPhotonDensity,
const RawDiffRate* pRawDiffRate,
DiffRate* pDiffRate, const int scatSwitch, ...)
{
int i;
int j;
int k;
int offset = 0;
int jLower;
int jUpper;
int num_main_bins;
int num_bg_bins;
num_main_bins = pRawDiffRate->mainDimension;
num_bg_bins = pRawDiffRate->bgDimension;
if ((pBgPhotonDensity->dimension != num_bg_bins) ||
(num_main_bins != pDiffRate->mainDimension))
{
Error("FoldDiffRate: inconsistent dimensions", PROGRAM_ERROR);
}
if (scatSwitch != 0)
/* scattering type: adjustment of total rate(s) needed */
{
va_list pArg;
// TotalRate* totalRateArray[scatSwitch];
TotalRate* totalRateArray[3];
va_start(pArg, scatSwitch);
for (i = 0; i < scatSwitch; i++)
totalRateArray[i] = va_arg(pArg, TotalRate*);
/* Let totalRateArray[i] point to the totalRate* we will modify; we do
not need to update the arguments later
(i.e. va_arg(...) = totalRateArray[i];) because the actual values
they point to have been properly updated */
for (i = 0; i < num_main_bins; i++)
{
jLower = num_main_bins - 1;
jUpper = 0;
for (j = 0; j < num_bg_bins; j++)
{
if (pRawDiffRate->bound[i][j][0] != -1)
/* above threshold */
{
offset += -(pRawDiffRate->bound)[i][j][0];
jLower = IMin(jLower, (pRawDiffRate->bound)[i][j][0]);
jUpper = IMax(jUpper, (pRawDiffRate->bound)[i][j][1]);
for (k = (pRawDiffRate->bound)[i][j][0];
k <= (pRawDiffRate->bound)[i][j][1]; k++)
{
#ifdef DEBUG
CheckIndex(0, i+1, k, "FoldDiffRate");
CheckIndex(0, pRawDiffRate->numberOfElements, k+offset,
"FoldDiffRate");
#endif
(pDiffRate->diffRate)[i][k] +=
(pBgPhotonDensity->vector)[j]*
(pRawDiffRate->diffRate)[k+offset];
}
/* these lines take care of the appropriate subtractions
made in the main implicit formula */
if ((pRawDiffRate->bound)[i][j][1] == i)
/* if (((pRawDiffRate->bound)[i][j][0] <= i) &&
((pRawDiffRate->bound)[i][j][1] >= i)) */
{
int l;
for (l = 0; l < scatSwitch; l++)
{
(totalRateArray[l]->totalRate)[i] +=
-(pRawDiffRate->diffRate)[i+offset]*
(pBgPhotonDensity->vector)[j];
}
(pDiffRate->diffRate)[i][i] +=
-(pRawDiffRate->diffRate)[i+offset]*
(pBgPhotonDensity->vector)[j];
}
offset += (pRawDiffRate->bound)[i][j][1] + 1;
/* reset the offset index */
}
}
(pDiffRate->bound)[i][0] = IMin((pDiffRate->bound)[i][0], jLower);
(pDiffRate->bound)[i][1] = IMax((pDiffRate->bound)[i][1], jUpper);
}
va_end(pArg);
}