SetDirectory[NotebookDirectory[]];

<<IsingScalingFunction`

N[{γ,(10^(-4)),1-(10^(-4)),(10^(-4))},30]

data=Table[{ut[1,γ Data[n]["θ0"]]((uh[Data[n]["θ0"],Data[n]["gs"]][1,γ Data[n]["θ0"]])^(-8/15)),Re@(DScriptF0DηList@@PrepareArgument[Data[n]])[0,γ Data[n]["θ0"]][[1]]},{n,2,6},Evaluate@N[{γ,(10^(-4)),1-(10^(-4)),(10^(-4))},30]];

dataf=Interpolation/@data;

pCovergence=LogPlot[Evaluate[(Abs[#[x]-Last[dataf][x]])&/@Most[dataf]],{x,-6,6},PlotLegends->LineLegend[{2,3,4,5},LegendLabel->"n"],AxesLabel->{"t (h^(-1/β δ))","| ((Subscript[ℱ, 0])^((n))) - ((Subscript[ℱ, 0])^((6))) |"},LabelStyle->{Black,FontSize->12}]

Export["/tmp/pConvergence.pdf",pCovergence];

data1=Table[{ut[1,γ Data[n]["θ0"]]((uh[Data[n]["θ0"],Data[n]["gs"]][1,γ Data[n]["θ0"]])^(-8/15)),Re@(DScriptF0DηList@@PrepareArgument[Data[n]])[1,γ Data[n]["θ0"]][[-1]]},{n,2,6},Evaluate@N[{γ,(10^(-4)),1-(10^(-4)),(10^(-4))},30]];

data1f=Interpolation/@data1;

LogPlot[Evaluate[(Abs[#[x]-Last[data1f][x]])&/@Most[data1f]],{x,-6,6},PlotLegends->LineLegend[{2,3,4,5},LegendLabel->"n"],AxesLabel->{"t (h^(-1/β δ))","| ((Subscript[ℱ, 0])^((n))) - ((Subscript[ℱ, 0])^((6))) |"},LabelStyle->{Black,FontSize->12}]

ParametricPlot[Evaluate@{
{ut[1,γ Data[2]["θ0"]]((uh[Data[2]["θ0"],Data[2]["gs"]][1,γ Data[2]["θ0"]])^(-8/15)),(DScriptF0DηList@@PrepareArgument[Data[2]])[0,γ Data[2]["θ0"]]},
{ut[1,γ Data[6]["θ0"]]((uh[Data[6]["θ0"],Data[6]["gs"]][1,γ Data[6]["θ0"]])^(-8/15)),(DScriptF0DηList@@PrepareArgument[Data[6]])[0,γ Data[6]["θ0"]]}
},{γ,0,0.999},
AspectRatio->1
]

1 * 3*2

ParametricPlot[Evaluate@{
{ut[1,γ Data[2]["θ0"]]((uh[Data[2]["θ0"],Data[2]["gs"]][1,γ Data[2]["θ0"]])^(-8/15)),(DScriptF0DηList@@PrepareArgument[Data[2]])[0,γ Data[2]["θ0"]]},
{ut[1,γ Data[6]["θ0"]]((uh[Data[6]["θ0"],Data[6]["gs"]][1,γ Data[6]["θ0"]])^(-8/15)),(DScriptF0DηList@@PrepareArgument[Data[6]])[0,γ Data[6]["θ0"]]}
},{γ,0,0.999},
AspectRatio->1
]

p2=ParametricPlot[Evaluate@{
{ut[1,γ Data[2]["θ0"]]((uh[Data[2]["θ0"],Data[2]["gs"]][1,γ Data[2]["θ0"]])^(-8/15)),Last@(DScriptF0DηList@@PrepareArgument[Data[2]])[1,γ Data[2]["θ0"]]},
{ut[1,γ Data[6]["θ0"]]((uh[Data[6]["θ0"],Data[6]["gs"]][1,γ Data[6]["θ0"]])^(-8/15)),Last@(DScriptF0DηList@@PrepareArgument[Data[6]])[1,γ Data[6]["θ0"]]}
},{γ,0,0.999},
AspectRatio->1
]

p2=ParametricPlot[Evaluate@{
{ut[1,γ Data[2]["θ0"]]((uh[Data[2]["θ0"],Data[2]["gs"]][1,γ Data[2]["θ0"]])^(-8/15)),-Last@(DScriptF0DηList@@PrepareArgument[Data[2]])[2,γ Data[2]["θ0"]]},
{ut[1,γ Data[6]["θ0"]]((uh[Data[6]["θ0"],Data[6]["gs"]][1,γ Data[6]["θ0"]])^(-8/15)),-Last@(DScriptF0DηList@@PrepareArgument[Data[6]])[2,γ Data[6]["θ0"]]}
},{γ,0,0.999},
AspectRatio->1
]

uh[Data[2]["θ0"],Data[2]["gs"]][1,γ Data[2]["θ0"]]((Abs[ut[1,γ Data[2]["θ0"]]])^(-15/8))

pMag=Show[ParametricPlot[Evaluate@{
{ξ[Data[2]["θ0"],Data[2]["gs"]][γ Data[2]["θ0"]],-(DufDuh@@PrepareArgument[Data[2]])[1][1,γ Data[2]["θ0"]]((Abs[ut[1,γ Data[2]["θ0"]]])^(-1/8))},
{ξ[Data[6]["θ0"],Data[6]["gs"]][γ Data[6]["θ0"]],-(DufDuh@@PrepareArgument[Data[6]])[1][1,γ Data[6]["θ0"]]((Abs[ut[1,γ Data[6]["θ0"]]])^(-1/8))},
{ξ[θ0Cas,gsCas][γ θ0Cas],DScriptMCasDξList[1,γ θ0Cas][[1]]}
},{γ,0,0.999},PlotRange->{{0,3.3},{0,1.6}},
AspectRatio->1,PlotPoints->50,AxesLabel->{"h | t((|)^(-β δ))","M | t((|)^(-β))"},LabelStyle->{Black,FontSize->14}
]]

pMag=Show[ParametricPlot[Evaluate@{
{ξ[Data[2]["θ0"],Data[2]["gs"]][θ],-(DufDuh@@PrepareArgument[Data[2]])[1][1,θ]((Abs[ut[1,θ]])^(-1/8))},
{ξ[Data[6]["θ0"],Data[6]["gs"]][θ],-(DufDuh@@PrepareArgument[Data[6]])[1][1,θ]((Abs[ut[1,θ]])^(-1/8))},
{ξ[θ0Cas,gsCas][θ],DScriptMCasDξList[1,θ][[1]]}
},{θ,0,1.4},
AspectRatio->1,PlotPoints->50,AxesLabel->{"h | t\!\(\*SuperscriptBox[\(|\), \(\(-β\)\\ δ\)]\)","M | t((|)^(-β))"},LabelStyle->{Black,FontSize->14},PlotRange->{{0,2.3},{1.35,1.45}}
]]

Gls[[2]]//N

pSus=Show[ParametricPlot[Evaluate@{
{uh[Data[2]["θ0"],Data[2]["gs"]][1,θ]((Abs[ut[1,θ]])^(-15/8)),-(DufDuh@@PrepareArgument[Data[2]])[2][1,θ]((Abs[ut[1,θ]])^(7/4))},
{uh[Data[6]["θ0"],Data[6]["gs"]][1,θ]((Abs[ut[1,θ]])^(-15/8)),-(DufDuh@@PrepareArgument[Data[6]])[2][1,θ]((Abs[ut[1,θ]])^(7/4))}
},{θ,1,Data[6]["θ0"]},PlotRange->{{0,2.3},{0.015,0.105}},
AspectRatio->1,WorkingPrecision->20,PlotPoints->50,AxesLabel->{"h | t((|)^(-β δ))","χ | t((|)^γ)"},LabelStyle->{Black,FontSize->14}
]]

((Abs[ut[1,γ Data[6]["θ0"]]])^(7/4))

pSus=Show[ParametricPlot[Evaluate@{
{uh[Data[2]["θ0"],Data[2]["gs"]][1,γ Data[2]["θ0"]]((Abs[ut[1,γ Data[2]["θ0"]]])^(-15/8)),-(DufDuh@@PrepareArgument[Data[2]])[2][1,γ Data[2]["θ0"]]((Abs[ut[1,γ Data[2]["θ0"]]])^(7/4))},
{uh[Data[6]["θ0"],Data[6]["gs"]][1,γ Data[6]["θ0"]]((Abs[ut[1,γ Data[6]["θ0"]]])^(-15/8)),-(DufDuh@@PrepareArgument[Data[6]])[2][1,γ Data[6]["θ0"]]((Abs[ut[1,γ Data[6]["θ0"]]])^(7/4))}
},{γ,0,0.999},PlotRange->{{0,3.3},Automatic},
AspectRatio->1,WorkingPrecision->20,PlotPoints->50,AxesLabel->{"h | t((|)^(-β δ))","χ | t((|)^γ)"},LabelStyle->{Black,FontSize->14}
],pCasS]

Export["/tmp/pMag.pdf",pMag];
Export["/tmp/pSus.pdf",pSus]

p2=ParametricPlot[Evaluate@{
{ut[1,γ Data[2]["θ0"]]((uh[Data[2]["θ0"],Data[2]["gs"]][1,γ Data[2]["θ0"]])^(-8/15)),-(DufDut@@PrepareArgument[Data[2]])[2][1,γ Data[2]["θ0"]]},
{ut[1,γ Data[6]["θ0"]]((uh[Data[6]["θ0"],Data[6]["gs"]][1,γ Data[6]["θ0"]])^(-8/15)),-(DufDut@@PrepareArgument[Data[6]])[2][1,γ Data[6]["θ0"]]}
},{γ,0,0.99},
AspectRatio->1
]

p2=Plot[{
-Re[Evaluate[DufDut@@PrepareArgument[Data[2]]][2]@@InverseCoordinates[Data[2]["θ0"],Data[2]["gs"]][t,1/10000]],
-Re[Evaluate[DufDut@@PrepareArgument[Data[6]]][2]@@InverseCoordinates[Data[6]["θ0"],Data[6]["gs"]][t,1/10000]]
},{t,-10,10},PlotRange->All,Exclusions->None]

InverseCoordinates[Data[6]["θ0"],Data[6]["gs"]][-1,0]

dat=Table[{uhh,Re[Evaluate[DufDuh@@PrepareArgument[Data[6]]][2]@@InverseCoordinates[Data[6]["θ0"],Data[6]["gs"]][-1/100,uhh]]},{uhh,-1,1,0.005}];

InverseCoordinates-1/10,0]

dat[[1]]

ListLogPlot[-dat,Joined->True,PlotRange->All]

p6=Plot[Re[Evaluate[DufDuh@@PrepareArgument[Data[6]]][2]@@InverseCoordinates[Data[6]["θ0"],Data[6]["gs"]][ut,1/100]],{ut,-10,10},PlotRange->All,Exclusions->None]

p6=Plot[Re[Evaluate[DufDut@@PrepareArgument[Data[6]]][4]@@InverseCoordinates[Data[6]["θ0"],Data[6]["gs"]][ut,1/100]],{ut,-10,10},PlotRange->All,Exclusions->None]

Show[p2,p6,PlotRange->{-10,30}]

Solve[{tt==R((θ^2)-1),h==(R^Δ)g[θ]},{R,θ}]

Plot[Evaluate[g[θ0,{g[0],g[1]}][θ]/.data2],{θ,0,1.148}]

Plot[(uf@@Most[prep2])[1,θ],{θ,-1.148,1.148}]

dat=Flatten[Table[{ut[R,θ],uh[θ0,{g[0],g[1]}][R,θ],-(DufDuh@@prep2)[1][R,θ]}/.data2,{R,0.05,2,0.05},{θ,-1.14841,1.14841,0.05}],1];

ListPlot3D[dat]

Plot[Evaluate[(DufDut@@prep2)[2][R,0.1]],{R,0,2}]

ParametricPlot[{θ,Evaluate[(DufDut@@prep2)[2][.1,θ]]},{θ,-1.148,1.148},AspectRatio->1]

dGdξ

(dΦdηList@@prep2)[0,1]

ListLogPlot[Abs[(DScriptFPlusMinusDξθ0List@@prep2)[10]]]

ListLogPlot[Abs[(DScriptF0DηList@@prep2)[10,0.5]]]