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