Hydrogen Probability Density Movies

SetOptions[Plot,BaseStyle->{FontSize->16},PlotStyle->Thick,ImageSize->500];
SetOptions[ParametricPlot3D,ColorFunctionScaling->False,Boxed->False,ImageSize->Medium,PlotPoints->50,PlotRange->{{-rng,rng},{-rng,rng},{-rng,rng}},AspectRatio->1,AxesLabel->{"x/(Subscript[a, 0])","y/(Subscript[a, 0])","z/(Subscript[a, 0])"},Mesh->None,ViewPoint->{5,3,2},AxesEdge->{{1,-1},{1,-1},{1,-1}},BaseStyle->{FontSize->12,FontFamily->"Arial"},ColorFunctionScaling->False];
SetOptions[SphericalPlot3D,PlotRange->All,ViewPoint->{2.6, 0, 1.4},Axes->False,Boxed->False,Mesh->{30,10},ImageSize->Medium];
SetOptions[Manipulator,Appearance->"Labeled"];
SetOptions[Graphics,ImageSize->488];

First, we define the Hydrogen atom’s eigenstate wavefunctions and relevant initialization parameters:

a0=1;
rng=15;
Npts=50;
R[n_,l_,r_]:=Sqrt[(2/n a0)^3 (n-l-1)!/(2n((n+l)!))]Exp[-r/(n a0)](2r/(n a0))^l LaguerreL[n-l-1,2l+1,2r/(n a0)]
Y[l_,m_,θ_,ϕ_]:=SphericalHarmonicY[l,m,θ,ϕ]
Ψ[n_,l_,m_,r_,θ_,ϕ_]:=R[n,l,r]Y[l,m,θ,ϕ];

Plot angular part. Use color-on-sphere plot.  Red is max, blue is min (0).  Viewpoint is from positive x-axis. Also try 3 - D Polar plot.  Viewpoint is from positive x-axis.

Manipulate[
Ysq[θ_,ϕ_]=FullSimplify[ComplexExpand[Conjugate[Y[l,m,θ,ϕ]]*Y[l,m,θ,ϕ]]];
maxx=Max[Table[Abs[Ysq[θ,ϕ]],{θ,0,π,π/20},{ϕ,0,2π,π/10}]];
YsphPlot1=SphericalPlot3D[1,{θ,0,π},{ϕ,0,2*π},ColorFunction->Function[{x,y,z,θ,ϕ,r},Hue[.67(1-Ysq[θ*Pi,ϕ]/maxx)]]];
YsphPlot2=SphericalPlot3D[1+Ysq[θ,ϕ],{θ,0,π},{ϕ,0,2*π},ColorFunction->Function[{x,y,z,θ,ϕ,r},Hue[.67(1-Ysq[θ*Pi,ϕ]/maxx)]]];
YlmPlot=SphericalPlot3D[Ysq[θ,ϕ],{θ,0,π},{ϕ,0,2*π},ColorFunction->Function[{x,y,z,θ,ϕ,r},Hue[.67(1-Ysq[θ*Pi,ϕ]/maxx)]]];
Off[N::meprec];
Grid[{{YsphPlot1,YsphPlot2,YlmPlot}}],{{n,1},1,5,1},{{l,0},0,n-1,1},{{m,0},-l,l,1},TrackedSymbols:>{n,l,m}]

Plot radial part

Rnlsq[n_,l_]:=Simplify[ComplexExpand[Conjugate[R[n,l,r]]*R[n,l,r]]]
Manipulate[Plot[Rnlsq[n,l],{r,0,rng}],{n,1,10,1},{l,0,n-1,1},{{m,0},-l,l,1},TrackedSymbols:>{n,l,m}]

Manipulate (animate) frames of z slices

Manipulate[
MyState[r_,θ_,ϕ_]=Ψ[n,l,m,r,θ,ϕ];
psimax=Max[Table[(Abs[Ψ[n,l,m,r,θ,ϕ]]),{r,0.01,rng,0.5},{θ,0,π,π/20},{ϕ,0,2π,π/10}]];"",{n,1,10,1},{l,0,n-1,1},{{m,0},-l,l,1},TrackedSymbols:>{n,l,m}]

Manipulate[
Plot1=ParametricPlot3D[{x,y,z},{x,-rng,rng},{y,-rng,rng},ColorFunction->Function[{x,y,z},Hue[0.67* (1-Abs[MyState[Sqrt[x^2+y^2+z^2],ArcCos[z/Sqrt[x^2+y^2+z^2]],ArcCos[x/Sqrt[x^2+y^2]]]]/psimax)]],ImageSize->Large];
PlotSlice=ParametricPlot3D[{x,0,z},{x,-rng,rng},{z,-rng,rng},ColorFunction->Function[{x,y,z},Hue[0.67* (1-Abs[MyState[Sqrt[x^2+y^2+z^2],ArcCos[z/Sqrt[x^2+y^2+z^2]],ArcCos[x/Sqrt[x^2+y^2]]]]/psimax)]],ImageSize->Large];
Graphics[Inset[Show[Plot1,PlotSlice],{0,0},Center,{2,2}]],{z,-rng,rng,rng/20.0},TrackedSymbols:>{z}]

David McIntyre, Mike Vignal, and Ian Founds
13 March 2012