Wellenpakete

Initialisierung

SetOptions[Plot,Frame->True,BaseStyle->{FontFamily->"Helvetica",16},Axes->False,ImageSize->600];
SetOptions[LogLinearPlot,Frame->True,BaseStyle->{FontFamily->"Helvetica",16}];

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
]
]
]

Plots

Initialization

Clear[x,t,ω,k,k0,a,c]

A[k_]:=(1/(Sqrt[2]))Exp[-(((k-k0))^2)/4]

ψ[x_,t_,ω_]:=(1/(Sqrt[2π]))(∫_(-∞)^∞)A[k]Exp[I(k x-ω t)]\[DifferentialD]k

ψ[x_,t_,ω_]:=(1/(Sqrt[2π]))Integrate[A[k]Exp[I(k x-ω t)],{k,-∞,∞},Assumptions->{x≥0,t≥0,c>0,k0≥0}]

(*ψ1[x_,t_]=ψ[x,t,c k]*)
ψ1[x_,t_]=(E^(-(c t-x) (I k0+c t-x)))

(*ψ2[x_,t_]=ψ[x,t,c (k^2)]*)
ψ2[x_,t_]=((E^((-c (k0^2) t+(k0+I x) x)/(-I+4 c t)))/(Sqrt[1+4 I c t]))

Wellenpaket mit linearer Dispersion

ω = c k
(Subscript[v, g])= (Subscript[v, ph])=c

ShowCodeButton
Manipulate[Block[{$PerformanceGoal="Quality",k0=10,c=1},Show[{
Plot[Abs[ψ1[x,t]],{x,-5,20},PlotRange->{-1,1},PlotStyle->{Red,Opacity[0.5],Thick},FrameLabel->{"x","ψ[x,t]","",""},ImageSize->800],
Plot[Re[ψ1[x,t]],{x,-5,20},PlotRange->{-1,1}]
}]],{{t,0,"Zeit [t]"},0,20,ControlType->Slider,Appearance->"Labeled"},LabelStyle->Large,SaveDefinitions->True]

Wellenpaket mit quadratischer Dispersion

ω = c (k^2)
(Subscript[v, g])=2 c (Subscript[k, 0]) =const
(Subscript[v, ph])=c k ≠ const

ShowCodeButton
vg=D[c (k^2),k]/.{k->k0};
vph=c (k^2)/k;
Grid[{{Graphics[{Red,AbsolutePointSize[5],Point[{0,0}]},ImageSize->{30,20}],Style["(Subscript[v, g])   ",Red,FontFamily->"Helvetica"]},{Graphics[{Darker[Green],AbsolutePointSize[5],Point[{0,0}]},ImageSize->{30,20}],Style["(Subscript[v, ph]) für k=(Subscript[k, 0])  ",Darker[Green],FontFamily->"Helvetica"]}},Alignment->Left]

Manipulate[Block[{$PerformanceGoal="Quality",k0=5,c=0.1},Show[{
Plot[Abs[ψ2[x,t]],{x,-5,100},PlotRange->{-1,1},PlotStyle->{Red,Opacity[0.5],Thick},FrameLabel->{"x","ψ[x,t]","",""},ImageSize->800],
Plot[Re[ψ2[x,t]],{x,-5,100},PlotRange->{-1,1}],
Graphics[{Red,AbsolutePointSize[5],Point[{vg t,Abs[ψ2[vg t,t]]}]}],
Graphics[{Darker[Green],AbsolutePointSize[5],Point[{vph t,Abs[ψ2[vph t,t]]}/.{k->k0}]}]
}]],{{t,0,"Zeit [t]"},0,100,ControlType->Slider,Appearance->"Labeled"},LabelStyle->Large,SaveDefinitions->True]

Zentriert auf Maximum der Umhüllenden

ShowCodeButton

Manipulate[Block[{$PerformanceGoal="Quality",k0=3,c=0.8},Show[{
Plot[Abs[ψ2[x,t]],{x,-50+vg t,50+vg t},PlotRange->{-1,1},PlotStyle->{Red,Opacity[0.5],Thick},FrameLabel->{"x","ψ[x,t]","",""},ImageSize->800],
Plot[Re[ψ2[x,t]],{x,-50+vg t,50+vg t},PlotRange->{-1,1}],
Graphics[{Red,AbsolutePointSize[5],Point[{vg t,Abs[ψ2[vg t,t]]}]}]
}]],{{t,0,"Zeit [t]"},0,50,ControlType->Slider,Appearance->"Labeled"},LabelStyle->Large,SaveDefinitions->True]