FindBounce tutorial

Documentation can be found in ‘Help’ & https://arxiv.org/pdf/2002.00881.pdf

Download the paclet
https://github.com/vguada/FindBounce

Install the paclet:

PacletInstall["full/path/to/FindBounce-X.Y.Z.paclet"]

Quit

Load the package:

Needs["FindBounce`"]

Get started

Clear[V]
V[x_]:=0.1 (x^4)-0.45 (x^3)+0.5 (x^2)
extrema=NSolve[D[V[x],x]==0,x][[All,1,2]]
pts=Transpose[{extrema,V/@extrema}];

Plot[
V[x],{x,-1,3},
Epilog->{Red,PointSize[Large],Point[pts]},AxesLabel->{"φ","V(φ)"}
]

bf=FindBounce[V[x],{x},{extrema[[1]],extrema[[-1]]}]

BouncePlot[bf]

bf["Properties"]

bf["Action"]

bf["Bounce"]

bf["Path"]

Thin/thick wall potential

Clear[V];
V[ϕ_]:=((ϕ^2)/2)+((ϕ^3)/2)+α ((ϕ^4)/8)

p1=Plot[V[ϕ]/.α->0.6,{ϕ,-5,4},PlotStyle->RGBColor[0.45,0,0]];
p2=Plot[V[ϕ]/.α->0.68,{ϕ,-5,4},PlotStyle->RGBColor[0.58,0,0]];
p3=Plot[V[ϕ]/.α->0.76,{ϕ,-5,4},PlotStyle->RGBColor[0.71,0,0]];
p4=Plot[V[ϕ]/.α->0.84,{ϕ,-5,4},PlotStyle->RGBColor[0.8,0,0]];
p5=Plot[V[ϕ]/.α->0.92,{ϕ,-5,4},PlotStyle->RGBColor[0.9,0,0]];
p6=Plot[V[ϕ]/.α->0.99,{ϕ,-5,4},PlotStyle->RGBColor[0.99,0,0]];
Show[p1,p2,p3,p4,p5,p6,PlotRange->{{-5,1},{-5,1}},AxesLabel->{"ϕ","V(ϕ)"}]

thickextrema=NSolve[D[V[ϕ]/.α->0.6,ϕ]==0,ϕ][[All,1,2]]

thickbf=FindBounce[V[ϕ]/.α->0.6,{ϕ},{thickextrema[[1]],thickextrema[[-1]]}]

thinextrema=NSolve[D[V[ϕ]/.α->0.99,ϕ]==0,ϕ][[All,1,2]]

thinbf=FindBounce[V[ϕ]/.α->0.99,{ϕ},{thinextrema[[1]],thinextrema[[-1]]}]

thickplot=BouncePlot[thickbf]
thinplot=BouncePlot[thinbf]

Quartic-quartic potential

biQuarticPotential[{ϕp_,ϕm_},{Vt_,Vm_},ϵ_]:=Module[
	{Vp,ΔVp,ΔVm,α,Δ},
	Vp=-18+(ϵ-1)*3;
	ΔVm=Vt-Vm;
	ΔVp=Vt-Vp;
	α=-ϕp/ϕm;
	Δ=ΔVp/ΔVm;
	Function[ϕ,
		Evaluate@Piecewise[
			{{(Vp+((ΔVp)/((ϕp)^4))(((ϕ-ϕp))^4))-Vp,ϕ<0}},
			(Vm+((ΔVm)/((ϕm)^4))(((ϕ-ϕm))^4))-Vp]
	]
];

biQuarticAction[{ϕp_,ϕm_},{Vt_,Vm_},ϵ_]:=Module[
	{Vp,ΔVp,ΔVm,α,Δ},
	Vp=-18+(ϵ-1)*3;
	ΔVm=Vt-Vm;
	ΔVp=Vt-Vp;
	α=-ϕp/ϕm;
	Δ=ΔVp/ΔVm;
	((2(π^2)*((ϕm)^4))/(3ΔVm))*(((4(α^3)+6(α^2)*Δ+4α*(Δ^2)+(Δ^3)+(α^4)*(3+Δ(Δ-3))))/(((1-Δ))^3))
];

U=biQuarticPotential[{-5,10},{5,-20},1]

Plot[U[x],{x,-10,20}]

bf =  FindBounce[
U[ϕ],ϕ,{-5.,10.},
"MidFieldPoint"->0.,
"Gradient"->None,
"FieldPoints"->20
]

bf200 = FindBounce[
U[ϕ],ϕ,{-5.,10.},
"MidFieldPoint"->0.,
"Gradient"->None,
"FieldPoints"->200
]

actionExact=biQuarticAction[{-5,10},{5,-20},1]

BouncePlot[
{bf,bf200},
PlotLabel->Row[{"(Subscript[S, exact]) = ",N@actionExact}],
PlotLegends->{
Row@{"(Subscript[S, N = 20]) = ",bf["Action"]},Row@{"(Subscript[S, N = 200]) = ",bf200["Action"]}
}
]

Two field benchmark

