3 deleted 14 characters in body edited Jul 28 '15 at 21:14 user31001 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}, {3-0.05, 800}20}, {1}] {{-1.2873402582429673, 414.62463948474493800}}, {2.6101985365488636, 820.8522532621079}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]}] In the range near zero there is no crossing. Verify: ContourPlot[{S1 == 0, S2 == 0}, {phip, -0.2, 0.3}, {t, 0, 20100}, PlotTheme -> "Detailed", PlotPoints -> 100]100, Epilog -> {Red, PointSize[Large], Point[p]}]  A question, how can I insert plots here? 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}, {3, 800}}, {1}] {{-1.287340258242967, 414.62463948474493}, {2.6101985365488636, 820.8522532621079}}   ContourPlot[{S1 == 0, S2 == 0}, {phip, -2, 3}, {t, 0, 1000}, PlotTheme -> "Detailed", PlotPoints -> 100, Epilog -> {Red, PointSize[Large], Point[p]}] In the range near zero there is no crossing. Verify: ContourPlot[{S1 == 0, S2 == 0}, {phip, -0.2, 0.3}, {t, 0, 20}, PlotTheme -> "Detailed", PlotPoints -> 100] A question, how can I insert plots here? 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? 2 added 144 characters in body edited Jul 28 '15 at 18:33 user31001 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}, {3, 800}}, {1}] {{-1.287340258242967, 414.62463948474493}, {2.6101985365488636, 820.8522532621079}} ContourPlot[{S1 == 0, S2 == 0}, {phip, -2, 3}, {t, 0, 1000}, PlotTheme -> "Detailed", PlotPoints -> 100, Epilog -> {Red, PointSize[Large], Point[p]}] In the range near zero there is no crossing. Verify: ContourPlot[{S1 == 0, S2 == 0}, {phip, -0.2, 0.3}, {t, 0, 20}, PlotTheme -> "Detailed", PlotPoints -> 100] A question, how can I insert plots here? 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}, {3, 800}}, {1}] {{-1.287340258242967, 414.62463948474493}, {2.6101985365488636, 820.8522532621079}} ContourPlot[{S1 == 0, S2 == 0}, {phip, -2, 3}, {t, 0, 1000}, PlotTheme -> "Detailed", PlotPoints -> 100, Epilog -> {Red, PointSize[Large], Point[p]}]  In the range near zero there is no crossing. Verify: ContourPlot[{S1 == 0, S2 == 0}, {phip, -0.2, 0.3}, {t, 0, 20}, PlotTheme -> "Detailed", PlotPoints -> 100]  A question, how can I insert plots here? 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}, {3, 800}}, {1}] {{-1.287340258242967, 414.62463948474493}, {2.6101985365488636, 820.8522532621079}} ContourPlot[{S1 == 0, S2 == 0}, {phip, -2, 3}, {t, 0, 1000}, PlotTheme -> "Detailed", PlotPoints -> 100, Epilog -> {Red, PointSize[Large], Point[p]}] In the range near zero there is no crossing. Verify: ContourPlot[{S1 == 0, S2 == 0}, {phip, -0.2, 0.3}, {t, 0, 20}, PlotTheme -> "Detailed", PlotPoints -> 100] A question, how can I insert plots here? 1 answered Jul 28 '15 at 17:43 user31001 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}, {3, 800}}, {1}] {{-1.287340258242967, 414.62463948474493}, {2.6101985365488636, 820.8522532621079}} ContourPlot[{S1 == 0, S2 == 0}, {phip, -2, 3}, {t, 0, 1000}, PlotTheme -> "Detailed", PlotPoints -> 100, Epilog -> {Red, PointSize[Large], Point[p]}]  In the range near zero there is no crossing. Verify: ContourPlot[{S1 == 0, S2 == 0}, {phip, -0.2, 0.3}, {t, 0, 20}, PlotTheme -> "Detailed", PlotPoints -> 100]  A question, how can I insert plots here?