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); } }