Message Boards Message Boards

GROUPS:

Solving a differential equation using DSolve: no output

Posted 4 months ago
871 Views
|
3 Replies
|
0 Total Likes
|

Hi everyone.
I try to solve the coupled differential equations that you can see in the notebook. But Mathematica can't find a solution and just returns the 2 differential equations, even though there exists a non-trivial solution. If W1[x] and W2[x] are linear and W1[x] = (2/R0)*W2[x] the equations are fulfilled. So, this is not the solution that I am interested in, but it shows that something is going wrong if Mathematica can't find it.
Does anyone know what it is?
Best. Luca

3 Replies

DSolve[]'s support for solving coupled differential equations is still somewhat limited,so don't be surprised if some things don't work yet.

A workaround:

ClearAll["`*"]; Remove["`*"];

eq1 =k Sech[(Sqrt[k] x)/(2 Sqrt[Dm])]^2 W1[x] + 
  1/2 k Sech[(Sqrt[k] x)/(2 Sqrt[Dm])]^2 Sinh[(Sqrt[k] x)/Sqrt[
    Dm]] W1[x] - (2 k Sech[(Sqrt[k] x)/(2 Sqrt[Dm])]^2 W2[x])/R0 - (
  k Sech[(Sqrt[k] x)/(2 Sqrt[Dm])]^2 Sinh[(Sqrt[k] x)/Sqrt[Dm]] W2[
    x])/R0 + Dm W1''[x] == 0;
eq2 =(Dc k R0 W1[x])/(4 Dm) + (
  Dc k R0 Tanh[(Sqrt[k] x)/(2 Sqrt[Dm])] W1[x])/(2 Dm) + (
  Dc k R0 Tanh[(Sqrt[k] x)/(2 Sqrt[Dm])]^2 W1[x])/(4 Dm) - (
  Dc k W2[x])/(2 Dm) - (Dc k Tanh[(Sqrt[k] x)/(2 Sqrt[Dm])] W2[x])/
  Dm - (Dc k Tanh[(Sqrt[k] x)/(2 Sqrt[Dm])]^2 W2[x])/(2 Dm) + 
  Dc W2''[x] == 0;


EQ = eq1 /. Solve[eq2, W1[x]] /. D[Solve[eq2, W1[x]], {x, 2}] // 
 FullSimplify

Solution for W2(x) :

 SOL = DSolve[EQ[[1]], W2[x], x] // Simplify
 (*{{W2[x] -> 
    C[3] + x C[4] + 
     1/6 ((3 Dm E^((Sqrt[k] x)/Sqrt[Dm]) C[1])/k - (6 Dm C[1])/(
        k + E^((Sqrt[k] x)/Sqrt[Dm]) k) + 6 x^2 C[1] - (
        Dm C[2])/((1 + E^((Sqrt[k] x)/Sqrt[Dm]))^2 k) + (4 Dm C[2])/(
        k + E^((Sqrt[k] x)/Sqrt[Dm]) k) - (2 Sqrt[Dm] x C[2])/Sqrt[
        k] - (6 Dm C[1] Log[E^((Sqrt[k] x)/Sqrt[Dm])]^2)/k + (
        2 Dm C[2] Log[1 + E^((Sqrt[k] x)/Sqrt[Dm])])/k + (
        6 Dm C[1] Log[E^((Sqrt[k] x)/Sqrt[
          Dm])] ((3 + 
            4 E^((Sqrt[k] x)/Sqrt[Dm]))/(1 + E^((Sqrt[k] x)/Sqrt[
             Dm]))^2 + 2 Log[1 + E^((Sqrt[k] x)/Sqrt[Dm])]))/k + (
        12 Dm C[1] PolyLog[2, -E^(((Sqrt[k] x)/Sqrt[Dm]))])/k)}}*)

