/*==============================================================================
* gen_refgrid:
*--------------------
* 1. test current grid for refinement, and generate adaptive grid (if required)
* 2. re-link particles
* 3. ajdust densities as neccessary.
*==============================================================================*/
boolean gen_refgrid(gridls **grid_list, int *no_grids)
{
gridls *coa_grid, *fin_grid; /* old/new grid pointer */
boolean refined; /* refined YES/NO flag */
boolean mg; /* does refinement hold enough particles */
int idim;
#ifdef REF_TEST
fprintf(stderr,"\ngen_refgrid: current coarse grid = %ld\n",
(*grid_list + (*no_grids-1))->l1dim);
#endif
/* set coarse grid pointer */
coa_grid = *grid_list + *no_grids - 1;
fin_grid = *grid_list + *no_grids;
/* timing... */
coa_grid->time.grid -= time(NULL);
if(coa_grid->next == FALSE) /* fin_grid does not exist ? */
{
/* reallocate the grid list array (including space for one additional grid) */
(*grid_list) = (gridls *) realloc(*grid_list, (*no_grids + 1) * sizeof(gridls));
if((*grid_list) == NULL)
{
fprintf(io.logfile,"gen_refgrid: error reallocating grid list\n");
fflush(io.logfile);
fclose(io.logfile);
exit(1);
}
/* grid_list block might have moved in memory */
global.dom_grid = *grid_list + global.domgrid_no;
coa_grid = *grid_list + *no_grids - 1;
fin_grid = *grid_list + *no_grids;
/* fill in new grid's entries */
fin_grid->masstodens = coa_grid->masstodens * CRITMULTI;
fin_grid->masstopartdens = coa_grid->masstopartdens * CRITMULTI;
#ifdef MULTIMASS
fin_grid->critdens = simu.Nth_ref*fin_grid->masstopartdens;
#else
fin_grid->critdens = simu.Nth_ref*fin_grid->masstodens;
#endif
fin_grid->timecounter = coa_grid->timecounter;
fin_grid->timestep = coa_grid->timestep/2;
fin_grid->l1dim = coa_grid->l1dim * 2;
fin_grid->spacing = (double)1.0 / (double)fin_grid->l1dim;
fin_grid->spacing2 = fin_grid->spacing * fin_grid->spacing;
fin_grid->no_pquad = 0;
fin_grid->pquad_array = NULL;
/* we measure the time throughout the two DKD cycles of this fin_grid */
fin_grid->time.potential = 0;
fin_grid->time.density = 0;
fin_grid->time.DK = 0;
fin_grid->time.grid = 0;
fin_grid->time.hydro = 0;
fin_grid->no_sweeps = 0;
fin_grid->cur_resid = 0.;
/* remember that fin_grid exists from now on */
fin_grid->next = FALSE;
coa_grid->next = TRUE;
}
/* (re-)set values that are changing within the two DKD cycles the grid lives through */
fin_grid->old_resid = 0.0;
fin_grid->cur_resid = 0.0;
fin_grid->multistep = 0;
/*------------------------------
* now call refinement rountine
*------------------------------*/
refined = refine_grid(fin_grid, coa_grid);
if(refined)
{
#ifdef REF_TEST
fprintf(stderr," placed new refinement = %ld\n", fin_grid->l1dim);
#endif
/* update number of grids */
*no_grids += 1;
/* now relink particles to new grid */
mg = relink(coa_grid, fin_grid); /* performs: unassign_part */
/* now assign mass to new grid: THIS IS NEEDED AS IT RETURNS "mg" ! */
zero_dens (fin_grid);
mg = assign_npart(fin_grid);
#ifdef REF_TEST
fprintf(stderr," grid %6ld: nnodes=%ld npart=%ld => %g (<! %g)\n",
fin_grid->l1dim,fin_grid->size.no_nodes,fin_grid->size.no_part,
(double)fin_grid->size.no_nodes/(double)fin_grid->size.no_part, CRITMULTI);
#endif
/* only use grid if it holds enough particles */
if(mg == FALSE)
{
refined = FALSE;
relink_back(coa_grid, fin_grid);
fin_grid->size.no_nodes = 0;
fin_grid->size.no_part = 0;
free_grid(fin_grid, no_grids);
#ifdef REF_TEST
fprintf(stderr," destroyed new refinement = %ld (%g)\n",
fin_grid->l1dim, fin_grid->critdens);
#endif
}
else
{
/* get potential onto fine grid (important for boundaries !) */
go_down(coa_grid);
}
}
else
{
#ifdef REF_TEST
fprintf(stderr," NO new refinement grid !\n\n");
#endif
/*
* no need to call free_grid()
* -> temporary pquads, cquads, nquads already destroyed within ref_grid()
*
* no need to realloc grid_list
* -> grid will be kept in memory from now on...
*/
}
/* grid_list block might have changed position in memory */
global.dom_grid = *grid_list + global.domgrid_no;
/* ...timing */
coa_grid->time.grid += time(NULL);
return(refined);
}
Scalar AdaptiveSparseGrid<Scalar,UserVector>::refine_grid(
typename std::multimap<Scalar,std::vector<int> > & indexSet,
UserVector & integralValue,
AdaptiveSparseGridInterface<Scalar,UserVector> & problem_data) {
int dimension = problem_data.getDimension();
std::vector<EIntrepidBurkardt> rule1D; problem_data.getRule(rule1D);
std::vector<EIntrepidGrowth> growth1D; problem_data.getGrowth(growth1D);
// Copy Multimap into a Set for ease of use
typename std::multimap<Scalar,std::vector<int> >::iterator it;
std::set<std::vector<int> > oldSet;
std::set<std::vector<int> >::iterator it1(oldSet.begin());
for (it=indexSet.begin(); it!=indexSet.end(); it++) {
oldSet.insert(it1,it->second);
it1++;
}
indexSet.clear();
// Find Possible Active Points
int flag = 1;
std::vector<int> index(dimension,0);
typename std::multimap<Scalar,std::vector<int> > activeSet;
for (it1=oldSet.begin(); it1!=oldSet.end(); it1++) {
index = *it1;
for (int i=0; i<dimension; i++) {
index[i]++;
flag = (int)(!oldSet.count(index));
index[i]--;
if (flag) {
activeSet.insert(std::pair<Scalar,std::vector<int> >(1.0,index));
oldSet.erase(it1);
break;
}
}
}
// Compute local and global error indicators for active set
typename std::multimap<Scalar,std::vector<int> >::iterator it2;
Scalar eta = 0.0;
Scalar G = 0.0;
Teuchos::RCP<UserVector> s = integralValue.Create();
for (it2=activeSet.begin(); it2!=activeSet.end(); it2++) {
// Build Differential Quarature Rule
index = it2->second;
CubatureTensorSorted<Scalar> diffRule(0,dimension);
build_diffRule(diffRule,index,problem_data);
// Apply Rule to function
problem_data.eval_cubature(*s,diffRule);
// Update local error indicator and index set
G = problem_data.error_indicator(*s);
activeSet.erase(it2);
activeSet.insert(it2,std::pair<Scalar,std::vector<int> >(G,index));
eta += G;
}
// Refine Sparse Grid
eta = refine_grid(activeSet,oldSet,integralValue,eta,
dimension,rule1D,growth1D);
// Insert New Active and Old Index sets into indexSet
indexSet.insert(activeSet.begin(),activeSet.end());
for (it1=oldSet.begin(); it1!=oldSet.end(); it1++) {
index = *it1;
indexSet.insert(std::pair<Scalar,std::vector<int> >(-1.0,index));
}
return eta;
}
int
gsl_monte_vegas_integrate (gsl_monte_function * f,
double xl[], double xu[],
size_t dim, size_t calls,
gsl_rng * r,
gsl_monte_vegas_state * state,
double *result, double *abserr)
{
double cum_int, cum_sig;
size_t i, k, it;
if (dim != state->dim)
{
GSL_ERROR ("number of dimensions must match allocated size", GSL_EINVAL);
}
for (i = 0; i < dim; i++)
{
if (xu[i] <= xl[i])
{
GSL_ERROR ("xu must be greater than xl", GSL_EINVAL);
}
if (xu[i] - xl[i] > GSL_DBL_MAX)
{
GSL_ERROR ("Range of integration is too large, please rescale",
GSL_EINVAL);
}
}
if (state->stage == 0)
{
init_grid (state, xl, xu, dim);
if (state->verbose >= 0)
{
print_lim (state, xl, xu, dim);
}
}
if (state->stage <= 1)
{
state->wtd_int_sum = 0;
state->sum_wgts = 0;
state->chi_sum = 0;
state->it_num = 1;
state->samples = 0;
state->chisq = 0;
}
if (state->stage <= 2)
{
unsigned int bins = state->bins_max;
unsigned int boxes = 1;
if (state->mode != GSL_VEGAS_MODE_IMPORTANCE_ONLY)
{
/* shooting for 2 calls/box */
boxes = floor (pow (calls / 2.0, 1.0 / dim));
state->mode = GSL_VEGAS_MODE_IMPORTANCE;
if (2 * boxes >= state->bins_max)
{
/* if bins/box < 2 */
int box_per_bin = GSL_MAX (boxes / state->bins_max, 1);
bins = GSL_MIN(boxes / box_per_bin, state->bins_max);
boxes = box_per_bin * bins;
state->mode = GSL_VEGAS_MODE_STRATIFIED;
}
}
{
double tot_boxes = gsl_pow_int ((double) boxes, dim);
state->calls_per_box = GSL_MAX (calls / tot_boxes, 2);
calls = state->calls_per_box * tot_boxes;
}
/* total volume of x-space/(avg num of calls/bin) */
state->jac = state->vol * pow ((double) bins, (double) dim) / calls;
state->boxes = boxes;
/* If the number of bins changes from the previous invocation, bins
are expanded or contracted accordingly, while preserving bin
density */
if (bins != state->bins)
{
resize_grid (state, bins);
if (state->verbose > 1)
{
print_grid (state, dim);
}
}
if (state->verbose >= 0)
{
print_head (state,
dim, calls, state->it_num, state->bins, state->boxes);
}
}
state->it_start = state->it_num;
cum_int = 0.0;
cum_sig = 0.0;
for (it = 0; it < state->iterations; it++)
{
double intgrl = 0.0, intgrl_sq = 0.0;
double tss = 0.0;
double wgt, var, sig;
size_t calls_per_box = state->calls_per_box;
double jacbin = state->jac;
double *x = state->x;
coord *bin = state->bin;
state->it_num = state->it_start + it;
reset_grid_values (state);
init_box_coord (state, state->box);
do
{
volatile double m = 0, q = 0;
double f_sq_sum = 0.0;
for (k = 0; k < calls_per_box; k++)
{
volatile double fval;
double bin_vol;
random_point (x, bin, &bin_vol, state->box, xl, xu, state, r);
fval = jacbin * bin_vol * GSL_MONTE_FN_EVAL (f, x);
/* recurrence for mean and variance (sum of squares) */
{
double d = fval - m;
m += d / (k + 1.0);
q += d * d * (k / (k + 1.0));
}
if (state->mode != GSL_VEGAS_MODE_STRATIFIED)
{
double f_sq = fval * fval;
accumulate_distribution (state, bin, f_sq);
}
}
intgrl += m * calls_per_box;
f_sq_sum = q * calls_per_box;
tss += f_sq_sum;
if (state->mode == GSL_VEGAS_MODE_STRATIFIED)
{
accumulate_distribution (state, bin, f_sq_sum);
}
}
while (change_box_coord (state, state->box));
/* Compute final results for this iteration */
var = tss / (calls_per_box - 1.0) ;
if (var > 0)
{
wgt = 1.0 / var;
}
else if (state->sum_wgts > 0)
{
wgt = state->sum_wgts / state->samples;
}
else
{
wgt = 0.0;
}
intgrl_sq = intgrl * intgrl;
sig = sqrt (var);
state->result = intgrl;
state->sigma = sig;
if (wgt > 0.0)
{
double sum_wgts = state->sum_wgts;
double wtd_int_sum = state->wtd_int_sum;
double m = (sum_wgts > 0) ? (wtd_int_sum / sum_wgts) : 0;
double q = intgrl - m;
state->samples++ ;
state->sum_wgts += wgt;
state->wtd_int_sum += intgrl * wgt;
state->chi_sum += intgrl_sq * wgt;
cum_int = state->wtd_int_sum / state->sum_wgts;
cum_sig = sqrt (1 / state->sum_wgts);
#if USE_ORIGINAL_CHISQ_FORMULA
/* This is the chisq formula from the original Lepage paper. It
computes the variance from <x^2> - <x>^2 and can suffer from
catastrophic cancellations, e.g. returning negative chisq. */
if (state->samples > 1)
{
state->chisq = (state->chi_sum - state->wtd_int_sum * cum_int) /
(state->samples - 1.0);
}
#else
/* The new formula below computes exactly the same quantity as above
but using a stable recurrence */
if (state->samples == 1) {
state->chisq = 0;
} else {
state->chisq *= (state->samples - 2.0);
state->chisq += (wgt / (1 + (wgt / sum_wgts))) * q * q;
state->chisq /= (state->samples - 1.0);
}
#endif
}
else
{
cum_int += (intgrl - cum_int) / (it + 1.0);
cum_sig = 0.0;
}
if (state->verbose >= 0)
{
print_res (state,
state->it_num, intgrl, sig, cum_int, cum_sig,
state->chisq);
if (it + 1 == state->iterations && state->verbose > 0)
{
print_grid (state, dim);
}
}
if (state->verbose > 1)
{
print_dist (state, dim);
}
refine_grid (state);
if (state->verbose > 1)
{
print_grid (state, dim);
}
}
/* By setting stage to 1 further calls will generate independent
estimates based on the same grid, although it may be rebinned. */
state->stage = 1;
*result = cum_int;
*abserr = cum_sig;
return GSL_SUCCESS;
}
