Initialisierung

SetOptions[Plot,LabelStyle->{FontFamily->"Helvetica",FontSize->16}];

En[n_,ω_]:=ℏ ω (n+(1/2))
ψ[n_,x_,ω_,m_]:=(((((m ω)/(π ℏ))))^(1/4))(1/(Sqrt[(2^n)n!]))HermiteH[n,(Sqrt[((m ω)/ℏ)])x]Exp[-(1/2)((m ω)/ℏ)(x^2)]

Clear[ω,m,k,ω1,GHz]
k=m (((ω1 GHz))^2);
h = 6.626068×(10^(-34));
ℏ=(h/(2π));
m=9.1 (10^(-31)); (*Elektronenmasse*)
nmax=10;
xmax=1.;
um=(10^(-6));
GHz=(10^9);
EUnit=ℏ GHz;

ShowCodeButton:=DynamicModule[{mode=1(*show*)},SelectionMove[EvaluationNotebook[],All,EvaluationCell];
SetOptions[NotebookSelection[EvaluationNotebook[]],CellOpen->False];
Button[Dynamic[If[mode==1,"Show code","Hide code"]],If[mode==1,SelectionMove[EvaluationNotebook[],All,EvaluationCell];
SelectionMove[EvaluationNotebook[],Previous,Cell];SetOptions[NotebookSelection[EvaluationNotebook[]],CellOpen->True];
mode=2,
(*else*)
SelectionMove[EvaluationNotebook[],All,EvaluationCell];
SelectionMove[EvaluationNotebook[],Previous,Cell];SetOptions[NotebookSelection[EvaluationNotebook[]],CellOpen->False];
mode=1
]
]
]

Wahrscheinlichkeitsamplitude

ShowCodeButton
Prob=Manipulate[Show[Plot[Evaluate@Table[((ψ[n,x um,ω GHz,m ])^2)0.0000006+En[n,ω GHz]/EUnit,{n,0,nmax}],{x,-xmax,xmax},Filling->Table[n->En[n-1,ω GHz]/EUnit,{n,1,nmax+1}],PlotRange->{{-1,1}xmax ,{-0.1,1.1}En[nmax,2 GHz]/EUnit},PlotStyle->ColorData[1,"ColorList"],Frame->True,ImageSize->600,Axes->False,FrameLabel->{"Ort x [μm]","Energie [GHz ℏ]"},Epilog->Table[Inset[Style[ToString[Subscript["|ψ",i],TraditionalForm]<>"(x)|\!\(\*SuperscriptBox[\(\\ \), \(2\)]\)",16],{0.9,En[i,ω GHz]/EUnit+0.05}],{i,0,nmax}]],
Plot[(1/2)k (((x um))^2)/EUnit/.{ω1->ω},{x,-xmax,xmax},Filling->-5,FillingStyle->Opacity[0.1]]],{{ω,2,"Frequenz ω [GHz]"},2,10 ,ControlType->Slider,Appearance->"Labeled"},LabelStyle->Large,SaveDefinitions->True]

Wellenfunktion

ShowCodeButton
WaveFunc=Manipulate[Show[Plot[Evaluate@Table[ψ[n,x um,ω GHz,m ]0.0005+En[n,ω GHz]/EUnit,{n,0,nmax}],{x,-xmax,xmax},Filling->Table[n->En[n-1,ω GHz]/EUnit,{n,1,nmax+1}],PlotRange->{{-1,1}xmax ,{-0.1,1.1}En[nmax,2 GHz]/EUnit},PlotStyle->ColorData[1,"ColorList"],Frame->True,ImageSize->600,Axes->False,FrameLabel->{"Ort x [μm]","Energie [GHz ℏ]"},Epilog->Table[Inset[Style[ToString[Subscript["ψ",i],TraditionalForm]<>"(x)",16],{0.9,En[i,ω GHz]/EUnit+0.05}],{i,0,nmax}]],
Plot[(1/2)k (((x um))^2)/EUnit/.{ω1->ω},{x,-xmax,xmax},Filling->-5,FillingStyle->Opacity[0.1]]],{{ω,2,"Frequenz ω [GHz]"},2,10 ,ControlType->Slider,Appearance->"Labeled"},LabelStyle->Large,SaveDefinitions->True]

Wahrscheinlichkeitsamplitude & Wellenfunktion

ShowCodeButton
Manipulate[Grid[{{Show[Plot[Evaluate@Table[((ψ[n,x um,ω GHz,m ])^2)0.0000006+En[n,ω GHz]/EUnit,{n,0,nmax}],{x,-xmax,xmax},Filling->Table[n->En[n-1,ω GHz]/EUnit,{n,1,nmax+1}],PlotRange->{{-1,1}xmax ,{-0.1,1.1}En[nmax,2 GHz]/EUnit},PlotStyle->ColorData[1,"ColorList"],Frame->True,ImageSize->500,Axes->False,FrameLabel->{"Ort x [μm]","Energie [GHz ℏ]"},Epilog->Table[Inset[Style[ToString[Subscript["|ψ",i],TraditionalForm]<>"(x)|\!\(\*SuperscriptBox[\(\\ \), \(2\)]\)",16],{0.85,En[i,ω GHz]/EUnit}],{i,0,nmax}]],
Plot[(1/2)k (((x um))^2)/EUnit/.{ω1->ω},{x,-xmax,xmax},Filling->-5,FillingStyle->Opacity[0.1]]],
Show[Plot[Evaluate@Table[ψ[n,x um,ω GHz,m ]0.0005+En[n,ω GHz]/EUnit,{n,0,nmax}],{x,-xmax,xmax},Filling->Table[n->En[n-1,ω GHz]/EUnit,{n,1,nmax+1}],PlotRange->{{-1,1}xmax ,{-0.1,1.1}En[nmax,2 GHz]/EUnit},PlotStyle->ColorData[1,"ColorList"],Frame->True,ImageSize->500,Axes->False,FrameLabel->{"Ort x [μm]","Energie [GHz ℏ]"},Epilog->Table[Inset[Style[ToString[Subscript["ψ",i],TraditionalForm]<>"(x)",16],{0.9,En[i,ω GHz]/EUnit}],{i,0,nmax}]],
Plot[(1/2)k (((x um))^2)/EUnit/.{ω1->ω},{x,-xmax,xmax},Filling->-5,FillingStyle->Opacity[0.1]]]
}}],{{ω,2,"Frequenz ω [GHz]"},2,10 ,ControlType->Slider,Appearance->"Labeled"},LabelStyle->Large,SaveDefinitions->True]

Vergleich Klassisch-QM

ShowCodeButton
xborder[n_]:=((1.4824986333222024*^6 (Sqrt[EUnit]) (Sqrt[0.5+ n]))/(um ω));
Manipulate[Show[{Plot[{((ψ[n,x um,1GHz,m ])^2)0.00001},{x,-2xborder[n]/.{ω->1},2xborder[n]/.{ω->1}},Frame->True,PerformanceGoal->"Quality",FrameLabel->{"Ort x [μm]","Wahrscheinlichkeitsdichte [a.u.]"}],Plot[{1/Cos[π/(2 xborder[n]/.{ω->1})x]},{x,-1xborder[n]/.{ω->1},1xborder[n]/.{ω->1}},PlotRange->{All,{0,1000}},Frame->True,PlotStyle->ColorData[1,"ColorList"][[2]]]}],{{n,0,"Mode n"},0,40,1,ControlType->Slider,Appearance->"Labeled"},LabelStyle->Large,SaveDefinitions->True]