void
bfam_log_init(int rank, FILE *stream, int threshold)
{
bfam_log_rank = rank;
if(stream == NULL)
{
bfam_log_stream = stdout;
}
else
{
bfam_log_stream = stream;
}
if(threshold == BFAM_LL_DEFAULT)
{
bfam_log_threshold = BFAM_LL_INFO;
}
else
{
BFAM_ABORT_IF_NOT(threshold <= BFAM_LL_SILENT &&
threshold >= BFAM_LL_ALWAYS,
"Invalid logging threshold");
bfam_log_threshold = threshold;
}
}
void bfam_ts_adams_init(
bfam_ts_adams_t *ts, bfam_domain_t *dom, bfam_ts_adams_method_t method,
bfam_domain_match_t subdom_match, const char **subdom_tags,
bfam_domain_match_t comm_match, const char **comm_tags, MPI_Comm mpicomm,
int mpitag, void *comm_data,
void (*aux_rates)(bfam_subdomain_t *thisSubdomain, const char *prefix),
void (*scale_rates)(bfam_subdomain_t *thisSubdomain,
const char *rate_prefix, const bfam_long_real_t a),
void (*intra_rhs)(bfam_subdomain_t *thisSubdomain, const char *rate_prefix,
const char *minus_rate_prefix, const char *field_prefix,
const bfam_long_real_t t),
void (*inter_rhs)(bfam_subdomain_t *thisSubdomain, const char *rate_prefix,
const char *minus_rate_prefix, const char *field_prefix,
const bfam_long_real_t t),
void (*add_rates)(bfam_subdomain_t *thisSubdomain,
const char *field_prefix_lhs,
const char *field_prefix_rhs, const char *rate_prefix,
const bfam_long_real_t a),
const int RK_init)
{
BFAM_LDEBUG("ADAMS INIT");
/*
* set up some preliminaries
*/
bfam_ts_init(&ts->base, dom);
bfam_dictionary_init(&ts->elems);
ts->t = BFAM_LONG_REAL(0.0);
ts->base.step = &bfam_ts_adams_step;
/*
* store the function calls
*/
ts->scale_rates = scale_rates;
ts->intra_rhs = intra_rhs;
ts->inter_rhs = inter_rhs;
ts->add_rates = add_rates;
ts->currentStage = 0;
ts->numSteps = 0;
ts->lsrk = NULL;
switch (method)
{
default:
BFAM_WARNING("Invalid Adams scheme, using ADAMS_3");
case BFAM_TS_ADAMS_3:
ts->nStages = 3;
/*
ts->A = bfam_malloc_aligned(ts->nStages*sizeof(bfam_long_real_t));
ts->A[0] = BFAM_LONG_REAL(23.0)/
BFAM_LONG_REAL(12.0);
ts->A[1] = BFAM_LONG_REAL(-4.0)/
BFAM_LONG_REAL( 3.0);
ts->A[2] = BFAM_LONG_REAL( 5.0)/
BFAM_LONG_REAL(12.0);
*/
/* if necessary initialize the RK scheme */
if (RK_init)
{
ts->lsrk = bfam_ts_lsrk_new_extended(
dom, BFAM_TS_LSRK_KC54, subdom_match, subdom_tags, comm_match,
comm_tags, mpicomm, mpitag, comm_data, aux_rates, scale_rates,
intra_rhs, inter_rhs, add_rates, 0);
}
break;
case BFAM_TS_ADAMS_1:
ts->nStages = 1;
/*
ts->A = bfam_malloc_aligned(ts->nStages*sizeof(bfam_long_real_t));
ts->A[0] = BFAM_LONG_REAL(1.0);
*/
/* if necessary initialize the RK scheme */
if (RK_init)
{
ts->lsrk = bfam_ts_lsrk_new_extended(
dom, BFAM_TS_LSRK_FE, subdom_match, subdom_tags, comm_match,
comm_tags, mpicomm, mpitag, comm_data, aux_rates, scale_rates,
intra_rhs, inter_rhs, add_rates, 0);
}
break;
case BFAM_TS_ADAMS_2:
ts->nStages = 2;
/*
ts->A = bfam_malloc_aligned(ts->nStages*sizeof(bfam_long_real_t));
ts->A[0] = BFAM_LONG_REAL( 3.0)/
BFAM_LONG_REAL( 2.0);
ts->A[1] = BFAM_LONG_REAL(-1.0)/
BFAM_LONG_REAL( 2.0);
*/
/* if necessary initialize the RK scheme */
if (RK_init)
{
ts->lsrk = bfam_ts_lsrk_new_extended(
dom, BFAM_TS_LSRK_HEUN, subdom_match, subdom_tags, comm_match,
comm_tags, mpicomm, mpitag, comm_data, aux_rates, scale_rates,
intra_rhs, inter_rhs, add_rates, 0);
}
break;
case BFAM_TS_ADAMS_4:
ts->nStages = 4;
/*
ts->A = bfam_malloc_aligned(ts->nStages*sizeof(bfam_long_real_t));
ts->A[0] = BFAM_LONG_REAL( 55.0)/
BFAM_LONG_REAL( 24.0);
ts->A[1] = BFAM_LONG_REAL(-59.0)/
BFAM_LONG_REAL( 24.0);
ts->A[2] = BFAM_LONG_REAL( 37.0)/
BFAM_LONG_REAL( 24.0);
ts->A[3] = BFAM_LONG_REAL( 3.0)/
BFAM_LONG_REAL( 8.0);
*/
/* if necessary initialize the RK scheme */
if (RK_init)
{
ts->lsrk = bfam_ts_lsrk_new_extended(
dom, BFAM_TS_LSRK_KC54, subdom_match, subdom_tags, comm_match,
comm_tags, mpicomm, mpitag, comm_data, aux_rates, scale_rates,
intra_rhs, inter_rhs, add_rates, 0);
}
break;
}
/*
* get the subdomains and create rates we will need
*/
bfam_subdomain_t *subs[dom->numSubdomains + 1];
bfam_locidx_t numSubs = 0;
bfam_domain_get_subdomains(dom, subdom_match, subdom_tags, dom->numSubdomains,
subs, &numSubs);
for (int s = 0; s < numSubs; s++)
{
int rval = bfam_dictionary_insert_ptr(&ts->elems, subs[s]->name, subs[s]);
BFAM_ABORT_IF_NOT(rval != 1, "Issue adding subdomain %s", subs[s]->name);
for (int n = 0; n < ts->nStages; n++)
{
char aux_rates_name[BFAM_BUFSIZ];
snprintf(aux_rates_name, BFAM_BUFSIZ, "%s%d_", BFAM_ADAMS_PREFIX, n);
aux_rates(subs[s], aux_rates_name);
}
}
/*
* Set up the communicator we will use
*/
ts->comm = bfam_communicator_new(dom, comm_match, comm_tags, mpicomm, mpitag,
comm_data);
}
int bfam_lua_global_function_call(lua_State *L, const char *name,
const char *sig, ...)
{
va_list vl;
int num_arg = 0;
int num_res = 0;
va_start(vl, sig);
char buf[BFAM_LUA_MAX_COMMAND_LEN];
/* Assign the Lua expression to a Lua global variable. */
snprintf(buf, BFAM_LUA_MAX_COMMAND_LEN, BFAM_LUA_EVALEXP_VAR "=%s", name);
if (!luaL_dostring(L, buf))
{
/* Get the value of the global varibable */
lua_getglobal(L, BFAM_LUA_EVALEXP_VAR);
}
else
{
BFAM_ROOT_WARNING("function `%s' not found in lua file", name);
return 1;
}
if (!lua_isfunction(L, -1))
{
BFAM_ROOT_WARNING("function `%s' not found in lua file", name);
lua_pop(L, 1);
return 1;
}
for (num_arg = 0; sig[num_arg] && sig[num_arg] != '>'; num_arg++)
{
luaL_checkstack(L, 1, "too many arguments");
switch (sig[num_arg])
{
case 'd':
lua_pushnumber(L, va_arg(vl, double));
break;
case 'l':
lua_pushnumber(L, (double)va_arg(vl, bfam_long_real_t));
break;
case 'r':
lua_pushnumber(L, (double)va_arg(vl, bfam_real_t));
break;
case 'i':
lua_pushinteger(L, va_arg(vl, int));
break;
case 's':
lua_pushstring(L, va_arg(vl, char *));
break;
case '>':
break;
default:
BFAM_ABORT("function '%s' invalid input argument (%c)", name,
sig[num_arg]);
}
}
BFAM_ABORT_IF_NOT(sig[num_arg] == '>', "arguments for '%s' does not contain "
" a '>' character",
name);
num_res = (int)strlen(sig) - num_arg - 1;
BFAM_ABORT_IF_NOT(lua_pcall(L, num_arg, num_res, 0) == 0,
"error running function %s: %s", name, lua_tostring(L, -1));
for (int n = 0; n < num_res; n++)
{
switch (sig[num_arg + 1 + n])
{
case 'd':
BFAM_ABORT_IF_NOT(lua_isnumber(L, n - num_res),
"for '%s' return %d expected number got '%s'", name, n,
lua_tostring(L, n - num_res));
*va_arg(vl, double *) = (double)lua_tonumber(L, n - num_res);
break;
case 'l':
BFAM_ABORT_IF_NOT(lua_isnumber(L, n - num_res),
"for '%s' return %d expected number got '%s'", name, n,
lua_tostring(L, n - num_res));
*va_arg(vl, bfam_long_real_t *) =
(bfam_long_real_t)lua_tonumber(L, n - num_res);
break;
case 'r':
BFAM_ABORT_IF_NOT(lua_isnumber(L, n - num_res),
"for '%s' return %d expected number got '%s'", name, n,
lua_tostring(L, n - num_res));
*va_arg(vl, bfam_real_t *) = (bfam_real_t)lua_tonumber(L, n - num_res);
break;
case 'i':
BFAM_ABORT_IF_NOT(lua_isnumber(L, n - num_res),
"for '%s' return %d expected number got '%s'", name, n,
lua_tostring(L, n - num_res));
*va_arg(vl, int *) = (int)lua_tointeger(L, n - num_res);
break;
case 's':
BFAM_ABORT_IF_NOT(lua_isstring(L, n - num_res),
"for '%s' return %d expected string got '%s'", name, n,
lua_tostring(L, n - num_res));
*va_arg(vl, const char **) = lua_tostring(L, n - num_res);
break;
default:
BFAM_ABORT("function '%s' invalid output argument (%c)", name,
sig[num_arg]);
}
}
lua_pop(L, num_res);
va_end(vl);
return 0;
}
