Definitions

β=1/8;δ=15;α=0;Δ=β δ;

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

f[n_][θ_]:=(((θ/θi))^2)-1

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

ℳf[y_]:=-(1/π)(1/y)(E^(1/y)) (-1+y) ExpIntegralEi[-(1/y)]

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

eqLow[n_][m_]:=SeriesCoefficient[
Rℳ[θ]+((f[n][θ])^β)Gl'[g[n][θ]((f[n][θ])^(-Δ))],
{θ,θc,m},Assumptions->Join[$Assumptions,{θ<θc,θ>θi}]
]
eqHigh[n_][m_]:=SeriesCoefficient[
Rℳ[θ]+(((-f[n][θ]))^β)Gh'[g[n][θ](((-f[n][θ]))^(-Δ))],
{θ,0,m},Assumptions->Join[$Assumptions,{θ>0,θ<θi}]
]
eqMid[n_][m_]:=SeriesCoefficient[
Rℳ[θ]-(((g[n][θ])^(1/δ))/Δ)(η Φ'[η]-(2-α)Φ[η]/.η->f[n][θ] ((g[n][θ])^(-1/Δ)))
,{θ,θi,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_]:=(π/(2 1.3578383417066)) (Δ g[n][θc]((f[n][θc])^(-Δ-1))f[n]'[θc]-g[n]'[θc]((f[n][θc])^(-Δ)))

ΦRules=MapIndexed[Derivative[#2[[1]]-1][Φ][0]->#1(#2[[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]->#1(#2[[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]->#1(#2[[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];

θi=1;

n1=2;
eq1={eqLow[n1][0],eqMid[n1][0],eqHigh[n1][1],eqLow[n1][1],eqHigh[n1][2]}//.Join[ℱsol[[1]],ΦRules,GlRules,GhRules,DmetaRules,{gC[0]->1,B->eqB[n1]}];

s1=FindRoot[eq1,{{θc,1+RandomReal[]},{ℳ0,RandomReal[]},{ℳ1,RandomReal[]},{gC[1],RandomReal[]},{gC[2],RandomReal[]}},MaxIterations->1000]

s11=#[[1]]->Re[#[[2]]]&/@s1;

B//.{B->eqB[n1]}/.s1/.gC[0]->1

GraphicsRow[{
Plot[Evaluate[Rℳ[θ]//.{B->eqB[n1]}/.s1/.gC[0]->1],{θ,-1.5,1.5}],
Plot[Evaluate[g[n1][θ]/.{B->eqB[n1]}/.s1/.gC[0]->1],{θ,-2,2}]
}]

{g[n1][θ]((f[n1][θ])^(-Δ)),((f[n1][θ])^(-β))Rℳ[θ]}/.B->eqB[n1]/.s1/.gC[0]->1/.θ->1.04

Show[ListPlot[Table[{g[n1][θ]((f[n1][θ])^(-Δ)),((f[n1][θ])^(-β))Rℳ[θ]}/.B->eqB[n1]/.s1/.gC[0]->1,{θ,1.3,1.4175,0.0001}]],
Plot[1.3578383417066+0.048953289720x/2,{x,0,5}]
]

n2=4;
eq2={eqLow[n2][0],eqMid[n2][0],eqHigh[n2][1],eqLow[n2][1],eqMid[n2][1],eqLow[n2][2],eqHigh[n2][2]}//.Join[ℱsol[[1]],ΦRules,GlRules,GhRules,DmetaRules,{θi->1,gC[0]->1,B->eqB[n2]}];

s2=#[[1]]->Re[#[[2]]]&/@FindRoot[eq2,{{θc,θc/.s1},{ℳ0,ℳ0/.s1},{ℳ1,ℳ1/.s1},{gC[1],gC[1]/.s1},{gC[2],gC[2]/.s1},{gC[3],0},{gC[4],RandomReal[]}},MaxIterations->10000]

GraphicsRow[{
Plot[Evaluate[Rℳ[θ]//.{θi->1,B->eqB[n2]}/.s2/.gC[0]->1],{θ,-1.3,1.3}],
Plot[Evaluate[g[n2][θ]/.{B->eqB[n2]}/.s2/.gC[0]->1/.t∞->100],{θ,-1.3,1.3}]
}]

ListPlot[Table[{g[n2][θ]((f[n2][θ])^(-Δ)),((f[n2][θ])^(-β))Rℳ[θ]}//.{θi->1,B->eqB[n2]}/.s2/.gC[0]->1,{θ,1,1.078,0.001}]]

n3=1;
eq3={eqLow[n3][1],eqMid[n3][0],eqHigh[n3][2],eqMid[n3][1],eqLow[n3][2]}//.Join[ℱsol[[1]],ΦRules,GlRules,GhRules,DmetaRules,{gC[0]->1,B->eqB[n3]}];

s3=FindRoot[eq3,{{θc,θc/.s2},{θi,θi/.s2},{δθ,δθ/.s2},{ℱ1,ℱ1/.s2},{gC[1],0.1RandomReal[]}},MaxIterations->4000]

GraphicsRow[{
Plot[Evaluate[Rℱ[θ]/.ℱsol[[1]]/.{B->eqB[n3]}/.s3/.gC[0]->1],{θ,-1.4,1.4}],
Plot[Evaluate[g[n3][θ]/.{B->eqB[n3]}/.s3/.gC[0]->1],{θ,-1.4,1.4}]
}]

GraphicsRow[{
Plot[Evaluate[Rℱ[θ]/.ℱsol[[1]]/.{B->eqB[n2]}/.s2/.gC[0]->1/.t∞->100],{θ,-1.4,1.4}],
Plot[Evaluate[g[n2][θ]/.{B->eqB[n2]}/.s2/.gC[0]->1/.t∞->100],{θ,-1.4,1.4}]
}]

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}]