Infinite Potential Wall

The energy eigenfunctions and eigenvalues of the infinite potetial wall:

ψ[x_,n_] = (Sqrt[(2/L)])Sin[((n π)/L)x];En[n_] = (((ℏ^2)(π^2))/(2 m (L^2)))(n^2);
nrule = {L-> 1,m-> 1, ℏ-> 1}; (*Numerical values chosen for plots*)
$Assumptions = n∈Integers && l∈Integers && n>0 && m > 0 && L>0 && ℏ>0 && l>0;

Problem 3:

Consider the particle in the initial state ϕ(x,0) = (Subscript[c, 1])(Subscript[ψ, 1])(x)+(Subscript[c, 3])(Subscript[ψ, 3])(x)+(Subscript[c, 5])(Subscript[ψ, 5])(x) for (Subscript[c, 3])/(Subscript[c, 1])=-1/3, (Subscript[c, 5])/(Subscript[c, 1])=1/5. Compute the state ϕ(x,t) and the corresponding average values of position , momentum etc.

Solution:

Consider the expression of the wave function interms of the energy eigenfunctions:
ϕ(x,0) ≡ϕ(x) =  (∑_(n=1)^∞)(Subscript[c, n])(Subscript[ψ, n])(x), (Subscript[c, n])= (∫_0^L)(Subscript[ψ, n])*(x)ϕ(x)dx
ϕ(x,t) = (∑_(n=1)^∞)(Subscript[c, n])(Subscript[ψ, n])(x) (e^(-i (Subscript[E, n])t/ℏ))
< x > (t) = (∑_(n,m=1)^∞)(Subscript[c, m])*(Subscript[c, n])(e^(-i ((Subscript[E, n])-(Subscript[E, m]))t/ℏ))(∫_0^L)(Subscript[ψ, m])*(x)x (Subscript[ψ, n])(x)dx
< (x^2) > (t) = (∑_(n,m=1)^∞)(Subscript[c, m])*(Subscript[c, n])(e^(-i ((Subscript[E, n])-(Subscript[E, m]))t/ℏ))(∫_0^L)(Subscript[ψ, m])*(x)(x^2) (Subscript[ψ, n])(x)dx

We compute the normalization factor A and define the wave function at t=0

A = (1/(Sqrt[(∫_0^L)(((ψ[x,1]-(1/3)ψ[x,3]+(1/5)ψ[x,5]))^2)\[DifferentialD]x]))

Even easier is by using the orthonormality of (Subscript[ψ, n])(x)

A= (1/(Sqrt[1+(((1/3))^2)+(((1/5))^2)]))

ϕ[x_,0] = A(ψ[x,1]-(1/3)ψ[x,3]+(1/5)ψ[x,5]);(∫_0^L)((ϕ[x,0])^2)\[DifferentialD]x

Plot[ϕ[x,0]/.nrule,{x,0,L/.nrule}]

We confirm the expected form of the coefficients (Subscript[c, n]):

cn[y_] = (∫_0^L)ψ[x,y] ϕ[x,0]\[DifferentialD]x

Except when the denominator vanishes:

Solve[-225+259 (y^2)-35 (y^4)+(y^6)==0,y]

cn[1] = (∫_0^L)ψ[x,1] ϕ[x,0]\[DifferentialD]x ;cn[3] = (∫_0^L)ψ[x,3] ϕ[x,0]\[DifferentialD]x ;cn[5]= (∫_0^L)ψ[x,5] ϕ[x,0]\[DifferentialD]x ;
cn[2] =0;cn[4]=0;
Print["(Subscript[c, 1])= ",cn[1]," (Subscript[c, 3])= ",cn[3]," (Subscript[c, 5])= ",cn[5]]

ϕ[x_,t_] = (∑_(n=1)^5)cn[n] ψ[x,n] (E^(-I En[n]t/ℏ))

Absϕ[x_,t_] = Abs[ϕ[x,t]]/.nrule;
Manipulate[Plot[((Absϕ[x,t])^2),{x,0,1},PlotRange->{{0,1},{0,4}}],{t,0,4,0.0001}]

Reϕ[x_,t_] = Re[ϕ[x,t]]/.nrule;
Imϕ[x_,t_] = Im[ϕ[x,t]]/.nrule;
Manipulate[Plot[{Reϕ[x,t],Imϕ[x,t]},{x,0,1},PlotRange->{{0,1},{-2,2}},PlotStyle->{Red,Blue}],{t,0,4,0.0001}]

Average energy <E>, <(E^2)> and uncetainty ΔE:

avE = (∑_(n=1)^5)((cn[n])^2)En[n];avE2 = (∑_(n=1)^5)((cn[n])^2)((En[n])^2);ΔE = (Sqrt[avE2-(avE^2)]);
Print[
"<E> = ", avE," = ",avE/En[1]," (Subscript[E, 1]) = ",avE/En[1]//N," (Subscript[E, 1])",
"\n\!\(\*Cell[TextData[{
Cell[BoxData[
FormBox[
RowBox[{"<", 
SuperscriptBox["E", "2"]}], TraditionalForm]]],
"> = "
}]]\)", avE2," = ",avE2/((En[1])^2)," ((Subscript[E, 1])^2) = ",avE2/((En[1])^2)//N," ((Subscript[E, 1])^2)",
"\nΔE = ",ΔE," = ",ΔE/En[1]//Simplify," (Subscript[E, 1]) = ",ΔE/En[1]//Simplify//N," (Subscript[E, 1])"
]

