Wilson-Fisher fixed-point for the O(N)-model in d=3 from the Wetterich equation by Michael Scherer (http://www.tpi.uni-jena.de/qfphysics/homepage/scherer/)

implemented by Michael M. Scherer

This simple mathematica-.nb allows to compute critical exponents of three-dimensional bosonic O(n)-models at the Wilson-Fisher fixed-point from a functional renormalization group approach based on the Wetterich equation. The notebook can be used as a blackbox. The implementation is rather simple, however, and it should be easily accessible to understand following the given references.

In order to start the evaluation specify n and the spacetime dimension dim in the cell "Input parameters". Then press "shift+enter" (leaving the cursor in the same cell) and confirm to automatically evaluate all the initialisation cells. The result will be displayed in the last cell. Also you have to specify if you want to compute in leading order derivative expansion or next-to-leading order. The results for leading order have been checked for n>0 to be consistent with Daniel Litim, arXiv:hep-th/0203006v2 (in 3 dimensions). As we truncate more severly here in the effectove potential the numerical results only agree within a precision of three digits for the two lowest order critical exponents "ν" and "ω". Convergence is better for large n.

Basics about the functional RG approach used here and about the notation can be found in Daniel Litim, arXiv:hep-th/0203006v2. Also in my PhD-Thesis a short introduction is given with concrete reference to the O(n)-model computed here. For more exhaustive reviews, see references therein.

Input parameters

dim=3; (*Spacetime dimension of the model should be chosen to be =3*)
n=1; (*Number of field components N*)
NLO=1; (*Next-to leading order "1" (includes anomalous dimension) or "0" (sets anomalous dimension to 0)*)

Flow equations, truncation and fixed-points

Implementation of flow equations in d dimensions

Flow of effective potential and anomalous dimension

dtu[d_]:=-d u[ρ]+(d-2+ηϕ)ρ u'[ρ]+2vd[d]((n-1)lB[d,0,u'[ρ],ηϕ]+lB[d,0,u'[ρ]+2 ρ u''[ρ],ηϕ]); (*effective potential*)

ηϕ1[d_]:=((16vd[d])/d)ρ(((u''[ρ]))^2)m[d,2,2,u'[ρ]+2 ρ u''[ρ],u'[ρ]];(*anomalous dimension*)

Volume element and treshold functions for linear cutoff in d dimensions

vd[d_]:=(((Gamma[(d/2)](2^(d+1))(π^(d/2))))^(-1))

lB[d_,n_,ω_,η_]:=((2(KroneckerDelta[0,n]+n))/d)(1-(η/(d+2)))(1/(((1+ω))^(n+1))) (*threshold function for effective potential*)
m[d_,n1_,n2_,ω1_,ω2_]:=(1/((((1+ω1))^n1)(((1+ω2))^n2))) (*threshold function for anomalous dimension*)

Truncation with spontaneously broken symmetry (SSB)

We choose a next-to-leading order derivative expansion and expand the effective potential about a non-vanishing vev as (Subscript[u, eff])=((Subscript[λ, 2])/2)(((ρ-κ))^2)+((Subscript[λ, 3])/2)(((ρ-κ))^3)+...

SSBtruncation:={u'[ρ]->0,ρ->κ,u''[ρ]->λ2};

Projection on the flow of the running couplings

ηϕ=If[NLO==1,(ηϕ1[d]/.{d->dim}/.SSBtruncation),0];
dtκ:= D[(((dtu[dim]))/(- λ2)),ρ]/.SSBtruncation
dtλ[ord_]:=(D[dtu[dim],{ρ,ord}]+Derivative[ord+1][u][ρ] dtκ)/.SSBtruncation;

dtλ[2]//.BasicExpansion

Computation of fixed-points and critical exponents

Basic next-to-leading order truncation (expansion of the effective potential up to four-boson vertex)

Solve for all solutions in the basic system

BasicExpansion={Derivative[3][u][κ]->0,Derivative[4][u][κ]->0};
BasicNLO={dtκ==0,dtλ[2]==0}//.BasicExpansion;
BasicNLOfp=NSolve[BasicNLO,{κ,λ2}]

Pick out the solution with real and positive parameters

Realstest:=If[(κ/.BasicNLOfp[[i]])∈Reals&&(λ2/.BasicNLOfp[[i]])∈Reals &&(κ/.BasicNLOfp[[i]])>0&&(λ2/.BasicNLOfp[[i]])>0&&(λ2/.BasicNLOfp[[i]])<1000,1,0]
For[i=1,Realstest<1,i++;Realstest]

bκ=κ/.BasicNLOfp[[i]];
bλ2=λ2/.BasicNLOfp[[i]];
bηϕ=ηϕ/.BasicNLOfp[[i]];

Extended effective potential to 12th order in field monomial ((Subscript[λ, 6]))

λlowExpansion={Derivative[3][u][κ]->0,Derivative[4][u][κ]->0,Derivative[5][u][κ]->0,Derivative[6][u][κ]->0};
λ4Expansion={Derivative[3][u][κ]->λ3,Derivative[4][u][κ]->λ4,Derivative[5][u][κ]->0,Derivative[6][u][κ]->0};
λ6Expansion={Derivative[3][u][κ]->λ3,Derivative[4][u][κ]->λ4,Derivative[5][u][κ]->λ5,Derivative[6][u][κ]->λ6,Derivative[7][u][κ]->0,Derivative[8][u][κ]->0};

λlow={dtκ==0,dtλ[2]==0}//.λlowExpansion;
λ4NLO={dtκ==0,dtλ[2]==0,dtλ[3]==0,dtλ[4]==0}//.λ4Expansion;
λ6NLO={dtκ==0,dtλ[2]==0,dtλ[3]==0,dtλ[4]==0,dtλ[5]==0,dtλ[6]==0}//.λ6Expansion;

λlowfp=FindRoot[λlow,{{κ,bκ},{λ2,bλ2}}];
λ4NLOfp=FindRoot[λ4NLO,{{κ,bκ},{λ2,bλ2},{λ3,0},{λ4,0}}];
λ6NLOfp=FindRoot[λ6NLO,{{κ,κ/.λ4NLOfp},{λ2,λ2/.λ4NLOfp},{λ3,λ3/.λ4NLOfp},{λ4,λ4/.λ4NLOfp},{λ5,0},{λ6,0}}];

Stability Matrix and critical exponents (phi^12)

smEigVal

λ6NLOβfunct={dtκ,dtλ[2],dtλ[3],dtλ[4],dtλ[5],dtλ[6]}//.λ6Expansion;
sm[i_,j_]:=D[λ6NLOβfunct[[i]],j];

StabilityMatrix=(({{sm[1,κ], sm[2,κ], sm[3,κ], sm[4,κ], sm[5,κ], sm[6,κ]}, {sm[1,λ2], sm[2,λ2], sm[3,λ2], sm[4,λ2], sm[5,λ2], sm[6,λ2]}, {sm[1,λ3], sm[2,λ3], sm[3,λ3], sm[4,λ3], sm[5,λ3], sm[6,λ3]}, {sm[1,λ4], sm[2,λ4], sm[3,λ4], sm[4,λ4], sm[5,λ4], sm[6,λ4]}, {sm[1,λ5], sm[2,λ5], sm[3,λ5], sm[4,λ5], sm[5,λ5], sm[6,λ5]}, {sm[1,λ6], sm[2,λ6], sm[3,λ6], sm[4,λ6], sm[5,λ6], sm[6,λ6]}}))//.λ6NLOfp;
smEigVal=Sort[Re[-N[Eigenvalues[StabilityMatrix]]],Greater];
ν=(1/(smEigVal[[1]]));
ω=-smEigVal[[2]];
ω2=-smEigVal[[3]];
ω3=-smEigVal[[4]];
ω4=-smEigVal[[5]];
ω5=-smEigVal[[6]];
(Subscript[η, ϕ])=ηϕ//.λ6NLOfp;

Stability Matrix and critical exponents (phi^4)

StabilityMatrixlow

λlowβfunct={dtκ,dtλ[2]}//.λlowExpansion;
sm[i_,j_]:=D[λlowβfunct[[i]],j];
StabilityMatrixlow=(({{sm[1,κ], sm[2,κ]}, {sm[1,λ2], sm[2,λ2]}}))//.λlowfp;
smEigVallow=Sort[Re[-N[Eigenvalues[StabilityMatrixlow]]],Greater];
νlow=(1/(smEigVallow[[1]]));
ωlow=-smEigVallow[[2]];
(Subscript[η, ϕlow])=ηϕ//.λlowfp;

Results for critical exponents and anomalous dimension

digits=3;
Print["nlow=",NumberForm[nlow,digits]]
Print["νlow=",NumberForm[νlow,digits]] 
Print["ωlow=",NumberForm[ωlow,digits]] 
Print["(Subscript[η, ϕlow])=",NumberForm[(Subscript[η, ϕlow]),digits]] 
(*Quit[]*)

digits=3;
Print["n=",NumberForm[n,digits]]
Print["ν=",NumberForm[ν,digits]] 
Print["ω=",NumberForm[ω,digits]] 
Print["(Subscript[η, ϕ])=",NumberForm[(Subscript[η, ϕ]),digits]] 
(*Quit[]*)