0
$\begingroup$

This is my code defining two nonlinear equations. I want to solve them simultaneously.

order = 1;
m = 1; 
g = 9.81; 
ks = 100 ;
omega2 = Sqrt[ks/m]; 
R = -0.7;

Hp0[k_, l_] := 2*m*g*l*k^2;
Hs0[Js_] := omega2*Js;
Jp[k_, l_] := 8*m*l^2*Sqrt[g/l]/Pi * ( EllipticE[k^2] - (1 -k^2)*EllipticK[k^2]);
q[k_] := Exp[-Pi*EllipticK[1 - k^2]/EllipticK[k^2]];
coeff[k_, Js_, n_] := 
  6*m*g*Sqrt[2*Js/m/omega2] / EllipticK[k^2]^2 * Pi^2 * n*q[k]^n/(1 - q[k]^(2*n));
phipdot[k_, Js_, n_, l_] := 
  D[Hp0[k, l], k]/D[Jp[k, l], k] + D[coeff[k, Js, n], k]/D[Jp[k, l], k];
phisdot[k_, Js_, n_] := omega2 + D[coeff[k, Js, n], Js];

(* Equation1 is 2n*phi_p_dot-phi_s_dot == 0 *)
Equation1[k_, Js_, n_, l_] := 2*n*phipdot[k, Js, n, l] - phisdot[k, Js, n];
(* Equation2 is Hamiltonian is constant *)
Equation2[k_, Js_, n_, l_] := Hp0[k, l] + Hs0[Js] + coeff[k, Js, n];

I want to solve for Equation1 = 0 and Equation2 = 0 for n = 1 and l = 1.

$\endgroup$
2
  • $\begingroup$ Your title and question are not consistent about the desired value of n. Should it be 1 or 2? Please edit question to clarify rather than responding with a comment. $\endgroup$
    – Bob Hanlon
    Oct 2, 2018 at 15:00
  • 1
    $\begingroup$ Talking a bit about where these equations came from might be helpful in solving your problem. $\endgroup$ Oct 2, 2018 at 15:49

1 Answer 1

1
$\begingroup$

This is a partial investigation. I replaced your Equation1 with

ClearAll[Equation1];

Equation1[k_, Js_, n_, l_] := 
  Evaluate[2*n*phipdot[k, Js, n, l] - phisdot[k, Js, n]];

This gets the derivative done at the definition stage. Otherwise you are giving k a value and then asking it to do symbolic differentiation with a number not a variable.

I then did

ContourPlot[{Equation1[k, Js, 1, 1] == 0}, {k, -2, 2}, {Js, -10, 10}]

Mathematica graphics

This gives the contour along which Equation1 equals zero. We now need to find a similar contour for Equaiton2. However, I could not find values where this happened. Then I did this to look at typical values of Equation2.

Plot[Evaluate@Table[Equation2[k, Js, 1, 1], {Js, 0, 10, 1}], {k, -2, 
  2}, PlotRange -> {All, {0, 200}}, 
 PlotLegends -> LineLegend[Range[0, 10, 1]]]

Mathematica graphics

This does not suggest there is a parameter range where Equation2 is zero except for the case Js =0 and k = 0.

Do you know ranges for k and Js?

Hope that helps.

$\endgroup$
2
  • $\begingroup$ range of k is from 0 to 1. range of Js we do not know. $\endgroup$ Oct 3, 2018 at 7:04
  • $\begingroup$ Well it looks like Js =0 is the only solution. Have you tried to take my last plot further with a wider range for Js? Does the function go down towards zero again? $\endgroup$
    – Hugh
    Oct 3, 2018 at 7:44

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service and acknowledge you have read our privacy policy.

Not the answer you're looking for? Browse other questions tagged or ask your own question.