Newtonovský efektivní potenciál (Subscript[V, ef])(r) = -(α/r) + (β/(r^2))

Následující aplet umožňuje názorně zobrazit průběh Newtonovského efektivního potenciálu v závislosti na vzdálenosti tělesa od centra centrálního silového pole.
Pomocí posuvníků lze nastavit:
	- hodnotu parametru α;
	- hodnotu parametru β;
	- hodnotu energie E, v závislosti na jejíž hodnotě se realizuje příslušný pohyb;
	- okamžitou vzdálenost pohybujícího se tělesa od centra uvažovaného pole (v této poloze se vykresluje kinetická energie T - je-li její zobrazování zvoleno).

Volitelně lze zobrazit:
	- energii E;
	- kinetickou energii T, která se vykresluje v závislosti na tom, zda okamžitá vzdálenost tělesa od centra pole je resp. není v zakázané oblasti;
	- zakázanou oblast - buď se nebude vykreslovat vůbec, nebo se vykreslí jako plocha pod grafem funkce (Subscript[V, ef])(r) a nebo jako interval na ose r;
	- body obratu;
	- popis.

Tlačítkem Ulož obrázek se uloží právě zobrazené "bílé" okno do aktuální složky (složka, v níž je uložen tento notebook) pod jménem, které je uloženo v proměnné jmenosouboru. K tomuto jménu souboru je při opakovaném ukládání grafu přidáváno pořadové číslo.
Pozor! Při každém spuštění tohoto apletu se začínají soubory číslovat opět od jedné! Tak mohou být přepsány dříve uložené obrázky.

© Jaroslav Reichl, 2009

Příprava pro vykreslení grafu

ClearAll["Global`*"];
jmenosouboru="efektivni_potencial_.jpg";
cesta=NotebookDirectory[];
pocetulozeni=0;

x1=-10;x2=-x1;
y1=-10;y2=-y1;

rmax=50;
alfa0=1.5;alfamin=0.1;alfamax=10;deltaalfa=0.1;
beta0=1.5;betamin=0;betamax=10;deltabeta=0.1;
energiemin=0.07y1;energiemax=0.07y2;deltaenergie=0.001(y2-y1);energie0=energiemax-10deltaenergie;
poloha0=0.25rmax;polohamin=0.0001;polohamax=rmax;deltapoloha=0.01rmax;


barva=Black;
barvagrafu=Blue;
barvaenergie=Red;
barvazakazu=Lighter[Gray,0.8];
barvazakazunaose=Black;
barvabodu=Magenta;
barvakinenergie=Orange;
barvapozadi=White;

tloustka=0.004;
velikostbodu=0.02;

