In[]:=
Quit[]

Contact jonathan.shock@uct.ac.za for questions/comments/concerns.

Plot options to be used later

In[]:=
plotoptions={FrameTrue,FrameStyle18,AspectRatio1,AxesOrigin{0,0},PlotRangePadding0,ImageSize450};​​plotoptionsrlf={FrameTrue,FrameStyle18,AspectRatio1,AxesOrigin{0,0},PlotRangePadding0,ImageSize450,RotateLabelFalse};

Equations of motion and constraint equation for the three variables U, V and W.

In[]:=
eom[B_]=U[r](
′′
V
[r]-
′′
W
[r])+(
′
U
[r]+U[r](2
′
V
[r]+
′
W
[r]))(
′
V
[r]-
′
W
[r])+2
2
B
-4V[r]

0,​​2
′′
V
[r]+
′′
W
[r]+2
2
′
V
[r]
+
2
′
W
[r]
0,​​
′′
U
[r]+
′
U
[r](2
′
V
[r]+
′
W
[r])-8-
4
3
2
B
-4V[r]

0;​​constraintequation[B_]=-12+2
2
B
-4V[r]

+
′
U
[r](2
′
V
[r]+W'[r])+2U[r]V'[r](V'[r]+2W'[r])==0;

Here we give the ansatz from the IR perturbative analysis and solve up to third order terms.

In[]:=
(*IRperturbativeexpressionsforthevariables*)​​irPerturbativeAnsatz=UFunctionr,
4
∑
i=1
u[i]
i
(r-1)
,VFunctionr,Log1+
4
∑
i=1
v[i]
i
(r-1)
,WFunctionr,Log
4
∑
i=0
w[i]
i
(r-1)
;​​(*It'seasiertousethefirsttwoequationsofmotionplustheconstraint*)​​eom2=Flatten[{eom[B][[;;2]],constraintequation[B]}];​​(*Plugintheperturbativeexpansionsclosetothehorizon.Pullouttheseriescoefficientsuptothirdorderin(r-1)*)​​ser=Table[SeriesCoefficient[#[[1]]&/@eom2/.irPerturbativeAnsatz,{r,1,i}]//Normal//FullSimplify,{i,0,3}]//Flatten;​​(*Findwhichcoefficientsappearinwhichequations*)​​Union[Cases[#,_[_],Infinity]]&/@ser;​​(*Findallthosethatdon'tcontainafourthorderterm*)​​Flatten[Position[%,#]&/@DeleteCases[%,{___,_[4],___}]]//Union;​​(*Solveallofthesetofinduptothethirdorderterms*)​​ircoeffs=Solve[0==ser[[#]]&/@%,{u[2],u[3],v[1],v[2],v[3],w[1],w[2],w[3]}]//Simplify//Flatten​​
Out[]=
u[2]-2+
5
2
B
3
,u[3]
16(27-24
2
B
+5
4
B
)
27u[1]
,v[1]-
4(-3+
2
B
)
3u[1]
,v[2]-
4
2
B
(-3+
2
B
)
9
2
u[1]
,v[3]-
16
2
B
(15-11
2
B
+2
4
B
)
81
3
u[1]
,w[1]
2(6+
2
B
)w[0]
3u[1]
,w[2]
8
2
B
(-3+
2
B
)w[0]
9
2
u[1]
,w[3]
16
2
B
(30-31
2
B
+7
4
B
)w[0]
81
3
u[1]


We expand in (1-r) for IR boundary behaviour (both variables and their derivatives) for the NDSolve (this isn’t strictly necessary but gives us polynomial rather than logarithmically defined BC’s).

In[]:=
{vapprox[r_,B_,u1_,w0_],wapprox[r_,B_,u1_,w0_],uapprox[r_,B_,u1_,w0_]}=Series[{V[r],W[r],U[r]}/.irPerturbativeAnsatz/.ircoeffs,{r,1,3}]/.{u[1]u1,w[0]w0}//Normal;​​{vpapprox[r_,B_,u1_,w0_],wpapprox[r_,B_,u1_,w0_],upapprox[r_,B_,u1_,w0_]}=D[%,r];

Boundaries set at
r
IR
=1+
-4
10
and
r
UV
=200

In[]:=
r
UV
=200;​​
r
IR
=1+
-4
10
;

Now we set up a memoized numerical solver for the solutions for U, V and W. These depend on the boundary parameters
u
1
and
w
0
as well as the value of the magnetic field.

In[]:=
Clear[sols]​​sols[B_?NumericQ,u1_?NumericQ,w0_?NumericQ]:=sols[B,u1,wh0]=NDSolve[{eom[B],​​V[
r
IR
]==vapprox[
r
IR
,B,u1,w0],V'[
r
IR
]==vpapprox[
r
IR
,B,u1,w0],​​W[
r
IR
]==wapprox[
r
IR
,B,u1,w0],W'[
r
IR
]==wpapprox[
r
IR
,B,u1,w0],​​U[
r
IR
]uapprox[
r
IR
,B,u1,w0],U'[
r
IR
]upapprox[
r
IR
,B,u1,w0]},​​{V,W,U},{r,
r
IR
,
r
UV
}][[1]]​​​​vsol[r_?NumericQ,B_?NumericQ,u1_?NumericQ,w0_?NumericQ]:=V[r]/.sols[B,u1,w0]​​wsol[r_?NumericQ,B_?NumericQ,u1_?NumericQ,w0_?NumericQ]:=W[r]/.sols[B,u1,w0]​​usol[r_?NumericQ,B_?NumericQ,u1_?NumericQ,w0_?NumericQ]:=U[r]/.sols[B,u1,w0]​​

