Solving coupled differential equation with Neumann boundary conditions?

Questions
, ,
1

I am trying to solve coupled differential equations with Neumann BCs which are dx[n,t]/dn =0 when n=0 and dx[n,t]/dn =0 wnen n=90
but After adding Neumann BCs, it shows error message that these Dirichlet BCs need to be linear but I need to solve these eqs with Neumann BCs But it is not accepting those.

NDSolve[{D[x[n, t], t] == D[x[n, t], {n, 2}] - q[n, t] x[n, t], D[q[n, t], t] == -q[n, t] Exp[x[n, t]], (D[x[n, t], n] /. n -> 0) == 0, (D[x[n, t], n] /. n -> 90) == 0}, {x[n, t], q[n, t]}, {n, 0, 90}, {t, 0, 10}]

and if I put conditions like D[x[0.t],n] ==0 and D[x[90,t],n]==0 then it shows “equation or list of equations expected instead of True in the first argument”

Is there any other way to do so?
Please look into this.

2

Shruti,

You need to specify Neumann conditions with the NeumannValue[] function or by specifying the derivative directly like this. You also must specify some initial conditions for x and q (Dirichlet conditions).

s = NDSolve[{D[x[n, t], t] == D[x[n, t], {n, 2}] - q[n, t] x[n, t], 
   D[q[n, t], t] == -q[n, t] Exp[x[n, t]], x[n, 0] == 0.01, 
   q[n, 0] == 0.01, Derivative[1, 0][x][0, t] == 0.0, 
   Derivative[1, 0][x][90, t] == 0}, {x[n, t], q[n, t]}, {n, 0, 
   90}, {t, 0, 10}]
Plot3D[x[n, t] /. s, {n, 0, 90}, {t, 0, 10}, PlotRange -> All]

I made up some conditions because you did not specify any:

x[n, 0] == 0.01, q[n, 0] == 0.01

Now the problem solves. You can specify more interesting initial conditions for x and q as long as you respect the derivative constraints at the two ends.

Here is an example in which I made up a complex function for x over the range of n=0 to n=90. The Sin function is flat at n=0 and n=90 (the two peaks) and dips in between. I also added a slope of 0.005 between n=0 and n=90 to make it more interesting. Note that I also needed to add the slope 0f 0.005 to the derivatives to make everything consistent.

s = NDSolve[{D[x[n, t], t] == D[x[n, t], {n, 2}] - q[n, t] x[n, t], 
   D[q[n, t], t] == -q[n, t] Exp[x[n, t]], 
   x[n, 0] == Sin[(n + 90/4)* 2*Pi/90] + 0.005*n, q[n, 0] == 0.01, 
   Derivative[1, 0][x][0, t] == 0.005, 
   Derivative[1, 0][x][90, t] == 0.005}, {x[n, t], q[n, t]}, {n, 0, 
   90}, {t, 0, 10}]
Plot3D[x[n, t] /. s, {n, 0, 90}, {t, 0, 10}, PlotRange -> All]

If you look at the plot, you can see its all consistent.

Regards

Neil

3

For completeness, here is the same solution using NeumannValue:

s1 = NDSolve[{D[x[n, t], t] == 
    D[x[n, t], {n, 2}] - q[n, t] x[n, t] + 
     NeumannValue[0.005, n == 0] + NeumannValue[0.005, n == 90], 
   D[q[n, t], t] == -q[n, t] Exp[x[n, t]], 
   x[n, 0] == Sin[(n + 90/4)* 2*Pi/90] + 0.005*n, 
   q[n, 0] == 0.01}, {x[n, t], q[n, t]}, {n, 0, 90}, {t, 0, 10}]
Plot3D[x[n, t] /. s1, {n, 0, 90}, {t, 0, 10}, PlotRange -> All]
Plot3D[(x[n, t] /. s) - (x[n, t] /. s1), {n, 0, 90}, {t, 0, 10}, 
 PlotRange -> All]

The last plot compares (subtracts) the two solutions to get zero.

4

Thanks a lot, Neil. It is really helpful.

5

Neil.. after getting Plot3D, I tried Plot[x[20,t],{t,0,100}]
It shows blank for any value of n.

Am I doing something wrong or something else is required?.. Plz, look into this.

6

Shruti,

You need to do this:

Plot[(x[n, t] /. s /. n -> 20) , {t, 0, 10}, PlotRange -> All]

You want to plot x[n,t] using the solution, s:

x[n,t] /. s

s has a substitution rule for x and q in the form of an interpolation function. you need to apply that rule to tell Mathematica what solution you want, x[n,t] or q[n,t]. After that you can substitute in values for n and/or t using /. n->20 or /. t-> 5, etc.

Regards,

Neil