How to force NMinimize to find the correct global minimum for equation with many local minima?

I have a function that I am unable to recover a solution for. Here, 0.533... and 0.428... are the exact solutions for Rs[399] and Rp[399], given a known nn1 and k. I am using NMinimize to recover the solution nn1 and k originally used to calculate those exact values by minimizing the difference between the solution and the function itself (I have tested some direct solving methods, but none have worked as well). If the variables in NMinimize are constrained close enough to the known solutions, it can find the global minimum. However, I am aiming to apply this solving method to problems where it would be unrealistic to constrain quite that closely (more realistic constraints are shown in the code below). Is there any way to further increase the likelihood that NMinimize picks the global minimum? I have tried several different methods, but none I have tested have fixed the issue thus far.

Subscript[n, 1] = nn1 + (I*k)
NMinimize[{Abs[0.533600799853412 - Rs[399]],
0. == Abs[0.4285443166333881 - Rp[399]] && nn1 > 0.01 &&
k > 0.01 && nn1 < 50 && k < 50}, {nn1, k},
Method -> {"SimulatedAnnealing", "PerturbationScale" -> 20},
AccuracyGoal -> 20, PrecisionGoal -> 20]


The correct solution would be nn1 = 3.392905674418965 and k = 2.411816858393506. Functions are shown below.