Position and momenta matrix elements:
(Subscript[x, nm])= (∫_0^L)(Subscript[ψ, n])*(x)x (Subscript[ψ, m])(x)dx,(Subscript[(x^2), nm])= (∫_0^L)(Subscript[ψ, n])*(x)(x^2)(Subscript[ψ, m])(x)dx , (Subscript[p, nm])= (∫_0^L)(Subscript[ψ, n])*(x)(OverHat[p]) ψ(x)dx, (Subscript[(p^2), nm])= (∫_0^L)(Subscript[ψ, n])*(x)((OverHat[p])^2) ψ(x)dx

xnm[n_,l_] = (∫_0^L)ψ[x,n]x ψ[x,l]\[DifferentialD]x;xnm[n_,n_] = (∫_0^L)ψ[x,n]x ψ[x,n]\[DifferentialD]x;
x2nm[n_,l_] = (∫_0^L)ψ[x,n](x^2) ψ[x,l]\[DifferentialD]x;x2nm[n_,n_] = (∫_0^L)ψ[x,n](x^2) ψ[x,n]\[DifferentialD]x;
pnm[n_,l_] = (∫_0^L)ψ[x,n](-I ℏ) (∂_x)ψ[x,l]\[DifferentialD]x /. Cos[l π] -> (((-1))^l);pnm[n_,n_] = (∫_0^L)ψ[x,n](-I ℏ) (∂_x)ψ[x,n]\[DifferentialD]x ;
p2nm[n_,l_] = (∫_0^L)ψ[x,n](- (ℏ^2)) (∂_(x,x))ψ[x,l]\[DifferentialD]x ;p2nm[n_,n_] = (∫_0^L)ψ[x,n](- (ℏ^2)) (∂_(x,x))ψ[x,n]\[DifferentialD]x ;

xavϕ[t_] = (∑_(n=1)^5)(∑_(l=1)^5) cn[n] cn[l] xnm[n,l] (E^(-I(En[l]-En[n])t/ℏ));
x2avϕ[t_] = (∑_(n=1)^5)(∑_(l=1)^5) cn[n] cn[l] x2nm[n,l] (E^(-I(En[l]-En[n])t/ℏ))//ExpToTrig;
pavϕ[t_] = (∑_(n=1)^5)(∑_(l=1)^5) cn[n] cn[l] pnm[n,l] (E^(-I(En[l]-En[n])t/ℏ));
p2avϕ[t_] = (∑_(n=1)^5)(∑_(l=1)^5) cn[n] cn[l] p2nm[n,l] (E^(-I(En[l]-En[n])t/ℏ));
Δx[t_] = (Sqrt[x2avϕ[t]-((xavϕ[t])^2)])//Simplify;Δp[t_]=(Sqrt[p2avϕ[t]-((pavϕ[t])^2)])//Simplify;
Print[
"<x>(t)= ",xavϕ[t],"\!\(\*Cell[TextData[{
" ",
Cell[BoxData[
FormBox[
RowBox[{"<", 
SuperscriptBox["x", "2"]}], TraditionalForm]]],
">(t)= "
}]]\)",x2avϕ[t],"\nΔx(t)= ",Δx[t],
"\n<p>(t)= ",pavϕ[t],"\!\(\*Cell[TextData[{
" ",
Cell[BoxData[
FormBox[
RowBox[{"<", 
SuperscriptBox["p", "2"]}], TraditionalForm]]],
">(t)= "
}]]\)",p2avϕ[t]," Δp(t)= ",Δp[t],
"\nΔx(t) Δp(t) = ", Δx[t] Δp[t]
]

{Plot[xavϕ[t]/.nrule,{t,0,1},PlotLabel-> "<x>(t)",PlotStyle->Directive[Red,Thick]],
Plot[(Sqrt[x2avϕ[t]/.nrule]),{t,0,1},PlotLabel-> "<(x^2)((>)^(1/2))(t)",PlotStyle->Directive[Blue,Thick]]}

{Plot[pavϕ[t]/.nrule,{t,0,1},PlotLabel-> "<p>(t)",PlotStyle->Directive[Red,Thick]],
Plot[(Sqrt[p2avϕ[t]/.nrule]),{t,0,1},PlotLabel-> "<(p^2)((>)^(1/2))(t)",PlotStyle->Directive[Blue,Thick]]}

{Plot[Δx[t]/.nrule,{t,0,1},PlotLabel-> "Δx(t)",PlotStyle->Directive[Red,Thick]],
Plot[Δp[t]/.nrule,{t,0,1},PlotLabel-> "Δ(t)",PlotStyle->Directive[Blue,Thick]],
Plot[{Δx[t]Δp[t]/.nrule,ℏ/2/.nrule},{t,0,1},PlotLabel-> "Δx(t) Δp(t)",PlotStyle->{Directive[Magenta,Thick],Directive[Green,Thick]}]}