Get["~/doc/research/first_order_singularities/mma/schofield.wl"]

Definitions

h1=h[0];
F1=RF[2];
eq1=eq[F1,h1][1];

θc1=1.2;

sol1=FindRoot[eq1/.θc->θc1,{{A,RandomReal[{0,3}]},{gC[0],RandomReal[]},{FC[0],RandomReal[]},{FC[1],RandomReal[]},{FC[2],RandomReal[]}},MaxIterations->500]

Plot[Evaluate[RF[2][θ]/.B->ruleB[h1]/.sol1/.θc->θc1],{θ,-θc1,θc1}]

h2=h[3];
F2=RF[2];
eq2=eq[F2,h2][2];

sol2=FindRoot[eq2/.θc->θc1,{{A,A/.sol1},{gC[0],gC[0]/.sol1},{FC[0],FC[0]/.sol1},{FC[1],FC[1]/.sol1},{FC[2],FC[2]/.sol1},{gC[1],0},{gC[2],0},{gC[3],RandomReal[]}},MaxIterations->10000]

GraphicsRow[{
Plot[h2[θ]/.sol2/.θc->θc1,{θ,-θc1,θc1}],
Plot[F2[θ]/.B->ruleB[h2]/.sol2/.θc->θc1,{θ,-θc1,θc1}]
}]

ParametricPlot[Evaluate[(R|->{R t[θ],(R^(Δ[2]))h2[θ]})/@{0.25,0.375,0.5,0.75,1}/.sol2/.θc->θc1],{θ,-θc1,θc1}]

Φη2=Table[{t[θ]((h2[θ])^(-1/Δ[2])),((h2[θ])^(-2/Δ[2]))(F2[θ]-(((t[θ])^2)/(8π))Log[((t[θ])^2)])}/.B->ruleB[h2]/.sol2/.θc->θc1,{θ,0.0001,θc1-0.0001,0.0001}];

ListPlot[Φη2,Joined->True,PlotRange->{{-20,20},{-2,0}}]

Mξ2=Table[{h2[θ]((t[θ])^(-Δ[2])),-(Transpose[Inverse[D[{R t[θp],(R^(Δ[2]))h2[θp]},{{R,θp}}]/.θp->θ]].(D[(R^2)(F2[θp]+((t[θp])^2)Log[(R^2)]/(8π)),{{R,θp}}]/.θp->θ))[[2]]/(((R t[θ]))^(1/8))}/.B->ruleB[h2]/.sol2/.θc->θc1/.R->1,{θ,1+0.001,θc1-0.001,0.001}];

ListPlot[Mξ2,Joined->True]

χξ2=Table[{h2[θ]((t[θ])^(-Δ[2])),-(Transpose[Inverse[D[{R t[θp],(R^(Δ[2]))h2[θp]},{{R,θp}}]]].D[(Transpose[Inverse[D[{R t[θp],(R^(Δ[2]))h2[θp]},{{R,θp}}]]].D[(R^2)(F2[θp]+((t[θp])^2)Log[(R^2)]/(8π)),{{R,θp}}])[[2]],{{R,θp}}])[[2]](((R t[θp]))^(7/4))}/.θp->θ/.B->ruleB[h2]/.sol2/.θc->θc1/.R->1,{θ,1+0.001,θc1-0.001,0.001}];

ListPlot[χξ2,Joined->True]

h3=h[5];
F3=RF[2];
eq3=eq[F3,h3][3];

sol3=FindRoot[eq3/.θc->θc1,{{A,A/.sol2},{gC[0],gC[0]/.sol2},{FC[0],FC[0]/.sol2},{FC[1],FC[1]/.sol2},{FC[2],FC[2]/.sol2},{gC[1],gC[1]/.sol2},{gC[2],gC[2]/.sol2},{gC[3],gC[3]/.sol2},{gC[4],0},{gC[5],0}},MaxIterations->500]

GraphicsRow[{
Plot[h3[θ]/.sol3/.θc->θc1,{θ,0,θc1}],
Plot[F3[θ]/.B->ruleB[h3]/.sol3/.θc->θc1,{θ,0,θc1}]
}]

Φη3=Table[{t[θ]((h3[θ])^(-1/Δ[2])),((h3[θ])^(-2/Δ[2]))(F3[θ]-(((t[θ])^2)/(8π))Log[((t[θ])^2)])}/.B->ruleB[h3]/.sol3/.θc->θc1,{θ,0.0001,θc1-0.0001,0.0001}];

Mξ3=Table[{h3[θ]((t[θ])^(-Δ[2])),-(Transpose[Inverse[D[{R t[θp],(R^(Δ[2]))h3[θp]},{{R,θp}}]/.θp->θ]].(D[(R^2)(F3[θp]+((t[θp])^2)Log[(R^2)]/(8π)),{{R,θp}}]/.θp->θ))[[2]]/(((R t[θ]))^(1/8))}/.B->ruleB[h3]/.sol3/.θc->θc1/.R->1,{θ,1+0.001,θc1-0.001,0.001}];