rs[\[Lambda]_] :=
(E^((4*I*Pi*Subscript[d, 1]*
Sqrt[(-Sin[\[Theta]]^2)*Subscript[n, 0]^2 +
Subscript[n, 1]^2])/\[Lambda])*
(Sqrt[Cos[\[Theta]]^2*Subscript[n, 0]^2] +
Sqrt[(-Sin[\[Theta]]^2)*Subscript[n, 0]^2 +

Subscript[n, 1]^2])*(Sqrt[(-Sin[\[Theta]]^2)*
Subscript[n, 0]^2 + Subscript[n, 1]^2] -

Sqrt[(-Sin[\[Theta]]^2)*Subscript[n, 0]^2 +
Subscript[n, 2]^2]) +
(Sqrt[Cos[\[Theta]]^2*Subscript[n, 0]^2] -
Sqrt[(-Sin[\[Theta]]^2)*Subscript[n, 0]^2 +

Subscript[n, 1]^2])*(Sqrt[(-Sin[\[Theta]]^2)*
Subscript[n, 0]^2 + Subscript[n, 1]^2] +

Sqrt[(-Sin[\[Theta]]^2)*Subscript[n, 0]^2 +
Subscript[n, 2]^2]))/
(E^((4*I*Pi*Subscript[d, 1]*
Sqrt[(-Sin[\[Theta]]^2)*Subscript[n, 0]^2 +
Subscript[n, 1]^2])/\[Lambda])*
(Sqrt[Cos[\[Theta]]^2*Subscript[n, 0]^2] -
Sqrt[(-Sin[\[Theta]]^2)*Subscript[n, 0]^2 +

Subscript[n, 1]^2])*(Sqrt[(-Sin[\[Theta]]^2)*
Subscript[n, 0]^2 + Subscript[n, 1]^2] -

Sqrt[(-Sin[\[Theta]]^2)*Subscript[n, 0]^2 +
Subscript[n, 2]^2]) +
(Sqrt[Cos[\[Theta]]^2*Subscript[n, 0]^2] +
Sqrt[(-Sin[\[Theta]]^2)*Subscript[n, 0]^2 +

Subscript[n, 1]^2])*(Sqrt[(-Sin[\[Theta]]^2)*
Subscript[n, 0]^2 + Subscript[n, 1]^2] +

Sqrt[(-Sin[\[Theta]]^2)*Subscript[n, 0]^2 + Subscript[n, 2]^2]))
Rs[\[Lambda]_] := rs[\[Lambda]]*Conjugate[rs[\[Lambda]]]
rp[\[Lambda]_] :=
((Cos[(2*Pi*Subscript[d, 1]*
Sqrt[(-Sin[\[Theta]]^2)*Subscript[n, 0]^2 +
Subscript[n, 1]^2])/\[Lambda]] +
(I*Sec[\[Theta]]^2*
Sin[(2*Pi*Subscript[d, 1]*
Sqrt[(-Sin[\[Theta]]^2)*Subscript[n, 0]^2 +
Subscript[n, 1]^2])/\[Lambda]]*
Sqrt[Cos[\[Theta]]^2*Subscript[n, 0]^2]*

Sqrt[(-Sin[\[Theta]]^2)*Subscript[n, 0]^2 +
Subscript[n, 1]^2])/Subscript[n, 1]^2)*
Subscript[n, 2]^2 +
((-Cos[(2*Pi*Subscript[d, 1]*
Sqrt[(-Sin[\[Theta]]^2)*Subscript[n, 0]^2 +
Subscript[n, 1]^2])/
\[Lambda]])*Sec[\[Theta]]^2*
Sqrt[Cos[\[Theta]]^2*Subscript[n, 0]^2] -
(I*
Sin[(2*Pi*Subscript[d, 1]*
Sqrt[(-Sin[\[Theta]]^2)*Subscript[n, 0]^2 +
Subscript[n, 1]^2])/
\[Lambda]]*Subscript[n, 1]^2)/
Sqrt[(-Sin[\[Theta]]^2)*Subscript[n, 0]^2 +
Subscript[n, 1]^2])*

Sqrt[(-Sin[\[Theta]]^2)*Subscript[n, 0]^2 + Subscript[n, 2]^2])/
((Cos[(2*Pi*Subscript[d, 1]*
Sqrt[(-Sin[\[Theta]]^2)*Subscript[n, 0]^2 +
Subscript[n, 1]^2])/\[Lambda]] -
(I*Sec[\[Theta]]^2*
Sin[(2*Pi*Subscript[d, 1]*
Sqrt[(-Sin[\[Theta]]^2)*Subscript[n, 0]^2 +
Subscript[n, 1]^2])/\[Lambda]]*
Sqrt[Cos[\[Theta]]^2*Subscript[n, 0]^2]*

Sqrt[(-Sin[\[Theta]]^2)*Subscript[n, 0]^2 +
Subscript[n, 1]^2])/Subscript[n, 1]^2)*
Subscript[n, 2]^2 +
(Cos[(2*Pi*Subscript[d, 1]*
Sqrt[(-Sin[\[Theta]]^2)*Subscript[n, 0]^2 +
Subscript[n, 1]^2])/\[Lambda]]*
Sec[\[Theta]]^2*
Sqrt[Cos[\[Theta]]^2*Subscript[n, 0]^2] -
(I*
Sin[(2*Pi*Subscript[d, 1]*
Sqrt[(-Sin[\[Theta]]^2)*Subscript[n, 0]^2 +
Subscript[n, 1]^2])/
\[Lambda]]*Subscript[n, 1]^2)/
Sqrt[(-Sin[\[Theta]]^2)*Subscript[n, 0]^2 +
Subscript[n, 1]^2])*

Sqrt[(-Sin[\[Theta]]^2)*Subscript[n, 0]^2 + Subscript[n, 2]^2])
Rp[\[Lambda]_] := rp[\[Lambda]]*Conjugate[rp[\[Lambda]]]


Variables are defined thus:

Subscript[n, 0] = 1;
Subscript[n, 2] = 1;
Subscript[d, 1] = 40;
\[Theta] = Pi/6;


Any input/suggestions are more than welcome! Thank you!

• When posting code please convert cells to InputForm prior to copy and paste into MSE. Jun 29, 2021 at 21:48
• @BobHanlon should be fixed, thanks! Jun 29, 2021 at 21:54
• If you only want to vary nn1 and k you need to assign values to the other parameters {d1, n0, n2, θ}. Jun 30, 2021 at 1:05
• @BobHanlon they were defined in my code, but I neglected to include here. They're added now! Jun 30, 2021 at 17:27

Clear["Global*"]

Format[n[k_]] := Subscript[n, k]

Format[d[1]] := Subscript[d, 1]

