箱の中の自由粒子/メモ の履歴(No.1)

Mathematica ソース†

LANG:mathematica
Sum[(1/n!)^2, {n, Infinity}]
(* output: -1 + BesselI[0, 2] *)

psi[x_, t_] := Sqrt[2/(BesselI[0, 2] - 1)] Sum[Exp[I n^2 t] Sin[n Pi x]/n!, {n, 50}]

Module[{t = 0},
  Show[{
    Plot[ Abs[psi[x, t]]^2, {x, 0, 1}, 
      BaseStyle -> {FontSize -> 18}, ImageSize -> Large, PlotRange -> {0, 3}],
    Graphics[Text["t = " <> ToString[t], {0.8, 2.8}, {-1, 0}]]
  }]
]

anim = Table[
  Show[{
    Plot[ Abs[psi[x, t]]^2, {x, 0, 1}, 
      BaseStyle -> {FontSize -> 18}, ImageSize -> Large, PlotRange -> {0, 3}],
    Graphics[Text["t = " <> ToString[t], {0.8, 2.8}, {-1, 0}]]
  }], {t, 0, 10, 0.02}
];
Export["time-dependent.gif", anim, "GIF"]

Show[{
  DensityPlot[ Abs[psi[x,t]]^2, {x, 0, 1}, {t, 0, 10}, 
    PlotPoints -> 100, ImageSize -> Large],
  ParametricPlot[
    { NIntegrate[x Abs[psi[x, t]]^2, {x, 0, 1}], t}, 
    {t, 0, 10}, PlotPoints -> 40, ImageSize -> Large, PlotStyle -> {Thick, Red}]
}, BaseStyle -> {FontSize -> 18}]

詳しい導出過程†

#ref(): File not found: "continuous.png" at page "量子力学Ｉ/箱の中の自由粒子"

、 に対して、

• 箱の左：
• 箱の中：
• 箱の右：

境界条件は、

• 、
• 、

代入すると、

、 より

、 より

したがって、

　

　

　

　

を得る。これを上の式に代入すれば 、 であり、 さらに より を得る。

　&math( \psi_1(x)&=A(e^{ikx}\pm e^{ka}e^{-ikx})\\ &=Ae^{ka/2}(e^{ik(x-a/2)}\pm e^{-ik(x-a/2)})\\ &=2Ae^{ka/2}\frac{e^{ik(x-a/2)}\pm e^{-ik(x-a/2)}}{2}\\ );

　

　

　

より、

[複号の上を取れば]

　

　

　

　

[複号の下を取れば]

　

　

　

　

のように、それぞれ を中心に 的、 的な波動関数となる。

についての条件式の両辺を二乗した上で の関係を使って書き直せば、

[ 的な関数について]

　 ただし

[ 的な関数について]

　 ただし

を得る。

Mathematica ソース†

LANG:mathematica
Plot[{
  If[Tan[x] < 0, Infinity, x^2 (1 + Tan[x]^2)],
  If[Cot[x] > 0, Infinity, x^2 (1 + Cot[x]^2)]}, 
  {x, 0, 14}, 
  PlotRange -> {0, 200}, BaseStyle -> {FontSize -> 18}, ImageSize -> Large, 
  PlotLegends -> Placed[{"cos 的", "sin 的"}, Above],
  AxesLabel -> {ka/2, mVa^2/(2 \[HBar]^2)}]

NSolve[x^2 (1 + Tan[x]^2) == 50 && Tan[x] > 0 && 0 < x < 10, x, WorkingPrecision -> 15]
(* {{x -> 1.37508316964374}, {x -> 4.09477807780528}, {x -> 6.63585976688118}} *)

NSolve[x^2 (1 + Cot[x]^2) == 50 && Cot[x] < 0 && 0 < x < 10, x, WorkingPrecision -> 15]
(* {{x -> 2.74319088650076}, {x -> 5.41164383515459}} *)

coslike[x_, k_] := Module[{k2 = Sqrt[4 50 - k^2]},
  Sign[k] If[x < 0, Cos[k/2] Exp[k2 x], 
     If[x < 1, Cos[k (x - 1/2)], Cos[k/2] Exp[-k2 (x - 1)]]] 10 + k^2
 ]

sinlike[x_, k_] := Module[{k2 = Sqrt[4 50 - k^2]},
  If[x < 0, -Sin[k/2] Exp[k2 x], 
     If[x < 1, Sin[k (x - 1/2)], Sin[k/2] Exp[-k2 (x - 1)]]] 10 + k^2
]
 
Plot[{
 coslike[x, 2 1.37508316964374341419334462792217407823`15.],
 sinlike[x, -2 2.74319088650075787031867823175879453346`15.],
 coslike[x, -2 4.0947780778052791609523226938312581713`15.],
 sinlike[x, 2 5.41164383515459114436056269363192749999`15.],
 coslike[x, 2 6.63585976688118310914259741089030967404`15.]
 },
 {x, -0.5, 1.5}, PlotRange -> {0, 300}, ImageSize -> Large, 
  BaseStyle -> {FontSize -> 20},
  Axes -> {True, False}, 
  PlotStyle -> {Thick, Thin, Thin, Thin, Thin, Thin},
  AspectRatio -> 1
]

sin[x_, n_] := If[x < 0, 0, If[x > 1, 0, Sin[n Pi x]]] 10 + (n Pi)^2

Plot[{If[x < 0, 500, If[x < 1, 0, 500]],
 sin[x, 1], sin[x, 2], sin[x, 3], sin[x, 4], sin[x, 5] },
 {x, -0.5, 1.5}, PlotRange -> {0, 300}, ImageSize -> Large, 
 BaseStyle -> {FontSize -> 20},
 Axes -> {True, False}, 
 PlotStyle -> {Thick, Thin, Thin, Thin, Thin, Thin}, 
 AspectRatio -> 1
]