Here we find the value of
u
1
and
w
0
which satisfy the UV behaviour which is V=Log[r] and W=Log[r]. These will be used to fix the boundary conditions in the numerical equation solver. They are also used to calculate the temperature.

In[]:=
u
1
[B_]:=
u
1
[B]=Module[{},​​u1v/.FindRoot[{​​vsol[
r
UV
,B,u1v,w0v]-Log[
r
UV
]0,​​wsol[
r
UV
,B,u1v,w0v]-Log[
r
UV
]0},​​{{u1v,0.1},{w0v,0.1}}]]//Quiet​​​​
w
0
[B_]:=
w
0
[B]=Module[{},​​w0v/.FindRoot[{​​vsol[
r
UV
,B,u1v,w0v]-Log[
r
UV
]0,​​wsol[
r
UV
,B,u1v,w0v]-Log[
r
UV
]0},​​{{u1v,0.1},{w0v,0.1}}]]//Quiet​​temp[B_]:=
u
1
[B]
4π

Define the renormalised action from which the limit of the cutoff is taken to
r
UV
to give us the final action which will be used below to calculate the Gibbs Free energy.

In[]:=
Clear[renormalisedaction];​​renormalisedaction[B_,rend_]:=renormalisedaction[B,rend]=Module{counterterm,lagrangian,action,sol},​​sol=sols[B,
u
1
[B],
w
0
[B]];​​counterterm=
U[r]
2
′
U
[r]
U[r]
+4
′
V
[r]+2
′
W
[r]-3-
1
4
1
2
Log[
2
B
-4V[r]

]2
2
B
-4V[r]

U[r]
2V[r]+W[r]

/.sol/.rrend;​​lagrangian=
2V[r]+W[r]

(-12+2
′
U
[r](2
′
V
[r]+
′
W
[r])+
′′
U
[r]+2U[r](3
2
′
V
[r]
+2
′
V
[r]
′
W
[r]+
2
′
W
[r]
+2
′′
V
[r]+
′′
W
[r]))+2
2
B
-2V[r]+W[r]

/.sol;​​action=-
1
2
NIntegrate[lagrangian,{r,
r
IR
,rend},PrecisionGoal12];​​action+counterterm​​action[x_]:=renormalisedaction[x,
r
UV
]

It takes around half an hour to generate the data for the Gibbs free energy as a function of
B
2
T
. You don’t need to do this as the data is stored in a plot in the next cells.

(*at1=AbsoluteTime[];​​Bvals=Range[0.001,
3
-0.01,0.001];​​data=
#
2
temp[#]
,-
action[#]
4
2
π
4
temp[#]
&/@Bvals;​​gibbsdatalistplot=ListPlot[data,PlotRange->All];​​ShowListLinePlotdata,PlotRange{{0,30},{-1.6,4}},FrameLabelStyle"

2
T
",FontSize22,Style"
G
4
T
",FontSize22,ImageSize400,PlotStyleBlue,plotoptionsrlf​​AbsoluteTime[]-at1*)

Here we include the data from the last calculation (gibbsdatalistplot) so that you don’t have to run it. This is the plot of
G/
4
T
versus
B/
2
T
that we will use for the rest of the calculations.

In[]:=
gibbsdatalist=Cases
0
0
,Point[__],Infinity[[1,1]];

We are going to fit to the data in gibbsdatalist using a polynomial, but the data range that we use for the fitting will depend on the value of b. We will be taking data from between lower[b] and upper[b]. These functions are not particularly carefully chosen, but just found to have a reasonable shape.

In[]:=
Clear[g,dg,ddg,gren,csx,csz,cv,gandderivatives]​​window=5;​​max=190;​​lower[b_]:=Min[{Max[{0.1+2LogisticSigmoid[-19.7+2.1b],b-(1+windowArcTan[b])}],150}]​​upper[b_]:=Min[{b+1+windowArcTan[b],max}]​​position[b_]:=Position[gibbsdatalist,Nearest[gibbsdatalist[[;;,1]],b][[1]]][[1,1]];

Illustrating what the region looks like. The plots are the same functions, just across different ranges.

In[]:=
GraphicsGrid[{Show[Plot[{lower[b],upper[b]},{b,0,#},FrameLabel->{"b","Range of b"},Filling->True],plotoptions]&/@{20,200}}]
Out[]=

This function takes the data from gibbsdatalist in the region dictated by lower and upper above

Define the renormalised gibbs density given by subtracting the quadratic piece.

This function fits the data to a sixth order polynomial in the range around the value of b

Here we define the magnetisation, entropy, susceptibility and pressures along with their renormalised counterparts

Define the region that we want to do most of the plots in

First the magnetisation minus the magnetisation at T=114 MeV

The subtracted susceptibility at a range of magnetic field values as a function of T.

The specific heat as a function of T.

The speeds of sound as a function of T for different values of the magnetic field.

The subtracted speeds of sound at T=150 and 300 MeV as a function of B

Comparison to lattice data

Here we take data from
​
author = {Bali, G. S. and Bruckmann, F. and Endrodi, G. and Katz, S. D. and Schafer, A.},
title = “{The QCD equation of state in background magnetic fields}”,
eprint = “1406.0269”,
archivePrefix = “arXiv”,
primaryClass = “hep-lat”,
doi = “10.1007/JHEP08(2014)177”,
journal = “JHEP”,
volume = “08”,
pages = “177”,
year = “2014”

where we have plotted various physical quantities and compare our results with these lattice results.