Init

<<PhysicalConstants`

Some Functions  and Definitions:

(* general pure state in polar coordinates *)
State[θ_,ϕ_]:={Cos[θ/2],Sin[θ/2]Exp[I ϕ]}
(*normalized state with real first argument *)
StateNorm[x_List]:=Module[{arg1=Arg[x[[1]]],arg2=Arg[x[[2]]],normx=x/Norm[x],θ,ϕ},
θ=2Chop@ArcCos[normx[[1]]Exp[-I arg1]];
ϕ=Mod[arg2-arg1,2π];
{Cos[θ/2],Sin[θ/2]Exp[I ϕ]}]
(* outputs the polar coordinate from a state vector *)
blochcoord[state_]:=Module[{arg1=Arg[state[[1]]],arg2=Arg[state[[2]]],normx=state/Norm[state],θ,ϕ},
θ=Abs[2Chop@ArcCos[normx[[1]]Exp[-I arg1]]];
ϕ=Abs@Mod[arg2-arg1,2π];
{θ,ϕ}]

(* define a bloch sphere graph *)
With[{r=1},xy=ParametricPlot3D[{r Cos[θ],r Sin[θ],0},{θ,0,2 π},PlotStyle->Dashed,Boxed->False,Axes->False];
yz=ParametricPlot3D[{0,r Cos[θ],r Sin[θ]},{θ,0,2 π},PlotStyle->Dashed,Boxed->False,Axes->False];
xz=ParametricPlot3D[{r Cos[θ],0,r Sin[θ]},{θ,0,2 π},PlotStyle->Dashed,Boxed->False,Axes->False];
bloch=Show[Graphics3D[{Green,Opacity[.25],Sphere[{0,0,0},r],Opacity[1],Black,Thick,Line[{{0,r,0},{0,-r,0}}],Line[{{0,0,r},{0,0,-r}}],Line[{{r,0,0},{-r,0,0}}],Text[Style["z+",FontSize->16,FontWeight->Bold,FontColor->GrayLevel[.3]],{0,0,1.3 r}],Text[Style["z-",FontSize->16,FontWeight->Bold,FontColor->GrayLevel[.3]],{0,0,-1.3 r}],Text[Style["x+",FontSize->16,FontWeight->Bold,FontColor->GrayLevel[.3]],{1.3 r,0,0}],Text[Style["x-",FontSize->16,FontWeight->Bold,FontColor->GrayLevel[.3]],{-1.3 r,0,0}],Text[Style["y+",FontSize->16,FontWeight->Bold,FontColor->GrayLevel[.3]],{0,1.3 r,0}],Text[Style["y-",FontSize->16,FontWeight->Bold,FontColor->GrayLevel[.3]],{0,-1.3 r,0}]}],xy,xz,yz,Boxed->False]];
(* generate vector for bloch sphere representation *)
Options[blochvec]={color->Blue};
blochvec[{θ_,ϕ_},OptionsPattern[]]:=Graphics3D[{OptionValue[color],Thickness[0.02],Line[{{0,0,0},{Sin[θ]Cos[ϕ],Sin[θ]Sin[ϕ],Cos[θ]}}]}]

(* draw vector for bloch sphere taking an arbitrary pure input state *)
blochvecstate[state_]:=blochvec@blochcoord[state]
(*bloch vector for mixed states *)
blochvecmsphere[r_,θ_,ϕ_]:=Graphics3D[{Blue,Thickness[0.02],Line[{{0,0,0},r{Sin[θ]Cos[ϕ],Sin[θ]Sin[ϕ],Cos[θ]}}]}]
blochvecmsphere[{r_,θ_,ϕ_}]:=blochvec[r,θ,ϕ]
(* cartesian coordinates *)
blochvecmcart[x_,y_,z_]:=Graphics3D[{Blue,Thickness[0.02],Line[{{0,0,0},{x,y,z}}]}]
blochvecmcart[{x_,y_,z_}]:=blochvecmcart[x,y,z]
(* show vector with sphere *)
vectoronsphere[vec_]:=Show[bloch,vec,SphericalRegion->True]
(* Bloch-sphere coordinates from arbitrary state *)
MatrixToBloch[x_]:={Tr[σx.x],Tr[σy.x],Tr[σz.x]}

Options[Arrow3D]={color->Red};
Arrow3D[a_,b_,OptionsPattern[]]:=Module[{l,n,rm,a3d,offset,col,arrowheadlength,thickness,arrowslope},
       col=OptionValue[color];
n=b-a;
l=Norm[n];
offset=l-1;
thickness=0.02;
arrowslope=0.3;
arrowheadlength=0.2;
rm=If[Abs[n]==l {0,0,1},Sign[n[[3]]]*IdentityMatrix[3],RotationMatrix[{{0,0,1},n}]];
a3d={ParametricPlot3D[rm.{(arrowslope v) Cos[u],(arrowslope v) Sin[u],1-v+offset},{u,0,2 π},{v,0,arrowheadlength},Mesh->None,PlotStyle->Directive[col]],ParametricPlot3D[rm.{v Cos[u],v Sin[u],1-arrowheadlength+offset},{u,0,2 π},{v,0,arrowslope*arrowheadlength},PlotStyle->Directive[col],Mesh->None],Graphics3D[{col,Cylinder[{a,b-arrowheadlength/l (b-a)},thickness]}]};
a3d];

ad Question 1f: Blackbody Radiation at Room Temperature

max. wavelength of thermal blackbody radiation

lmax=2897.8/300 (10^(-6))

Planck distribution

hb=PlanckConstant/Joule /Second;
kb=BoltzmannConstant/Joule Kelvin;
c=SpeedOfLight/Meter Second;

planck[ω_,T_]:=(((ω^3) ℏ)/((c^3) (-1+(E^((ω ℏ)/(kb T)))) (π^2)))/.ℏ->hb/(2π)

planckl[λ_,T_]:=planck[c 2π/λ,T]2π c/(λ^2)

planckplot=Plot[planckl[x (10^(-6)),300],{x,1,100},PlotRange->All,Frame->True,FrameLabel->{"λ [μm]","I[λ]"},BaseStyle->{FontSize->14}]

Transition frequencies (in wavelengths)

TransitionLambda[n1_,n2_]:=(((RydbergConstant(1/(n1^2)-1/(n2^2))))^(-1))

transitions=Table[{j,Abs@(TransitionLambda[j,60](10^6)/Meter)},{j,1,59}]~Join~Table[{j,Abs@(TransitionLambda[j,60](10^6)/Meter)},{j,61,100}];
transitionsplot=ListPlot[transitions,PlotRange->{0,100},Frame->True,FrameLabel->{"(Subscript[n, i])","λ[μm]"},BaseStyle->{FontSize->14}];

GraphicsRow[{transitionsplot,planckplot},ImageSize->600]

Question 2: Bloch Sphere

general 2 - level (spin - 1/2) state :

(({{a}, {b}}))=(({{Cos[(θ/2)]}, {(e^(i ϕ))Sin[(θ/2)]}}))

θ = 2 ArcCos[a]
ϕ = Arg[b]

question 2a)

{θa,ϕa}=blochcoord[(1/(Sqrt[3])){1,(Sqrt[2])}]
θa//N
ϕa//N

State :

(({{Cos[θa/2]}, {Sin[θa/2](E^(I ϕa))}}))//N

vectoronsphere@blochvecstate[(1/(Sqrt[3])){1,(Sqrt[2])}]

question 2b)

{θb,ϕb}=blochcoord[(1/(Sqrt[3])){1,-I (Sqrt[2])}]
θb//N
ϕb//N

State :

(({{Cos[θb/2]}, {Sin[θb/2](E^(I ϕb))}}))//N

vectoronsphere@blochvecstate[(1/(Sqrt[3])){1,-I(Sqrt[2])}]

question 2c)

{θc,ϕc}=blochcoord[((Exp[I π/4])/(Sqrt[3])){1,-I (Sqrt[2])}]
θc//N
ϕc//N

State :

(({{Cos[θc/2]}, {Sin[θc/2](E^(I ϕc))}}))//N

vectoronsphere@blochvecstate[((Exp[I π/4])/(Sqrt[3])){1,-I(Sqrt[2])}]

Global phase is irrelevant!

Question 3

Definitions

id=(({{1, 0}, {0, 1}}));σx=(({{0, 1}, {1, 0}}));σy=(({{0, -I}, {I, 0}}));σz=(({{1, 0}, {0, -1}}));
tps[x_]:=Outer[Times,Conjugate[x],x]
tps[x_,y_]:=Outer[Times,Conjugate[x],y]
(* groundstate *) 
gs={0,1};
(* excited state *)
es={1,0};
(* superpositions state *)
xps={1,1}/(Sqrt[2]);
xms={1,-1}/(Sqrt[2]);
yps={1,I}/(Sqrt[2]);
yms={1,-I}/(Sqrt[2]);

B-field in z-direction

Hamilton Operator :

σz//MatrixForm

Hz[ω_]:= (ω/2) σz

The unitary matrix can be calculated either by using MatrixExp:

Uz[ω_,t_]:=MatrixExp[-I Hz[ω]t]

Uz[ωL,t]//MatrixForm

Uz[2 μ B/ℏ,t]//MatrixForm

gs

before Bx is applied, state stays in ground state :

Manipulate[
vectoronsphere@blochvecstate[Uz[1,t].gs],{t,0,2π}]

at time (Subscript[t, 0])B-field in x-direction is switched on (approximation Bz<<Bx):

Hx[ωx_]:= ((ωx)/2) σx
Ux[ωx_,t_]:=MatrixExp[-I Hx[ωx]t]

Ux[ωx,t]//MatrixForm

(({{Cos[((t ωx)/2)], -I Sin[((t ωx)/2)]}, {-I Sin[((t ωx)/2)], Cos[((t ωx)/2)]}}))

Manipulate[
vectoronsphere@blochvecstate[Ux[1,t].gs],{t,0,2π}]

Excited State Population

popestate[ωx_,t_]=(Ux[ωx,t].gs)\[Conjugate].(({{1, 0}, {0, 0}})).(Ux[ωx,t].gs)//ComplexExpand

Plot[popestate[1,t],{t,0,4π},Frame->True,BaseStyle->{FontSize->14},FrameLabel->{"t","(Subscript[p, e])"}]

Implementation of π/2 pulse about x-axis:

(Ux[ωx,π/(2ωx)].gs)

vectoronsphere@blochvecstate[Ux[ωx,π/(2ωx)].gs]