Techniques to solve complicated simultaneous equations

Question

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.

Equations: https://docs.google.com/document/d/1aGpOQuZ9jDdzX9dUTMTtQYMfE0f5ySEKAqslnT5g5R8/edit?usp=sharing

Answer 1

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}