Оказалось, что
должны быть в знаменателях.
Мне повезло, я никогда не менял
.
Новый код:
Код:
MakeSchrodingerTimeStep[V_, m_, \[HBar]_, \[CapitalDelta]t_, \[CapitalDelta]x_] := Module[{a1, V1},
a1 = I \[HBar] \[CapitalDelta]t/(2 m \[CapitalDelta]x^2);
V1 = 1 - 2 I \[HBar] \[CapitalDelta]t/(m \[CapitalDelta]x^2) - (I \[CapitalDelta]t)/\[HBar] V;
Function[{\[Psi]},
ArrayPad[ListConvolve[{{0, a1, 0}, {a1, 0, a1}, {0, a1, 0}}, \[Psi]], 1] + V1 \[Psi]
]
]
Новый пример:
Код:
(* Улучшил цвет и немного ускорил *)
AmplitudeCF[zoom_] := Module[{f},
f = Compile[{{z, _Complex}},
Block[{absz = Abs[z] 1./zoom},
{Arg[z]/6.283185307179586`, Tanh[absz], If[absz > 10., 0., 2. - Cosh[.6 absz]]}
]
];
Hue @@ f[#] &
]
(* Пример *)
n = 100;
V = Array[0 &, {n, n}];
step = MakeSchrodingerTimeStep[V, 1., 1., .2, 1.];
\[Psi] = Array[Exp[-I 2 \[Pi] 6 #2/n] Exp[-((#1 - .5 n)^2 + (#2 - .5 n)^2)/(.3 n)]/Sqrt[2. \[Pi] (.3 n)] &, {n, n}];
First@Timing[steps = NestList[step, \[Psi], 180]] (* 8.469 *)
someSteps = steps[[;; ;; 5]]; (* отображение отнимает много времени *)
First@Timing[anim = ListAnimate[
frames = ArrayPlot[#, ColorFunction -> AmplitudeCF[.1], ColorFunctionScaling -> False] & /@ someSteps,
AnimationRunning -> False]
] (* 29.734 — и это пятая часть! *)
anim
Увы, разрисовывание получается дольше, чем вычисления.
Без компиляции было ещё больше. Я и к вычислениям её собирался применить, но не понял, что было не так.
Пока это пример свободной частицы (хм, надо уже сделать преобразование от
в
)
и в конце можно наблюдать, как замечательно модель расходится:
P.S. Вам нулевые краевые условия принципиальны?
Даже не знаю. Можно вместо них поставить за краями бесконечно большой потенциал; надо будет посчитать, как изменить счёт (UPD: пока возился, подумал; не понял). Но на все случаи это не подойдёт.
-- Пт авг 22, 2014 19:54:24 --(Белый — ноль, чёрный — значения модуля больше какого-то, посередине цветное в соответствии с аргументом.)