6. Quantum Mechanics

Legal Notice, Disclaimer, and Book Ordering Information:

Null

Setup

\(Clear["Global`*"]; 
Off[General::spell]; 
Off[General::spell1]; 
    \)

Needs["Calculus`VectorAnalysis`"]

Needs["Graphics`ParametricPlot3D`"]

<< "D:\Mma\Inits\ch6init.m"

Clear["Global`*"];

6.2 Problems

6.2.3  Three Dimensional Schrödinger Equation

Problem 3:  Particle in an infinite spherical box.

Consider a three-dimensional square well of infinite depth and radius a defined by V[r] = 0 for r<a and V[r] = ∞ for r>a..  Assume the wave function separates and is of the form ψ[r,θ,ϕ] = R[r] Θ[θ] Φ[ϕ] .  The radial wave function satisfies the equation R[r] (
              ℓ (1 + ℓ) - 
                ((2 En m (r^2))/(ℏ^2)) + 
                ((2 m (r^2) V[r])/(ℏ^2)))-2 r R'[r]-(r^2) R''[r]==0
where En = (ℏ k)^2/(2 m) + V

Part (a)  Express Schrödinger's equation in spherical coordinates and derive an equation for the angular function Φ[ϕ].  Solve for Φ[ϕ] and show that:
	Φ[ϕ] = c1Exp[-I (Subscript[m, ϕ]) ϕ] + c2Exp[I (Subscript[m, ϕ]) ϕ] .

ψ[r,θ,ϕ] = R[r] Θ[θ] Φ[ϕ]

SetCoordinates[Spherical[r,θ,ϕ]]

eq1 = R[r]*(k^2 r^2 - ℓ(1 + ℓ)) + 2 r R'[r] + r^2 R''[r] == 0

kRule = {k -> Sqrt[2 m (En-V)]/ℏ} /. {V->0}

bfSol = DSolve[eq1,R[r],r]//Flatten//PowerExpand//Simplify

norm[el_,k_,a_] = 1/Sqrt[Integrate[(r^2 BesselJ[(1/2)+el,k r]^2/r),{r,0,a}] ];

rWave[el_,k_,a_,r_] = (norm[el,k,a] BesselJ[(1/2)+el,k r]/Sqrt[r]);

Part (b)  Use the boundary condition at te wall to derive an expression for the eigenvalues.  Solve for the eigenvalues by plotting the two sdes of the eigenvalue equation and observing where the curves intersect.  olve for the eigenvalues a second way by finding the roots of the eigenvalue equation using the command FindRoot.  Display the results in tabular and graphical forms.

Plot[Evaluate[
	Table[BesselJ[(1/2)+n,k],{n,0,2,1}]
	],{k,0.01,6π}];

{guess[0],guess[1],guess[2]}=
	{{3,6,9,13}
	,{4.5,7.8,11,14}
	,{5.7,9,12.5,15.5}};

eigenE[el_,guess_] :=
( guess
	//Map[FindRoot[BesselJ[(1/2)+n,k]==0,{k,#}]& ,#]& )

kValues = Table[eigenE[n,guess[n]],{n,0,2,1}];

TableForm[k/.kValues
	,TableSpacing->{0,2,2}
	,TableHeadings->{{"S-Wave","P-Wave","D-Wave"}
					,{"first","second","third","fourth"}}]

list = k/.kValues;

levels =
	Table[{{2i,list[[i,j]]},{2i+1,list[[i,j]]}}
	,{i,1,3}
	,{j,1,Length[list[[1]] ]}];

Show[	{Graphics[Map[Line,levels,{2}]	]
		,Graphics[Text["S state",{2.5,1}]	]
		,Graphics[Text["P state",{4.5,1}]	]
		,Graphics[Text["D state",{6.5,1}]	]}
		,Frame->True	];

kv1=k/.kValues[[1]]

tr1 = Table[Evaluate[rWave[0,k,1,r]/.k->kv1[[m]]],{m,1,4}]

pt0 = Plot[Evaluate[tr1],{r,.001,1}
		,PlotStyle->{Dashing[{.01,.00}]
					,Dashing[{.05,.02}]
					,Dashing[{.03,.02}]
					,Dashing[{.01,.02}]	}
		,PlotLabel->FontForm["ψ(0)",{"Symbol",10}]
	];

kv2=k/.kValues[[2]];

tr2 = Table[Evaluate[rWave[1,k,1,r]/.k->kv2[[m]]],{m,1,4}];

pt1 = Plot[Evaluate[tr2],{r,.001,1}
		,PlotStyle->{Dashing[{.01,.00}]
					,Dashing[{.05,.02}]
					,Dashing[{.03,.02}]
					,Dashing[{.01,.02}]	}
		,PlotLabel->FontForm["ψ(1)",{"Symbol",10}]
	];

kv3=k/.kValues[[3]];

tr3 = Table[Evaluate[rWave[2,k,1,r]/.k->kv3[[m]]],{m,1,4}];

pt2 = Plot[Evaluate[tr3],{r,.001,1}
		,PlotStyle->{Dashing[{.01,.00}]
					,Dashing[{.05,.02}]
					,Dashing[{.03,.02}]
					,Dashing[{.01,.02}]	}
		,PlotLabel->FontForm["ψ(2)",{"Symbol",10}]
	];

Show@GraphicsArray[{pt0,pt1,pt2}];