I have the following functions,
f[Cpl_, a_, EF_, V_, Jsd_, α_, β_, σ_, ϕ_][kp_] :=
With[{kx = kp*Cos[σ], ky = kp*Sin[σ]},
With[
{θ =
ϕ -
If[α*kx >= 0,
ArcCos[β*ky/Sqrt[(α*kx)^2 + (β*ky)^2]],
2*Pi - ArcCos[β*ky/Sqrt[(α*kx)^2 + (β*ky)^2]]],
kzdo = Sqrt[Cpl*(EF + (Jsd/2)) - kx^2 - ky^2],
kzup = Sqrt[Cpl*(EF - (Jsd/2)) - kx^2 - ky^2],
Qp =
Sqrt[Cpl*(V - EF + Sqrt[(α*kx)^2 + (β*ky)^2]) + kx^2 + ky^2],
Qm =
Sqrt[Cpl*(V - EF - Sqrt[(α*kx)^2 + (α*ky)^2]) + kx^2 + ky^2]
},
4*
(Sin[a*kzdo]*
(kzup*(Qm + Qp + (Qm - Qp)*Cos[θ])*Cos[a*kzup] + 2*Qm*Qp*Sin[a*kzup]) +
kzdo*Cos[a*kzdo]*(2*kzup*Cos[a*kzup] +
(Qm + Qp - (Qm - Qp)*Cos[θ])*Sin[a*kzup]))^2]];
and then I fix all variables except three of them,
CPl1 = 0.262227;
a1 = 5.0000000000;
EF1 = 2.600000000;
V1 = EF1 + 0.500000000000;
Jsd1 = 1.50000000000;
ϕ1 = Pi/12;
α1 = 1.0;
β1 = 1.0;
function[En_, σ_][kp_] := f[CPl1, a1, En, En + 0.5, Jsd1, α1, β1, σ, ϕ1][kp]
I would like to solve this equation for fixed values of En
& σ
for kp
. Function NSolve
does not work, so I use FindRoot
function. To use it, I plot my function using Plot
and deduce where roots are "located" (careful analysis of regions says that there are 4 roots):
For instance, fixing E=3.0
and σ=0
method FindRoot
gives me 4 roots.
Then, I chek my results. I plot implicit function function=0
using ContourPlot
:
It is clearly only two roots. I know that ContourPlot
sometimes gives inaccurate plots and it can be fixed by plotting $\text{function}=\epsilon$, where, for instance, $\epsilon\sim 10^{-8}$. However, it does not solve my problem.
Accuracy of FindRoot
says that value function
is about $\sim 10^{-11}-10^{-14}$ in every root. I do not understand what is wrong with my code. How should I deal with this problem?