NSolve, no output

Question

I want to eventually solve this with these three parameters being given from a list or table. It is not returning a solution, but I know that there is a 0 of this function (from looking at the plot)

NSolve[-((2 #2^2 #1 (1 - BesselK[0, r #3]/BesselK[0, #2 #3])^2)/
  r^3) + (2 (1 + #2^2/r^2) #1 #3 (1 - BesselK[0, r #3]/
    BesselK[0, #2 #3]) BesselK[1, r #3])/BesselK[0, #2 #3] == 0.0,
r] &[0.1, 5, 1.5]

What am I doing wrong?

Answer 1

If you ask Solve to work over a finite domain, than it can use interval techniques to find all roots in the domain:

Solve[
    -((2 #2^2 #1 (1-BesselK[0,r #3]/BesselK[0,#2 #3])^2)/r^3)+
    (2 (1+#2^2/r^2) #1 #3 (1-BesselK[0,r #3]/BesselK[0,#2 #3]) 
    BesselK[1,r #3])/BesselK[0,#2 #3]==0 && 0<r<10, r
]&[.1,5,1.5]

Solve::ratnz: Solve was unable to solve the system with inexact coefficients. The answer was obtained by solving a corresponding exact system and numericizing the result.

{{r -> 5.}, {r -> 7.27748}}

Answer 2

For (non-elementary) transcendental equations, you usually have to specify a finite domain, as Carl Woll advises. But NSolve suffers from the same bug in V11.1 in this case as found in Backslide in NSolve in V11.1?.

Reduce`RealTNRoots;
nonElementaryQ[f_] := Module[{x}, ! ListQ[Simplify`FunctionSingularities[f[x], x, "ELEM"]]]
Internal`InheritedBlock[{System`TRootsDump`NIntervalRoots},
 System`TRootsDump`NIntervalRoots[f_?nonElementaryQ, ii_, prec_] := $Failed;
 NSolve[-((2 #2^2 #1 (1 - BesselK[0, r #3]/BesselK[0, #2 #3])^2)/
          r^3) + (2 (1 + #2^2/r^2) #1 #3 (1 - 
            BesselK[0, r #3]/BesselK[0, #2 #3]) BesselK[1, r #3])/
        BesselK[0, #2 #3] == 0.0 && 0 < r < 10, r] &[0.1, 5, 1.5]
 ]
(*  {{r -> 5.}, {r -> 7.27748}}  *)

This fix is borrowed from this answer; the other answer works as well, but with a warning.

Answer 3

eq = -((5. (1 - 4013.201565307701 BesselK[0, 1.5 r])^2)/r^3) + 1203.9604695923106 
       (1 + 25/r^2) (1 -4013.201565307701 BesselK[0, 1.5 r]) BesselK[1, 1.5 r];

Plot[eq == 0, {r, -10, 10}, PlotRange -> {{4, 10}, {-0.1, 0.15}}]

NSolve[{eq == 0 && (4 <= r <= 8)}, r]

{{r -> 5.}, {r -> 7.27748}}

Plot[eq, {r, 4, 10}, Epilog -> {Red, PointSize[.03],  Point[{r, eq}] 
         /. NSolve[{eq == 0 && (4 <= r <= 8)}, r]}]