# Part specification error

I am doing a solved exercise shared here.

However, while running the code, I encountered an error on page-8, under the Dynamics section. I think this error is due to the absence of range for i or initialstate . However, I cannot find a solution to provide a proper range.

Here is the code:

(*Parameters of the Hamiltonian*)

Clear[chainsize, upspins, downspins, dim, Jxy, Jz, open];
chainsize = 10;(*number of sites*)
upspins = chainsize/2;(*number of spins pointing up in the z direction*)
downspins = chainsize - upspins;
dim = chainsize! /(upspins! downspins!);(*dimension of the subspace  being studied=upspins = (chainsize
upspins
)*)
Jxy =
1.0;(*strength of the flip-flop term between nearest neighbors*)

Jz = 0.5;(*strength of the Ising interaction between nearest neighbors*)

open = 1;(*determines whether the chain is open or closed. For closed chain,open=0. For open chain, open=1*)

(*Creating the basis*)
Clear[onebasisvector, basis];
onebasisvector =
Flatten[{Table[1, {k, 1, upspins}], Table[0, {k, 1, downspins}]}];
basis = Permutations[onebasisvector];

(*ELEMENTS OF THE HAMILTONIAN*)
(*Initialization*)
Clear[HH];
Do[Do[HH[i, j] = 0., {j, 1, dim}], {i, 1, dim}];

(*Diagonal elements-Ising interaction*)

Do[Do[HH[i, i] =
HH[i, i] + (Jz/4)*(-1.)^(basis[[i, k]] + basis[[i, k + 1]]);
, {k, 1, chainsize - 1}];
, {i, 1, dim}];

(*Term included in the Ising interaction if the chain is closed*)

If[open == 0,
Do[HH[i, i] =
HH[i, i] + (Jz/
4.0)*(-1.0)^(basis[[i, chainsize]] + basis[[i, 1]]), {i, 1,
dim}]];

(*Off-diagonal elements-flip-flop term*)
Clear[howmany, site];
Do[Do[(*Initialization*)
howmany = 0;
Do[site[z] = 0, {z, 1, chainsize}];
(*Sites where states i and j differ*)

Do[If[basis[[i, k]] != basis[[j, k]], {howmany = howmany + 1,
site[howmany] = k}];, {k, 1, chainsize}];
(*Coupling matrix element-when only two neighbor sites differ*)

If[howmany == 2,
If[site - site == 1, {HH[i, j] = HH[i, j] + Jxy/2.0,
HH[j, i] = HH[j, i] + Jxy/2.0}]];

If[open == 0,
Ifpsite - site ==
chainsize - 1, {HH[i, j] = HH[i, j] + Jxy/2.0,
HH[j, i] = HH[j, i] + Jxy/2.0}];
, {j, i + 1, dim}];
, {i, 1, dim - 1}];

(*Hamiltonian*)
Clear[Hamiltonian];
Hamiltonian = Table[Table[HH[i, j], {i, 1, dim}], {j, 1, dim}];
MatrixForm[Hamiltonian];

(*Diagonalization*)
Clear[Energy, Vector];
Energy = Chop[Eigenvalues[Hamiltonian]];
Vector = Chop[Eigenvectors[Hamiltonian]];

(*Parameters of the Hamiltonian*)

Clear[chainsize, upspins, downspins, dim, Jxy, Jz, open];
chainsize = 6;
upspins = 1;
downspins = chainsize - upspins;
dim = chainsize! /(upspins! downspins!) ;
Jxy = 1.0;
Jz = 0.5;
open = 1;

Do[If[basis[[i, 1]] == 1 && basis[[i, 2]] == 0, initialstate = i];
, {i, 1, dim}];

(*DYNAMICS*)
Clear[endtime, PSI, increment, Magsite];
endtime = 81;
increment = 0.1;
Do[PSI[t] = Sum[Vector[[j, initialstate]]*
Vector[[j]]*Exp[-I*Energy[[j]]*(t - 1)*increment], {j, 1, dim}];

(*Magnetization*)

Do[Magsite[j, t] =
0.5*Sum[Abs[PSI[t][[i]]]^2*(-1.0)^(1 + basis[[i, j]]), {i,
dim}];
, {j, 1, chainsize}];
(*Print[{(t-1)increment,Magsite[1,t]}];*)
, {t, 1, endtime}];

<< PlotLegends;

Clear[magT, ProbT];
Do[magT[j] =
Table[{(t - 1) increment, Magsite[j, t]}, {t, 1, endtime}], {j, 1,
chainsize}];
Do[ProbT[k] =
Table[{(t - 1) increment, Abs[PSI[t][[k]]]^2}, {t, 1,
endtime}], {k, 1, dim}];
Print[];
Print["Magnetization of each site"];

ListPlot[Table[magT[j], {j, 1, chainsize}], PlotRange -> All,
Joined -> True,
PlotStyle -> {{Thick, Black}, {Thick, Blue}, {Thick, Red}, {Thick,
Darker[Green]}, {Thick, Magenta}, {Thick, Brown}},
LabelStyle -> Directive[Black, Bold, Medium],
PlotLegend -> Table["mag"[x], {x, 1, dim}], LegendPosition -> {1, 0},
AxesLabel -> {"time", "Magnetization"}]

Print[];
Print["Probability of each site-basis"];

ListPlot[Table[ProbT[k], {k, 1, dim}], PlotRange -> All,
Joined -> True,
PlotStyle -> {{Thick, Black}, {Thick, Blue}, {Thick, Red}, {Thick,
Darker[Green]}, {Thick, Magenta}, {Thick, Brown}},
LabelStyle -> Directive[Black, Bold, Medium],
PlotLegend -> Table[basis[[k]], {k, 1, dim}],
LegendPosition -> {1, 0}, LegendSize -> {1, 1},
AxesLabel -> {"time", "Probability"}]


• There is code on page 8 which sets initialstate to some value. try it. Do[ If[basis[[i, 1]] == 1 && basis[[i, 2]] == 0, initialstate = i ] , {i, 1, dim} ] The code must have been written by a professional teacher, since it is very badly written :) Jul 18 at 5:34
• The code seems written for old version of Mathematica. You do not need to do << PlotLegends; any more. Jul 18 at 6:07