# solving non-linear set of equations using NSolve in order to get all roots

vpw = 3.3
Mp = 80
rp = 0.014*Mp
b0 = 26.31016273 - (1.7168*10^3/t) - 3.5519*Log[t]
b1 = 24.65681838 - (1.547*10^3/t) - 3.4314*Log[t]
b2 = 9.080370819 - (6.9445*10^2/t) - 1.2222*Log[t]
g = b0 + b1*phip + b2*phip^2
dg = b1 + 2*b2*phip
ddg = 2*b2
dddg = 0

S1 = (1/(phip*rp*vpw)) + (1/(1 - phip)) - (2*g - 2*(1 - 2*phip)*dg - phip*(1 - phip)*ddg)
S2 = -(1/(phip^2*rp*vpw)) + (1/(1 - phip)^2) - (6*dg - 3*(1 - 2*phip)*ddg -
phip*(1 - phip)*dddg)


I have tried FindRoot to solve S1==0 and S2==0 but it gives only one root which may be real or imaginary depending upon initial guess.

In order to get all real roots, I am trying to solve S1==0 and S2==0 by using NSolve. But it takes too long time and does not give any solution.

In order to get all possible real roots of above non-linear equations, please suggest me the possible solution of my problem. Thanks in advance and Regards

• Just to clarify: You want to solve for t and phip? – sebhofer Jul 28 '15 at 12:36
• Here goes a numerical solution for you {phip -> -1.2873402582429818, t -> 414.62463948474345}. As far as I can see there is no real root for t<0. Also using Plot3D I doubt if there is any solution to {S1==0, S2==0} for t>0 and phip>1. Function is also unbounded in that region. – PlatoManiac Jul 28 '15 at 12:51

vpw = 3.3;
Mp = 80;
rp = 0.014*Mp;
b0 = 26.31016273 - 1.7168*(10^3/t) - 3.5519*Log[t];
b1 = 24.65681838 - 1.547*(10^3/t) - 3.4314*Log[t];
b2 = 9.080370819 - 6.9445*(10^2/t) - 1.2222*Log[t];
g = b0 + b1*phip + b2*phip^2;
dg = b1 + 2*b2*phip;
ddg = 2*b2;
dddg = 0;

S1 = 1/(phip*rp*vpw) + 1/(1 - phip) - (2*g - 2*(1 - 2*phip)*dg -
phip*(1 - phip)*ddg);
S2 = -(1/(phip^2*rp*vpw)) + 1/(1 - phip)^2 -
(6*dg - 3*(1 - 2*phip)*ddg - phip*(1 - phip)*dddg);

p = Apply[{phip, t} /. FindRoot[{S1 == 0, S2 == 0}, {phip, #1}, {t, #2}] & ,
{{-2, 400}, {-0.05, 20}, {3, 800}}, {1}]


{{-1.28734, 414.625}, {-0.0436006, 23.3922}, {2.6102, 820.852}}

ContourPlot[{S1 == 0, S2 == 0}, {phip, -2, 3}, {t, 0, 1000},
PlotTheme -> "Detailed", PlotPoints -> 100,
Epilog -> {Red, PointSize[Large], Point[p]}]


   ContourPlot[{S1 == 0, S2 == 0}, {phip, -0.2, 0.3}, {t, 0, 100},
PlotTheme -> "Detailed", PlotPoints -> 100,
Epilog -> {Red, PointSize[Large], Point[p]}]


A question, how can I insert plots here?

• Use "Save Selection As" in Mathematica, save the plot as a gif or other format, use the image selector to place it in your post (sixth icon from the left). – Daniel Lichtblau Jul 28 '15 at 17:49