Problem 3.18

Two state paramagnet with ‘n’ dipoles, nUp spin up, and nDown spin down.  The magnetic dipole moment is μ.  The external magnetic field has strength B.

Reproduce Table 3.2.  Introduced ‘scaled’ versions of U, M, and S to make table entries dimensionless.  Use the N[ ] function to change the huge exact integer expressions into more-readable approximate  numerical values.

Clear["Global`*"]

First, calculate the energy, magnetization, multiplicity, and entropy.

Ω[n_, nUp_] := N[((n!)/(nUp! (n-nUp)!))]

U[n_, nUp_] := μ B (n - 2 nUp); Us[n_, nUp_] := U[n, nUp]/(μ B)

M[n_, nUp_] := N[-((U[n, nUp])/B)]; Ms[n_, nUp_] := M[n, nUp]/(n μ)

S[n_, nUp_] := k Log[Ω[n, nUp]]; Ss[n_, nup_] := S[n, nup]/k

The Temperature and heat capacity calculations involve derivatives.  Approximate them by a centered finite-difference scheme for (nUp+1) and (nUp-1).  However, that only works if nUp is in the range [1, ntotal-1].  Outside that range, simply call the derivative 0.  Also, calculate the scaled versions indicated in the table.

Ts[ntotal_, nUp_] := If[0 <  nUp < ntotal,  ((Us[ntotal, nUp+1] - Us[ntotal, nUp -1])/(Ss[ntotal, nUp+1] - Ss[ntotal, nUp-1])), 0]

Cvs[ntotal_, nUp_] := If[0 <  nUp < ntotal,  (1/ntotal)*((Us[ntotal, nUp+1] - Us[ntotal, nUp -1])/(Ts[ntotal, nUp+1] - Ts[ntotal, nUp-1])),0]

ntotal = 100;

data = Table[{nUp, Us[ntotal, nUp], Ms[ntotal, nUp], Ω[ntotal, nUp], Ss[ntotal, nUp], Ts[ntotal, nUp ], Cvs[ntotal, nUp] }, {nUp, ntotal, 0, -1}];

(* Show a few sample segments of the full table. *)
n2 = IntegerPart[ntotal/2];
sample = Flatten[{Range[1, 4], Range[n2-1, n2+3], Range[-4, -1]}]

TableForm[data[[sample]], 
TableHeadings->{None, {"nUp", "U/μB", "M/Nμ", "Ω", "S/k", "kT/μB", "CV/Nk"}}]

Splot = ListLinePlot[data[[All, {2,5}]], LabelStyle->Larger, AxesLabel -> {"U/μB", "S/k"}, ImageSize->Scaled[0.8], PlotRange->All]

SetDirectory[NotebookDirectory[]]
Export["Paramagnet-Splot.pdf", Splot]

ListLinePlot[data[[All, {2,6}]], LabelStyle->Larger, AxesLabel -> {"U/μB", "kT/μB"}, ImageSize->Scaled[0.8]]

ListLinePlot[data[[All, {6, 7}]], LabelStyle->Larger, AxesLabel -> {"kT/μB", "C/Nk"}, ImageSize->Scaled[0.8], PlotRange->{{0, 10}, All}]

ListLinePlot[data[[All, {6, 3}]], LabelStyle->Larger, AxesLabel -> {"kT/μB", "M/Nμ"}, ImageSize->Scaled[0.8], PlotRange->{{-10, 10}, All}]

ListLinePlot[Map[{1/#[[6]],#[[3]]} &, data], LabelStyle->Larger, AxesLabel -> {"μB/kT", "M/Nμ"}, ImageSize->Scaled[0.8], PlotRange->{ All}]