Definitions

β=1/8;δ=15;α=0;
Δ=β δ;
ℳ0Square:=((((2^(5/2))ArcSinh[1]))^β)
TcSquare:=2/Log[1+Sqrt[2]]
ASquare:=(TcSquare^2)ℳ0Square/(16 π)
Ch:=0.838677624411

$Assumptions={θc>1,t∞>0,gC[∞]>0,gC[_]∈Reals,B>0,A>0,ℱ1>0,ℱ0∈Reals,γ>0};

f[n_][θ_]:=(((θ^2)-1)/(1+(θ^2)RealAbs[θ]/t∞))

g[n_][θ_]:=(1-((((θ/(θc))))^2))(((1+((gC[n])/(gC[∞]))RealAbs[θ](θ^(2n+2))/((θc)^2)))^(-1))Sum[gC[i](θ^(2i+1)),{i,0,n}]

ℱf[y_]:=(1/π)(((E^(1/y)) y γ ExpIntegralEi[-(1/y)]-(E^γ) ExpIntegralEi[-γ])/(γ-y (γ^2)))

Rℱ[θ_]:=ℱ0+ℱ1(ℱf[B(θc-θ)]+ℱf[B(θc+θ)])
Iℱ[θ_]:=ℱ1( HeavisideTheta[θ-θc]+HeavisideTheta[-θ-θc])B RealAbs[θ-θc]/(1+γ B RealAbs[θ-θc])Exp[-(((B RealAbs[θ-θc]))^(-1))]

