void Solver::jac(real t, real *ydata, real *vdata, real *Jvdata)
{
#ifdef CHECK
int msg_point = msg_stack.push("Running Jacobian: Solver::jac(%e)", t);
#endif
if(jacfunc == NULL)
bout_error("ERROR: No jacobian function supplied!\n");
// Load state from ydate
load_vars(ydata);
// Load vector to be multiplied into F_vars
load_derivs(vdata);
// Call function
(*jacfunc)(t);
// Save Jv from vars
save_vars(Jvdata);
#ifdef CHECK
msg_stack.pop(msg_point);
#endif
}
static awk_bool_t
init_my_module(void)
{
load_vars();
mpfr_set_default_prec((int) NUMVAL(MPFR_PRECISION));
return 1;
}
static void test_call()
{
char *r[] = { "one_r1" };
char *w[] = { };
char *t[] = { "___param" };
/* simulate a function call whih ignores the return value of a function
see stmt_call for implementation details */
Head *head = env_head(env, "one_r1");
Rel *stmts[] = { rel_store("___param", rel_load(head, "one_r1")),
rel_store("___param", rel_load(head, "one_r1")) };
Rel *fn = rel_call(r, 1, w, 0, t, 1,
stmts, 2,
NULL, 0,
NULL, "",
NULL);
Vars *wvars = vars_new(0);
long long sid = tx_enter("", rvars, wvars);
vars_free(wvars);
load_vars();
rel_eval(fn, vars, &arg);
rel_free(fn);
rel_free(stmts[0]);
rel_free(stmts[1]);
free_vars();
tx_commit(sid);
}
void Solver::pre(real t, real gamma, real delta, real *udata, real *rvec, real *zvec)
{
#ifdef CHECK
int msg_point = msg_stack.push("Running preconditioner: Solver::pre(%e)", t);
#endif
real tstart = MPI_Wtime();
int N = NV_LOCLENGTH_P(uvec);
if(prefunc == NULL) {
// Identity (but should never happen)
for(int i=0;i<N;i++)
zvec[i] = rvec[i];
return;
}
// Load state from udata (as with res function)
load_vars(udata);
// Load vector to be inverted into F_vars
load_derivs(rvec);
(*prefunc)(t, gamma, delta);
// Save the solution from vars
save_vars(zvec);
pre_Wtime += MPI_Wtime() - tstart;
pre_ncalls++;
#ifdef CHECK
msg_stack.pop(msg_point);
#endif
}
static int count(const char *name)
{
Rel *r = load(name);
Vars *wvars = vars_new(0);
long long sid = tx_enter("", rvars, wvars);
load_vars();
rel_eval(r, vars, &arg);
Tuple *t;
int i = 0;
while ((t = tbuf_next(r->body)) != NULL) {
tuple_free(t);
i++;
}
rel_free(r);
free_vars();
tx_commit(sid);
vars_free(wvars);
return i;
}
/* Initialization for data that needs other units */
static void
load_init1(void)
{
set_var_str(&load_unit, "version", rcsid);
/*
* Load variables from file
* For example:
* [main]
* debug=True
* memdebug=True
* [conn]
* #S4, Join Timeout, s
* S4=60
*/
load_vars(var_file);
Debug_unit(&load_unit, "Initialized.");
}
real Solver::run(real tout, int &ncalls, real &rhstime)
{
#ifdef CHECK
int msg_point = msg_stack.push("Running solver: solver::run(%e)", tout);
#endif
MPI_Barrier(MPI_COMM_WORLD);
rhs_wtime = 0.0;
rhs_ncalls = 0;
pre_Wtime = 0.0;
pre_ncalls = 0.0;
int flag = CVode(cvode_mem, tout, uvec, &simtime, CV_NORMAL);
ncalls = rhs_ncalls;
rhstime = rhs_wtime;
// Copy variables
load_vars(NV_DATA_P(uvec));
// Call rhs function to get extra variables at this time
real tstart = MPI_Wtime();
(*func)(simtime);
rhs_wtime += MPI_Wtime() - tstart;
rhs_ncalls++;
if(flag < 0) {
output.write("ERROR CVODE solve failed at t = %e, flag = %d\n", simtime, flag);
return -1.0;
}
#ifdef CHECK
msg_stack.pop(msg_point);
#endif
return simtime;
}
static int equal(Rel *left, const char *name)
{
Rel *right = load(name);
Vars *wvars = vars_new(0);
long long sid = tx_enter("", rvars, wvars);
load_vars();
rel_eval(left, vars, &arg);
rel_eval(right, vars, &arg);
int res = rel_eq(left, right);
rel_free(left);
rel_free(right);
free_vars();
tx_commit(sid);
vars_free(wvars);
return res;
}
static void test_store()
{
Rel *r = load("one_r1");
Vars *wvars = vars_new(1);
vars_add(wvars, "one_r1_cpy", 0, NULL);
long long sid = tx_enter("", rvars, wvars);
load_vars();
rel_eval(r, vars, &arg);
vol_write(wvars->vols[0], r->body, wvars->names[0], wvars->vers[0]);
rel_free(r);
free_vars();
tx_commit(sid);
vars_free(wvars);
if (!equal(load("one_r1"), "one_r1_cpy"))
fail();
/* TODO: test reassignment in one statement logic */
}
void Solver::rhs(real t, real *udata, real *dudata)
{
#ifdef CHECK
int msg_point = msg_stack.push("Running RHS: Solver::res(%e)", t);
#endif
real tstart = MPI_Wtime();
// Load state from udata
load_vars(udata);
// Call RHS function
(*func)(t);
// Save derivatives to dudata
save_derivs(dudata);
rhs_wtime += MPI_Wtime() - tstart;
rhs_ncalls++;
#ifdef CHECK
msg_stack.pop(msg_point);
#endif
}
static int equal_clone(const char *name)
{
Rel *cp1 = load(name);
Rel *cp2 = load(name);
Vars *wvars = vars_new(0);
long long sid = tx_enter("", rvars, wvars);
load_vars();
rel_eval(cp1, vars, &arg);
rel_eval(cp2, vars, &arg);
int res = rel_eq(cp1, cp2);
rel_free(cp1);
rel_free(cp2);
free_vars();
tx_commit(sid);
vars_free(wvars);
return res;
}