EfektivniPotencial=Manipulate[
(*Vef[r_]:=-(alfa/r)+(beta/(r^2))-(beta2/(r^3));*)
Vef[r_]:=-(alfa/r)+(beta/(r^2));
Ekineticka[r_]:=energie-Vef[r];
lineEkineticka=Line[{{poloha,energie},{poloha,Vef[poloha]}}];
znackaEkineticka=Point[{poloha,0}];

reseni=Solve[Vef[rpom]==energie,rpom];
If[reseni≠{},
{bod1=rpom/.reseni[[1]],
If[Im[bod1]==0,
{kreslibod1=Point[{bod1,energie}],
chyba1=False},
chyba1=True],
If[Length[reseni]>1,
{bod2=rpom/.reseni[[2]],
If[Im[bod2]==0,
{kreslibod2=Point[{bod2,energie}],
chyba2=False},
chyba2=True]},
chyba2=True]},
chyba1=True];

bod0zakazline=Point[{0,0}];
bod1zakazline=Point[{bod1,0}];
bod2zakazline=Point[{bod2,0}];
rzakazline1=Line[{{0,0},{bod1,0}}];
rzakazline2=Line[{{0,0},{bod2,0}}];
rzakazline3=Line[{{bod2,0},{1.1rmax,0}}];
rzakazline4=Line[{{0,0},{1.1rmax,0}}];
pomline1=Line[{{bod1,0},{bod1,energie}}];
pomline2=Line[{{bod2,0},{bod2,energie}}];

grafik=Show[
If[zobrazitenergii==False,
If[zobrazitzakazanouoblast=="plocha",
Plot[Vef[r],{r,0.001,rmax},PlotStyle->{barvagrafu,Thickness[tloustka]},PerformanceGoal->"Quality",AxesOrigin->{0,0},PlotRange->{{0.05x1,rmax},{energiemin,energiemax}},Ticks->None,AxesLabel->{Style["r",15,barva,FontFamily->Times],Style["(Subscript[V, ef])",15,barva,FontFamily->Times]},Filling->{1->{Bottom,barvazakazu}}],
Plot[Vef[r],{r,0.001,rmax},PlotStyle->{barvagrafu,Thickness[tloustka]},PerformanceGoal->"Quality",AxesOrigin->{0,0},PlotRange->{{0.05x1,rmax},{energiemin,energiemax}},Ticks->None,AxesLabel->{Style["r",15,barva,FontFamily->Times],Style["(Subscript[V, ef])",15,barva,FontFamily->Times]}]],
If[zobrazitzakazanouoblast=="plocha",
Plot[{Vef[r],energie},{r,0.001,rmax},PlotStyle->{{barvagrafu,Thickness[tloustka]},{barvaenergie,Thickness[tloustka]}},PerformanceGoal->"Quality",AxesOrigin->{0,0},PlotRange->{{0.05x1,rmax},{energiemin,energiemax}},Ticks->None,AxesLabel->{Style["r",15,barva,FontFamily->Times],Style["(Subscript[V, ef])",15,barva,FontFamily->Times]},Filling->{1->{Bottom,barvazakazu}}],
Plot[{Vef[r],energie},{r,0.001,rmax},PlotStyle->{{barvagrafu,Thickness[tloustka]},{barvaenergie,Thickness[tloustka]}},PerformanceGoal->"Quality",AxesOrigin->{0,0},PlotRange->{{0.05x1,rmax},{energiemin,energiemax}},Ticks->None,AxesLabel->{Style["r",15,barva,FontFamily->Times],Style["(Subscript[V, ef])",15,barva,FontFamily->Times]}]]],

Graphics[{
If[zobrazitbody∧zobrazitenergii∧chyba1==False,
{barvabodu,PointSize[velikostbodu],kreslibod1},
Text[""]],
If[zobrazitbody∧zobrazitenergii∧chyba2==False,
{barvabodu,PointSize[velikostbodu],kreslibod2},
Text[""]],
If[zobrazitkinenergii∧zobrazitenergii,
{{barvakinenergie,PointSize[velikostbodu],znackaEkineticka},
If[Ekineticka[poloha]≥0,
{barvakinenergie,Thickness[tloustka],lineEkineticka},
Text[""]]},
Text[""]],
If[zobrazitzakazanouoblast=="na ose"∧zobrazitenergii,
If[energie>0,
{{barva,Thickness[0.5tloustka],Dashed,pomline2},
{barvazakazunaose,PointSize[0.7velikostbodu],bod0zakazline},
{barvazakazunaose,PointSize[0.7velikostbodu],bod2zakazline},
{barvazakazunaose,Thickness[1.7tloustka],rzakazline2}},
If[energie==0,
{{barva,Thickness[0.5tloustka],Dashed,pomline1},
{barvazakazunaose,PointSize[0.7velikostbodu],bod0zakazline},
{barvazakazunaose,PointSize[0.7velikostbodu],bod1zakazline},
{barvazakazunaose,Thickness[1.7tloustka],rzakazline1}},
If[chyba1==False,
{{barva,Thickness[0.5tloustka],Dashed,pomline1},
{barva,Thickness[0.5tloustka],Dashed,pomline2},
{barvazakazunaose,PointSize[0.7velikostbodu],bod0zakazline},
{barvazakazunaose,PointSize[0.7velikostbodu],bod1zakazline},
{barvazakazunaose,Thickness[1.7tloustka],rzakazline1},
{barvazakazunaose,PointSize[0.7velikostbodu],bod2zakazline},
{barvazakazunaose,Thickness[1.7tloustka],rzakazline3}},
{{barvazakazunaose,PointSize[0.7velikostbodu],bod0zakazline},
{barvazakazunaose,Thickness[1.7tloustka],rzakazline4}}]]],
Text[""]],
If[zobrazitpopis,
{Text[Style["(Subscript[V, ef])(r)",15,barvagrafu,FontFamily->Times],{rmax,0},{Right,Bottom}],
If[zobrazitenergii,
Text[Style["E = konst",15,barvaenergie,FontFamily->Times],{rmax,energie},{Right,Bottom}],
Text[""]],
If[zobrazitkinenergii∧Ekineticka[poloha]≥0∧zobrazitenergii,
Text[Style["T",15,barvakinenergie,FontFamily->Times],{poloha+20deltaenergie,energie-2deltaenergie},{Left,Top}],
Text[""]],
If[zobrazitzakazanouoblast=="plocha",
Text[Style["Z A K Á Z A N Á   O B L A S T",18,barva,FontFamily->Times,Bold],{0.5rmax,energiemin+3deltaenergie},{Center,Bottom}],
Text[""]]},
Text[""]]
}],
FormatType->StandardForm,ImageSize->500],

{{alfa,alfa0,Style["α",15,barva,Italic]},alfamin,alfamax,deltaalfa},
{{beta,beta0,Style["β",15,barva,Italic]},betamin,betamax,deltabeta},
Delimiter,
{{energie,energie0,Style["E",15,barvaenergie,Italic]},energiemin,energiemax,deltaenergie},
Delimiter,
{{poloha,poloha0,Style["r",15,barvakinenergie,Italic]},polohamin,polohamax,deltapoloha},
Delimiter,
Item[Style["Zobrazit",20,barva,FontFamily->Times,Bold,Underlined],Alignment->Left],
{{zobrazitenergii,True,Style["energii",15,barvaenergie,FontFamily->Times]},{True,False},ControlType->Checkbox},
{{zobrazitkinenergii,True,Style["kinetickou energii",15,barvakinenergie,FontFamily->Times]},{True,False},ControlType->Checkbox},
{{zobrazitzakazanouoblast,"na ose",Style["zakázanou oblast",15,barva,FontFamily->Times]},{"nijak","na ose","plocha"},ControlType->RadioButton},
{{zobrazitbody,True,Style["body obratu",15,barvabodu,FontFamily->Times]},{True,False},ControlType->Checkbox},
{{zobrazitpopis,True,Style["popis",15,barva,FontFamily->Times]},{True,False},ControlType->Checkbox},
Delimiter,
Button[" Ulož obrázek ",{pocetulozeni=pocetulozeni+1,Export[StringInsert[StringJoin[cesta,jmenosouboru],ToString[pocetulozeni],-5],grafik]},ImageSize->{100,Automatic}],
ControlPlacement->Left,
FrameLabel->{Style["© Jaroslav Reichl, 2009",10,Black,FontFamily->Times],"",Style["Newtonovský efektivní potenciál (Subscript[V, ef])(r) = -(α/r) + (β/(r^2))",25,Black,FontFamily->Times],""}];

Spuštění animace
Zpracujte běžným způsobem následující buňku a na dotaz, který se objeví, odpovězte ANO.

EfektivniPotencial