1
$\begingroup$

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

$\endgroup$

1 Answer 1

1
$\begingroup$

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}]  

Figure 1

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} 
$\endgroup$
7
  • $\begingroup$ Hi, thanks for the answer. What do you mean by "removing the '=='"? If the equal signs are removed, how does mathematic solve the equations? $\endgroup$ May 3, 2022 at 9:15
  • $\begingroup$ @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. $\endgroup$ May 3, 2022 at 11:31
  • $\begingroup$ 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? $\endgroup$ May 3, 2022 at 11:34
  • $\begingroup$ @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. $\endgroup$ May 3, 2022 at 11:46
  • 1
    $\begingroup$ @bobthelegend You are welcome! $\endgroup$ May 3, 2022 at 14:05

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.