b[d_]:=Piecewise[{{-7/3,d==3},{-(d-3)d/2,True}}]

imF[d_,c_,a_,m_:1][X_]:=(((X+(((c X))^(m a/b[d]))))^(b[d]/m))(E^(-1/(X^(d-1))))

ClearAll[imF]

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

S[d_]:=((2((π )^(d/2)))/(Gamma[d/2]))

V[3]

S[3]

ClearAll[ℱD]

ClearAll[B]

B[ℳ_,𝒮_][d_]:=((2 V[d] ℳ)/(d-1))((((d/(S[d] 𝒮))))^(d/(d-1)))

Needs["NumericalCalculus`"]

ℱReal[D_,A_?NumericQ,B_,c_,a_,n_:0,m_:1?NumericQ][X_?NumericQ]:=((A n!)/π)NIntegrate[((imF[D,c,a,m][B Xp])/(((Xp+X))^(1+n))),{Xp,0,∞},MaxRecursion->20,WorkingPrecision->30]

ℱD[D_,A_?NumericQ,B_,c_?NumericQ,a_,n_,m_:1?NumericQ]:=((A FactorialPower[-1,n])/π)NIntegrate[((imF[D, c ,a,m][B Xp])/(((Xp))^(1+n))),{Xp,0,∞},MaxRecursion->20,WorkingPrecision->30]

ℱDinf[D_,A_?NumericQ,B_,α_,rx_,ix_,n_,γ_]:=NLimit[(X^γ)ℱReal[D,A,B,α,rx,ix,n][X],X->∞]

4D Ising

Tc4D=6.650365;
ℳ03D=1.6919045; (*Talapov_1996_The*)
𝒴03D=0.99051;(*Blote_1994_Ising*)
𝒮03D=10.083/(Tc3D^(2 ν3D));(*Caselle_2007_The*)
Rχ=1.674;(*Guida_1997_3D*)
CpCm=4.78;(*Same*)
𝒴∞3D=((( Tc3D 𝒴03D CpCm ((ℳ03D)^(δ3D-1))/Rχ))^(1/δ3D))/δ3D 2;
R3=Around[6.1,0.06];
𝒴13D=-Tc3D Around[6.015,0.015]/ ℳ03D (((2!Around[0.5608,0.0009]/Around[4.78,0.03]))^2); (*Butera_2011*)
𝒴23D=4!Tc3D Around[0.1608,0.0005]/Around[9.2,0.3];

B4D=B[ℳ03D,𝒮03D][4]

𝒴4D0=FullSimplify[(1/π)Integrate[(((X^(-2))Exp[-1/(X^3)])/(((X+Y))^3)),{X,0,∞},Assumptions->{Y>0}],Assumptions->{Y>0}]

δ4D=3;
β4D=1/2;
ν4D=1/2;
γ4D=1;
α4D=0;