Plot[Iℱ

eqLow[n_][m_]:=SeriesCoefficient[
Rℱ[θ]-((f[n][θ])^(2-α))Gl[g[n][θ]((f[n][θ])^(-Δ))],
{θ,θc,m},Assumptions->Join[$Assumptions,{θ<θc,θ>1}]
]
eqHigh[n_][m_]:=SeriesCoefficient[
Rℱ[θ]-(((-f[n][θ]))^(2-α))Gh[g[n][θ](((-f[n][θ]))^(-Δ))],
{θ,0,m},Assumptions->Join[$Assumptions,{θ>0,θ<1}]
]
eqMid[n_][m_]:=SeriesCoefficient[
Rℱ[θ]-(((g[n][θ])^((2-α)/Δ))Φ[η]+((η^2)/(8π))Log[(η^2)]/.η->f[n][θ] ((g[n][θ])^(-1/Δ)))
,{θ,1,m},Assumptions->Join[$Assumptions,{θ>0,θ<θc}]
]
eqMeta[n_][m_]:=SeriesCoefficient[
Iℱ[1/θinv]-(((- g[n][1/θinv]))^((2-α)/Δ))Dmeta[f[n][1/θinv](((- g[n][1/θinv]))^(-1/Δ))]
,{θinv,0,m},Assumptions->Join[$Assumptions,{θinv>0,θinv<1/θc}]
]
eqB[n_]:=B->A ((- g[n]'[θc])/(((((θc)^2)-1))^(β δ)))

ΦRules=MapIndexed[Derivative[#2[[1]]-1][Φ][0]->(#2[[1]]-1)!#1&,{-1.197733383797993,-0.318810124891,0.110886196683,0.01642689465,-2.639978 (10^(-4)),-5.140526 (10^(-4)),2.08856 (10^(-4)),-4.4819 (10^(-5))}];
GlRules=MapIndexed[Derivative[#2[[1]]-1][Gl][0]->(#2[[1]]-1)!#1&,{0,-1.3578383417066,-0.048953289720,0.038863932,-0.068362119,0.18388370,-0.6591714,2.937665,-15.61}];
GhRules=MapIndexed[Derivative[#2[[1]]-1][Gh][0]->(#2[[1]]-1)!#1&,{0,0,-1.8452280782328,0,8.333711750,0,-95.16896,0,1457.62,0,-25891}];
DmetaRules=
Derivative[#][Dmeta][0]->If[#≠2,Sin[8π(2-#)/15]Derivative[#][Φ][0],2/15]&/@Range[0,5];
ARule=A->ASquare;

testN=0;
testEq1={eqLow[testN][1],eqHigh[testN][1],eqMid[testN][1]}

testEq2=Simplify[testEq1//.Join[ΦRules,GlRules,GhRules,DmetaRules,{ARule,h0->1,gC[0]->1,eqB[testN]}]];

ss1=FindRoot[testSol,{{gC[∞],1RandomReal[]},{θc,1+RandomReal[]},{ℱ0,0},{ℱ1,RandomReal[]},{γ,RandomReal[]},{t∞,RandomReal[]}},MaxIterations->4000]

Plot[Rℱ[θ]/.eqB[testN]/.ARule/.ss1/.gC[0]->1/.h0->1,{θ,-2,2}]

Rℱ[θ]/.eqB[testN]/.ARule/.ss1/.gC[0]->1/.h0->1

ξ[0][θ]/.eqB[0]/.ARule/.ss1/.{gCoeff[0]->1,h0->1,t∞->1}

Plot[(((((Abs[1-(θ^2)])/(1+(θ^3)/t∞))))^(-β))/.t∞->1000,{θ,1,1.3}]

eqB[0]/.ARule/.ss1/.{gCoeff[0]->1,h0->1,t∞->1}

Plot[RM[θ]/.eqB[0]/.ARule/.ss1/.{gCoeff[0]->1,h0->1,t∞->1}/.m1->0,{θ,-2,2}]

ListLogPlot[Table[{θ,Sign[θc-θ]Abs@ξ[0][θ]}/.eqB[0]/.ARule/.ss1/.{gCoeff[0]->1,h0->1,t∞->1,m1->0},{θ,1.01,1.3,0.001}],PlotRange->All,Joined->True]

tastTab=Table[{Sign[θc-θ]Abs@ξ[0][θ],(((((Abs[1-(θ^2)])/(1+(θ^3)/t∞))))^(-β))RM[θ]}/.eqB[0]/.ARule/.ss1/.{gCoeff[0]->1,h0->1,t∞->1000000,m1->0},{θ,1.01,1.4462747730035337`,0.0001}];

ListLogLogPlot[tastTab,PlotRange->All,Joined->True]

testSol[[All,1]]/.ss1

D[(h^(16/15))ℱ[t (h^(-1/(β δ)))],h]

Series[Simplify[η[0][1/θinv]],{θinv,0,1}]

SeriesCoefficient[Simplify[η[0][1/θinv]],{θinv,0,1}]

eqMeta[3][3]

eqLow[2][1]

Simplify[SeriesCoefficient[G[ξ[0][θ]],{θ,θc,1}]]

Simplify[SeriesCoefficient[Φ[η[3][θ]],{θ,1,2}]]

params[n_]:=Join[{h0,t∞},gParams[n]]

Limit[((1-(((θ/θc))^2))/(1+gN/g∞  (θ^(2n+3))/((θc)^2)))gN (θ^(2n+1)),θ->∞]

Series[((1-(θ^2))/(1 +(θ^3)/t∞))/(((h0 g[θ]))^(1/βδ)),{θ,1,2}]

Series[M[((1-((θinv)^(-2)))/(1 +((θinv)^(-3))/t∞))/(((h0 ginv[θinv]))^(1/βδ))],{θinv,0,2}]

Plot[((1-(θ^2))/(1+0.1 (θ^3))),{θ,0,10}]

Integrate[(x(x-1)-Exp[1/x]ExpIntegralEi[-1/x])/(x^3),x]

R->2^Range[-2,2]

D[x Exp[-(((x))^(-1))]f[x],x]

Plot[x Exp[-(((x))^(-1))],{x,0,10}]

D[-(((E^(1/(x+I y))) ExpIntegralEi[-(1/(x+I y))])/(x+I y)),x]/.{y->0}//Simplify

D[(((x+I y))^(-1))Exp[-(((x+I y))^(-1))],y]/.y->0

Solve[ExpIntegralEi[x]==0,x]

Plot[ExpIntegralEi[x],{x,0,3}]

Plot[-(((θc-θ-1)(E^(1/(θc-θ))) ExpIntegralEi[-(1/(θc-θ))])/(θc-θ))/.{θc->1.3},{θ,-5,3}]

Plot[-(((E^(1/(θc-θ))) ExpIntegralEi[-(1/(θc-θ))])/(θc-θ))+(((E^(1/(θc+θ))) ExpIntegralEi[-(1/(θc+θ))])/(θc+θ))/.{θc->1.3},{θ,-5,5}]

LogPlot[Evaluate[Det[D[{R((1-(θ^2))/(1+2 (θ^3))),(R^(15/8))((1-(((θ/1.08))^2))/(1+1/20 (θ^3)/(1.08^2))) θ},{{R,θ},1}]]/.R->(2^(Range[-2,2]))],{θ,0,10}]

Evaluate[{R((1-(θ^2))/(1+0.5 (θ^3))),(R^(15/8))((1-(((θ/1.3))^2))/(1+1/0.4  (θ^3)/(1.3^2))) θ}/.R->2^Range[-2,2]]

Series[(1-(θ^2))/((((1-(((θ/1.3))^2)) θ))^(8/15)),{θ,∞,1}]

ParametricPlot[Evaluate[{#(1-(θ^2)),((#)^(15/8))(1-(((θ/1.3))^2)) θ}&/@(2^Range[-2,0,0.25])],{θ,0,1.8},PlotRange->All]

Series[(h0 g[θ])/(((((1-(θ^2))/(1+1/t∞ (θ^3)))))^(βδ)),{θ,0,2}]