Physics 480/Fall 1999
Professor Klaus Schulten /Prepared by Guochun Shi

Mathematica notebook for Problem Set 8

(3)
(b) Plot the energies for n=1,2,...,16
En= E0-2t cos (n Pi/8) =-5.2 cos(n Pi/8)

En[n_]:=-5.2*Cos[n Pi/8];
energyarray={};
Do[AppendTo[energyarray,En[n]],{n,1,16}];
ListPlot[energyarray,PlotJoined->False];
energyarray

(4) 
(c)Plot eigenvalues for N=3,11

for N=3,
En=E0-2tcos(2n Pi/7)=-5.2cos(2n Pi/7)

En[n_]:=-5.2*Cos[2*n Pi/7];
energyarray={};
Do[AppendTo[energyarray,En[n]],{n,1,6}];
ListPlot[energyarray,PlotJoined->True];
energyarray

For N=11
En=E0-2tcos(2n Pi/23)=-5.2 cos(2n Pi/23)

En[n_]:=-5.2*Cos[2*n Pi/7];
energyarray={};
Do[AppendTo[energyarray,En[n]],{n,1,22}];
ListPlot[energyarray,PlotJoined->True];
energyarray

Plot all eigenstates for N=3

there are six eigenstates

Do[
statesarray={};
Do[AppendTo[statesarray,Sin[2*m*n*Pi/7]],{m,1,6}];
ListPlot[statesarray,PlotJoined->True,PlotLabel->n],
{n,1,6}];

problem 5
(c)

first we input the hamiltonian matrix

Clear[E0];
Clear[w];
E0=1.5;
w=0.003;wrr=-0.058;
h={
{E0,w,0,0,0,0,0,0,0,0,0,0,0,0,0,w,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0},
{w,E0,w,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0},
{0,w,E0,w,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0},
{0,0,w,E0,w,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0},
{0,0,0,w,E0,w,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0},
{0,0,0,0,w,E0,w,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0},
{0,0,0,0,0,w,E0,w,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0},
{0,0,0,0,0,0,w,E0,w,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0},
{0,0,0,0,0,0,0,w,E0,w,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0},
{0,0,0,0,0,0,0,0,w,E0,w,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0},
{0,0,0,0,0,0,0,0,0,w,E0,w,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0},
{0,0,0,0,0,0,0,0,0,0,w,E0,w,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0},
{0,0,0,0,0,0,0,0,0,0,0,w,E0,w,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0},
{0,0,0,0,0,0,0,0,0,0,0,0,w,E0,w,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0},
{0,0,0,0,0,0,0,0,0,0,0,0,0,w,E0,w,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0},
{w,0,0,0,0,0,0,0,0,0,0,0,0,0,w,E0,wrr,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0},
{0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,wrr,E0,w,0,0,0,0,0,0,0,0,0,0,0,0,0,w},
{0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,w,E0,w,0,0,0,0,0,0,0,0,0,0,0,0,0},
{0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,w,E0,w,0,0,0,0,0,0,0,0,0,0,0,0},
{0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,w,E0,w,0,0,0,0,0,0,0,0,0,0,0},
{0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,w,E0,w,0,0,0,0,0,0,0,0,0,0},
{0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,w,E0,w,0,0,0,0,0,0,0,0,0},
{0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,w,E0,w,0,0,0,0,0,0,0,0},
{0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,w,E0,w,0,0,0,0,0,0,0},
{0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,w,E0,w,0,0,0,0,0,0},
{0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,w,E0,w,0,0,0,0,0},
{0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,w,E0,w,0,0,0,0},
{0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,w,E0,w,0,0,0},
{0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,w,E0,w,0,0},
{0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,w,E0,w,0},
{0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,w,E0,w},
{0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,w,0,0,0,0,0,0,0,0,0,0,0,0,0,w,E0}};

Find the eigenvalues and eigenvectors of the hamiltonian

evalues=Eigenvalues[h];
evectors=Eigenvectors[h];

Input the intial wavefunction psi0 (this is the ground state when there is only one ring)

psi0=1/Sqrt[16]*{1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,1,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0};

expand psi0 in eigenvectors( assume the coffient is cof[n])
note hbar=6.58*10^(-16) ev*s

cof={};
Do[AppendTo[cof,psi0 . evectors[[n]]],{n,1,32}];

Now we find the probability of electronic exitation in ring 2 as a function of t prob[t]

Clear[t];
hbar=6.58*10^(-16);
prob[t_]=Sum[Abs[Sum[cof[[k]]*evectors[[k]][[n]]Exp[-I*evalues[[k]]*t/hbar],{k,1,32}]]^2,{n,17,32}];

plot the probality vs time

tarray={};
stoptime=10^(-9);
numofdata=100;
Do[AppendTo[tarray,(stoptime*k)/(numofdata-1)],{k,0,numofdata-1}];
parray={};
Do[AppendTo[parray,prob[tarray[[k]]]],{k,1,numofdata}];
array1={};array2={};
Do[AppendTo[array2,{tarray[[n]],parray[[n]]}],{n,1,numofdata}]
ListPlot[array2,PlotJoined->True,AxesOrigin->{0,0},AxesLabel->{t,Probability}];