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

```

• Prev by Date: Re: k-permutations enumeration
• Next by Date: Re: 3D surface plots - non deletion of data inside undesirable
• Previous by thread: ndsolve of coupled equation
• Next by thread: Solids of revolution