102 |
|
|
103 |
static double hinit (unsigned n, FcnEqDiff *fcn, double x, double* y, |
static double hinit (unsigned n, FcnEqDiff *fcn, double x, double* y, |
104 |
double posneg, double* f0, double* f1, double* yy1, int iord, |
double posneg, double* f0, double* f1, double* yy1, int iord, |
105 |
double hmax, double* atoler, double* rtoler, int itoler){ |
double hmax, double* atoler, double* rtoler, int itoler |
106 |
|
,void *user_data |
107 |
|
){ |
108 |
double dnf, dny, atoli, rtoli, sk, h, h1, der2, der12, sqr; |
double dnf, dny, atoli, rtoli, sk, h, h1, der2, der12, sqr; |
109 |
unsigned i; |
unsigned i; |
110 |
|
|
143 |
/* perform an explicit Euler step */ |
/* perform an explicit Euler step */ |
144 |
for (i = 0; i < n; i++) |
for (i = 0; i < n; i++) |
145 |
yy1[i] = y[i] + h * f0[i]; |
yy1[i] = y[i] + h * f0[i]; |
146 |
fcn (n, x+h, yy1, f1); |
fcn (n, x+h, yy1, f1, user_data); |
147 |
|
|
148 |
/* estimate the second derivative of the solution */ |
/* estimate the second derivative of the solution */ |
149 |
der2 = 0.0; |
der2 = 0.0; |
178 |
|
|
179 |
/* core integrator */ |
/* core integrator */ |
180 |
static int dopcor (unsigned n, FcnEqDiff *fcn, double x, double* y, double xend, |
static int dopcor (unsigned n, FcnEqDiff *fcn, double x, double* y, double xend, |
181 |
double hmax, double h, double* rtoler, double* atoler, |
double hmax, double h, double* rtoler, double* atoler, |
182 |
int itoler, FILE* fileout, SolTrait *solout, int iout, |
int itoler, FILE* fileout, SolTrait *solout, int iout, |
183 |
long nmax, double uround, int meth, long nstiff, double safe, |
long nmax, double uround, int meth, long nstiff, double safe, |
184 |
double beta, double fac1, double fac2, unsigned* icont){ |
double beta, double fac1, double fac2, unsigned* icont |
185 |
|
, void *user_data |
186 |
|
){ |
187 |
double facold, expo1, fac, facc1, facc2, fac11, posneg, xph; |
double facold, expo1, fac, facc1, facc2, fac11, posneg, xph; |
188 |
double atoli, rtoli, hlamb, err, sk, hnew, yd0, ydiff, bspl; |
double atoli, rtoli, hlamb, err, sk, hnew, yd0, ydiff, bspl; |
189 |
double stnum, stden, sqr; |
double stnum, stden, sqr; |
228 |
last = 0; |
last = 0; |
229 |
hlamb = 0.0; |
hlamb = 0.0; |
230 |
iasti = 0; |
iasti = 0; |
231 |
fcn(n, x, y, k1); |
fcn(n, x, y, k1, user_data); |
232 |
hmax = fabs (hmax); |
hmax = fabs (hmax); |
233 |
iord = 5; |
iord = 5; |
234 |
if (h == 0.0) |
if (h == 0.0) |
235 |
h = hinit (n, fcn, x, y, posneg, k1, k2, k3, iord, hmax, atoler, rtoler, itoler); |
h = hinit (n, fcn, x, y, posneg, k1, k2, k3, iord, hmax, atoler, rtoler, itoler, user_data); |
236 |
nfcn += 2; |
nfcn += 2; |
237 |
reject = 0; |
reject = 0; |
238 |
xold = x; |
xold = x; |
241 |
irtrn = 1; |
irtrn = 1; |
242 |
hout = h; |
hout = h; |
243 |
xout = x; |
xout = x; |
244 |
solout (naccpt+1, xold, x, y, n, &irtrn); |
solout (naccpt+1, xold, x, y, n, &irtrn, user_data); |
245 |
if (irtrn < 0) |
if (irtrn < 0) |
246 |
{ |
{ |
247 |
if (fileout) |
if (fileout) |
282 |
/* the first 6 stages */ |
/* the first 6 stages */ |
283 |
for (i = 0; i < n; i++) |
for (i = 0; i < n; i++) |
284 |
yy1[i] = y[i] + h * a21 * k1[i]; |
yy1[i] = y[i] + h * a21 * k1[i]; |
285 |
fcn (n, x+c2*h, yy1, k2); |
fcn (n, x+c2*h, yy1, k2, user_data); |
286 |
for (i = 0; i < n; i++) |
for (i = 0; i < n; i++) |
287 |
yy1[i] = y[i] + h * (a31*k1[i] + a32*k2[i]); |
yy1[i] = y[i] + h * (a31*k1[i] + a32*k2[i]); |
288 |
fcn (n, x+c3*h, yy1, k3); |
fcn (n, x+c3*h, yy1, k3, user_data); |
289 |
for (i = 0; i < n; i++) |
for (i = 0; i < n; i++) |
290 |
yy1[i] = y[i] + h * (a41*k1[i] + a42*k2[i] + a43*k3[i]); |
yy1[i] = y[i] + h * (a41*k1[i] + a42*k2[i] + a43*k3[i]); |
291 |
fcn (n, x+c4*h, yy1, k4); |
fcn (n, x+c4*h, yy1, k4, user_data); |
292 |
for (i = 0; i <n; i++) |
for (i = 0; i <n; i++) |
293 |
yy1[i] = y[i] + h * (a51*k1[i] + a52*k2[i] + a53*k3[i] + a54*k4[i]); |
yy1[i] = y[i] + h * (a51*k1[i] + a52*k2[i] + a53*k3[i] + a54*k4[i]); |
294 |
fcn (n, x+c5*h, yy1, k5); |
fcn (n, x+c5*h, yy1, k5, user_data); |
295 |
for (i = 0; i < n; i++) |
for (i = 0; i < n; i++) |
296 |
ysti[i] = y[i] + h * (a61*k1[i] + a62*k2[i] + a63*k3[i] + a64*k4[i] + a65*k5[i]); |
ysti[i] = y[i] + h * (a61*k1[i] + a62*k2[i] + a63*k3[i] + a64*k4[i] + a65*k5[i]); |
297 |
xph = x + h; |
xph = x + h; |
298 |
fcn (n, xph, ysti, k6); |
fcn (n, xph, ysti, k6, user_data); |
299 |
for (i = 0; i < n; i++) |
for (i = 0; i < n; i++) |
300 |
yy1[i] = y[i] + h * (a71*k1[i] + a73*k3[i] + a74*k4[i] + a75*k5[i] + a76*k6[i]); |
yy1[i] = y[i] + h * (a71*k1[i] + a73*k3[i] + a74*k4[i] + a75*k5[i] + a76*k6[i]); |
301 |
fcn (n, xph, yy1, k2); |
fcn (n, xph, yy1, k2, user_data); |
302 |
if (iout == 2){ |
if (iout == 2){ |
303 |
if (nrds == n){ |
if (nrds == n){ |
304 |
for (i = 0; i < n; i++) |
for (i = 0; i < n; i++) |
422 |
{ |
{ |
423 |
hout = h; |
hout = h; |
424 |
xout = x; |
xout = x; |
425 |
solout (naccpt+1, xold, x, y, n, &irtrn); |
solout (naccpt+1, xold, x, y, n, &irtrn, user_data); |
426 |
if (irtrn < 0) |
if (irtrn < 0) |
427 |
{ |
{ |
428 |
if (fileout) |
if (fileout) |
468 |
double* atoler, int itoler, SolTrait *solout, int iout, FILE* fileout, double uround, |
double* atoler, int itoler, SolTrait *solout, int iout, FILE* fileout, double uround, |
469 |
double safe, double fac1, double fac2, double beta, double hmax, double h, |
double safe, double fac1, double fac2, double beta, double hmax, double h, |
470 |
long nmax, int meth, long nstiff, unsigned nrdens, unsigned* icont, unsigned licont |
long nmax, int meth, long nstiff, unsigned nrdens, unsigned* icont, unsigned licont |
471 |
|
, void *user_data |
472 |
){ |
){ |
473 |
int arret, idid; |
int arret, idid; |
474 |
unsigned i; |
unsigned i; |
665 |
} |
} |
666 |
else |
else |
667 |
{ |
{ |
668 |
idid = dopcor (n, fcn, x, y, xend, hmax, h, rtoler, atoler, itoler, fileout, |
idid = dopcor (n, fcn, x, y, xend, hmax, h, rtoler, atoler, itoler, fileout |
669 |
solout, iout, nmax, uround, meth, nstiff, safe, beta, fac1, fac2, icont); |
, solout, iout, nmax, uround, meth, nstiff, safe, beta, fac1, fac2, icont |
670 |
|
, user_data |
671 |
|
); |
672 |
free (ysti); |
free (ysti); |
673 |
free (k6); |
free (k6); |
674 |
free (k5); /* reverse order freeing too increase chances */ |
free (k5); /* reverse order freeing too increase chances */ |