data4D=Dataset[With[
{
info=ToExpression/@Rest[StringSplit[FileBaseName[#],"_"]],
dat=Import[#]
},
<|
"D"->info[[1]],
"L"->info[[2]],
"T"->info[[3]],
"H"->info[[4]],
"Me"->Around@@dat[[1]],
"Mm"->Around@@dat[[2]],
"Mt"->Around@@dat[[3]],
"Ma"->Around@@dat[[4]],
"χe"->Around@@dat[[5]],
"χm"->Around@@dat[[6]],
"χt"->Around@@dat[[7]],
"χa"->Around@@dat[[8]]
|>]&/@FileNames["~/doc/research/first_order_singularities/data/3d_ising/metastable_4_*_m.dat.processed"]];

LogLogPlot[𝒴4D0,{Y,1,(10^6)}]

Show[
ListLogLogPlot[data4D[All,{0.0001#H/#T ((((Tc4D-#T)/#T))^(-β4D δ4D)),5#χe["Value"]((((Tc4D-#T)/#T))^(γ4D))#T ((#L)^(-#D)) }&]],
LogLogPlot[𝒴4D0,{Y,0.1,(10^6)}]
]

3D Ising

Tc3D=1/0.22165455;
ℳ03D=1.6919045; (*Talapov_1996_The*)
𝒴03D=0.99051;(*Blote_1994_Ising*)
𝒮03D=10.083/(Tc3D^(2 ν3D));(*Caselle_2007_The*)
Rχ=1.674;(*Guida_1997_3D*)
CpCm=4.78;(*Same*)
𝒴∞3D=((( Tc3D 𝒴03D CpCm ((ℳ03D)^(δ3D-1))/Rχ))^(1/δ3D))/δ3D 2;
R3=Around[6.1,0.06];
𝒴13D=-Tc3D Around[6.015,0.015]/ ℳ03D (((2!Around[0.5608,0.0009]/Around[4.78,0.03]))^2); (*Butera_2011*)
𝒴23D=4!Tc3D Around[0.1608,0.0005]/Around[9.2,0.3];

Tc3D 2!Around[0.5608,0.0009]

-𝒴∞3D /((x^2)-x)/.x->((2-α3D)/(β3D δ3D))

𝒴13D

𝒴∞3D

2ν3D

𝒴03D

𝒴23D

𝒴23D

B[m,s][3]

B3D=B[ℳ03D,𝒮03D][3]

δ3D=4.78984;
β3D=0.326419;
ν3D=0.629971;
γ3D=1.237075;
α3D=0.11008;

data3D=Dataset[With[
{
info=ToExpression/@Rest[StringSplit[FileBaseName[#],"_"]],
dat=Import[#]
},
<|
"D"->info[[1]],
"L"->info[[2]],
"T"->info[[3]],
"H"->info[[4]],
"Me"->Around@@dat[[1]],
"Mm"->Around@@dat[[2]],
"Mt"->Around@@dat[[3]],
"Ma"->Around@@dat[[4]],
"χe"->Around@@dat[[5]],
"χm"->Around@@dat[[6]],
"χt"->Around@@dat[[7]],
"χa"->Around@@dat[[8]]
|>]&/@FileNames["~/doc/research/first_order_singularities/data/3d_ising/metastable_3_*_m.dat.processed"]];

𝒴4D0=FullSimplify[(1/π)Integrate[(((X^(-2))Exp[-1/(X^3)])/(((X+Y))^3)),{X,0,∞},Assumptions->{Y>0}],Assumptions->{Y>0}]

𝒴3D0=FullSimplify[(2/π)Integrate[(((X^1)Exp[-1/(X^2)])/(((X+Y))^3)),{X,0,∞},Assumptions->{Y>0}],Assumptions->{Y>0}]

(2/π)Integrate[(((X^1)Exp[-1/(X^2)])/(((X))^(3+n))),{X,0,∞},Assumptions->{Y>0}]

solAB3D=Solve[{A3D (B3D^2)((Gamma[1+(0/2)])/π)==𝒴03D},{A3D}]

B3D

B3D

𝒴3D1=A3D (B3D^2)𝒴3D0/.solAB3D[[1]]

co3D0

co3D0={#-1,A3D (B3D^(1+#))((Gamma[1+((#-1)/2)])/π)/.solAB3D[[1]],Abs@{𝒴03D,𝒴13D["Value"],𝒴23D["Value"],0,0,0,0,0,0,0,0,0,0}[[#]],Abs@{𝒴03D,𝒴13D["Uncertainty"],𝒴23D["Uncertainty"],0,0,0,0,0,0,0,0,0}[[#]]}&/@Range[13];

ListLogPlot[
{co3D0[[All,{1,2}]],co3D0[[All,{1,3}]]},PlotRange->All]

Export["~/doc/research/thesis/data/essential/data_coefficients_3d_0.dat",
co3D0
]

co2D0

(2-α3D)/(β3D δ3D)

solAc3D=FindRoot[{𝒴03D==ℱD[3,A3D,B3D,c3D,(2-α3D)/(β3D δ3D),2,0.5],𝒴∞3D==(2-α3D)/(β3D δ3D)((2-α3D)/(β3D δ3D)-1)Gamma[2-(2-α3D)/(β3D δ3D)]Gamma[(2-α3D)/(β3D δ3D)-1](1/π)A3D (c3D^(((2-α3D)/(β3D δ3D))))(((B3D))^((2-α3D)/(β3D δ3D)))},{{A3D,77},{c3D,1}},MaxIterations->1000]

𝒴3D2=Table[{10^x,ℱReal[3,A3D/.solAc3D,B3D, c3D/.solAc3D,(2-α3D)/(β3D δ3D),2][10^x]},{x,-5,5,0.1}];

𝒴

Show[
ListPlot[data3D[All,{ #H/#T ((((Tc3D-#T)/#T))^(-β3D δ3D)),#χe["Value"]((((Tc3D-#T)/#T))^(γ3D))#T ((#L)^(-#D)) }&],PlotRange->{{0,1},All}],
Plot[𝒴03D+𝒴13D["Value"]x,{x,0,5}]
]

Show[
ListLogLogPlot[data3D[All,{B3D #H/#T ((((Tc3D-#T)/#T))^(-β3D δ3D)),#χe["Value"]((((Tc3D-#T)/#T))^(γ3D))#T ((#L)^(-#D)) }&]/.solAB3D],
LogLogPlot[{𝒴3D1, 𝒴∞3D ((((B3D^(-1)) Y))^((2-α3D)/(β3D δ3D)-2))}/.solAB3D,{Y,0.0001,1000},WorkingPrecision->40]
]

ListLogLogPlot[𝒴3D2,Joined->True,PlotStyle->Black]

Series[𝒴3D0,{Y,∞,4}]

sol3D=FindRoot[
{
ℱD[3,A,B3D,((2-α3D)/(β3D δ3D))-b[3],x,1,2]==𝒴03D,
ℱDinf[3,A,B3D,2+((2-α3D)/(β3D δ3D)-2)-b[3],x,1,2,2-(2-α3D)/(β3D δ3D)]==𝒴∞3D
},{{A,0.873 },{x,1}},
MaxIterations->1000]

α==-2+b-x

-2+((2-α3D)/(β3D δ3D)-2)+b[3]

2-((2-α3D)/(β3D δ3D)-2)-b[3]

f3D=
Table[{10^X,ℱReal[3,A,B3D,2+((2-α3D)/(β3D δ3D)-2)-b[3],x,1,2][10^X]/.sol3D},{X,-3,10,0.1}];

(2)/(β2D δ2D)

Show[
ListLogLogPlot[data3D[All,{#H/#T ((((Tc3D-#T)/#T))^(-β3D δ3D)),#χe["Value"]((((Tc3D-#T)/#T))^(γ3D))#T/((#L)^(#D)) }&],PlotRange->{0.005,2}],
LogLogPlot[{𝒴03D,𝒴∞3D (X^((2-α3D)/(β3D δ3D)-2))},{X,0.001,1000}],
ListLogLogPlot[{#1,#2}&@@@f3D,Joined->True,PlotStyle->Black]
]

2D Ising

Tc2D=2/Log[1+(Sqrt[2])];
β2D=1/8;
δ2D=15;
ν2D=1;
γ2D=7/4;
𝒴02D=-2 G2C[2];
𝒴∞2D=-Φ2C[0] 2((2/(β2D δ2D))-1)/(β2D δ2D);

data2D=Dataset[With[
{
info=ToExpression/@Rest[StringSplit[FileBaseName[#],"_"]],
dat=Import[#]
},
<|
"D"->info[[1]],
"L"->info[[2]],
"T"->info[[3]],
"H"->info[[4]],
"Me"->Around@@dat[[1]],
"Mm"->Around@@dat[[2]],
"Mt"->Around@@dat[[3]],
"Ma"->Around@@dat[[4]],
"χe"->Around@@dat[[5]],
"χm"->Around@@dat[[6]],
"χt"->Around@@dat[[7]],
"χa"->Around@@dat[[8]]
|>]&/@FileNames["~/doc/research/metastable_scaling/data/2d-ising-new/metastable_2_*_m.dat.processed"]];

data2D2=Dataset[With[
{
dat=Import["~/doc/research/thesis/data/essential/data_square-4096.dat"]
},
<|
"D"->2,
"L"->#[[1]],
"T"->#[[2]],
"H"->#[[3]],
"M"->#[[8]],
"χ"->#[[10]]
|>&/@dat]];

𝒴2D0=(2/π)Integrate[(((X^1)Exp[-1/X])/(((X+Y))^3)),{X,0,∞},Assumptions->{Y>0}]

𝒴2D01=(2/π)Integrate[(((X^(2/(β2D δ2D)))Exp[-1/X])/(((X+Y))^3)),{X,0,∞},Assumptions->{Y>0}]

SeriesCoefficient[𝒴2D01,{Y,∞,14/15}]

solc2D=Solve[ (B2D^2) c2D SeriesCoefficient[𝒴2D01,{Y,∞,14/15}]==𝒴∞2D]

solA2D=NSolve[{A2D (B2D^2)Limit[𝒴2D0,Y->0]==𝒴02D}/.solc2D[[1]],{A2D}]

ℳ0//N

B2D=B[ℳ0,4/Tc2D][2]

𝒴2D1=A2D (B2D^2)𝒴2D0/.solA2D[[1]]/.Y->B2D x/.B2D->B[ℳ0,4/Tc2D][2]/.𝒴02D->-2 G2C[2]

G2C[5]

Export["~/doc/research/thesis/data/essential/data_coefficients_0.dat",
{#-1,Abs@SeriesCoefficient[𝒴2D1,{x,0,#-1},Assumptions->{x>0}],(#(#+1))Abs[G2C[#+1]]}&/@Range[13]
]

co2D0={#-1,Abs@SeriesCoefficient[𝒴2D1,{x,0,#-1},Assumptions->{x>0}],(#(#+1))Abs[G2C[#+1]]}&/@Range[13]

ListLogPlot[
{{#-1,Abs@SeriesCoefficient[𝒴2D1,{x,0,#-1},Assumptions->{x>0}]}&/@Range[13],
{#-1,(#(#+1))Abs[G2C[#+1]]}&/@Range[13]}]

Solve[𝒴∞2D==(2)/(β2D δ2D)((2)/(β2D δ2D)-1)Gamma[2-(2)/(β2D δ2D)]Gamma[(2)/(β2D δ2D)-1](1/π)A2D (c2D^(-b[2]+(2)/(β2D δ2D)))(((B2D))^((2)/(β2D δ2D)))/.A2D->0.5,c2D]

6G2C[3]

2-(2/(β2D δ2D))

1/(β2D δ2D)

Series[(((1+X))^((1/((β2D δ2D)))-2))𝒴2D0/.Y->X(((1+X))^(1/(β2D δ2D)-1)),{X,∞,2}]

solAc2D=FindRoot[{𝒴02D==ℱD[2,A2D,B2D,c2D,(2)/(β2D δ2D),2,m],-6G2C[3]==ℱD[2,A2D,B2D,c2D,(2)/(β2D δ2D),3,m],
𝒴∞2D==(2)/(β2D δ2D)((2)/(β2D δ2D)-1)Gamma[2-(2)/(β2D δ2D)]Gamma[(2)/(β2D δ2D)-1](1/π)A2D (c2D^(2/(β2D δ2D)))(((B2D))^((2)/(β2D δ2D)))},{{A2D,1},{c2D,1},{m,2}},
MaxIterations->100]

𝒴3D1=A3D (B3D^2)𝒴3D0/.solA3D[[1]]

𝒴2D2=Table[{10^x,ℱReal[2,A2D/.solAc2D,B2D, c2D/.solAc2D,2/(β2D δ2D),2,m/.solAc2D][10^x]},{x,-5,5,0.1}];

Show[
ListLogLogPlot[data2D2[All,{#H/#T ((((Tc2D-#T)/#T))^(-β2D δ2D)),#χ((((Tc2D-#T)/#T))^(γ2D))#T }&]],
LogLogPlot[𝒴2D1,{x,0.0001,1000},WorkingPrecision->40]
]

sol2D=FindRoot[
{
ℱD[2,A,B,2/(β2D δ2D)-1,x,2,2]==,
ℱDinf[2,A,B,2/(β2D δ2D)-1,x,2,2,2-2/(β2D δ2D)]==-Φ2C[0] 2((2/(β2D δ2D))-1)/(β2D δ2D)
},{{A,0.013},{x,5}},
MaxIterations->1000]

Plot[Exp[(x^(-7/3))(1+(x^2)),{x,0,10}]

test=
Table[{10^X,ℱReal[2,A,B,2/(β2D δ2D)-1,x,2,2][10^X]/.sol2D},{X,-3,5,0.1}];

Φ2C[0]

Show[
ListLogLogPlot[data2D2[All,{#H/#T ((((Tc2D-#T)/#T))^(-β2D δ2D)),#χ((((Tc2D-#T)/#T))^(γ2D))#T }&]],
LogLogPlot[{-2 G2C[2],-Φ2C[0] (((X))^((2/(β2D δ2D))-2))2((2/(β2D δ2D))-1)/(β2D δ2D),
(X^(-2+(1/(β2D δ2D))))(((Φ2C[1])/(β2D δ2D))-((3 Φ2C[1])/(((β2D δ2D))^2)))-Φ2C[0] (((X))^((2/(β2D δ2D))-2))2((2/(β2D δ2D))-1)/(β2D δ2D)},{X,0.0001,10000}],
ListLogLogPlot[{#1,#2}&@@@test,Joined->True,PlotStyle->Black]
]

Show[LogLogPlot[{-2 G2C[2],-Φ2C[0] (((X))^((2/(β2D δ2D))-2))2((2/(β2D δ2D))-1)/(β2D δ2D),
(X^(-2+(1/(β2D δ2D))))(((Φ2C[1])/(β2D δ2D))-((3 Φ2C[1])/(((β2D δ2D))^2)))-Φ2C[0] (((X))^((2/(β2D δ2D))-2))2((2/(β2D δ2D))-1)/(β2D δ2D)},{X,0.0001,10000}],
ListLogLogPlot[test,Joined->True,PlotStyle->Black]]

D[(x^((2-α)/βδ)),{x,2}]

Collect[D[(h^((2-α)/(βδ)))Φt[t (h^(-1/βδ))],{h,1}],(h^((2-α)/βδ-2))]//Simplify

2Φ2C[0](0-2)/(β2D δ2D)

G2C[3]3 2

D[(1/((xp-x))),{x,5}]

New Schofield

𝒴2D[A_,B_][X_]:=With[{Y=B X},((A (B^2))/(π (Y^3)))(Y(Y-1)-Exp[1/Y]ExpIntegralEi[-1/Y])]

𝒴2Dtmp=SeriesCoefficient[𝒴2D[A,B2D][X],{X,0,0},Assumptions->{X>0}]

θc=1.08;

e1=((Abs[1-((θc)^2)])^(-γ))𝒴02D==Simplify[Y0+(((((h0(-g'[θc]))/(((((θc)^2)-1))^(β2D δ2D)))))^2)𝒴2Dtmp+𝒴2D[A,((h0(-g'[θc]))/(((((θc)^2)-1))^(β2D δ2D))) B2D][2 θc]]//.{g->Function[x,(1-((x^2)/((θc)^2)))x]}//Expand

e2=(((h0 g[1]))^(-γ2D/(δ2D β2D)))𝒴∞2D==Y0+𝒴2D[A,((h0(-g'[θc]))/(((((θc)^2)-1))^(β2D δ2D))) B2D][( θc-1)]+𝒴2D[A,((h0(-g'[θc]))/(((((θc)^2)-1))^(β2D δ2D)))B2D][( θc+1)]//.{g->Function[x,(1-((x^2)/((θc)^2)))x]};

e3=-2(-0.4812908661543487`)==Y0+𝒴2D[A,((h0(-g'[θc]))/(((((θc)^2)-1))^(β2D δ2D))) B2D][θc]+𝒴2D[A,((h0(-g'[θc]))/(((((θc)^2)-1))^(β2D δ2D))) B2D][ θc]//.{g->Function[x,(1-((x^2)/((θc)^2)))x]};

-2(-0.4812908661543487`)

s2D=FindRoot[{e1,e2,e3},{{h0,0.57},{A,0.0014},{Y0,1}},MaxIterations->1000]

func=Sort@(Reverse/@Table[{θ,h0 (1-((θ^2)/((θc)^2)))θ/((Abs[1-(θ^2)])^Δ)/.s2D},{θ,1.0001,θc-0.00001,0.00001}]);

𝒴2DScho={#1,(((((#2)^2)-1))^(7/4))(Y0+𝒴2D[A,((h0(-g'[θc]))/(((((θc)^2)-1))^(β2D δ2D))) B2D][θc-#2]+𝒴2D[A,((h0(-g'[θc]))/(((((θc)^2)-1))^(β2D δ2D))) B2D][ θc+#2])/.g->Function[x,(1-((x^2)/((θc)^2)))x]/.s2D}&@@@func;

Show[
ListLogLogPlot[data2D2[All,{#H/#T ((((Tc2D-#T)/#T))^(-β2D δ2D)),#χ((((Tc2D-#T)/#T))^(γ2D))#T }&]],
LogLogPlot[𝒴2D1,{x,0.0001,1000},WorkingPrecision->40],
ListLogLogPlot[𝒴2DScho,Joined->True,PlotStyle->Black]
]

𝒴3D[A_,B_][X_]:=With[{Y=B X},((A (B^2))/π)(1/(9 (Y^5)))(-3 Y (3+13 Y)+(E^(1/Y)) (9+10 Y (6+7 Y)) ExpIntegralE[(7/3),(1/Y)]) Gamma[(7/3)]]

𝒴3Dtmp=Limit[𝒴3D[A,B3D][X],X->0,Direction->"FromAbove"]

θc3D=Sqrt[1.16951]

𝒴∞2D

e13D=((Abs[1-((θc3D)^2)])^(-γ3D))𝒴03D==Y0+(((((h0(-g'[θc3D]))/(((((θc3D)^2)-1))^(β3D δ3D))) ))^2)𝒴3Dtmp+𝒴3D[A,((h0(-g'[θc3D]))/(((((θc3D)^2)-1))^(β3D δ3D))) B3D][2 θc3D]/.{g->Function[x,(1-((x^2)/((θc3D)^2)))x]}

e23D=(((h0 g[1]))^(-γ3D/(δ3D β3D)))𝒴∞3D==Y0+𝒴3D[A,((h0(-g'[θc3D]))/(((((θc3D)^2)-1))^(β3D δ3D))) B3D][( θc3D-1)]+𝒴3D[A,((h0(-g'[θc3D]))/(((((θc3D)^2)-1))^(β3D δ3D)))B3D][( θc3D+1)]//.{g->Function[x,(1-((x^2)/((θc3D)^2)))x]};

e33D=𝒴03D CpCm==Y0+𝒴3D[A,((h0(-g'[θc3D]))/(((((θc3D)^2)-1))^(β3D δ3D))) B3D][θc3D]+𝒴3D[A,((h0(-g'[θc3D]))/(((((θc3D)^2)-1))^(β3D δ3D))) B3D][ θc3D]//.{g->Function[x,(1-((x^2)/((θc3D)^2)))x]};

s3D=FindRoot[{e13D,e23D,e33D},{{h0,1},{A,1},{Y0,10}},MaxIterations->1000]

func3D=Sort@(Reverse/@Table[{θ,h0 (1-((θ^2)/((θc3D)^2)))θ/((Abs[1-(θ^2)])^(β3D δ3D))/.s3D},{θ,1.0001,θc3D-0.00001,0.00001}]);

𝒴3DScho={#1,(((((#2)^2)-1))^(γ3D))(Y0+𝒴3D[A,((h0(-g'[θc3D]))/(((((θc3D)^2)-1))^(β3D δ3D))) B3D][θc3D-#2]+𝒴3D[A,((h0(-g'[θc3D]))/(((((θc3D)^2)-1))^(β3D δ3D))) B3D][ θc3D+#2])/.g->Function[x,(1-((x^2)/((θc3D)^2)))x]/.s3D}&@@@func3D;

Show[
ListLogLogPlot[data3D[All,{B3D#H/#T ((((Tc3D-#T)/#T))^(-β3D δ3D)),#χe["Value"]((((Tc3D-#T)/#T))^(γ3D))#T ((#L)^(-#D)) }&]],
LogLogPlot[{𝒴03D,𝒴∞3D (((Y/B3D))^(-γ3D/(β3D δ3D))),𝒴3D1},{Y,0.0001,1000},WorkingPrecision->40],
ListLogLogPlot[{B3D #1,#2}&@@@𝒴3DScho,Joined->True,PlotStyle->Black]
]

Exports

Export["~/doc/research/thesis/data/metastable/example.dat",
Join[{"D L T H ME δME MM δMM MT δMT MA δMA χE δχE χM δχM χT δχT χA δχA"},Normal[data2D[Select[#L==64&],{#D,#L,#T,#H,#Me["Value"],#Me["Uncertainty"],
#Mm["Value"],#Mm["Uncertainty"],
#Mt["Value"],#Mt["Uncertainty"],
#Ma["Value"],#Ma["Uncertainty"],
#χe["Value"],#χe["Uncertainty"],
#χm["Value"],#χm["Uncertainty"],
#χt["Value"],#χt["Uncertainty"],
#χa["Value"],#χa["Uncertainty"]}&,FailureAction->None]],1]]

Export["~/doc/research/thesis/data/metastable/scaling.dat",
Flatten[Join[{"\n\n#"<>ToString[#[[1]]]},{"D L T H ME δME MM δMM MT δMT MA δMA χE δχE χM δχM χT δχT χA δχA"},#[[2]]]&/@Normal@Normal[data2D[Select[#L==128&]][GroupBy[#L (Tc2D-#T)/Tc2D&],All,{#D,#L,#T,#H,#Me["Value"],#Me["Uncertainty"],
#Mm["Value"],#Mm["Uncertainty"],
#Mt["Value"],#Mt["Uncertainty"],
#Ma["Value"],#Ma["Uncertainty"],
#χe["Value"],#χe["Uncertainty"],
#χm["Value"],#χm["Uncertainty"],
#χt["Value"],#χt["Uncertainty"],
#χa["Value"],#χa["Uncertainty"]}&,FailureAction->None]],1]]

Export["~/doc/research/thesis/data/essential/3d_ising.dat",
Join[{"D L T H ME δME MM δMM MT δMT MA δMA χE δχE χM δχM χT δχT χA δχA"},Normal@data3D[Select[#L==128&],{#D,#L,#T,#H,#Me["Value"],#Me["Uncertainty"],
#Mm["Value"],#Mm["Uncertainty"],
#Mt["Value"],#Mt["Uncertainty"],
#Ma["Value"],#Ma["Uncertainty"],
#χe["Value"],#χe["Uncertainty"],
#χm["Value"],#χm["Uncertainty"],
#χt["Value"],#χt["Uncertainty"],
#χa["Value"],#χa["Uncertainty"]}&,FailureAction->None]]]

scalingDat2D=Table[{10^x/B2D,(𝒴2D0/.Y->10^x)},{x,-6,3,1/100}];

ListLogLogPlot[{#1,#2(B2D^2)(A2D/.solA2D[[1]] )}&@@@N[scalingDat2D,50],Joined->True]

Export["~/doc/research/thesis/data/essential/2d_scaling.dat",
{#1,#2(B2D^2)(A2D/.solA2D[[1]])}&@@@N[scalingDat2D,60]
];

scalingDat3D=Table[{10^x/B3D,(𝒴3D0/.Y->10^x)},{x,-5,4,1/100}];

ListLogLogPlot[{#1,#2(B3D^2)(A3D/.solA3D[[1]])}&@@@N[scalingDat3D,50],Joined->True]

Export["~/doc/research/thesis/data/essential/3d_scaling.dat",
{#1,#2(B3D^2)(A3D/.solA3D[[1]])}&@@@N[scalingDat3D,60]
];