diff options
author | Jaron Kent-Dobias <jaron@kent-dobias.com> | 2020-12-21 19:05:27 +0100 |
---|---|---|
committer | Jaron Kent-Dobias <jaron@kent-dobias.com> | 2020-12-21 19:05:27 +0100 |
commit | b71f4f5fd402ef107a7b0ab3a4712e3dcefa31be (patch) | |
tree | 8a1244099832f85f2cb2c1f2daf634cea7a388a6 | |
parent | dfda358a7100f5491a4cc537c28d0fc718e5a544 (diff) | |
download | mma-b71f4f5fd402ef107a7b0ab3a4712e3dcefa31be.tar.gz mma-b71f4f5fd402ef107a7b0ab3a4712e3dcefa31be.tar.bz2 mma-b71f4f5fd402ef107a7b0ab3a4712e3dcefa31be.zip |
Work.
-rw-r--r-- | schofield.wl | 81 |
1 files changed, 69 insertions, 12 deletions
diff --git a/schofield.wl b/schofield.wl index fdb76e3..6adbe10 100644 --- a/schofield.wl +++ b/schofield.wl @@ -1,12 +1,7 @@ BeginPackage["Schofield`"] -β::usage = "Gives the exponent for the magnetization." -δ::usage = "Exponent." -α::usage = "Exponent." -Δ::usage = "Exponent." - -$Assumptions = {θc > 0, θi > 0, θc > θi, gC[_] ∈ Reals, B > 0, γ > 0} +$Assumptions = {θc > 0, θc > 1, gC[_] ∈ Reals, B > 0, γ > 0} β[D_:2] := Piecewise[ { @@ -37,18 +32,80 @@ $Assumptions = {θc > 0, θi > 0, θc > θi, gC[_] ∈ Reals, B > 0, γ > 0} Δ[D_:2] := β[D] δ[D] -f[θi_:1][n_][θ_] := (θ / θi)^2 - 1 +f[θ_] := θ^2 - 1 g[gC_:gC, θc_:θc][n_][θ_] := (1 - (θ/θc)^2) Sum[gC[i] θ^(2i+1), {i, 0, n}] -I\[ScriptCapitalM]f[γ_][y_] := (1 + (1 + γ x) / x) Exp[-1/x] -R\[ScriptCapitalM]f[γ_][y_] := (1 - y - γ y) Exp[1/y] ExpIntegralEi[-1/y] / (π y) +I\[ScriptCapitalM]f[y_] := (1 + 1 / x) Exp[-1/x] +R\[ScriptCapitalM]f[y_] := (1 - y) Exp[1/y] ExpIntegralEi[-1/y] / (π y) + +R\[ScriptCapitalM][2][B_, θc_, M0_][θ_] := - M0 (R\[ScriptCapitalM]f[B(θc - θ)] - R\[ScriptCapitalM]f[B(θc + θ)]) -R\[ScriptCapitalM][2][γ_, B_, θc_, M0_][θ_] := - M0 (R\[ScriptCapitalM]f[γ][B(θc - θ)] - R\[ScriptCapitalM]f[γ][B(θc + θ)]) +ruleB[2][f_, g_] := π / (2 1.3578383417066) (Δ g[θc] f[θc]^(-Δ[2]-1) f'[θc] - g'[θc] / f[θc]^Δ[2]) eqLow[D_:2][f_, g_][m_] := SeriesCoefficient[ - R\[ScriptCapitalM][D][γ, B, θc, M0][θ] + f[θ]^β[D] Gl'[g[θ] f[θ]^(-Δ[D])], + R\[ScriptCapitalM][D][B, θc, M0][θ] + f[θ]^β[D] Gl'[g[θ] / f[θ]^Δ[D]], {θ, θc, m}, - Assumptions -> Join[$Assumptions, {θ < θc, θ > θi}] + Assumptions -> Join[$Assumptions, {θ < θc, θ > 1}] +] + +eqHigh[D_:2][f_, g_][m_] := SeriesCoefficient[ + R\[ScriptCapitalM][D][B, θc, M0][θ] + (-f[θ])^β[D] Gh'[g[θ] / (-f[θ])^Δ[D]], + {θ, 0, m}, + Assumptions -> Join[$Assumptions, {θ > 0, θ < 1}] ] + +eqMid[D_:2][f_, g_][m_] := SeriesCoefficient[ + R\[ScriptCapitalM][D][B, θc, M0][θ] + g[θ]^(1/δ[D]) ((2 - α[D]) Φ'[η] - η Φ'[η]) / Δ[D] /. η -> f[θ] / g[θ]^(1 / Δ[D]), + {θ, 1, m}, + Assumptions -> Join[$Assumptions, {θ > 0, θ < θc}] +] + +eq[D_:2][f_, g_][m_] := Flatten[{eqLow[D][f, g][#], eqMid[D][f, g][#], eqHigh[D][f, g][#]} & /@ Range[0, m]] + +Φs = { + -1.197733383797993, + -0.318810124891, + 0.110886196683, + 0.01642689465, + -2.639978 10^-4, + -5.140526 10^-4, + 2.08856 10^-4, + -4.4819 10^-5 +} + +Gls = { + 0, + -1.3578383417066, + -0.048953289720, + 0.038863932, + -0.068362119, + 0.18388370, + -0.6591714, + 2.937665, + -15.61 +} + +Ghs = { + 0, + 0, + -1.8452280782328, + 0, + 8.333711750, + 0, + -95.16896, + 0, + 1457.62, + 0, + -25891 +} + +dRule[sym_][f_, i_] := Derivative[i[[1]] - 1][sym][0] -> f (i[[1]] - 1)! + +ΦRules = MapIndexed[dRule[Φ], Φs]; +GlRules = MapIndexed[dRule[Gl], Gls]; +GhRules = MapIndexed[dRule[Gh], Ghs]; + +rules[f_, g_] := Join[{B -> ruleB[2][f, g]}, ΦRules, GlRules, GhRules] + EndPackage[] |