Services & Resources / Wolfram Forums / MathGroup Archive
-----

MathGroup Archive 2011

[Date Index] [Thread Index] [Author Index]

Search the Archive

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