thinextrema = {{0,12.91},{6.25,6.01},{20.,0.}};
Clear[Vthin]
Vthin[ϕ_]:=With[
{μ = {80.,100.},λ={0.1,0.3},α=2.,ϵ={0.,0.}},
Sum[
-μ[[i]] (ϕ[[i]])^2 +λ[[i]](ϕ[[i]])^4+ϵ[[i]]*ϕ[[i]] ,
{i,1,2}
]+ α(ϕ[[1]])^2 (ϕ[[2]])^2
]

bfthin = FindBounce[Vthin[{φ1,φ2}],{φ1,φ2},thinextrema[[{1,3}]]]

BouncePlot[bfthin]

Show[
 ContourPlot[
Vthin[{ϕ1,ϕ2}],{ϕ1,-1,21},{ϕ2,-1,14},
PlotRange->{-16000,1000},
LabelStyle->Black,
ContourShading->None,
FrameLabel->{"(Subscript[φ, 1])","(Subscript[φ, 2])"},
Contours->30,
ContourStyle->Gray,
Axes->False
],
ParametricPlot[Through@bfthin["Bounce"][ρ],{ρ,0,Max@bfthin["Radii"]}]
]

bfthin["Path"]

thickextrema ={{0.,8.410},{1.168,6.314},{19.919,-0.568}};
Clear[Vthick]
Vthick[ϕ_]:=With[
{μ = {80.,90.},λ={0.1,0.3},α=2.,ϵ={0.,800.}},
Sum[
-μ[[i]] (ϕ[[i]])^2 +λ[[i]](ϕ[[i]])^4+ϵ[[i]]*ϕ[[i]] ,
{i,1,2}
]+ α(ϕ[[1]])^2 (ϕ[[2]])^2
];

bfthick = FindBounce[Vthick[{φ1,φ2}],{φ1,φ2},thickextrema[[{1,3}]]]

BouncePlot[bfthick]

Show[
 ContourPlot[
Vthick[{ϕ1,ϕ2}],{ϕ1,-1,22},{ϕ2,-2,14},
PlotRange->{-25000,5000},
LabelStyle->Black,
ContourShading->None,
FrameLabel->{"(Subscript[φ, 1])","(Subscript[φ, 2])"},
Contours->40,
ContourStyle->Gray,
Axes->False
],
ParametricPlot[Through@bfthick["Bounce"][ρ],{ρ,0,Max@bfthick["Radii"]}]
]

bfthick["Path"]

xSM

Goal: compute the nucleation temperature of a SM extension with a real scalar singlet

Clear[V,ch,cs,μh2,μs2,vh2,vs2,mW,mZ,mh,v,mt,TC,λ,λs,λh];

V[h_,s_,T_]:=((-μh2[T])/2)(h^2)+((μs2[T])/2)(s^2)+((λh )/4)(h^4)+((λs)/4)(s^4)+(λ/4)(s^2) (h^2);
ch=(((2 (mW^2)+(mZ^2)+(mh^2)+2 (mt^2)))/(4(v^2)))+(λ/24);
cs=(((2 λ+3 λs))/12);
μh2[T_]:=((mh^2)/(2(v^2))) vh2[T];
μs2[T_]:=-λs*vs2[T]; 
vh2[T_]:=(v^2)(1-2 (ch/(mh^2)) (T^2));
vs2[T_]:=(1/(λs))(((mh/(2 v)) vh2[TC]*Sqrt[2 λs]+cs*(TC^2))-cs*(T^2));

SM values and benchmark point

{mW,mZ,mh,v,mt}={80.4,91.2,125.1,246.2,173.2}(*GeV*);
{TC,λ,λs,λh}={110 (*GeV*),1.5,0.65,mh^2/(2 v^2)};

FindBounce

BT[T_?NumericQ,fp_]:=FindBounce[V[h,s,T],{h,s},{{Sqrt@vh2[T],0},{0,Sqrt@vs2[T]}},"Dimension"->3,"FieldPoints"->fp];
Action[T_?NumericQ,fp_]:=1/T*BT[T,fp]["Action"];

Trajectory in field space

τ=TC-1;
Bτ=BT[τ,31];
minimaτ={Transpose[{Sqrt@vh2[τ],0}],Transpose[{0,Sqrt@vs2[τ]}]}
Show[ContourPlot[
V[h,s,τ],{h,-1.5*Sqrt@vh2[τ],1.5*Sqrt@vh2[τ]},{s,-1.5*Sqrt@vs2[τ],1.5*Sqrt@vs2[τ]},
Contours->55,
ContourShading->LightGray,
PlotRange->Automatic,
FrameLabel->{"h","s"}
],
ParametricPlot[Through@Bτ["Bounce"][ρ],{ρ,0,Max@Bτ["Radii"]}],
Epilog->{Red,PointSize[Large],Point[minimaτ]}
]

Bτ["Path"]

Nucleation temperature

LogPlot[{Action[T,10],Action[T,31],140},{T,70,100},AxesLabel->{"T[GeV]","(Subscript[S, 3]) / T"},PerformanceGoal->"Speed"]

Round[T/.FindRoot[Action[T,31]==140,{T,85}]](*GeV*)