void alloc_kernels(int flag) {
int i, n = MaxPoints;
int j;
double mu;
for (i = 0; i < NKernel; i++) {
if (kernel[i].flag == CONV) {
if (flag == 1)
free(kernel[i].cnv);
kernel[i].cnv = (double *)malloc((n + 1) * sizeof(double));
for (j = 0; j <= n; j++) {
set_ivar(0, T0 + DELTA_T * j);
kernel[i].cnv[j] = evaluate(kernel[i].kerform);
}
}
/* Do the alpha functions here later */
if (kernel[i].mu > 0.0) {
mu = kernel[i].mu;
if (flag == 1)
free(kernel[i].al);
kernel[i].al = (double *)malloc((n + 1) * sizeof(double));
for (j = 0; j <= n; j++)
kernel[i].al[j] = alpbetjn(mu, DELTA_T, j);
}
}
}
/* more general mixed boundary types */
void do_bc(double *y__0, double t0, double *y__1, double t1, double *f, int n) {
int n0 = PrimeStart;
int i;
if (HOMOCLINIC_FLAG)
do_projection(y__0, t0, y__1, t1);
set_ivar(0, t0);
set_ivar(n0, t1);
for (i = 0; i < n; i++) {
set_ivar(i + 1, y__0[i]);
set_ivar(i + n0 + 1, y__1[i]);
}
for (i = n; i < n + FIX_VAR; i++)
set_ivar(i + 1, evaluate(my_ode[i]));
for (i = 0; i < n; i++)
f[i] = evaluate(my_bc[i].com);
}
int eval_fun_table(int n, double xlo, double xhi, char *formula, double *y) {
int i;
double dx;
double oldt;
int command[200];
if (parse_expr(formula, command, &i)) {
err_msg("Illegal formula...");
return (0);
}
oldt = get_ivar(0);
dx = (xhi - xlo) / ((double)(n - 1));
for (i = 0; i < n; i++) {
set_ivar(0, dx * i + xlo);
y[i] = evaluate(command);
}
set_ivar(0, oldt);
return (1);
}
/*** FIX THIS TO DO MORE GENERAL STUFF
K(t,t',u,u') someday...
***/
void init_sums(double t0, int n, double dt, int i0, int iend, int ishift) {
double t = t0 + n * dt, tp = t0 + i0 * dt;
double sum[MAXODE], al, alpbet, mu;
int nvar = FIX_VAR + NODE + NMarkov;
int l, ioff, ker, i;
set_ivar(0, t);
set_ivar(PrimeStart, tp);
for (l = 0; l < nvar; l++)
set_ivar(l + 1, Memory[l][ishift]);
for (ker = 0; ker < NKernel; ker++) {
kernel[ker].k_n1 = kernel[ker].k_n;
mu = kernel[ker].mu;
if (mu == 0.0)
al = .5 * dt;
else
al = alpha1n(mu, dt, t, tp);
sum[ker] = al * evaluate(kernel[ker].formula);
if (kernel[ker].flag == CONV)
sum[ker] = sum[ker] * kernel[ker].cnv[n - i0];
}
for (i = 1; i <= iend; i++) {
ioff = (ishift + i) % MaxPoints;
tp += dt;
set_ivar(PrimeStart, tp);
for (l = 0; l < nvar; l++)
set_ivar(l + 1, Memory[l][ioff]);
for (ker = 0; ker < NKernel; ker++) {
mu = kernel[ker].mu;
if (mu == 0.0)
alpbet = dt;
else
alpbet = kernel[ker].al[n - i0 - i]; /* alpbetjn(mu,dt,t,tp); */
if (kernel[ker].flag == CONV)
sum[ker] += (alpbet * evaluate(kernel[ker].formula) *
kernel[ker].cnv[n - i0 - i]);
else
sum[ker] += (alpbet * evaluate(kernel[ker].formula));
}
}
for (ker = 0; ker < NKernel; ker++) {
kernel[ker].sum = sum[ker];
}
}
/* uses the guessed value y to update Kn */
void get_kn(double *y, double t) {
int i;
set_ivar(0, t);
set_ivar(PrimeStart, t);
for (i = 0; i < NODE; i++)
set_ivar(i + 1, y[i]);
for (i = NODE; i < NODE + FIX_VAR; i++)
set_ivar(i + 1, evaluate(my_ode[i]));
for (i = 0; i < NKernel; i++) {
if (kernel[i].flag == CONV)
kernel[i].k_n =
kernel[i].sum +
kernel[i].betnn * evaluate(kernel[i].formula) * kernel[i].cnv[0];
else
kernel[i].k_n =
kernel[i].sum + kernel[i].betnn * evaluate(kernel[i].formula);
/* plintf(" Value t=%g %d =%g %g\n",t,i,kernel[i].k_n,y[i]); */
}
}
void re_evaluate_kernels(void) {
int i, j, n = MaxPoints;
if (AutoEvaluate == 0)
return;
for (i = 0; i < NKernel; i++) {
if (kernel[i].flag == CONV) {
for (j = 0; j <= n; j++) {
set_ivar(0, T0 + DELTA_T * j);
kernel[i].cnv[j] = evaluate(kernel[i].kerform);
}
}
}
}
int volterra(double *y, double *t, double dt, int nt, int neq, int *istart,
double *work) {
double *jac, *yg, *yp, *yp2, *ytemp, *errvec;
double z, mu, bet;
int i, j;
yp = work;
yg = yp + neq;
ytemp = yg + neq;
errvec = ytemp + neq;
yp2 = errvec + neq;
jac = yp2 + neq;
/* Initialization of everything */
if (*istart == 1) {
CurrentPoint = 0;
KnFlag = 1;
for (i = 0; i < NKernel; i++) { /* zero the integrals */
kernel[i].k_n = 0.0;
kernel[i].k_n1 = 0.0;
mu = kernel[i].mu; /* compute bet_nn */
if (mu == 0.0)
bet = .5 * dt;
else
bet = betnn(mu, dt, *t, *t);
kernel[i].betnn = bet;
}
set_ivar(0, *t);
set_ivar(PrimeStart, *t);
for (i = 0; i < NODE; i++)
if (!EqType[i])
set_ivar(i + 1, y[i]); /* assign initial data */
for (i = NODE; i < NODE + FIX_VAR; i++)
set_ivar(i + 1, evaluate(my_ode[i])); /* set fixed variables for pass 1 */
for (i = 0; i < NODE; i++)
if (EqType[i]) {
z = evaluate(my_ode[i]); /* reset IC for integral eqns */
set_ivar(i + 1, z);
y[i] = z;
}
for (i = NODE; i < NODE + FIX_VAR; i++) /* pass 2 for fixed variables */
set_ivar(i + 1, evaluate(my_ode[i]));
for (i = 0; i < NODE + FIX_VAR + NMarkov; i++)
Memory[i][0] = get_ivar(i + 1); /* save everything */
CurrentPoint = 1;
*istart = 0;
}
for (i = 0; i < nt; i++) /* the real computation */
{
*t = *t + dt;
set_wieners(dt, y, *t);
if ((j = volt_step(y, *t, dt, neq, yg, yp, yp2, ytemp, errvec, jac)) != 0)
return (j);
stor_delay(y);
}
return (0);
}
double MGXS::ldsi()const{
set_ivar();
return ivar_->ldsi();
}
const SpdMatrix & MGXS::siginv()const{
set_ivar();
return ivar_->ivar();
}
const SpdMatrix & MGXS::Sigma()const{
set_ivar();
return ivar_->var();
}
int volt_step(double *y, double t, double dt, int neq, double *yg, double *yp,
double *yp2, double *ytemp, double *errvec, double *jac) {
int i0, iend, ishift, i, iter = 0, info, ipivot[MAXODE1], j, ind;
int n1 = NODE + 1;
double dt2 = .5 * dt, err;
double del, yold, fac, delinv;
i0 = MAX(0, CurrentPoint - MaxPoints);
iend = MIN(CurrentPoint - 1, MaxPoints - 1);
ishift = i0 % MaxPoints;
init_sums(T0, CurrentPoint, dt, i0, iend,
ishift); /* initialize all the sums */
KnFlag = 0;
for (i = 0; i < neq; i++) {
set_ivar(i + 1, y[i]);
yg[i] = y[i];
}
for (i = NODE; i < NODE + NMarkov; i++)
set_ivar(i + 1 + FIX_VAR, y[i]);
set_ivar(0, t - dt);
for (i = NODE; i < NODE + FIX_VAR; i++)
set_ivar(i + 1, evaluate(my_ode[i]));
for (i = 0; i < NODE; i++) {
if (!EqType[i])
yp2[i] = y[i] + dt2 * evaluate(my_ode[i]);
else
yp2[i] = 0.0;
}
KnFlag = 1;
while (1) {
get_kn(yg, t);
for (i = NODE; i < NODE + FIX_VAR; i++)
set_ivar(i + 1, evaluate(my_ode[i]));
for (i = 0; i < NODE; i++) {
yp[i] = evaluate(my_ode[i]);
/* plintf(" yp[%d]=%g\n",i,yp[i]); */
if (EqType[i])
errvec[i] = -yg[i] + yp[i];
else
errvec[i] = -yg[i] + dt2 * yp[i] + yp2[i];
}
/* Compute Jacobian */
for (i = 0; i < NODE; i++) {
del = NEWT_ERR * MAX(NEWT_ERR, fabs(yg[i]));
yold = yg[i];
yg[i] += del;
delinv = 1. / del;
get_kn(yg, t);
for (j = NODE; j < NODE + FIX_VAR; j++)
set_ivar(j + 1, evaluate(my_ode[j]));
for (j = 0; j < NODE; j++) {
fac = delinv;
if (!EqType[j])
fac *= dt2;
jac[j * NODE + i] = (evaluate(my_ode[j]) - yp[j]) * fac;
}
yg[i] = yold;
}
for (i = 0; i < NODE; i++)
jac[n1 * i] -= 1.0;
sgefa(jac, NODE, NODE, ipivot, &info);
if (info != -1) {
return (-1); /* Jacobian is singular */
}
err = 0.0;
sgesl(jac, NODE, NODE, ipivot, errvec, 0);
for (i = 0; i < NODE; i++) {
err = MAX(fabs(errvec[i]), err);
yg[i] -= errvec[i];
}
if (err < EulTol)
break;
iter++;
if (iter > MaxEulIter)
return (-2); /* too many iterates */
}
/* We have a good point; lets save it */
get_kn(yg, t);
/* for(i=NODE;i<NODE+FIX_VAR;i++)
set_ivar(i+1,evaluate(my_ode[i])); */
for (i = 0; i < NODE; i++)
y[i] = yg[i];
ind = CurrentPoint % MaxPoints;
for (i = 0; i < NODE + FIX_VAR + NMarkov; i++)
Memory[i][ind] = get_ivar(i + 1);
CurrentPoint++;
return (0);
}
void do_range_clines()
{
static char *n[]={"*2Range parameter","Steps","Low","High"};
char values[4][MAX_LEN_SBOX];
int status,i;
double z,dz,zold;
float xmin,xmax,y_tp,y_bot;
int col1=XNullColor,col2=YNullColor;
int course=NMESH;
/* if(PaperWhite){
col1=1;
col2=9;
} */
sprintf(values[0],"%s",ncrange.rv);
sprintf(values[1],"%d",ncrange.nstep);
sprintf(values[2],"%g",ncrange.xlo);
sprintf(values[3],"%g",ncrange.xhi);
status=do_string_box(4,4,1,"Range Clines",n,values,45);
if(status!=0){
strcpy(ncrange.rv,values[0]);
ncrange.nstep=atoi(values[1]);
ncrange.xlo=atof(values[2]);
ncrange.xhi=atof(values[3]);
if(ncrange.nstep<=0)return;
dz=(ncrange.xhi-ncrange.xlo)/(double)ncrange.nstep;
if(dz<=0.0)return;
get_val(ncrange.rv,&zold);
for(i=NODE;i<NODE+NMarkov;i++)set_ivar(i+1+FIX_VAR,last_ic[i]);
xmin=(float)MyGraph->xmin;
xmax=(float)MyGraph->xmax;
y_tp=(float)MyGraph->ymax;
y_bot=(float)MyGraph->ymin;
null_ix=MyGraph->xv[0];
null_iy=MyGraph->yv[0];
for(i=0;i<=ncrange.nstep;i++){
z=(double)i*dz+ncrange.xlo;
set_val(ncrange.rv,z);
if(NULL_HERE==0)
{
if((X_n=(float *)malloc(4*MAX_NULL*sizeof(float)))!=NULL
&& (Y_n=(float *)malloc(4*MAX_NULL*sizeof(float)))!=NULL)
NULL_HERE=1;
NTop=(float *)malloc((course+1)*sizeof(float));
NBot=(float *)malloc((course+1)*sizeof(float));
if(NTop==NULL||NBot==NULL)NULL_HERE=0;
}
else {
free(NTop);
free(NBot);
NTop=(float *)malloc((course+1)*sizeof(float));
NBot=(float *)malloc((course+1)*sizeof(float));
if(NTop==NULL||NBot==NULL){NULL_HERE=0;
return;}
}
WHICH_CRV=null_ix;
set_linestyle(col1);
new_nullcline(course,xmin,y_bot,xmax,y_tp,X_n,&num_x_n);
WHICH_CRV=null_iy;
set_linestyle(col2);
new_nullcline(course,xmin,y_bot,xmax,y_tp,Y_n,&num_y_n);
add_froz_cline(X_n,num_x_n,null_ix,Y_n,num_y_n,null_iy);
}
set_val(ncrange.rv,zold);
}
}
