Cálculos associados à dedução do espectro de corpo negro

Integral do espectro para determinar a energia total

Integrate[1/(x^5 (Exp[a/x]-1)),{x,0,Infinity},Assumptions->a>0]

Integrate[f^3/(Exp[a f]-1),{f,0,Infinity},Assumptions->a>0]

Cálculo da Constante de Stefan-Boltzmann a partir de c, h e k.

c=QuantityMagnitude[ UnitConvert[Quantity["SpeedOfLight"]] ]

h=QuantityMagnitude[ UnitConvert[Quantity["PlanckConstant"]] ]

k=QuantityMagnitude[ UnitConvert[Quantity["BoltzmannConstant"]] ]

2Pi^5k^4/(15c^2h^3)

σ=QuantityMagnitude[ UnitConvert[Quantity["StefanBoltzmannConstant"]] ]

Lei de Wien

Note que é preciso expressar a radiância em função do comprimento de onda;
 o máximo em unidades de comprimento de onda não coincide com aquele em frequência

solução numérica

u=Solve[( (D[x^5/(Exp[x]-1),x]/.x->b)==0&&b>0),b]//N

h c /(k b)/.u

w=QuantityMagnitude[ UnitConvert[Quantity["WienWavelengthDisplacementLawConstant"]] ]

Solução gráfica

Plot[{5(Exp[x]-1),x Exp[x]},{x,4,6}]

Plot[{5(Exp[x]-1),x Exp[x]},{x,4.9,5.0}]

Determinando as componentes de onda viajantes

Clear[x,y,z,t]

uma dimensão

TrigReduce[ Sin[x]Cos[t]]

duas dimensões

TrigReduce[ Sin[x]Sin[y]Cos[t]]

três dimensões

TrigReduce[ Sin[x]Sin[y]Sin[z]Cos[t]]

fórmulas de prostaférese

TrigReduce[ Sin[x]Sin[y]]

TrigReduce[ Sin[x]Cos[t]]

TrigReduce[ Cos[x]Cos[t]]

Contando os modos

em 2D

modes[] e texto são funcoes auxiliares

modes[w_,n_]:=First[ w[[ Flatten[ Position[ w[[All,1]],First[ Nearest[w[[All,1]],n] ] ] ],2]] ]

texto[w_,n_,δn_]:=Row[{"estimativa        contagem\n",NumberForm[(2Pi/4) n δn,{12,3}],"\t",NumberForm[modes[w,n],{12,3}]}];

Manipulate[Module[{rede,δn=0.5,u,w},rede=Tuples[Range[1,max],2] ;
u=BinCounts[Norm /@ rede, {0,max,δn}];
w=Transpose[{Range[0+δn/2,max-δn/2,δn] ,u}];
ListPlot[rede, AxesLabel->{"(Subscript[n, x])","(Subscript[n, y])"},AspectRatio->Automatic,AxesOrigin->{0,0},PlotLabel->texto[w,n,δn],Epilog->{Circle[{0,0},n,{0,Pi/2}],Circle[{0,0},n+δn,{0,Pi/2}]}]
],{{max,20},10,100,5},{{n,5},1,max-1,1} ]

só o gráfico da aproximação comparado com a contagem

rede=Tuples[Range[1,200],2] ;

u=BinCounts[Norm /@ rede, {0,200,1/2}];

w=Transpose[{Range[1/4,200-1/4,1/2] ,u}];

Show[ Plot[(2Pi/4) n 1/2 ,{n,1,199}] ,ListPlot[ w ] ]

3 D não dá para visualizar nada

ListPointPlot3D[ Tuples[Range[1,10],3] , AspectRatio->Automatic,AxesOrigin->{0,0,0}]

rede3D=Tuples[Range[1,50],3] ;

u3D=BinCounts[Norm /@ rede3D, {0,50,1/2}];

w3D=Transpose[{Range[1/4,50-1/4,1/2] ,u3D}];

Show[ Plot[1/2 (3Pi/6) n^2 ,{n,1,49},AxesLabel->{n,"número de modos"}] ,ListPlot[ w3D ] ]