χξ3=Table[{h3[θ]((t[θ])^(-Δ[2])),-(Transpose[Inverse[D[{R t[θp],(R^(Δ[2]))h3[θp]},{{R,θp}}]]].D[(Transpose[Inverse[D[{R t[θp],(R^(Δ[2]))h3[θp]},{{R,θp}}]]].D[(R^2)(F3[θp]+((t[θp])^2)Log[(R^2)]/(8π)),{{R,θp}}])[[2]],{{R,θp}}])[[2]](((R t[θp]))^(7/4))}/.θp->θ/.B->ruleB[h3]/.sol3/.θc->θc1/.R->1,{θ,1+0.001,θc1-0.001,0.001}];

χ3ξ3=Table[{h3[θ]((t[θ])^(-Δ[2])),(Transpose[Inverse[D[{R t[θp],(R^(Δ[2]))h3[θp]},{{R,θp}}]]].D[(Transpose[Inverse[D[{R t[θp],(R^(Δ[2]))h3[θp]},{{R,θp}}]]].D[(Transpose[Inverse[D[{R t[θp],(R^(Δ[2]))h3[θp]},{{R,θp}}]]].D[(R^2)(F3[θp]+((t[θp])^2)Log[(R^2)]/(8π)),{{R,θp}}])[[2]],{{R,θp}}])[[2]],{{R,θp}}])[[2]](((R t[θp]))^(7/4+Δ[2]))}/.θp->θ/.B->ruleB[h3]/.sol3/.θc->θc1/.R->1,{θ,1+0.001,θc1-0.001,0.001}];

ListPlot[{Φη2,Φη3},Joined->True,PlotRange->{{-20,20},{-2,0}}]

ListPlot[{Mξ2,Mξ3},Joined->True]

ListLogLogPlot[{χξ2,χξ3},Joined->True]

h4=h[7];
F4=RF[3];
eq4=eq[F4,h4][4];

h5=h[8];
F5=RF[4];
eq5=eq[F5,h5][5];

h6=h[10];
F6=RF[5];
eq6=eq[F6,h6][6];

Caselle comparison

hCaselle[θ_]:=h0 θ(1-((θ^2)/1.16951))(1-0.222389 (θ^2)-0.043547 (θ^4)-0.014809 (θ^6)-0.007168 (θ^8))

m0Sol=Solve[-Gls[[2]]==m0 θ/((((θ^2)-1))^(β[2])) /.θ->Sqrt[1.16951],m0][[1]]

(Transpose[Inverse[D[{R t[θp],(R^(Δ[2]))hCaselle[θp]},{{R,θp}}]/.θp->θ]].(D[m0 (R^(β[2]))θp,{{R,θp}}]/.θp->θ))[[2]]/(R^(-7/4))/.θ->Sqrt[1.16951]/.m0Sol

h0Sol=Solve[-2 Gls[[3]]==(Transpose[Inverse[D[{R t[θp],(R^(Δ[2]))hCaselle[θp]},{{R,θp}}]/.θp->θ]].(D[m0 (R^(β[2]))θp,{{R,θp}}]/.θp->θ))[[2]]/(((R t[θ]))^(-7/4))/.θ->Sqrt[1.16951]/.m0Sol,h0][[1]]

MCaselle=Table[{hCaselle[θ]((t[θ])^(-Δ[2])),m0 θ/((((θ^2)-1))^(β[2]))}/.m0Sol/.h0Sol,{θ,1.0001,Sqrt[1.16951],0.0001}];

ListPlot[{Mξ3,MCaselle},Joined->True]

χCaselle=Table[{hCaselle[θ]((t[θ])^(-Δ[2])),(Transpose[Inverse[D[{R t[θp],(R^(Δ[2]))hCaselle[θp]},{{R,θp}}]/.θp->θ]].(D[m0 (R^(β[2]))θp,{{R,θp}}]/.θp->θ))[[2]]/(((R t[θ]))^(-7/4))}/.m0Sol/.h0Sol,{θ,1.0001,Sqrt[1.16951],0.0001}];

ListPlot[{χξ3,χCaselle},Joined->True]

χ3Caselle=Table[{hCaselle[θ]((t[θ])^(-Δ[2])),-(Transpose[Inverse[D[{R t[θp],(R^(Δ[2]))hCaselle[θp]},{{R,θp}}]]].D[(Transpose[Inverse[D[{R t[θp],(R^(Δ[2]))hCaselle[θp]},{{R,θp}}]/.θp->θ]].(D[m0 (R^(β[2]))θp,{{R,θp}}]))[[2]],{{R,θp}}])[[2]](((R t[θ]))^(7/4+Δ[2]))/.θp->θ}/.m0Sol/.h0Sol,{θ,1.0001,Sqrt[1.16951],0.0001}];

ListLogLogPlot[{χ3ξ3,χ3Caselle},Joined->True]