void get_intern_set()
{
char *n[MAX_INTERN_SET],key[MAX_INTERN_SET],ch;
int i,j;
int count=Nintern_set;
Window temp=main_win;
if(count==0)return;
for(i=0;i<Nintern_set;i++){
n[i]=(char *)malloc(256);
key[i]='a'+i;
sprintf(n[i],"%c: %s",key[i],intern_set[i].name);
}
key[count]=0;
ch=(char)pop_up_list(&temp,"Param set",n,key,count,12,0,10,0,
no_hint,info_pop,info_message);
for(i=0;i<count;i++)free(n[i]);
j=(int)(ch-'a');
if(j<0||j>=Nintern_set){
err_msg("Not a valid set");
return;
}
/* plintf(" Got set %d \n",j); */
get_graph();
extract_internset(j);
chk_delay();
redraw_params();
redraw_ics();
reset_graph();
}
void file_inf()
{
int ok;
FILE *fp;
char filename[256];
sprintf(filename,"%s.pars",this_file);
ping();
if(!file_selector("Save info",filename,"*.pars*"))return;
/* if(new_string("Filename: ",filename)==0)return; */
open_write_file(&fp,filename,&ok);
if(!ok)return;
redraw_params();
do_info(fp);
fclose(fp);
}
int do_calc(char *temp, double *z) {
char val[15];
int ok;
int i;
double newz;
if (strlen(temp) == 0) {
*z = 0.0;
return (1);
}
if (has_eq(temp, val, &i)) {
newz = calculate(&temp[i], &ok); /* calculate quantity */
if (ok == 0)
return (-1);
i = find_user_name(PARAMBOX, val);
if (i > -1) {
set_val(val, newz); /* a parameter set to value */
*z = newz;
redraw_params();
} else {
i = find_user_name(ICBOX, val);
if (i < 0) {
err_msg("No such name!");
return (-1);
}
set_val(val, newz);
last_ic[i] = newz;
*z = newz;
redraw_ics();
}
return (0);
}
newz = calculate(temp, &ok);
if (ok == 0)
return (-1);
*z = newz;
return (1);
}
void bvshoot(double *y, double *yend, double err, double eps, int maxit,
int *iret, int n, int ishow, int iper, int ipar, int ivar,
double sect) {
double *jac, *f, *fdev, *y0, *y1;
double dev, error, ytemp;
int ntot = n;
int i, istart = 1, j;
int ipvt[MAXODE1];
char esc;
int info, niter = 0;
double dt = DELTA_T, t;
double t0 = T0;
double t1 = T0 + TEND * dt / fabs(dt);
if (iper)
ntot = n + 1;
jac = (double *)malloc(ntot * ntot * sizeof(double));
f = (double *)malloc(ntot * sizeof(double));
fdev = (double *)malloc(ntot * sizeof(double));
y0 = (double *)malloc(ntot * sizeof(double));
y1 = (double *)malloc(ntot * sizeof(double));
for (i = 0; i < n; i++)
y0[i] = y[i];
if (iper)
get_val(upar_names[ipar], &y0[n]);
/* dt=(t1-t0)/nt; */
while (1) {
esc = my_abort();
{
if (esc == ESC) {
*iret = ABORT;
break;
}
if (esc == '/') {
*iret = ABORT_ALL;
break;
}
}
t = t0;
istart = 1;
if (iper)
set_val(upar_names[ipar], y0[n]);
if (ishow) {
integrate(&t, y, TEND, DELTA_T, 1, NJMP, &istart);
} else {
if (ode_int(y, &t, &istart) == 0) {
*iret = -4;
goto bye;
}
}
for (i = 0; i < n; i++) {
y1[i] = y[i];
/* plintf("%f \n",y[i]); */
}
do_bc(y0, t0, y1, t1, f, n);
if (iper)
f[n] = y1[ivar] - sect;
error = 0.0;
for (i = 0; i < ntot; i++)
error += fabs(f[i]);
if (error < err) {
for (i = 0; i < n; i++)
y[i] = y0[i]; /* Good values .... */
if (iper) {
set_val(upar_names[ipar], y0[n]);
redraw_params();
}
for (i = 0; i < n; i++)
yend[i] = y1[i];
*iret = GOODSHOT;
goto bye;
}
/* plintf("err1 = %f tol= %f \n",error,err); */
niter++;
if (niter > maxit) {
*iret = -2;
goto bye;
} /* Too many iterates */
/* create the Jacobian matrix ... */
for (j = 0; j < ntot; j++) {
for (i = 0; i < n; i++)
y[i] = y0[i];
if (fabs(y0[j]) < eps)
dev = eps * eps;
else
dev = eps * fabs(y0[j]);
if (j < n)
y[j] = y[j] + dev;
ytemp = y0[j];
y0[j] = y0[j] + dev;
if (j == n)
set_val(upar_names[ipar], y0[j]);
t = t0;
istart = 1;
if (ode_int(y, &t, &istart) == 0) {
*iret = -4;
goto bye;
}
do_bc(y0, t0, y, t1, fdev, n);
if (iper)
fdev[n] = y[ivar] - sect;
y0[j] = ytemp;
for (i = 0; i < ntot; i++)
jac[j + i * ntot] = (fdev[i] - f[i]) / dev;
}
sgefa(jac, ntot, ntot, ipvt, &info);
if (info != -1) {
*iret = -3;
goto bye;
}
for (i = 0; i < ntot; i++)
fdev[i] = f[i];
sgesl(jac, ntot, ntot, ipvt, fdev, 0);
error = 0.0;
for (i = 0; i < ntot; i++) {
y0[i] = y0[i] - fdev[i];
error += fabs(fdev[i]);
}
for (i = 0; i < n; i++)
y[i] = y0[i];
/* plintf("error2 = %f \n",error); */
if (error < 1.e-10) {
for (i = 0; i < n; i++)
yend[i] = y1[i];
*iret = 2;
goto bye;
}
}
bye:
free(f);
free(y1);
free(y0);
free(jac);
free(fdev);
}
