Záření absolutně černého tělesa

Tento interaktivní notebook zobrazuje závislost spektrální hustoty intenzity vyzařování absolutně černého tělesa na vlnové délce záření a na teplotě. Pomocí posuvníků lze:
	měnit teplotu absolutně černého tělesa;
	nastavit konkrétní vlnovou délku (Subscript[λ, 0]) elektromagnetického záření, v závislosti na níž se zobrazí bod na vykreslené křivce.

Volitelně lze zobrazit:
	popis - vypíší se hodnoty charakteristické pro zobrazený graf: nastavená teplota T, aktuální vlnová délka (Subscript[λ, 0]) (je-li vybrána volba bod) a vlnová délka (Subscript[λ, max]), při níž je spektrální hustota intenzity vyzařování nejvyšší;
	bod daný aktuální vlnovou délkou (Subscript[λ, 0]), kterou lze nastavit pomocí posuvníku;
	(Subscript[λ, max]) vlnová délka, při níž nabývá zobrazená křivka maxima;
	více grafů charakterizovaných různou teplotou, z nichž jsou zřejmé polohy maxim křivek;
	Rayleigh - Jeans - graf, který odpovídá vztahu, který odvodili pánové Rayleigh a Jeans bez znalosti kvantové mechaniky;
	Wien - graf, který odpovídá vztahu odvozenému Wienem (opět bez znalosti kvantové mechaniky);
	rozsah světla - zobrazí interval světla viditelného lidským okem.

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 může dojít k přepsání minule uložených obrázků.

© Jaroslav Reichl, 2010

Příprava pro vykreslení grafu

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

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

T0=7000;Tmin=0;Tmax=10000;deltaT=50;
T0table=1000;deltaTtable=1000;
lambda0=100;lambdamin=0;lambdamax=2500;deltalambda=50;

tloustka=0.005;
velikostbodu=0.02;
velikostpisma=18;

h=6.63*(10^(-34));
c=3*(10^8);
k=1.38*(10^(-23));
b=2.9 (10^(-3));

barva=Black;
barvagrafu=Blue;
barvajeansovagrafu=Darker[Green];
barvawienovagrafu=Magenta;
barvabodu=Red;
barvalambdamax=Orange;
barvahyperboly=Brown;

mezebarvy={360,430,490,550,590,650,760};
barvasvetla={Magenta,Blue,Green,Yellow,Orange,Red};
(*barvasvetla={LightMagenta,LightBlue,LightGreen,LightYellow,LightOrange,LightRed};*)

intenzita[λ_,T_]:=((2π h (c^2))/(((((λ/(10^9))))^5)((E^((h c (10^9))/(k T λ)))-1)));
maximumintenzity=intenzita[(((10^9)b)/Tmax),Tmax];
intenzitaklasicka[λ_,T_]:=((2c k T)/((((λ/(10^9))))^4));
intenzitawien[λ_,T_]:=((2h (c^2) )/((((λ/(10^9))))^5))(E^(-((h c (10^9))/(k T λ))));

