/*************************************************************************
mcell_generate_range:
Generate a num_expr_list containing the numeric values from start to end,
incrementing by step.
In: state: the simulation state
list: destination to receive list of values
start: start of range
end: end of range
step: increment
Out: 0 on success, 1 on failure. On success, list is filled in.
*************************************************************************/
MCELL_STATUS mcell_generate_range(struct num_expr_list_head *list, double start,
double end, double step) {
list->value_head = NULL;
list->value_tail = NULL;
list->value_count = 0;
list->shared = 0;
if (step > 0) {
/* JW 2008-03-31: In the guard on the loop below, it seems to me that
* the third condition is redundant with the second.
*/
for (double tmp_dbl = start;
tmp_dbl < end || !distinguishable(tmp_dbl, end, EPS_C) ||
fabs(end - tmp_dbl) <= EPS_C;
tmp_dbl += step) {
if (advance_range(list, tmp_dbl))
return MCELL_FAIL;
}
} else /* if (step < 0) */
{
/* JW 2008-03-31: In the guard on the loop below, it seems to me that
* the third condition is redundant with the second.
*/
for (double tmp_dbl = start;
tmp_dbl > end || !distinguishable(tmp_dbl, end, EPS_C) ||
fabs(end - tmp_dbl) <= EPS_C;
tmp_dbl += step) {
if (advance_range(list, tmp_dbl))
return MCELL_FAIL;
}
}
return MCELL_SUCCESS;
}
/*************************************************************************
timeof_unimolecular:
In: the reaction we're testing
Out: double containing the number of timesteps until the reaction occurs
*************************************************************************/
double timeof_unimolecular(struct rxn *rx, struct abstract_molecule *a,
struct rng_state *rng) {
double k_tot = rx->max_fixed_p;
double p = rng_dbl(rng);
if ((k_tot <= 0) || (!distinguishable(p, 0, EPS_C)))
return FOREVER;
return -log(p) / k_tot;
}
/*************************************************************************
eval_oexpr_tree:
In: root of an output_expression tree
flag indicating whether to recalculate values marked CONST
Out: no return value. The value member variable of each
output_expression in the tree is updated to be accurate given
current leaf values.
*************************************************************************/
void eval_oexpr_tree(struct output_expression *root, int skip_const) {
double lval = 0.0;
double rval = 0.0;
if ((root->expr_flags & OEXPR_TYPE_CONST) && skip_const)
return;
if (root->left != NULL) {
if ((root->expr_flags & OEXPR_LEFT_MASK) == OEXPR_LEFT_INT)
lval = (double)*((int *)root->left);
else if ((root->expr_flags & OEXPR_LEFT_MASK) == OEXPR_LEFT_DBL)
lval = *((double *)root->left);
else if ((root->expr_flags & OEXPR_LEFT_MASK) == OEXPR_LEFT_OEXPR) {
eval_oexpr_tree((struct output_expression *)root->left, skip_const);
lval = ((struct output_expression *)root->left)->value;
}
}
if (root->right != NULL) {
if ((root->expr_flags & OEXPR_RIGHT_MASK) == OEXPR_RIGHT_INT)
rval = (double)*((int *)root->right);
else if ((root->expr_flags & OEXPR_RIGHT_MASK) == OEXPR_RIGHT_DBL)
rval = *((double *)root->right);
else if ((root->expr_flags & OEXPR_RIGHT_MASK) == OEXPR_RIGHT_OEXPR) {
eval_oexpr_tree((struct output_expression *)root->right, skip_const);
rval = ((struct output_expression *)root->right)->value;
}
}
switch (root->oper) {
case '=':
break;
case '(':
case '#':
case '@':
if (root->right != NULL)
root->value = lval + rval;
else
root->value = lval;
break;
case '_':
root->value = -lval;
break;
case '+':
root->value = lval + rval;
break;
case '-':
root->value = lval - rval;
break;
case '*':
root->value = lval * rval;
break;
case '/':
root->value = (!distinguishable(rval, 0, EPS_C)) ? 0 : lval / rval;
break;
default:
break;
}
}
/*************************************************************************
timeof_unimolecular:
In: the reaction we're testing
Out: double containing the number of timesteps until the reaction occurs
*************************************************************************/
double timeof_unimolecular(struct rxn *rx, struct abstract_molecule *a,
struct rng_state *rng) {
double k_tot = rx->max_fixed_p;
if (rx->rates) {
for (int path_idx = rx->n_pathways; path_idx-- != 0;) {
if (!rx->rates[path_idx])
break;
k_tot += macro_lookup_rate(rx->rates[path_idx], a, rx->pb_factor);
}
}
double p = rng_dbl(rng);
if ((k_tot <= 0) || (!distinguishable(p, 0, EPS_C)))
return FOREVER;
return -log(p) / k_tot;
}
void totypesRec(node e) {
int i, j;
/*
e is a list of TYPEs to be defined recursively
The recursion is handled through the type fields of the symbols
involved, which are assumed to be already set, or through TYPEs.
TYPEs have no POSITIONs in them.
Any type which turns out to be equivalent to a prior one has the
address of the prior one inserted into its value field.
We assume that the value fields have been run through ExpandType,
so that each value field is an expression constructed from other
TYPEs.
This routine probably has bugs, with the result that the order of
declarations makes a difference.
*/
numnewtypes = length(e);
newtypeslist = newarray(node,numnewtypes);
ttable = newarray(struct DISTIN *, numnewtypes);
/* we could perform some hashing first */
for (i=0; i<numnewtypes; i++) {
node t = nth(e,i+1);
assert(istype(t));
newtypeslist[i] = t;
assert(t->tag == type_tag);
assert(!(t->body.type.flags & deferred_F));
t->body.type.seqno = i + numtypes;
ttable[i] = newarray(struct DISTIN,numtypes+numnewtypes);
for (j=0; j<numtypes+numnewtypes; j++) {
ttable[i][j].listp = NULL;
ttable[i][j].distinguishable = FALSE;
}
}
for (i=numtypes; i<numnewtypes+numtypes; i++) {
for (j=0; j<i; j++) {
struct DISTIN *dd = table(i,j);
node t = thetype(i), u = thetype(j), tval, uval, th, uh;
assertpos(istype(t),t);
assertpos(istype(u),u);
if ((t->body.type.flags & basic_type_F) || (u->body.type.flags & basic_type_F)) {
assert(t != u);
differ: mark(i,j);
continue;
}
tval = t -> body.type.definition;
uval = u -> body.type.definition;
assertpos(tval != NULL,t);
assertpos(uval != NULL,u);
if (equal(tval,uval)) continue;
assertpos(iscons(tval),t);
assertpos(iscons(uval),u);
assert(! dd->distinguishable );
th = car(tval);
uh = car(uval);
tval = cdr(tval);
uval = cdr(uval);
if (th != uh) goto differ;
if (th == or_K) {
for (;tval != NULL && uval != NULL;
tval = cdr(tval), uval = cdr(uval)) {
node ti = typeforward(car(tval));
node tj = typeforward(car(uval));
int ii = typeseqno(ti);
int jj = typeseqno(tj);
if (ti == tj) continue;
if (ii == -1 || jj == -1) goto differ; /* not defined yet... */
if (distinguishable(ii,jj)) goto differ;
appendlt(ii,jj,i,j);
}
if (tval != NULL || uval != NULL) goto differ;
}
else if (th == object__K || th == tagged_object_K) {
for (;tval != NULL && uval != NULL;
tval = cdr(tval), uval = cdr(uval)) {
node tmem = car(tval);
node umem = car(uval);
int ii, jj;
node tt, uu;
if (car(tmem) != car(umem)) goto differ;
ii = typeseqno(tt=typeforward(cadr(tmem)));
jj = typeseqno(uu=typeforward(cadr(umem)));
if (tt==uu) continue;
if (ii == -1 || jj == -1) goto differ; /* not defined yet... */
if (distinguishable(ii,jj)) goto differ;
appendlt(ii,jj,i,j);
}
if (tval != NULL || uval != NULL) goto differ;
}
else if (th == array_K || th == tarray_K) {
node tt,uu;
int ii = typeseqno(tt=typeforward(car(tval)));
int jj = typeseqno(uu=typeforward(car(uval)));
if (tt!=uu) {
if (ii == -1 || jj == -1) goto differ; /* not defined yet... */
else if (distinguishable(ii,jj)) goto differ;
else if (!equal(cdr(tval),cdr(uval))) goto differ;
else appendlt(ii,jj,i,j);
}
else {
if (!equal(cdr(tval),cdr(uval))) goto differ;
}
}
else if (th == function_S) {
node ttt,uuu;
node targs = car(tval);
node uargs = car(uval);
int iii = typeseqno(ttt=typeforward(cadr(tval)));
int jjj = typeseqno(uuu=typeforward(cadr(uval)));
if (ttt!=uuu) {
if (iii == -1 || jjj == -1) goto differ; /* not defined yet... */
if (distinguishable(iii,jjj)) goto differ;
}
for (;targs != NULL && uargs != NULL;
targs = cdr(targs), uargs = cdr(uargs)) {
node tt,uu;
int ii = typeseqno(tt=typeforward(car(targs)));
int jj = typeseqno(uu=typeforward(car(uargs)));
if (tt==uu) continue;
if (ii == -1 || jj == -1) goto differ; /* not defined yet... */
if (distinguishable(ii,jj)) goto differ;
}
if (targs != NULL || uargs != NULL) goto differ;
}
else {
assert(FALSE); return;
}
}
}
for (i=0; i<numnewtypes; i++) {
for (j=0;j<i+numtypes;j++) {
if (!distinguishable(i+numtypes,j)) {
/* indistinguishable types are identified here */
node t = newtypeslist[i];
node n = t->body.type.name;
if (n != NULL) {
assert(n->tag == symbol_tag);
n->body.symbol.value = thetype(j);
}
t->body.type.forward = thetype(j);
t->body.type.flags = identified_F;
newtypeslist[i] = NULL;
break;
}
}
}
for (i=0; i<numnewtypes; i++) {
if (newtypeslist[i] != NULL) {
node t = newtypeslist[i];
interntype(t);
}
}
}
/**************************************************************************
update_reaction_output:
In: the output_block we want to update
Out: 0 on success, 1 on failure.
The counters in this block are updated, and the block is
rescheduled for the next output time. The counters are saved
to an internal buffer, and written out when full.
**************************************************************************/
int update_reaction_output(struct volume *world, struct output_block *block) {
int report_as_non_trigger = 1;
int i = block->buf_index;
if (block->data_set_head != NULL &&
block->data_set_head->column_head != NULL &&
block->data_set_head->column_head->buffer[i].data_type == COUNT_TRIG_STRUCT)
report_as_non_trigger = 0;
if (report_as_non_trigger) {
switch (world->notify->reaction_output_report) {
case NOTIFY_NONE:
break;
case NOTIFY_BRIEF:
mcell_log(
"Updating reaction output scheduled at time %.15g on iteration %lld.",
block->t, world->current_iterations);
break;
case NOTIFY_FULL:
mcell_log("Updating reaction output scheduled at time %.15g on iteration"
" %lld.\n Buffer fill level is at %u/%u.",
block->t, world->current_iterations, block->buf_index,
block->buffersize);
break;
default:
UNHANDLED_CASE(world->notify->reaction_output_report);
}
}
/* update all counters */
block->t /= (1. + EPS_C);
if (world->chkpt_seq_num == 1) {
if (block->timer_type == OUTPUT_BY_ITERATION_LIST)
block->time_array[i] = block->t;
else
block->time_array[i] = block->t * world->time_unit;
} else {
if (block->timer_type == OUTPUT_BY_ITERATION_LIST) {
block->time_array[i] = block->t;
} else if (block->timer_type == OUTPUT_BY_TIME_LIST) {
if (block->time_now == NULL) {
return 0;
} else {
block->time_array[i] = block->time_now->value;
}
} else {
/* OUTPUT_BY_STEP */
block->time_array[i] = convert_iterations_to_seconds(
world->start_iterations, world->time_unit,
world->simulation_start_seconds, block->t);
}
}
struct output_set *set;
struct output_column *column;
// Each file
for (set = block->data_set_head; set != NULL; set = set->next)
{
if (report_as_non_trigger) {
if (world->notify->reaction_output_report == NOTIFY_FULL)
mcell_log(" Processing reaction output file '%s'.", set->outfile_name);
}
// Each column
for (column = set->column_head; column != NULL; column = column->next)
{
if (column->buffer[i].data_type != COUNT_TRIG_STRUCT) {
eval_oexpr_tree(column->expr, 1);
switch (column->buffer[i].data_type) {
case COUNT_INT:
column->buffer[i].val.ival = (int)column->expr->value;
break;
case COUNT_DBL:
column->buffer[i].val.dval = (double)column->expr->value;
break;
case COUNT_UNSET:
column->buffer[i].val.cval = 'X';
break;
case COUNT_TRIG_STRUCT:
default:
UNHANDLED_CASE(column->buffer[i].data_type);
}
}
}
}
block->buf_index++;
int final_chunk_flag = 0; // flag signaling an end to the scheduled
// reaction outputs. Takes values {0,1}.
// 0 - end not reached yet,
// 1 - end reached.
/* Pick time of next output, if any */
if (block->timer_type == OUTPUT_BY_STEP)
block->t += block->step_time / world->time_unit;
else if (block->time_now != NULL) {
block->time_now = block->time_now->next;
if (block->time_now == NULL)
final_chunk_flag = 1;
else {
if (block->timer_type == OUTPUT_BY_ITERATION_LIST)
block->t = block->time_now->value;
else {
/* OUTPUT_BY_TIME_LIST */
if (world->chkpt_seq_num == 1) {
block->t = block->time_now->value / world->time_unit;
} else {
block->t = world->start_iterations +
(block->time_now->value - world->simulation_start_seconds) /
world->time_unit;
}
}
}
} else
final_chunk_flag = 1;
/* Schedule next output event--even if we're at the end, since triggers may
* not yet be written */
double actual_t;
if (final_chunk_flag == 1) {
actual_t = block->t;
block->t = FOREVER;
} else
actual_t = -1;
block->t *= (1. + EPS_C);
if (schedule_add(world->count_scheduler, block)) {
mcell_allocfailed_nodie("Failed to add count to scheduler.");
return 1;
}
if (distinguishable(actual_t, -1, EPS_C))
block->t = actual_t; /* Fix time for output */
if (report_as_non_trigger &&
world->notify->reaction_output_report == NOTIFY_FULL) {
mcell_log(" Next output for this block scheduled at time %.15g.",
block->t);
}
if (block->t >= world->iterations + 1)
final_chunk_flag = 1;
/* write data to outfile */
if (block->buf_index == block->buffersize || final_chunk_flag) {
for (set = block->data_set_head; set != NULL; set = set->next) {
if (set->column_head->buffer[i].data_type == COUNT_TRIG_STRUCT)
continue;
if (write_reaction_output(world, set)) {
mcell_error_nodie("Failed to write reaction output to file '%s'.",
set->outfile_name);
return 1;
}
}
block->buf_index = 0;
no_printf("Done updating reaction output\n");
}
if (distinguishable(actual_t, -1, EPS_C))
block->t = FOREVER; /* Back to infinity if we're done */
return 0;
}