Date: Jun 15, 2012 3:34 PM
Author: Iván Lazaro
Subject: System of Integro-differential equations

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.

Thanks in advance!

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]];