Search All of the Math Forum:

Views expressed in these public forums are not endorsed by NCTM or The Math Forum.

Notice: We are no longer accepting new posts, but the forums will continue to be readable.

Topic: System of Integro-differential equations
Replies: 0

 Iván Lazaro Posts: 34 Registered: 6/18/07
System of Integro-differential equations
Posted: Jun 15, 2012 3:34 PM

Hi!

I'm trying to solve a system of four integro-differential equations
using Mathematica. I'm using Interpolation to do it, but until know
I'm not getting correct behaviors. Maybe the system is too complicated
to be solve like I'm trying, but maybe I'm making some silly mistake.
For some reason the system is "exploding", but the first three
variables have to remain below 1 (in fact, their sum must remain below
1).

So, if anyone has some insight, it would be very welcome!

It may look bad here because I'm using subscripts.

n = 1;
nf = 30;
nEq = 4;
Tau = 0.05;
Table[If[i == 3, Subscript[c, i] = {1}, Subscript[c, i] = {0}], {i, 1, nEq}];

Block[{\$RecursionLimit = \[Infinity]}, While[n < nf, Table[{
Table[Subscript[LC, i] = Table[{(j - 1) Tau, Subscript[c,
i][[j]]}, {j, 1, n}], {i, 1, nEq}];
Table[Subscript[IntC, i] = Interpolation[Subscript[LC, i], If[i <
4, Method -> "Spline", Method -> "Hermite"]], {i, 1, nEq}];
Which[k == 1, time = (n - 1) Tau, k == 2 || k == 3, time = Tau (n
- 1/2), k == 4, time = Tau*n];

Subscript[c1, 1, k] = Tau*NIntegrate[0.1*(Subscript[IntC, 3][s] -
Subscript[IntC, 1][s]) + 2.5*Subscript[IntC, 2][s], {s, 0, time},
AccuracyGoal -> 10];
Subscript[c1, 2, k] = Tau*NIntegrate[-2.60*Subscript[IntC, 2][s]
- 7*Im[Subscript[IntC, 4][s]], {s, 0, time}, AccuracyGoal -> 10];
Subscript[c1, 3, k] = Tau*NIntegrate[0.1 (Subscript[IntC, 1][s] -
Subscript[IntC, 3][s]) + 7*Im[Subscript[IntC, 4][s]], {s, 0, time},
AccuracyGoal -> 10];
Subscript[c1, 4, k] = Tau*NIntegrate[I*3.5*(Subscript[IntC, 2][s]
- Subscript[IntC, 3][s]) - 1.35*Subscript[IntC, 4][s], {s, 0, time},
AccuracyGoal -> 10];

Which[k == 1, Table[Subscript[c, i][[n]] = Subscript[c, i][[n]] +
Subscript[c1, i, 1]/2, {i, 1, nEq}],
k == 2, Table[Subscript[c, i][[n]] = Subscript[c, i][[n]] +
Subscript[c1, i, 2]/2, {i, 1, nEq}],
k == 3, Table[Subscript[c, i][[n]] = Subscript[c, i][[n]] +
Subscript[c1, i, 3], {i, 1, nEq}],
k == 4, Table[Subscript[c, i][[n]] = Subscript[c, i][[n]], {i,
1, nEq}]]}, {k, 1, 4}];

Table[Subscript[c, i] = Append[Subscript[c, i], Subscript[c,
i][[n]] + (Subscript[c1, i, 1] + 2.0*Subscript[c1, i, 2] +
2.0*Subscript[c1, i, 3] + Subscript[c1, i, 4])/6], {i, 1, nEq}]; n = n
+ 1]];