Solution for W1(x) :

 (Solve[eq2, W1[x]] /. SOL /. D[SOL, {x, 2}])[[1, 1, 1]] // Simplify

        (*{W1[x] -> 
          1/(12 k R0)
            Sech[(Sqrt[k] x)/(
            2 Sqrt[Dm])]^2 (-3 Dm C[1] + 12 k x^2 C[1] + Dm C[2] - 
             4 Sqrt[Dm] Sqrt[k] x C[2] + 12 k C[3] + 12 k x C[4] + 
             3 Dm C[1] Cosh[(2 Sqrt[k] x)/Sqrt[Dm]] + 
             6 Dm C[1] Log[E^((Sqrt[k] x)/Sqrt[Dm])] - 
             12 Dm C[1] Log[E^((Sqrt[k] x)/Sqrt[Dm])]^2 + 
             4 Dm C[2] Log[1 + E^((Sqrt[k] x)/Sqrt[Dm])] + 
             24 Dm C[1] Log[E^((Sqrt[k] x)/Sqrt[Dm])] Log[
               1 + E^((Sqrt[k] x)/Sqrt[Dm])] + 
             Cosh[(Sqrt[k] x)/Sqrt[
               Dm]] (12 k x^2 C[1] + 3 Dm C[2] - 4 Sqrt[Dm] Sqrt[k] x C[2] + 
                12 k C[3] + 12 k x C[4] - 
                12 Dm C[1] Log[E^((Sqrt[k] x)/Sqrt[Dm])]^2 + 
                4 Dm C[2] Log[1 + E^((Sqrt[k] x)/Sqrt[Dm])] + 
                6 Dm C[1] Log[E^((Sqrt[k] x)/Sqrt[
                  Dm])] (3 + 4 Log[1 + E^((Sqrt[k] x)/Sqrt[Dm])])) + 
             48 Dm C[1] Cosh[(Sqrt[k] x)/(2 Sqrt[Dm])]^2 PolyLog[
               2, -E^(((Sqrt[k] x)/Sqrt[Dm]))] - 
             12 Dm C[1] Sinh[(Sqrt[k] x)/Sqrt[Dm]] - 
             3 Dm C[2] Sinh[(Sqrt[k] x)/Sqrt[Dm]] - 
             18 Dm C[1] Log[E^((Sqrt[k] x)/Sqrt[Dm])] Sinh[(Sqrt[k] x)/Sqrt[
               Dm]])}*)

An approach using a change of dependent variable:

origEqs = {(k + k Tanh[(Sqrt[k] x)/(2 Sqrt[Dm])] - 
        k Tanh[(Sqrt[k] x)/(2 Sqrt[Dm])]^2) (W1[x] - (2 W2[x])/R0) + 
     Dm (W1^\[Prime]\[Prime])[x] == 
    0, (Dc k R0 (1 + Tanh[(Sqrt[k] x)/(2 Sqrt[Dm])])^2 (W1[x] - (
        2 W2[x])/R0))/(4 Dm) + Dc (W2^\[Prime]\[Prime])[x] == 0};
substitution = W1 -> Function[x, (2 W2[x])/R0 + f[x]];
newEqs = 
 Solve[origEqs /. substitution, {f''[x], W2''[x]}][[1]] /. 
  Rule -> Equal
solF = DSolve[newEqs[[1]], f, x][[1]]
solW2 = DSolve[newEqs[[2]] /. solF, W2[x], x][[1]] // PowerExpand // 
  Simplify
W1[x] -> (W1[x] /. substitution /. solF)

It is disappointing that Mathematica cannot solve the two new equation together

DSolve[newEqs, {f, W2}, x]

so that I am forced to solve separately the first equation and then replace into the second.

Thank you very much for your effort. I tried to convert the problem to one that Mathematica could handle but without success. So, thanks. Having your approaches is really helpful.

Reply to this discussion
Community posts can be styled and formatted using the Markdown syntax.
Reply Preview
Attachments
Remove
or Discard

Group Abstract Group Abstract