Re: ndsolve of coupled equation
- To: mathgroup at smc.vnet.net
- Subject: [mg116493] Re: ndsolve of coupled equation
- From: Daniel Lichtblau <danl at wolfram.com>
- Date: Thu, 17 Feb 2011 05:17:35 -0500 (EST)
tarun dutta wrote:
> n = 5;
> p = 5/1000;
> q = 1/10;
> c[i_][t] = a[i][t];
> d[i_][t] = b[i][t];
>
> eqn = Join[
> Table[{c[i]'[t] == ((1/2)*i (i - 1) - q*i)*c[i][t] -
> p*(Sqrt[i]*
> c[i - 1][t]*(Sum[Sqrt[i]*d[i - 1][t]*d[i][t], {i, 0, n}]) +
> Sqrt[i + 1]*
> c[i + 1][
> t]*(Sum[Sqrt[i + 1]*d[i - 1][t]*d[i][t], {i, 0, n}])),
> d[i]'[t] == ((1/2)*i (i - 1) - q*i)*d[i][t] -
> p*(Sqrt[i]*
> d[i - 1][t]*(Sum[Sqrt[i]*c[i - 1][t]*c[i][t], {i, 0, n}]) +
> Sqrt[i + 1]*
> d[i + 1][
> t]*(Sum[
> Sqrt[i + 1]*c[i - 1][t]*c[i][t], {i, 0, n}]))}, {i, 0,
> n}], Sum[(c[i]^2)[t], {i, 0, n}] == 1,
> Sum[(d[i]^2)[t], {i, 0, n}] ==
> 1, {c[0][0] == 0.004567 == d[0][0]}, {Table[
> c[i][0] == 0.0000000034, {i, 1, 5}],
> Table[d[i][0] == 0.0000000034, {i, 1, 5}]}];
> vars1 = Table[c[i][t], {i, 0, 5}];
> vars2 = Table[d[i][t], {i, 0, 5}];
> vars = Join[vars1, vars2];
> sol = NDSolve[eqn, vars, {t, 1/10}]
>
> it shows some error as NDSolve::deqn..
> give some explanation..
> regards,
> tarun
You have a slew of problems. You really should look at the inputs, as
some are fairly apparent.
The set of equations should be a flattened array.
The derivatives will not get caught by your replacement of c-->a and
d-->b (why do you do that anyway?) So variables listed and what appear
in the equations do not match up.
There are c[-1] and d[-1] in the equations but not appearing as
differentiated or initialized variables. Maybe they were meant to be set
to zero? Or set equal to c[5] resp d[5]? I assume the latter. Likewise
with c[6] and d[6].
You use a notation for summing the squares that is not correct. So you
get things like c[0]^2 instead of c[0][t]^2.
I changed to the setup below.
n = 5;
p = 5/1000;
q = 1/10;
c[-1][t_] = c[5][t];
d[-1][t_] = d[5][t];
c[6][t_] = c[0][t];
d[6][t_] = d[0][t];
eqn = Flatten[
Join[Table[{c[i]'[t] == ((1/2)*i (i - 1) - q*i)*c[i][t] -
p*(Sqrt[i]*
c[i - 1][
t]*(Sum[Sqrt[i]*d[i - 1][t]*d[i][t], {i, 0, n}]) +
Sqrt[i + 1]*
c[i + 1][
t]*(Sum[Sqrt[i + 1]*d[i - 1][t]*d[i][t], {i, 0, n}])),
d[i]'[t] == ((1/2)*i (i - 1) - q*i)*d[i][t] -
p*(Sqrt[i]*
d[i - 1][
t]*(Sum[Sqrt[i]*c[i - 1][t]*c[i][t], {i, 0, n}]) +
Sqrt[i + 1]*
d[i + 1][
t]*(Sum[
Sqrt[i + 1]*c[i - 1][t]*c[i][t], {i, 0, n}]))}, {i, 0,
n}], {Sum[(c[i][t]^2), {i, 0, n}] == 1,
Sum[(d[i][t]^2), {i, 0, n}] == 1, c[0][0] == 0.004567,
d[0][0] == 0.004567}, Table[c[i][0] == 0.0000000034, {i, 1, 5}],
Table[d[i][0] == 0.0000000034, {i, 1, 5}]]];
vars1 = Table[c[i][t], {i, 0, 5}];
vars2 = Table[d[i][t], {i, 0, 5}];
vars = Join[vars1, vars2];
I now get this error.
NDSolve::overdet: There are fewer dependent variables,
{c[0][t],c[1][t],c[2][t],c[3][t],c[4][t],c[5][t],d[0][t],d[1][t],d[2][t],d[3][t],d[4][t],d[5][t]},
than equations, so the system is overdetermined. >>
Not surprising, I think. I suspect those algebraic constraints will
indeed make it overdetermined. When I comment out the two sum
constraints I then get a solution set.
Daniel Lichtblau
Wolfram Research