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