0
$\begingroup$

I want to find the nearest 50(or 80, even 100)solutions under 1.4628 from big to small, I tried FindInstance function in MMA, but still cannot get the desired results I need.Here is my code:

Clear["Global'*"];
$RecursionLimit = Infinity;
nco = 1.4681; ncl = 1.4628; nair = 1; rco = 4.2*10^3; rcl = 
 62.5*10^3; \[CapitalDelta]n = ncl - nair;
wl = 1000;
u = 2*\[Pi]*rcl*((ncl^2 - neffcl^2)^((1/2))/wl);
w = 2*\[Pi]*rcl*((neffcl^2 - nair^2)^((1/2))/wl);
J0 = BesselJ[0, u]; J1 = BesselJ[1, u];
K0 = BesselK[0, w]; K1 = BesselK[1, w];
N[
 FindInstance[
  J1/(u*J0) == (1 - 2*\[CapitalDelta]n)*(K1/(w*K0)) && 
   1.45 < neffcl < 1.463, neffcl, PositiveReals, 50]
 ]
TM
Plot[{J1/(u*J0), (1 - 2*\[CapitalDelta]n)*(K1/(w*K0))}, {neffcl, -2, 
  2}]
Plot[{J1/(u*J0), (1 - 2*\[CapitalDelta]n)*(K1/(w*K0))}, {neffcl, 
  1.453, 1.463}, PlotRange -> {-0.005, 0.005}]

I plotted two pictures, the first one represent the solutions of the unsolved function, and in the 2nd one, I plotted the formula with neffcl from 1.453 to 1.463.

As for the given results, we can see that MMA only returns 15 solutions, not 50 I set, but we can see both in the first and 2nd picture that there is absolutely more than 15 solutions for my formula, here is what MMA returns:

{{neffcl -> 1.45092}, {neffcl -> 1.45193}, {neffcl -> 
1.45289}, {neffcl -> 1.4538}, {neffcl -> 1.45467}, {neffcl -> 
   1.45549}, {neffcl -> 1.45628}, {neffcl -> 1.45701}, {neffcl -> 
   1.45835}, {neffcl -> 1.45951}, {neffcl -> 1.4622}, {neffcl -> 
   1.46241}, {neffcl -> 1.46257}, {neffcl -> 1.46269}, {neffcl -> 
   1.46277}}

enter image description here picture1 enter image description here Picture2

Somebody can tell me what is wrong with my code and how can I make it work? Thanks in advance!

$\endgroup$

1 Answer 1

2
$\begingroup$
Clear["Global'*"];

nco = 1.4681 // Rationalize; 
ncl = 1.4628 // Rationalize; 
nair = 1; 
rco = 4.2*10^3 // Rationalize; 
rcl = 62.5*10^3 // Rationalize; 
Δn = ncl - nair;
wl = 1000;
u = 2*π*rcl*((ncl^2 - neffcl^2)^((1/2))/wl);
w = 2*π*rcl*((neffcl^2 - nair^2)^((1/2))/wl);
J0 = BesselJ[0, u];
J1 = BesselJ[1, u];
K0 = BesselK[0, w]; K1 = BesselK[1, w];

eqn = J1/(u*J0) == (1 - 2*Δn)*(K1/(w*K0)) // FullSimplify;

To find a large number of solutions you need to widen the interval, e.g., 6/5 < neffcl < 1463/1000

sol = NSolve[{eqn, 6/5 < neffcl < 1463/1000}, neffcl, 
   WorkingPrecision -> 15];

Length@sol

(* 100 *)

Plot[{J1/(u*J0), (1 - 2*Δn)*(K1/(w*K0))},
 {neffcl, 6/5, 1463/1000},
 PlotRange -> {-0.005, 0.005},
 Epilog -> {Red, AbsolutePointSize[4],
   Tooltip[Point[{neffcl, J1/(u*J0)}], neffcl] /. sol},
 ImageSize -> Large,
 WorkingPrecision -> 15]

enter image description here

EDIT: Re your comment

sol[[-1]]

(* {neffcl -> 1.46219836998378} *)

Since NSolve is numeric, i.e., inexact solver; there is no guarantee that all roots are found. Tightening the interval can give different results. With a tighter interval, you can switch to an exact solver (Solve or Reduce).

(sol2 = Solve[{eqn, 146/100 < neffcl < 1463/1000}, neffcl, 
    Method -> Reduce]) // N[#, 15] &

(* Solve::incs: Warning: Solve was unable to prove that the solution set found is complete.

{{neffcl -> 1.46002938826877}, {neffcl -> 1.46050070411957}, {neffcl -> 
   1.46092804493494}, {neffcl -> 1.46131144933488}, {neffcl -> 
   1.46165095192033}, {neffcl -> 1.46194658328016}, {neffcl -> 
   1.46219836998378}, {neffcl -> 1.46240633453443}, {neffcl -> 
   1.46257049518216}, {neffcl -> 1.46269086505254}, {neffcl -> 
   1.46276744566539}} *)

Note however that the exact solver indicates that the results may not be complete. Tighten the interval until the results do not change.

(sol3 = Solve[{eqn, 14622/10000 < neffcl < 1463/1000}, neffcl, 
    Method -> Reduce]) // N[#, 15] &

(* Solve::incs: Warning: Solve was unable to prove that the solution set found is complete.

{{neffcl -> 1.46240633453443}, {neffcl -> 1.46257049518216}, {neffcl -> 
   1.46269086505254}, {neffcl -> 1.46276744566539}} *)

While the warning is still present, the results in the common interval are identical.

sol3 === sol2[[-4 ;;]]

(* True *)
$\endgroup$
1
  • $\begingroup$ Thanks for your patience on this question, but it seems that there is still some problem that remains to be sovled. We can see that in my results I posted, the biggest neffcl value I got is 1.46277, which is very close to 1.4628. Then in your code, the biggest neffcl returned is 1.4622, there is some difference between the two numbers. I then changed the solve range of neffcl, making it 1.45->1.463, I got the same results like I posted, I don't know why would this happen, and how to chose a proper neffcl range for such a problem. $\endgroup$
    – Levin Koo
    Oct 2, 2021 at 10:49

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.