Finding zeros with ratios

Question

I have a function that reads:

f[P_?NumericQ, 
Ob_?NumericQ] := -Sqrt[P/Ob^2 + Sqrt[P^2 + Ob^2 w^2]/Ob^2] Tan[
 Sqrt[-(P/Ob^2) + Sqrt[P^2 + Ob^2 w^2]/Ob^2]] + 
 Sqrt[-(P/Ob^2) + Sqrt[P^2 + Ob^2 w^2]/Ob^2]
 Tanh[Sqrt[P/Ob^2 + Sqrt[P^2 + Ob^2 w^2]/Ob^2]]

For each pair of numerical values of P and Ob, there are infinitely many solutions for w (denoted as w0, w1, w2, w3, ...).

I want to write a concise code that does the following:

1. Loops over values of Ob from 0 to 1.
2. For each value of Ob, finds a critical value of P (Pcr) that makes the ratio of w2/w1 approximately equal to 3 (with reasonable tolerance).
3. Stores or outputs these critical values of P for each Ob. I tried but couldn't come up with a successful one. Thanks for any help in advance.

Below is one of my trials:

     Remove["Global`*"];
     tolerance = 0.05;
     results = {};

     For[ObValue = 0.01, ObValue <= 1, ObValue += 0.01, 
    For[P = 0.01, P <= 1, P += 0.01,(*Add a loop for P values*)
    roots = NSolve[f[P, ObValue] == 0 && 0 < w < 20, w, Reals];
    If[Length[roots] > 1, w1 = w /. roots[[1]];
    w2 = w /. roots[[2]];
    Pcr = FindRoot[Abs[w2/w1 - 3] <= tolerance, {P, .1}];
    If[NumberQ[P /. Pcr], AppendTo[results, {ObValue, P /. Pcr}]; 
  Break[];] (*Exit P loop if critical value found*)];];];

results

Answer 1

With your function f[ ] as above, you can see the output of the function for a specific value. For example

f[0.1,0.2]

gives a formula with 2 terms, each with a square root and a tanh.

NSolve doesn't work on this

NSolve[f[0.1,0.2]==0,w] 

it just sits there. So let's try FindRoot:

FindRoot[f[0.1, 0.2] == 0, {w, 1}]

this returns

{w -> 3.43538}

almost immediately. You can do this for many starting values of w in a number of ways. For example:

Table[FindRoot[f[0.1, 0.2] == 0, {w, w0}], {w0, 1, 50}]

spits out 50 different terms, some of them redundant (which you would likely want to remove). Then you can iterate over different values of P and Ob.

If you only want the value near 3.4, you can do:

FindRoot[f[0.1, 0.2] == 0, {w, Pi}]

To iterate this over Ob, you might do:

Table[FindRoot[f[0.1, Ob] == 0, {w, Pi}], {Ob, 0.1, 2, 0.1}]

which gives a variety of answers, one for each Ob value.