# Techniques to solve complicated simultaneous equations

I want to solve 5 equations simultaneously for 5 variables (N2[t],TT[t],PP'[t],SS'[t],z1'[t], code attached at the end of the post).

The equations are extremely long and complicated. I have tried using both NSolve and FindRoot. NSolve takes forever to run while 'FindRoot' gives me imaginary solutions, and the solutions vary greatly when I make minor adjustments to the starting values.

For example, FindRoot[eqnlist, {{TT[t], 1}, {N2[t], 1}, {SS'[t], 10}, {PP'[t] , 10}, {z'[t], 0.5} }] gives me {TT[t] -> 0.841069 - 1.21403*10^-12 I, N2[t] -> 0.00465752 + 0.00174916 I, Derivative[1][SS][t] -> 0.000664034 - 33.0891 I, Derivative[1][PP][t] -> -0.000975051 + 49.6336 I, Derivative[1][z][t] -> -6.27545*10^-6 - 1.62921*10^-6 I}

while changing to {z'[t], 0.4} gives me {TT[t] -> 0.841069 + 1.16717*10^-12 I, N2[t] -> -5.3095*10^-6 - 0.0000693473 I, Derivative[1][SS][t] -> -8.66276*10^-6 - 33.0891 I, Derivative[1][PP][t] -> 0.0000129935 + 49.6337 I, Derivative[1][z][t] -> 4.72639*10^-9 + 6.44207*10^-9 I}

Is there any efficient and reliable way to solve such complicated simultaneous equations to obtain all the real solutions? Thank you.

P.S. After staring at the equations for a while, equation 1, 2 and 4 only depend on 3 variables while equation 3 and 5 depend on all 5 variables.

## 1 Answer

There are mixture of exact numbers and real numbers with several digits like 0.05886 in eqnlist, therefore we can't use WorkingPrecision higher then $MachinePrecision as an option in FindRoot. To solve this problem we can use NMinimize. First, remove all == from eqnlist with eq = Table[ eqnlist[[i]][[1]] - eqnlist[[i]][[2]], {i, Length[eqnlist]}];  and use it as follows sol = NMinimize[eq . Conjugate[eq], {TT[t], N2[t], SS'[t], PP'[t], z'[t]}, MaxIterations -> 1000, PrecisionGoal -> 5, AccuracyGoal -> 5] Out[]= {1.356*10^-6, {TT[t] -> 0.841065, N2[t] -> 24.7031, Derivative[1][SS][t] -> -0.0946177, Derivative[1][PP][t] -> -0.015582, Derivative[1][z][t] -> -0.000194137}}  Second, use sol with FindRoot in the form  sol1 = FindRoot[Table[eq[[i]] Conjugate[eq[[i]]] == 0, {i, Length[eq]}], Table[{var[[i]], var[[i]] /. sol[[2]]}, {i, Length[var]}], MaxIterations -> 1000, PrecisionGoal -> 6, AccuracyGoal -> 6] Out[]= {TT[t] -> 0.841069, N2[t] -> 24.5294, Derivative[1][SS][t] -> -0.00237493, Derivative[1][PP][t] -> -0.000395797, Derivative[1][z][t] -> -4.92941*10^-6}  Let check that eq been solved with maximal error of $$2.37\times 10^{-5}$$ Table[eq [[i]], {i, 5}] /. sol1 Out[]= {-4.92942*10^-6, -0.0000237491, -0.000010477, \ -4.13951*10^-9, -1.76118*10^-6}  Hence the value z'[t] needs to be recalculated. We can plot eq as function of z'[t] as Plot[Log[eq . Conjugate[eq] /. Drop[sol1, -1]], {z'[t], -10^-4, 0}]  The minimal value of eq . Conjugate[eq] is about $$10^{-21}$$ it is why we can't solve this problem with $MachinePrecision using FindRoot. Now we can try

sol2=NMinimize[{Log[eq . Conjugate[eq] /. Drop[sol1, -1]],
z'[t] < 0}, z'[t]]

Out[]= {-21.0926, {Derivative[1][z][t] -> -2.95916*10^-6}}


Let check how we improve solution

Table[eq [[i]], {i, 5}] /. Join[Drop[sol1, -1], sol2[[2]]]

Out[]= {-2.95917*10^-6, -0.0000237491, -0.0000104769, \
-4.13951*10^-9, -2.93993*10^-6}


Compare to that find above with sol1 we improve first and last equations. We can recommend turn all numbers to rational and use option WorkingPrecision -> 40 with sol1 as starting point in FindRoot as follows

eq1 = Rationalize[eq, 10^-30];

sol3 =
FindRoot[Table[eq1[[i]] Conjugate[eq1[[i]]] == 0, {i, Length[eq1]}],
Table[{var[[i]], var[[i]] /. sol1}, {i, Length[var]}],
AccuracyGoal -> 18, PrecisionGoal -> 20, WorkingPrecision -> 40,
MaxIterations -> 10000]

During evaluation of In[63]:= FindRoot::cvmit: Failed to converge to the requested accuracy or precision within 10000 iterations.

Out[63]= {TT[t] -> 0.8410686705679302557765250318264307467021,
N2[t] -> 24.52500016238743443940870727557720488810,
Derivative[1][SS][
t] -> -8.834618704174150338967041790049095324767*10^-8,
Derivative[1][PP][
t] -> -1.472436452169582384601225318143779829260*10^-8,
Derivative[1][z][
t] -> -1.833168600179621480183988024023755387758*10^-10}


This solution not converges but we can check that eq1 satisfies with maximal error of $$8.83\times 10^{-10}$$

eq1 /. sol3

Out[]= {-1.833168600179621480*10^-10, \
-8.8346187050584847358310728019304536898*10^-10, -3.8972984275*10^-10,
0.*10^-21, 2.83945093*10^-11}

• Hi, thanks for the answer. What do you mean by "removing the '=='"? If the equal signs are removed, how does mathematic solve the equations? May 3, 2022 at 9:15
• @bobthelegend Actually we remove == to use NMinimize with eq . Conjugate[eq] then we use this solution as initial point for FindRoot with Table[eq[[i]] Conjugate[eq[[i]]] == 0, {i, Length[eq]}] to compute real roots. May 3, 2022 at 11:31
• May I know how eq looks like? For example the equation in eqnlist may look like a==b, so after you remove the "==", it will just be ab? May 3, 2022 at 11:34
• @bobthelegend It looks as a-b then we can use it as (a-b)^2 for minimization or as equation a-b==0 as well. May 3, 2022 at 11:46
• @bobthelegend You are welcome! May 3, 2022 at 14:05