rs[λ_] := (E^((4*I*Pi*d[1]*
Sqrt[(-Sin[θ]^2)*n[0]^2 + n[1]^2])/λ)*(Sqrt[
Cos[θ]^2*n[0]^2] +
Sqrt[(-Sin[θ]^2)*n[0]^2 +
n[1]^2])*(Sqrt[(-Sin[θ]^2)*n[0]^2 + n[1]^2] -
Sqrt[(-Sin[θ]^2)*n[0]^2 + n[2]^2]) + (Sqrt[
Cos[θ]^2*n[0]^2] -
Sqrt[(-Sin[θ]^2)*n[0]^2 +
n[1]^2])*(Sqrt[(-Sin[θ]^2)*n[0]^2 + n[1]^2] +
Sqrt[(-Sin[θ]^2)*n[0]^2 +
n[2]^2]))/(E^((4*I*Pi*d[1]*
Sqrt[(-Sin[θ]^2)*n[0]^2 + n[1]^2])/λ)*(Sqrt[
Cos[θ]^2*n[0]^2] -
Sqrt[(-Sin[θ]^2)*n[0]^2 +
n[1]^2])*(Sqrt[(-Sin[θ]^2)*n[0]^2 + n[1]^2] -
Sqrt[(-Sin[θ]^2)*n[0]^2 + n[2]^2]) + (Sqrt[
Cos[θ]^2*n[0]^2] +
Sqrt[(-Sin[θ]^2)*n[0]^2 +
n[1]^2])*(Sqrt[(-Sin[θ]^2)*n[0]^2 + n[1]^2] +
Sqrt[(-Sin[θ]^2)*n[0]^2 + n[2]^2]))

Rs[λ_] := rs[λ]*Conjugate[rs[λ]]

rp[λ_] := ((Cos[(2*Pi*d[1]*
Sqrt[(-Sin[θ]^2)*n[0]^2 + n[1]^2])/λ] + (I*
Sec[θ]^2*
Sin[(2*Pi*d[1]*
Sqrt[(-Sin[θ]^2)*n[0]^2 + n[1]^2])/λ]*
Sqrt[Cos[θ]^2*n[0]^2]*
Sqrt[(-Sin[θ]^2)*n[0]^2 + n[1]^2])/n[1]^2)*
n[2]^2 + ((-Cos[(2*Pi*d[1]*
Sqrt[(-Sin[θ]^2)*n[0]^2 + n[1]^2])/λ])*
Sec[θ]^2*
Sqrt[
Cos[θ]^2*n[0]^2] - (I*
Sin[(2*Pi*d[1]*
Sqrt[(-Sin[θ]^2)*n[0]^2 + n[1]^2])/λ]*
n[1]^2)/Sqrt[(-Sin[θ]^2)*n[0]^2 + n[1]^2])*
Sqrt[(-Sin[θ]^2)*n[0]^2 +
n[2]^2])/((Cos[(2*Pi*d[1]*
Sqrt[(-Sin[θ]^2)*n[0]^2 + n[1]^2])/λ] - (I*
Sec[θ]^2*
Sin[(2*Pi*d[1]*
Sqrt[(-Sin[θ]^2)*n[0]^2 + n[1]^2])/λ]*
Sqrt[Cos[θ]^2*n[0]^2]*
Sqrt[(-Sin[θ]^2)*n[0]^2 + n[1]^2])/n[1]^2)*
n[2]^2 + (Cos[(2*Pi*d[1]*
Sqrt[(-Sin[θ]^2)*n[0]^2 + n[1]^2])/λ]*
Sec[θ]^2*
Sqrt[
Cos[θ]^2*n[0]^2] - (I*
Sin[(2*Pi*d[1]*
Sqrt[(-Sin[θ]^2)*n[0]^2 + n[1]^2])/λ]*
n[1]^2)/Sqrt[(-Sin[θ]^2)*n[0]^2 + n[1]^2])*
Sqrt[(-Sin[θ]^2)*n[0]^2 + n[2]^2])

Rp[λ_] := rp[λ]*Conjugate[rp[λ]]

n[0] = 1;
n[2] = 1;
d[1] = 40;
θ = Pi/6;

n[1] = nn1 + I*k;


Use Minimize. From the documentation, "If f and cons are linear or convex, the result given by NMinimize will be the global minimum, over both real and integer values; otherwise, the result may sometimes only be a local minimum."

Minimize[{Abs[0.533600799853412 - Rs[399]],
0 == Abs[0.4285443166333881 - Rp[399]], nn1 > 1/100, k > 1/100,
nn1 < 50, k < 50}, {nn1, k}]

(* {2.47942*10^-8, {nn1 -> 3.39292, k -> 2.41182}} *)
`