Finding the conditions for degenerate solutions to a cubic equation
Further edited to simplify results
It is not difficult to show that the three eigenvalues, w
, of M
are equal if and only if M
is diagonal; i.e., ab = ac = bc = 0
.
f[e_] := 2 Norm[e]^-3 (1 - 3 Sin[θ]^2 Cos[ϕ - ArcTan[e[[1]], e[[2]]]]^2) Cos[{x, y}.e]
abeval = f[{1, 0}]
(* 2 Cos[x] (1 - 3 Cos[ϕ]^2 Sin[θ]^2) *)
aceval = f[{0, 1}]
(* 2 Cos[y] (1 - 3 Sin[θ]^2 Sin[ϕ]^2) *)
bceval = Simplify[TrigExpand[f[{1, 1}] + f[{-1, 1}]]]
(* (Cos[x] Cos[y] (1 + 3 Cos[2 θ]) + 6 Sin[x] Sin[y] Sin[θ]^2 Sin[2 ϕ])/(2 Sqrt[2]) *)
Solutions can be obtained in an orderly manner as follows. For {Cos[x] -> 0, Cos[y] -> 0}
, abeval
and aceval
are zero, and bceval
reduces to
Sin[θ] Sin[2 ϕ] == 0
For {Sin[x] -> 0, Cos[y] -> 0}
, aceval
and bceval
are zero, and abeval
reduces to
1 - 3 Cos[ϕ]^2 Sin[θ]^2 == 0
Finally, for {Cos[x] -> 0, Sin[y] -> 0}
, abeval
and bceval
are zero, and aceval
reduces to
(1 - 3 Sin[θ]^2 Sin[ϕ]^2) == 0
These curves are plotted below and indicate where solutions are located in θ
and ϕ
.
ContourPlot[{Sin[θ] Sin[2 ϕ] == 0,
(1 - 3 Cos[ϕ]^2 Sin[θ]^2) == 0,
(1 - 3 Sin[θ]^2 Sin[ϕ]^2) == 0},
{θ, 0, Pi + .01}, {ϕ, 0, 2 Pi + .01}, Frame -> False, Axes -> True,
Ticks -> {{0, Pi}, {0, Pi, 2 Pi}}, AxesLabel -> {"θ", "ϕ"},
ContourStyle -> Directive[Black, Thick],
AxesStyle -> Directive[Black, Bold, Thick, 12]]
Other values of x
and y
give rise to discrete points in θ
and ϕ
, located at the intersections of curves in this plot.
Band Structure Plot
With the information just presented, generating band structure plots is straightforward. To do so, evaluate s
seval = f[{2, 0}] + f[{0, 2}]
(* 1/4 Cos[2 x] (1 - 3 Cos[ϕ]^2 Sin[θ]^2) + 1/4 Cos[2 y] (1 - 3 Sin[θ]^2 Sin[ϕ]^2) *)
define
mplt[θ0_, ϕ0_] := Module[{meval =
Det[M] /. {ab -> abeval, ac -> aceval, bc -> bceval,
s -> seval} /. {θ -> θ0, ϕ -> ϕ0} // Simplify},
Plot3D[Evaluate[w /. Solve[meval == 0, w]], {x, -Pi, Pi}, {y, -Pi, Pi},
AxesLabel -> {"x", "y"}, AxesStyle -> Directive[Black, Bold, 12],
Ticks -> {{-Pi, 0, Pi}, {-Pi, 0, Pi}, Automatic},
ImageSize -> Large, ViewPoint -> {1.4, -3.0, .35}]]
and invoke it with any pair {θ0, ϕ0}
from the plot above or from the three equations that the plot represents. For instance
mplt[Pi/2, ArcSin[Sqrt[1/3]]]
or
mplt[Pi/2, ArcCos[Sqrt[1/3]]]
Plots for values corresponding to interior curve intersections from the {θ0, ϕ0}
plot are in a sense degenerate.
mplt[ArcSin[Sqrt[1/3]], Pi]
mplt[0, 0]
, of course, gives the plot in the Question.
Addendum
At the request of the OP in a comment below, here is a more detailed argument that M
must be diagonal for its three eigenvalues to be equal. To begin, its Determinant
must be proportional to [-(w - w0)^3
, where w0
is the three-fold-repeated eigenvalue.
eq0 = Expand[-(w - w0)^3]
(* -w^3 + 3 w^2 w0 - 3 w w0^2 + w0^3 *)
The Determinant
of M
actually is
eq = Collect[Det[M], w, Simplify]
(* 2 ab ac bc - ab^2 s - s (ac^2 + bc^2 - s^2) + (ab^2 + ac^2 + bc^2 - 3 s^2) w +
3 s w^2 - w^3 *)
Equating the two yields
Collect[eq - eq0, w, Simplify]
(* 2 ab ac bc - ab^2 s - ac^2 s - bc^2 s + s^3 + 3 w^2 (s - w0) - w0^3 +
w (ab^2 + ac^2 + bc^2 - 3 s^2 + 3 w0^2) *)
and the coefficient of every power of w
must vanish. Thus, w0
must be equal to s
. With that substitution,
Collect[% /. w0 -> s, {w, s}, Simplify]
(* 2 ab ac bc + (-ab^2 - ac^2 - bc^2) s + (ab^2 + ac^2 + bc^2) w *)
The coefficient of w
in the last expression vanishes if and only if all three of ab
, ac
, and bc
vanish, in other word, if M
is diagonal.
This is an incomplete answer, but we will be able to show that there is no solution for most values of θ and ϕ. We will also be able to draw a plot of the regions of interest that you should check further to find solutions, should they exist.
M = {{s - w, ab, ac}, {ab, s - w, bc}, {ac, bc, s - w}};
{d, c, b, a} = CoefficientList[Det[M], w];
disc = Discriminant[Det@M, w] // FullSimplify;
disc0 = b^2 - 3 a c;
Now, if we want three Real (equal) solutions both disc
and disc0
must vanish simultaneously.
As both discriminants are always positive, we can explore when the minimum of their sum is zero:
f[e_] := 2 Norm[e]^-3 (1 - 3 Sin[theta]^2 Cos[phi - ArcTan[e[[1]], e[[2]]]]^2)
Cos[{x, y}.e];
ab = f[{1, 0}];
ac = f[{0, 1}];
bc = f[{1, 1}] + f[{-1, 1}];
s = f[{2, 0}] + f[{0, 2}];
Plot3D[FindMinValue[disc + disc0 /. {theta -> t, phi -> p},
{{x, 0, Pi}, {y, 0, Pi}}],
{t, 0, Pi/2}, {p, 0, Pi/2}, PlotRange -> {0, .1}, ClippingStyle -> None]
So there you have the few regions to explore (they are lines, BTW)
Starting with bbgodfrey's excellent suggestion to solve ab == ac == bc == 0
, we can obtain a fairly compact list of all of the solutions. If we Reduce
the equations with conditions on the variables we get a complicated result, so it's easier to Reduce
first and apply conditions after:
Reduce
the equations and throw out some obviously inconsistent results:
sols = List @@ (
LogicalExpand@FullSimplify@Reduce[Thread[Simplify@{ab, ac, bc} == 0]] /.
{___ && Cos[x_] == 0 && ___ && Sin[x_] == 0 && ___ -> False,
___ && Sin[x_] == 0 && ___ && Cos[x_] == 0 && ___ -> False}
)
The last four solutions are
sols[[-4 ;;]]
We can show that these are not self-consistent by eliminating θ
and ϕ
like so:
(Or @@ FullSimplify[# /. Solve[#[[;; 2]], {θ, ϕ}], C[_] ∈ Integers] &) /@ %
{False, False, False, False}
The remainder of the solutions are
(sols = Drop[sols, -4]) // TableForm
We can Solve
to find some particular solutions and throw away duplicates with
sols1 = Union@Simplify@Flatten[Solve /@ (sols /. _Unequal -> Sequence[]) /. C[_] -> 0, 1];
Then pick out solutions where the fixed parameters are between 0 and π:
sols2 = Pick[sols1, 0 == # & /@ Count[v_ /; ! 0 <= v < π] /@ ({x, y, θ, ϕ} /. sols1)]
Plot the third and fourth solutions for {x -> 0, y -> π/2}
in the θ
and ϕ
plane:
ContourPlot[Evaluate[Equal @@@ sols2[[3 ;; 4, 3]]], {θ, 0, π}, {ϕ, -π/2, π/2}, MaxRecursion -> 3]
And plot the energies as a function of θ
and ϕ
:
Plot3D[Evaluate[Re[w /. {x -> 0, y -> π/2}]], {θ, 0, π}, {ϕ, -π/2, π/2}, MaxRecursion -> 5]