2
$\begingroup$

I must find the zeros of a complex function $\xi$ that depends upon two real variables $B$ and $k$. The function is obtained by evaluating the determinant of the identity matrix of dimension $2n$ minus the product of two matrices $T$ and $S$ obtained by some procedure that is not important for the problem. In the case of $n=1$, it is possible to express the function $\xi$ analytically and in almost compact form. Specifically, we have

ξ[k_, B_] := (1/((Sqrt[2] - 2 I k)^8)) 32 E^(4 I k) (3 + 
    32 I Sqrt[2] k^7 (E^(-4 I k) - Cos[B]) + 
    16 I Sqrt[2] k^5 (2 + 3 E^(-2 I k) + E^(2 I k) - 7 E^(-4 I k) + Cos[B]) - 
    4 Cos[2 k] + Cos[4 k] + 16 k^8 (-Cos[B] + Cos[4 k]) + 
    32 Sqrt[2] E^(-I k) k Sin[k]^3 + 
    8 Sqrt[2] k^3 (I + 7 I E^(-4 I k) - 8 I Cos[2 k] - 12 Sin[2 k]) + 
    16 k^2 Sin[k]^2 (-1 + 6 Cos[2 k] - 8 I Sin[2 k]) + 
    16 k^6 (1 + 3 Cos[B] + 2 Cos[2 k] - 6 Cos[4 k] + 8 I Sin[4 k]) - 
    4 k^4 (9 + Cos[B] + 28 Cos[2 k] - 38 Cos[4 k] - 32 I Sin[2 k] + 32 I Sin[4 k]))

Fixing one of the two variables, either $B$ or $k$, I have searched for simultaneous solutions of the real and imaginary part of $\xi$ using FindRoot. However, this procedure fails when the determinant function has a zero derivative. This is because of Newton's method for finding the zeros used by default in FindRoot. Here I have not understood how to use a more efficient method in FindRoot for a two-dimensional search.

I am now using a different strategy based on finding the minima of the Abs[ξ]. This strategy has fewer problems when the $\xi$ has zero derivatives locally.

My concern is that when the variable $n$ increases, the complexity of $\xi$ increases as well.

I am looking for suggestions or alternative to tackle this problem.

$\endgroup$

2 Answers 2

5
$\begingroup$

Your function $\xi(k,B)$ does not depend on $B$ directly but only on $\cos(B)$, in a simple way. You can solve $\xi=0$ for $\cos(B)$ and thus find $\cos(B)$ as a function of $k$.

ξ[k_, B_] = (1/((Sqrt[2] - 2 I k)^8))32 E^(4 I k) (3 + 32 I Sqrt[2] k^7 (E^(-4 I k) - Cos[B]) + 16 I Sqrt[2] k^5 (2 + 3 E^(-2 I k) + E^(2 I k) - 7 E^(-4 I k) + Cos[B]) -    4 Cos[2 k] + Cos[4 k] + 16 k^8 (-Cos[B] + Cos[4 k]) +    32 Sqrt[2] E^(-I k) k Sin[k]^3 +    8 Sqrt[2] k^3 (I + 7 I E^(-4 I k) - 8 I Cos[2 k] - 12 Sin[2 k]) +    16 k^2 Sin[k]^2 (-1 + 6 Cos[2 k] - 8 I Sin[2 k]) +    16 k^6 (1 + 3 Cos[B] + 2 Cos[2 k] - 6 Cos[4 k] + 8 I Sin[4 k]) -    4 k^4 (9 + Cos[B] + 28 Cos[2 k] - 38 Cos[4 k] - 32 I Sin[2 k] + 32 I Sin[4 k]));

cosB[k_] = SolveValues[ξ[k, B] == 0, Cos[B]] // First // ComplexExpand // FullSimplify
(*    (3 + 4 k^2 + (1 + 4 k^2 (-3 + k^2)) Cos[4 k] + 8 Sqrt[2] k Sin[2 k] + 4 (-1 + 2 k^2) (Cos[2 k] + Sqrt[2] k Sin[4 k]))/(4 k^4)    *)


Plot[cosB[k], {k, -3, 3}]

enter image description here

There are infinitely many solutions for $B$ that give this value of $\cos(B)$, of course. One of these branches is

Plot[ArcCos[cosB[k]], {k, -10, 10}]

enter image description here

Plotting a few more branches for a more complete picture:

Plot[Evaluate[
  Join @@ Table[{2π*n + ArcCos[cosB[k]], 
                 2π*n - ArcCos[cosB[k]]},
                {n, -3, 3}]], {k, -10, 10},
                AxesLabel -> {k, B}]

enter image description here

$\endgroup$
3
$\begingroup$

Try

xsi[k_, B_] := (1/((Sqrt[2] - 2 I k)^8)) 32 E^(4 I k) (3 + 
    32 I Sqrt[2] k^7 (E^(-4 I k) - Cos[B]) + 
    16 I Sqrt[
      2] k^5 (2 + 3 E^(-2 I k) + E^(2 I k) - 7 E^(-4 I k) + Cos[B]) - 
    4 Cos[2 k] + Cos[4 k] + 16 k^8 (-Cos[B] + Cos[4 k]) + 
    32 Sqrt[2] E^(-I k) k Sin[k]^3 + 
    8 Sqrt[2] k^3 (I + 7 I E^(-4 I k) - 8 I Cos[2 k] - 12 Sin[2 k]) + 
    16 k^2 Sin[k]^2 (-1 + 6 Cos[2 k] - 8 I Sin[2 k]) + 
    16 k^6 (1 + 3 Cos[B] + 2 Cos[2 k] - 6 Cos[4 k] + 8 I Sin[4 k]) - 
    4 k^4 (9 + Cos[B] + 28 Cos[2 k] - 38 Cos[4 k] - 32 I Sin[2 k] + 
       32 I Sin[4 k]))

ContourPlot[{Re[xsi[k, B]] == 0, Im[xsi[k, B]] == 0}, {k, 0, 5}, {B,0 , 5 }, ContourStyle -> {Red, {Dashed, Black}},MaxRecursion -> 4(*,PlotPoints\[Rule]100*)]

enter image description here

At the intersections of blue(realpart==0) and red(imaginary part==0) function xsi ==0

NSolve evaluates the solution

sol=NSolve[{Re[xsi[k, B]] == 0, Im[xsi[k, B]] == 0, 0 < k <= 5, 
0 < B <= 5}, {k, B} ]
ListPlot[{k, B} /. sol , Joined -> ! True]

enter image description here

$\endgroup$

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.