ZareniACT=Manipulate[Deploy[
If[lambdaaktualni≠0∧T≠0,
bodkrivky=Point[{lambdaaktualni,intenzita[lambdaaktualni,T]}],
""];
If[zobrazitvicegrafu==False,
If[T≠0,
{bodmaxlambda=Point[{(((10^9)b)/T),intenzita[(((10^9)b)/T),T]}],
bodmaxpruvodic=Line[{{(((10^9)b)/T),intenzita[(((10^9)b)/T),T]},{(((10^9)b)/T),0}}]},
""],
{bodymaximkrivek=Table[{(((10^9)b)/i),intenzita[(((10^9)b)/i),i]},{i,T0table,Tmax,deltaTtable}],
bodymaxlambdatable=Table[Point[{bodymaximkrivek[[i,1]],bodymaximkrivek[[i,2]]}],{i,1,Length[bodymaximkrivek],1}]
}];
(*If[zobrazithyperbolu ∧zobrazitvicegrafu,
{
(*hyperbola[x_]:=(kpom/(x-mpom)),
reseni=Quiet[Solve[{hyperbola[(((10^9)b)/Tmax)]==intenzita[(((10^9)b)/Tmax),Tmax],hyperbola[(((10^9)b)/(Tmax-deltaTtable))]==intenzita[(((10^9)b)/(Tmax-deltaTtable)),Tmax-deltaTtable]},{kpom,mpom}]],
khyp=kpom/.reseni[[1,1]],
mhyp=mpom/.reseni[[1,2]],
hyperbolakresli[x_]:=hyperbola[x]/.{kpom->khyp,mpom->mhyp}*)

(*hyperbolafit=FindFit[bodymaximkrivek,(apom/x)+bpom,{apom,bpom},x],*)
hyperbolakresli[x_]:=Fit[bodymaximkrivek,{1,(x^(-1))},x],
(*koefa=apom/.hyperbolafit[[1]],
koefb=bpom/.hyperbolafit[[2]],
hyperbolakresli[x_]:=(koefa/x)+koefb*)
},
""];*)

If[lambdaaktualni≠0,
pislambda0=StringJoin[ToString[Style["(Subscript[λ, 0])",barvabodu],StandardForm],ToString[Style[" = ",barva],StandardForm],ToString[Style[ToString[Round[lambdaaktualni]],barvabodu],StandardForm],ToString[Style[" nm",barva],StandardForm]],
pisinfo="Není definováno!"];
If[T≠0,
pislambdamax=StringJoin[ToString[Style["(Subscript[λ, max])",barvalambdamax],StandardForm],ToString[Style[" = ",barva],StandardForm],ToString[Style[ToString[Round[(((10^9)b)/T)]],barvalambdamax],StandardForm],ToString[Style[" nm",barva],StandardForm]],
pislambdamax="Maximum není definováno!"];
pisteplotagrafu=StringJoin[ToString[Style["(Subscript[T, grafu])",barvagrafu],StandardForm],ToString[Style[" = ",barva],StandardForm],ToString[Style[ToString[Round[T]],barvagrafu],StandardForm],ToString[Style[" K",barva],StandardForm]];

grafik=Show[
If[zobrazitvicegrafu==False,
{If[T≠0,
Plot[intenzita[λ,T],{λ,1,lambdamax},PlotStyle->{Thickness[tloustka],barvagrafu}],
Plot[intenzita[λ,1],{λ,1,lambdamax},PlotStyle->{Thickness[tloustka],barvagrafu}]],
If[zobrazitklasickygraf,
Plot[intenzitaklasicka[λ,T],{λ,1,lambdamax},PlotStyle->{Thickness[tloustka],barvajeansovagrafu}],
Plot[0,{λ,0,0.0001},PlotStyle->{Thickness[0.0001tloustka],barva}]],
If[zobrazitwienuvgraf,
Plot[intenzitawien[λ,T],{λ,1,lambdamax},PlotStyle->{Thickness[tloustka],barvawienovagrafu}],
Plot[0,{λ,0,0.0001},PlotStyle->{Thickness[0.0001tloustka],barva}]]},
{Plot[Table[intenzita[λ,i],{i,T0table,Tmax,deltaTtable}],{λ,1,lambdamax},PlotStyle->{Thickness[tloustka],barvagrafu},PlotRange->{{0,lambdamax},{0,maximumintenzity}}]
(*If[zobrazithyperbolu,
Plot[hyperbolakresli[x],{x,0.1,lambdamax},PlotStyle->{Thickness[tloustka],barvahyperboly}],
Plot[0,{x,0,0.001},PlotStyle->{Thickness[0.0001tloustka],barva}]]*)}],

Graphics[{
If[zobrazitbod∧zobrazitvicegrafu==False,
{barvabodu,PointSize[velikostbodu],bodkrivky},
Text[""]],
If[zobrazitlambdamax,
If[zobrazitvicegrafu==False,
{{barvalambdamax,PointSize[velikostbodu],bodmaxlambda},
{barvalambdamax,Dotted,Thickness[0.5tloustka],bodmaxpruvodic}},
{barvalambdamax,PointSize[velikostbodu],bodymaxlambdatable}],
Text[""]],
If[zobrazitintervalsvetla∧zobrazitvicegrafu==False,
Table[
Table[{barvasvetla[[i]],Thickness[1.5tloustka],Line[{{mezebarvy[[i]]+krok,0},{mezebarvy[[i]]+krok,0.96intenzita[mezebarvy[[i]]+krok,T]}}]},
{krok,0,mezebarvy[[i+1]]-mezebarvy[[i]],10}],
{i,1,Length[mezebarvy]-1,1}],
Text[""]]
}],
FormatType->StandardForm,PlotRange->{{0,lambdamax},{0,maximumintenzity}},AxesOrigin->{0,0},AxesLabel->{"(λ/nm)","(H/(J . (s^(-1)) . (m^(-3))))"},Ticks->{Automatic,None},ImageSize->500
]],

{{T,T0,Style["T",15,barva,FontFamily->Times]},Tmin,Tmax,deltaT},
Delimiter,
{{lambdaaktualni,lambda0,Style["(Subscript[λ, 0])",15,barvabodu,FontFamily->Times]},lambdamin,lambdamax,deltalambda},
Delimiter,
Item[Style["Zobrazit",20,barva,FontFamily->Times,Bold,Underlined],Alignment->Left],
{{zobrazitpopis,True,Style["- popis",15,barva,FontFamily->Times]},{True,False},ControlType->Checkbox},
{{zobrazitbod,True,Style["- bod",15,barvabodu,FontFamily->Times]},{True,False},ControlType->Checkbox},
{{zobrazitlambdamax,True,Style["- (Subscript[λ, max])",15,barvalambdamax,FontFamily->Times]},{True,False},ControlType->Checkbox},
{{zobrazitvicegrafu,False,Style["- více grafů",15,barvagrafu,FontFamily->Times]},{True,False},ControlType->Checkbox},
(*{{zobrazithyperbolu,True,Style["- křivku maxim",15,barvahyperboly,FontFamily->Times]},{True,False},ControlType->Checkbox},*)
{{zobrazitklasickygraf,False,Style["- Rayleigh-Jeans",15,barvajeansovagrafu,FontFamily->Times]},{True,False},ControlType->Checkbox},
{{zobrazitwienuvgraf,False,Style["- Wien",15,barvawienovagrafu,FontFamily->Times]},{True,False},ControlType->Checkbox},
{{zobrazitintervalsvetla,False,Style["- rozsah světla",15,barva,FontFamily->Times]},{True,False},ControlType->Checkbox},
Delimiter,

Dynamic[
Grid[{
{If[zobrazitpopis∧zobrazitvicegrafu==False,
Item[Style[pisteplotagrafu,velikostpisma,barva,FontFamily->Times],Alignment->Left],
""]},
{If[zobrazitpopis∧zobrazitbod∧zobrazitvicegrafu==False∧lambdaaktualni≠0,
Item[Style[" ",velikostpisma,barva,FontFamily->Times],Alignment->Left],
""]},
{If[zobrazitpopis∧zobrazitbod∧zobrazitvicegrafu==False∧lambdaaktualni≠0,
Item[Style[pislambda0,velikostpisma,barva,FontFamily->Times],Alignment->Left],
""]},
{If[zobrazitpopis∧zobrazitbod∧zobrazitvicegrafu==False∧lambdaaktualni==0,
Item[Style[pisinfo,velikostpisma,barva,FontFamily->Times],Alignment->Left],
""]},
{If[zobrazitpopis∧zobrazitlambdamax∧zobrazitvicegrafu==False,
Item[Style[" ",velikostpisma,barva,FontFamily->Times],Alignment->Left],
""]},
{If[zobrazitpopis∧zobrazitlambdamax∧zobrazitvicegrafu==False,
Item[Style[pislambdamax,velikostpisma,barva,FontFamily->Times],Alignment->Left],
""]}
}]],
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, 2010",10,Black,FontFamily->Times],"",Style["Záření absolutně černého tělesa",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.

ZareniACT