The goal of the question is to solve a system of coupled linear differential equations representing a two-component wave function depending on two spatial coordinates x
, y
, and one time variable t
. The system is governed by a time-independent Hamiltonian that acts on the two components and the spatial coordinates.
The question contains a matrix version of the time-evolution operator that is two-dimensional, i.e., acts only on the wave function components. It is translated from a paper in which the treatment of the spatial degrees of freedom is not written down explicitly. This caused the misunderstanding that the evolution across a time step can be done by a multiplication with the two-dimensional matrix. In practice, what you really have to do in order to implement this formalism is to form a KroneckerProduct
between the matrix form you have, and the matrices representing the discretization of the position-dependence, or equivalently its Fourier transform.
But implementing this from scratch isn't really necessary, because the built-in NDSolve
is able to handle this kind of problem, too. Here is an example:
Clear[x, y, ψ1, ψ2, b, eqn, eqnWithInitial, aX, aY, v];
{σx, σy} = 1/2 PauliMatrix[{1, 2}];
eqn = Thread[
I D[{ψ1[x, y, t], ψ2[x, y, t]},
t] == σx.(-I D[{ψ1[x, y, t], ψ2[x, y, t]}, x] +
aX {ψ1[x, y, t], ψ2[x, y, t]}) +
σy.(-I D[{ψ1[x, y, t], ψ2[x, y, t]}, y] +
aY {ψ1[x, y, t], ψ2[x, y, t]}) +
v[x, y] {ψ1[x, y, t], ψ2[x, y, t]}];
eqnWithInitial =
Join[eqn,
Thread[{ψ1[x, y, 0], ψ2[x, y, 0]} == {1,
1} (x + I*y) Exp[-(x^2 + y^2)]],
Thread[{ψ1[-5, y, t], ψ2[-5, y, t]} == {ψ1[5, y,
t], ψ2[5, y, t]}],
Thread[{ψ1[x, -5, t], ψ2[x, -5, t]} == {ψ1[x, 5,
t], ψ2[x, 5, t]}]];
v[x_, y_] := 0;
b = 0;
{aX, aY} = {-b y, 0};
tMax = 8;
solution = First@NDSolve[
eqnWithInitial, {ψ1[x, y, t], ψ2[x, y, t]}, {x, -5,
5}, {y, -5, 5}, {t, 0, tMax},
Method -> {"MethodOfLines",
"SpatialDiscretization" -> {"TensorProductGrid",
"DifferenceOrder" -> "Pseudospectral"}}];
Ψ1[x_, y_, t_] = ψ1[x, y, t] /. solution;
Ψ2[x_, y_, t_] = ψ2[x, y, t] /. solution;
pl = Table[
Plot3D[{Re[Ψ1[x, y, t]] - 2,
2 + Re[Ψ2[x, y, t]]}, {x, -5, 5}, {y, -5, 5},
PlotRange -> {-3, 3},
PlotStyle -> {Red, Directive[Opacity[.9], Orange]},
BoxRatios -> 1], {t, 0, tMax, tMax/20}];
ListAnimate[pl]
This is the time evolution without potential and without magnetic field. Shown are the two components of the wave function in a plot that represents their real parts versus x
and y
, offset for clarity.
Next, turn on a magnetic field:
b = 1;
{aX, aY} = {-b y, 0};
solution = First@NDSolve[
eqnWithInitial, {ψ1[x, y, t], ψ2[x, y, t]}, {x, -5,
5}, {y, -5, 5}, {t, 0, tMax},
Method -> {"MethodOfLines",
"SpatialDiscretization" -> {"TensorProductGrid",
"DifferenceOrder" -> "Pseudospectral"}}];
Ψ1[x_, y_, t_] = ψ1[x, y, t] /. solution;
Ψ2[x_, y_, t_] = ψ2[x, y, t] /. solution;
pl = Table[
Plot3D[{Re[Ψ1[x, y, t]] - 2,
2 + Re[Ψ2[x, y, t]]}, {x, -5, 5}, {y, -5, 5},
PlotRange -> {-3, 3},
PlotStyle -> {Red, Directive[Opacity[.9], Orange]},
BoxRatios -> 1], {t, 0, tMax, tMax/20}];
ListAnimate[pl]
In the NDSolve
command, I use a set of differential equations created from the Dirac Hamiltonian in eq. (12) of the paper linked in the question. This way, there is no need to re-invent the wheel by implementing our own time-stepping algorithm. I'm leaving that work to Mathematica. In order to make this work, I chose periodic boundary conditions in space, and a Gaussian initial condition with orbital angular momentum 1 (as it also appears in the question) at t = 0
. All inessential parameters were given some arbitrary values. The main parameters are the magnetic field b
which enters the vector potential ax
, ay
through the Landau gauge, and the potential v[x, y]
. I set the latter to zero because it doesn't appear in the question at all. But you could define it to be a nonzero function of position, as long as it's consistent with the periodic boundary conditions.
Edit: checking probability conservation
In response to the comment, I would suggest something like this if you want to check whether the numerical integration has been able to preserve the norm of the solution, as it should for a hermitian Hamiltonian:
gridNormsB = With[{delta = .1},
Table[
Total@Flatten@
Table[
Abs[Ψ1[x, y, t]]^2 + Abs[Ψ2[x, y, t]]^2,
{x, -5, 5, delta}, {y, -5, 5, delta}],
{t, 0, tMax, 1}]]
(*
==> {156.28745, 156.2309, 156.23151, 156.18101, 156.1363, 156.12584, 156.08589, 156.00673, 155.99424}
*)
ListLinePlot[gridNormsB/gridNormsB[[1]],
PlotRange -> {0, 1.1}, DataRange -> {0, 8}]
Here I did not do the norm using NIntegrate
because that actually crashed in Mathematica version 8 (maybe I ran out of memory - anyway, the following is faster). Instead, I chose a discrete grid of spatial points and simply summed the quantity Abs[Ψ1[x, y, t]]^2 + Abs[Ψ2[x, y, t]]^2
over these points, varying t
from the initial t=0
to tMax = 8
, using the solutions of the last calculation (for b = 1
). As you can see, the norm is indeed preserved.