Einführung in Mathematica XXIII

Rayleigh-Ritz-Variationsverfahren

© Jürgen Schnack, 2012/05/15

Problem

Suche approximative Eigenzustände zu einem Hamiltonoperator, zu dem ich die exkten
Eigenzustände und Eigenwerte nicht finde.
Die Wellenfunktion wird dabei geschickt geraten; sie hängt noch von freien Parametern ab, 
die dann so festgelegt werden, dass die Energie minimal wir.
(Walter Ritz, “Über eine neue Methode zur Lösung gewisser Variationsprobleme der mathematischen Physik.” J. reine angew. Math. 135, 1-61, 1908)

Diese Methode wird auch heute noch sehr oft angewendet, weil man Vielteilchenprobleme
in der Regel weder analytisch noch numerisch exakt lösen kann.

Wir wollen hier die Idee an dem Beispiel eines Teilchens in einer Raumdimension kennenlernen.

Hamiltonoperator des harmonischen Oszillators
(-d²/dx² + ω² x² -ϵ) ψ = 0

ω=1.0;(* Wähle ω o.B.d.A..*)
V[x_]=(ω^2)* (x^2);

ψ[x_,a_,b_]=Exp[-a*(x^2)-b*(x^4)]

h[a_,b_]:=(NIntegrate[-ψ[x,a,b]*D[ψ[x,a,b],{x,2}],
{x,-100.0,-2.0-1.0,0.0,1.0,2.0,100.0}]+
NIntegrate[ψ[x,a,b]*V[x]*ψ[x,a,b],{x,-100.0,-2.0-1.0,0.0,1.0,2.0,100.0}])/
NIntegrate[ψ[x,a,b]*ψ[x,a,b],{x,-100.0,-2.0-1.0,0.0,1.0,2.0,100.0}]

Beispielfunktionen

Plot[{V[x],ψ[x,1.0,0.0],ψ[x,1.0,2.0]}, {x, -2, 2}, PlotRange -> {-2, 2},
PlotStyle->{{Red,Thick},{Green,Thick},{Blue,Thick}},BaseStyle->{FontFamily->"Helvetica",FontSize->18}]

Graphische Darstellung von h[a,b]

CP1=ContourPlot[h[a,b],{a,0,1},{b,0,1}, 
BaseStyle->{FontFamily->"Helvetica",FontSize->18}]

Minimumssuche

In vielen interessanten Fällen kann man den Gradienten gar nicht analytisch bilden. Dann nimmt man z.B. den numerischen Gradienten oder tastet sich entlang der Koordinaten schrittweise vor, wie hier.

x0=1.0;y0=1.0;  (* Startwerte *)
Deltax=0.01;Deltay=0.01; (* Schrittweiten *)
KoordinatenPfad=Table[{x0,y0},{n,1,1}];
Length0=Length[KoordinatenPfad];
Weitersuchen=True;
While[Weitersuchen,
xneu=x0+Deltax;
yneu=y0;
If[h[xneu,yneu]<h[x0,y0],
x0=xneu;AppendTo[KoordinatenPfad,{x0,y0}],
xneu=x0-Deltax;
yneu=y0;
If[h[xneu,yneu]<h[x0,y0],
x0=xneu;AppendTo[KoordinatenPfad,{x0,y0}]]];
xneu=x0;
yneu=y0+Deltay;
If[h[xneu,yneu]<h[x0,y0],
y0=yneu;AppendTo[KoordinatenPfad,{x0,y0}],
xneu=x0;
yneu=y0-Deltay;
If[h[xneu,yneu]<h[x0,y0],
y0=yneu;AppendTo[KoordinatenPfad,{x0,y0}]]];
If[Length[KoordinatenPfad]==Length0,Weitersuchen=False,Length0=Length[KoordinatenPfad]];];

Print[TableForm[KoordinatenPfad]]

Pseudo-Gradientenverfahren II

Pfad im Parameterraum

KP1=ListPlot[KoordinatenPfad,PlotStyle->{Hue[0.0],PointSize[0.01]},
PlotRange->{{0.0,1.0},{0.0,1.0}}]

Show[CP1,KP1]