From 6e9d7bb427e9bcfcb24e2d874c007bbbcb63e28a Mon Sep 17 00:00:00 2001 From: Philip-Lynch Date: Wed, 12 Jul 2023 17:10:56 +0200 Subject: [PATCH 1/5] Simplified Schwarzschild circ velocities so they are finite on ISCO #50 --- Kernel/FourVelocity.m | 51 +++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 49 insertions(+), 2 deletions(-) diff --git a/Kernel/FourVelocity.m b/Kernel/FourVelocity.m index 6dd30e4..5b41968 100644 --- a/Kernel/FourVelocity.m +++ b/Kernel/FourVelocity.m @@ -23,7 +23,54 @@ KerrGeoFourVelocity::parametrization = "Parameterization error: `1`" -(* ::Section::Closed:: *) +(* ::Section:: *) +(*Schwarzschild*) + + +(* ::Subsection:: *) +(*Circular, Equatorial*) + + +KerrGeoVelocityMino[(0|0.),p_,(0|0.),x_,initPhases_,index_ ]:= Module[{En,L,Q,r,z,r1,r2,r3,r4,kr,zp,zm,kz, \[CapitalUpsilon]r, \[CapitalUpsilon]z, +qr, qz, \[Lambda]local ,qr0, qz0, rprime, zprime, \[CapitalDelta], \[CapitalSigma], \[Omega], utContra,urContra,u\[Theta]Contra,uzContra,u\[Phi]Contra, utCo, urCo, u\[Theta]Co, u\[Phi]Co}, + +(*Constants of Motion*) +{En,L,Q}= {"\[ScriptCapitalE]","\[ScriptCapitalL]","\[ScriptCapitalQ]"}/.KerrGeoConstantsOfMotion[0,p,0,x]; + +\[CapitalUpsilon]z = p/Sqrt[-3+p]; + +{qr0,qz0} = initPhases; + +qz[\[Lambda]_] := \[Lambda] \[CapitalUpsilon]z + qz0; + +If[index == "Contravariant", + +utContra= Function[{Global`\[Lambda]},Evaluate[Sqrt[p/(-3+p)] ], Listable]; +urContra:= Function[{Global`\[Lambda]},Evaluate[0],Listable]; +u\[Theta]Contra = Function[{Global`\[Lambda]}, Evaluate[(Sqrt[((1-x^2)/(-3+p))] Sin[qz[Global`\[Lambda]]] )/(p Sqrt[1+(-1+x^2) Cos[qz[Global`\[Lambda]]]^2])],Listable]; +u\[Phi]Contra = Function[{Global`\[Lambda]},Evaluate[x/(Sqrt[-3+p] (p+p (-1+x^2) Cos[qz[Global`\[Lambda]]]^2))],Listable]; + +<|"\!\(\*SuperscriptBox[\(u\), \(t\)]\)"->utContra, "\!\(\*SuperscriptBox[\(u\), \(r\)]\)"->urContra, "\!\(\*SuperscriptBox[\(u\), \(\[Theta]\)]\)"-> u\[Theta]Contra, "\!\(\*SuperscriptBox[\(u\), \(\[Phi]\)]\)"-> u\[Phi]Contra|>, + +(*Else if Index \[Equal] Covariant*) + +utCo = Function[{Global`\[Lambda]},Evaluate[-En], Listable]; +urCo= Function[{Global`\[Lambda]},Evaluate[0],Listable]; +u\[Theta]Co= Function[{Global`\[Lambda]},Evaluate[(p Sqrt[(1-x^2)/(-3+p)] Sin[qz[Global`\[Lambda]]])/ Sqrt[1+(-1+x^2) Cos[qz[Global`\[Lambda]]]^2]],Listable]; +u\[Phi]Co= Function[{Global`\[Lambda]},Evaluate[L],Listable]; + +<|"\!\(\*SubscriptBox[\(u\), \(t\)]\)"->utCo, "\!\(\*SubscriptBox[\(u\), \(r\)]\)"->urCo, "\!\(\*SubscriptBox[\(u\), \(\[Theta]\)]\)"-> u\[Theta]Co, "\!\(\*SubscriptBox[\(u\), \(\[Phi]\)]\)"-> u\[Phi]Co|> +] + + +] + + +(* ::Subsection:: *) +(*Eccentric*) + + +(* ::Section:: *) (*Kerr*) @@ -185,7 +232,7 @@ ] -(* ::Section::Closed:: *) +(* ::Section:: *) (*KerrGeoFourVelocity Wrapper*) From ab16e47e0bd336d25ab2f0f4afcc66d45ee8878c Mon Sep 17 00:00:00 2001 From: Philip-Lynch Date: Mon, 17 Jul 2023 15:53:12 +0200 Subject: [PATCH 2/5] Created KerrGeoOnSeparatrixQ and added condition to KerrGeoOrbit to abort when on the separatrix --- Kernel/KerrGeoOrbit.m | 89 +++++++++++++++++++------------------ Kernel/OrbitalFrequencies.m | 2 +- Kernel/SpecialOrbits.m | 44 +++++++++++++----- 3 files changed, 79 insertions(+), 56 deletions(-) diff --git a/Kernel/KerrGeoOrbit.m b/Kernel/KerrGeoOrbit.m index 1d1731b..1123ef9 100644 --- a/Kernel/KerrGeoOrbit.m +++ b/Kernel/KerrGeoOrbit.m @@ -19,13 +19,16 @@ KerrGeoOrbitFunction::usage = "KerrGeoOrbitFunction[a,p,e,x,assoc] an object for storing the trajectory and orbital parameters in the assoc Association."; -(* ::Subsection::Closed:: *) +(* ::Subsection:: *) (*Error messages*) KerrGeoOrbit::OutOfBounds = "For this hyperbolic orbit the Darwin parameter \[Chi] must be between `1` and `2`" +KerrGeoOrbit::OnSeparatrix = "This orbit is on the separatrix where many expressions are numerically singular. Aborting..." + + (* ::Subsection::Closed:: *) (*Being the private context*) @@ -33,7 +36,7 @@ Begin["`Private`"]; -(* ::Subsection::Closed:: *) +(* ::Subsection:: *) (*Error messages*) @@ -133,7 +136,7 @@ ] -(* ::Section::Closed:: *) +(* ::Section:: *) (*Kerr*) @@ -374,7 +377,7 @@ (* Hopper, Forseth, Osburn, and Evans, PRD 92 (2015)*) -(* ::Subsubsection:: *) +(* ::Subsubsection::Closed:: *) (*Main file that calculates geodesics using spectral integration*) @@ -512,7 +515,7 @@ -(* ::Subsection::Closed:: *) +(* ::Subsection:: *) (*Generic (Mino)*) @@ -597,7 +600,7 @@ -(* ::Subsubsection:: *) +(* ::Subsubsection::Closed:: *) (*Scattering orbit (e > 1)*) @@ -720,7 +723,7 @@ -(* ::Subsection::Closed:: *) +(* ::Subsection:: *) (*Generic (Fast Spec - Mino)*) @@ -1228,7 +1231,7 @@ ] -(* ::Section::Closed:: *) +(* ::Section:: *) (*KerrGeoOrbit and KerrGeoOrbitFuction*) @@ -1236,41 +1239,41 @@ SyntaxInformation[KerrGeoOrbit] = {"ArgumentsPattern"->{_,_,OptionsPattern[]}}; -KerrGeoOrbit[a_,p_,e_,x_, initPhases:{_,_,_,_}:{0,0,0,0},OptionsPattern[]]:=Module[{param, method}, -(*FIXME: add stability check but make it possible to turn it off*) - -method = OptionValue["Method"]; -param = OptionValue["Parametrization"]; - -If[param == "Darwin" && Abs[x]!=1, Message[KerrGeoOrbit::parametrization, "Darwin parameterization only valid for equatorial motion"]; Return[];]; - -If[Precision[{a,p,e,x}] > 30, method = "Analytic"]; -If[e > 1, method = "Analytic"]; - -If[method == "FastSpec", - - If[param == "Mino", If[PossibleZeroQ[a] || PossibleZeroQ[e], Return[KerrGeoOrbitMino[a, p, e, x, initPhases]], Return[KerrGeoOrbitFastSpec[a, p, e, x, initPhases]]]]; - If[param == "Darwin", - If[PossibleZeroQ[a], Return[KerrGeoOrbitSchwarzDarwin[p, e]], Return[KerrGeoOrbitFastSpecDarwin[a,p,e,x,initPhases]]] - ]; - Message[KerrGeoOrbit::parametrization, "Unrecognized parametrization: " <> OptionValue["Parametrization"]]; - -]; - -If[method == "Analytic", -(*Changed "KerrGeoOrbitDarwin" to "KerrGeoOrbitEquatorialDarwin"*) - If[param == "Mino", Return[KerrGeoOrbitMino[a, p, e, x, initPhases]]]; - If[param == "Phases", Return[KerrGeoOrbitPhases[a, p, e, x]]]; - If[param == "Darwin", - If[PossibleZeroQ[a], Return[KerrGeoOrbitSchwarzDarwin[p, e]], Return[KerrGeoOrbitEquatorialDarwin[a,p,e,x,initPhases]]] - ]; - Message[KerrGeoOrbit::parametrization, "Unrecognized parametrization: " <> OptionValue["Parametrization"]]; - -]; - -Message[KerrGeoOrbit::general, "Method " <> method <> " is not one of {FastSpec, Analytic}"]; - -] +KerrGeoOrbit[a_, p_, e_, x_, initPhases : {_, _, _, _} : {0, 0, 0, 0}, OptionsPattern[]] := Module[{param, method}, + (*FIXME: add stability check but make it possible to turn it off*) + If[a!=0 ||e != 0,If[KerrGeodesics`SpecialOrbits`Private`KerrGeoOnSeparatrixQ[a, p, e, x],Message[KerrGeoOrbit::OnSeparatrix];Abort[];]]; + method = OptionValue["Method"]; + param = OptionValue["Parametrization"]; + + If[param == "Darwin" && Abs[x] != 1, Message[KerrGeoOrbit::parametrization, "Darwin parameterization only valid for equatorial motion"]; Return[];]; + + If[Precision[{a, p, e, x}] > 30, method = "Analytic"]; + If[e > 1, method = "Analytic"]; + + If[method == "FastSpec", + + If[param == "Mino", If[PossibleZeroQ[a] || PossibleZeroQ[e], Return[KerrGeoOrbitMino[a, p, e, x, initPhases]], Return[KerrGeoOrbitFastSpec[a, p, e, x, initPhases]]]]; + If[param == "Darwin", + If[PossibleZeroQ[a], Return[KerrGeoOrbitSchwarzDarwin[p, e]], Return[KerrGeoOrbitFastSpecDarwin[a, p, e, x, initPhases]]] + ]; + Message[KerrGeoOrbit::parametrization, "Unrecognized parametrization: " <> OptionValue["Parametrization"]]; + + ]; + + If[method == "Analytic", + (*Changed "KerrGeoOrbitDarwin" to "KerrGeoOrbitEquatorialDarwin"*) + If[param == "Mino", Return[KerrGeoOrbitMino[a, p, e, x, initPhases]]]; + If[param == "Phases", Return[KerrGeoOrbitPhases[a, p, e, x]]]; + If[param == "Darwin", + If[PossibleZeroQ[a], Return[KerrGeoOrbitSchwarzDarwin[p, e]], Return[KerrGeoOrbitEquatorialDarwin[a, p, e, x, initPhases]]] + ]; + Message[KerrGeoOrbit::parametrization, "Unrecognized parametrization: " <> OptionValue["Parametrization"]]; + + ]; + + Message[KerrGeoOrbit::general, "Method " <> method <> " is not one of {FastSpec, Analytic}"]; + + ] KerrGeoOrbitFunction /: diff --git a/Kernel/OrbitalFrequencies.m b/Kernel/OrbitalFrequencies.m index d0e6ee6..f6f51c9 100644 --- a/Kernel/OrbitalFrequencies.m +++ b/Kernel/OrbitalFrequencies.m @@ -70,7 +70,7 @@ ] -(* ::Section::Closed:: *) +(* ::Section:: *) (*Orbital Frequencies*) diff --git a/Kernel/SpecialOrbits.m b/Kernel/SpecialOrbits.m index aa8eb5a..1c4ce16 100644 --- a/Kernel/SpecialOrbits.m +++ b/Kernel/SpecialOrbits.m @@ -8,7 +8,7 @@ (*Define usage for public functions*) -(* ::Section::Closed:: *) +(* ::Section:: *) (*Create Package*) @@ -16,7 +16,7 @@ {"KerrGeodesics`ConstantsOfMotion`"}]; -(* ::Subsection::Closed:: *) +(* ::Subsection:: *) (*Usage messages*) @@ -34,7 +34,9 @@ (*KerrGeoBoundOrbitQ::usage = "KerrGeoBoundOrbitQ[a,p,e,x] tests if the orbital parameters correspond to a bound orbit." KerrGeoScatterOrbitQ::usage = "KerrGeoScatterOrbitQ[a,p,e,x] tests if the orbital parameters correspond to a scatter orbit." -KerrGeoPlungeOrbitQ::usage = "KerrGeoPlungeOrbitQ[a,p,e,x] tests if the orbital parameters correspond to a plunge orbit."*) +KerrGeoPlungeOrbitQ::usage = "KerrGeoPlungeOrbitQ[a,p,e,x] tests if the orbital parameters correspond to a plunge orbit." +KerrGeoOnSeparatrixQ::usage = "KerrGeoOnSeparatrixQ[a,p,e,x] tests if the orbital parameters correspond to being on the separatrix." +*) (* ::Subsection::Closed:: *) @@ -134,7 +136,7 @@ ] -(* ::Section:: *) +(* ::Section::Closed:: *) (*Innermost bound spherical orbits (IBSO)*) @@ -176,7 +178,7 @@ p/.FindRoot[IBSOPoly/.{a->a1,x->x1},{p,KerrGeoIBSO[a1,0],KerrGeoIBSO[a1,-1]},WorkingPrecision->Max[MachinePrecision,prec-1]]]; -(* ::Section:: *) +(* ::Section::Closed:: *) (*Separatrix*) @@ -252,7 +254,7 @@ KerrGeoISSO[a_,x_]:=KerrGeoSeparatrix[a,0,x] -(* ::Section::Closed:: *) +(* ::Section:: *) (*Bound Orbit Q*) @@ -262,7 +264,7 @@ ] -(* ::Section::Closed:: *) +(* ::Section:: *) (*Scatter Orbit Q*) @@ -273,7 +275,7 @@ KerrGeoScatterOrbitQ[a_?NumericQ, p_?NumericQ, e_?NumericQ, x_?NumericQ] := If[p >= KerrGeoSeparatrix[a,e,x] && e >= 1, True, False] -(* ::Section::Closed:: *) +(* ::Section:: *) (*Plunge Orbit Q*) @@ -285,6 +287,24 @@ If[KerrGeoBoundOrbitQ[0,p,e,1] == KerrGeoScatterOrbitQ[0,p,e,1] == False, True, False] +(* ::Section:: *) +(*OnSeparatrixQ*) + + +(* ::Text:: *) +(*Test to see if the orbit is exactly on the separatrix, where many of our expressions become singular. This is a stopgap solution until we can think of a nice way of taking the separatrix limit of all of these functions. *) + + +KerrGeoOnSeparatrixQ[a_?NumericQ,p_?NumericQ,e_?NumericQ,x_?NumericQ]:= Module[{En,L,Q,r1,r2,r3,r4,prec}, + +prec = Precision[{a,p,e,x}]; +{En,L,Q} = Values[KerrGeoConstantsOfMotion[a,p,e,x]]; +{r1,r2,r3,r4} = KerrGeodesics`OrbitalFrequencies`Private`KerrGeoRadialRoots[a, p, e, x, En, Q]; +(*Assuming KerrGeoSeparatrix only finds solution to within half of the working precision*) +Abs[r2 - r3] <= 10^(-prec/2) +] + + (* ::Section::Closed:: *) (*Orbit type*) @@ -336,11 +356,11 @@ ] -(* ::Section::Closed:: *) +(* ::Section:: *) (*Resonances*) -(* ::Subsection::Closed:: *) +(* ::Subsection:: *) (*r\[Theta]-resonances*) @@ -562,7 +582,7 @@ ]; -(* ::Subsection::Closed:: *) +(* ::Subsection:: *) (*Generic resonance interface*) @@ -582,7 +602,7 @@ ] -(* ::Section::Closed:: *) +(* ::Section:: *) (*Close the package*) From 92e1100730b1ecc74e7b8e4db23ff6955182b215 Mon Sep 17 00:00:00 2001 From: Philip-Lynch Date: Mon, 17 Jul 2023 16:43:22 +0200 Subject: [PATCH 3/5] FourVelocity.m now uses functions from OrbitalFrequencies.m #50 --- Kernel/FourVelocity.m | 43 +++++++++++-------------------------- Kernel/KerrGeoOrbit.m | 10 ++++----- Kernel/OrbitalFrequencies.m | 8 +++---- Kernel/SpecialOrbits.m | 14 ++++++------ 4 files changed, 29 insertions(+), 46 deletions(-) diff --git a/Kernel/FourVelocity.m b/Kernel/FourVelocity.m index 5b41968..88adc1e 100644 --- a/Kernel/FourVelocity.m +++ b/Kernel/FourVelocity.m @@ -9,7 +9,8 @@ BeginPackage["KerrGeodesics`FourVelocity`", - {"KerrGeodesics`ConstantsOfMotion`"}]; + {"KerrGeodesics`ConstantsOfMotion`", + "KerrGeodesics`OrbitalFrequencies`"}]; KerrGeoFourVelocity::usage = "KerrGeoVelocity[a,p,e,x] returns the four-velocity components as parametrized functions."; @@ -27,7 +28,7 @@ (*Schwarzschild*) -(* ::Subsection:: *) +(* ::Subsection::Closed:: *) (*Circular, Equatorial*) @@ -66,45 +67,31 @@ ] -(* ::Subsection:: *) -(*Eccentric*) - - (* ::Section:: *) (*Kerr*) -(* ::Subsection:: *) +(* ::Subsection::Closed:: *) (*Generic (Mino)*) -(* ::Text:: *) -(*FixMe: Circular Equatorial Retrograde orbits don't normalize to -1*) - - KerrGeoVelocityMino[a_,p_,e_,x_,initPhases_,index_ ]:= Module[{En,L,Q,r,z,r1,r2,r3,r4,kr,zp,zm,kz, \[CapitalUpsilon]r, \[CapitalUpsilon]z, qr, qz, \[Lambda]local ,qr0, qz0, rprime, zprime, \[CapitalDelta], \[CapitalSigma], \[Omega], utContra,urContra,u\[Theta]Contra,uzContra,u\[Phi]Contra, utCo, urCo, u\[Theta]Co, u\[Phi]Co}, (*Constants of Motion*) {En,L,Q}= {"\[ScriptCapitalE]","\[ScriptCapitalL]","\[ScriptCapitalQ]"}/.KerrGeoConstantsOfMotion[a,p,e,x]; -(*Roots*) -r1 = p/(1-e); -r2 = p/(1+e); -zm = Sqrt[1-x^2]; +{r1,r2,r3,r4}=KerrGeodesics`OrbitalFrequencies`Private`KerrGeoRadialRoots[a, p, e, x]; -(*Other Roots*) -r3 = 1/(1-En^2) - (r1 + r2)/2 + Sqrt[(-(1/(1-En^2)) + (r1 + r2)/2 )^2 - (a^2 Q)/(r1 r2 (1 - En^2))]; -r4 = (a^2 Q)/(r1 r2 r3 (1-En^2)); +{zp,zm}= KerrGeodesics`OrbitalFrequencies`Private`KerrGeoPolarRoots[a, p, e, x]; -zp = Sqrt[a^2 (1 - En^2) + (L^2)/(1 - zm^2) ]; kr = ((r1-r2)(r3-r4))/((r1-r3)(r2-r4)); kz = a^2 (1-En^2) zm^2/zp^2; (*Frequencies*) -\[CapitalUpsilon]r = \[Pi]/(2 EllipticK[kr]) Sqrt[(1 - En^2)(r1 - r3)(r2 - r4)]; -\[CapitalUpsilon]z = (\[Pi] zp)/(2EllipticK[kz] ); +\[CapitalUpsilon]r = KerrGeodesics`OrbitalFrequencies`Private`KerrGeoMinoFrequencyr[a,p,e,x,{En,L,Q},{r1,r2,r3,r4}]; +\[CapitalUpsilon]z = KerrGeodesics`OrbitalFrequencies`Private`KerrGeoMinoFrequency\[Theta][a,p,e,x,{En,L,Q},{zp,zm}]; (*Action Angle Phases*) { qr0, qz0} = {initPhases[[1]], initPhases[[2]]}; @@ -153,7 +140,7 @@ (*Equatorial (Darwin)*) -(* ::Subsubsection:: *) +(* ::Subsubsection::Closed:: *) (*Circular Case*) @@ -176,7 +163,7 @@ ] -(* ::Subsubsection:: *) +(* ::Subsubsection::Closed:: *) (*Eccentric Case*) @@ -187,16 +174,12 @@ {En,L,Q}= {"\[ScriptCapitalE]","\[ScriptCapitalL]","\[ScriptCapitalQ]"}/.KerrGeoConstantsOfMotion[a,p,e,x]; (*Roots*) -r1 = p/(1-e); -r2 = p/(1+e); +{r1,r2,r3,r4}=KerrGeodesics`OrbitalFrequencies`Private`KerrGeoRadialRoots[a, p, e, x]; -(*Other Roots*) -r3 = 1/(1-En^2) - (r1 + r2)/2 + Sqrt[(-(1/(1-En^2)) + (r1 + r2)/2 )^2 - (a^2 Q)/(r1 r2 (1 - En^2))]; -r4 = (a^2 Q)/(r1 r2 r3 (1-En^2)); kr = ((r1-r2)(r3-r4))/((r1-r3)(r2-r4)); (*Frequencies*) -\[CapitalUpsilon]r = \[Pi]/(2 EllipticK[kr]) Sqrt[(1 - En^2)(r1 - r3)(r2 - r4)]; +\[CapitalUpsilon]r = KerrGeodesics`OrbitalFrequencies`Private`KerrGeoMinoFrequencyr[a,p,e,x,{En,L,Q},{r1,r2,r3,r4}]; (*Initial Phase*) \[Chi]0 = initPhases[[1]]; @@ -232,7 +215,7 @@ ] -(* ::Section:: *) +(* ::Section::Closed:: *) (*KerrGeoFourVelocity Wrapper*) diff --git a/Kernel/KerrGeoOrbit.m b/Kernel/KerrGeoOrbit.m index 1123ef9..b4e3880 100644 --- a/Kernel/KerrGeoOrbit.m +++ b/Kernel/KerrGeoOrbit.m @@ -19,7 +19,7 @@ KerrGeoOrbitFunction::usage = "KerrGeoOrbitFunction[a,p,e,x,assoc] an object for storing the trajectory and orbital parameters in the assoc Association."; -(* ::Subsection:: *) +(* ::Subsection::Closed:: *) (*Error messages*) @@ -36,7 +36,7 @@ Begin["`Private`"]; -(* ::Subsection:: *) +(* ::Subsection::Closed:: *) (*Error messages*) @@ -515,7 +515,7 @@ -(* ::Subsection:: *) +(* ::Subsection::Closed:: *) (*Generic (Mino)*) @@ -723,7 +723,7 @@ -(* ::Subsection:: *) +(* ::Subsection::Closed:: *) (*Generic (Fast Spec - Mino)*) @@ -1231,7 +1231,7 @@ ] -(* ::Section:: *) +(* ::Section::Closed:: *) (*KerrGeoOrbit and KerrGeoOrbitFuction*) diff --git a/Kernel/OrbitalFrequencies.m b/Kernel/OrbitalFrequencies.m index f6f51c9..cadffb5 100644 --- a/Kernel/OrbitalFrequencies.m +++ b/Kernel/OrbitalFrequencies.m @@ -16,7 +16,7 @@ Begin["`Private`"]; -(* ::Section::Closed:: *) +(* ::Section:: *) (*Roots of the radial and polar equations*) @@ -121,11 +121,11 @@ KerrGeoProperFrequencyFactor[a_?PossibleZeroQ ,p_,e_,x_]:=(p^2 ((1+e) (28+4 e^2+(-12+p) p)-((1+e) (-4+p) (-6+2 e+p) EllipticE[(4 e)/(-6+2 e+p)]+2 (6+2 e-p) (3+e^2-p) EllipticPi[(2 e (-4+p))/((1+e) (-6+2 e+p)),(4 e)/(-6+2 e+p)])/EllipticK[(4 e)/(-6+2 e+p)]))/(2 (-1+e) (1+e)^2 (-4+p)^2) -(* ::Subsection::Closed:: *) +(* ::Subsection:: *) (*Kerr*) -(* ::Subsubsection::Closed:: *) +(* ::Subsubsection:: *) (*KerrGeoMinoFrequencyr*) @@ -147,7 +147,7 @@ -(* ::Subsubsection::Closed:: *) +(* ::Subsubsection:: *) (*KerrGeoMinoFrequency\[Theta]*) diff --git a/Kernel/SpecialOrbits.m b/Kernel/SpecialOrbits.m index 1c4ce16..cb4c3f4 100644 --- a/Kernel/SpecialOrbits.m +++ b/Kernel/SpecialOrbits.m @@ -16,7 +16,7 @@ {"KerrGeodesics`ConstantsOfMotion`"}]; -(* ::Subsection:: *) +(* ::Subsection::Closed:: *) (*Usage messages*) @@ -81,7 +81,7 @@ ]; -(* ::Section:: *) +(* ::Section::Closed:: *) (*Photon Sphere*) @@ -254,7 +254,7 @@ KerrGeoISSO[a_,x_]:=KerrGeoSeparatrix[a,0,x] -(* ::Section:: *) +(* ::Section::Closed:: *) (*Bound Orbit Q*) @@ -264,7 +264,7 @@ ] -(* ::Section:: *) +(* ::Section::Closed:: *) (*Scatter Orbit Q*) @@ -275,7 +275,7 @@ KerrGeoScatterOrbitQ[a_?NumericQ, p_?NumericQ, e_?NumericQ, x_?NumericQ] := If[p >= KerrGeoSeparatrix[a,e,x] && e >= 1, True, False] -(* ::Section:: *) +(* ::Section::Closed:: *) (*Plunge Orbit Q*) @@ -287,7 +287,7 @@ If[KerrGeoBoundOrbitQ[0,p,e,1] == KerrGeoScatterOrbitQ[0,p,e,1] == False, True, False] -(* ::Section:: *) +(* ::Section::Closed:: *) (*OnSeparatrixQ*) @@ -356,7 +356,7 @@ ] -(* ::Section:: *) +(* ::Section::Closed:: *) (*Resonances*) From 1f6492a166cb543a7e5426c4dff7ef3449eb5cd5 Mon Sep 17 00:00:00 2001 From: Philip-Lynch Date: Mon, 17 Jul 2023 17:35:54 +0200 Subject: [PATCH 4/5] Simplified KerrGeoFourVelocity API by removing index option. All components are returned in association. --- Kernel/FourVelocity.m | 114 ++++++++++++++++++++++-------------------- 1 file changed, 61 insertions(+), 53 deletions(-) diff --git a/Kernel/FourVelocity.m b/Kernel/FourVelocity.m index 88adc1e..dad7e0e 100644 --- a/Kernel/FourVelocity.m +++ b/Kernel/FourVelocity.m @@ -17,7 +17,7 @@ Begin["`Private`"]; -(* ::Subsection::Closed:: *) +(* ::Subsection:: *) (*Error messages*) @@ -32,7 +32,7 @@ (*Circular, Equatorial*) -KerrGeoVelocityMino[(0|0.),p_,(0|0.),x_,initPhases_,index_ ]:= Module[{En,L,Q,r,z,r1,r2,r3,r4,kr,zp,zm,kz, \[CapitalUpsilon]r, \[CapitalUpsilon]z, +KerrGeoVelocityMino[(0|0.),p_,(0|0.),x_,initPhases_ ]:= Module[{En,L,Q,r,z,r1,r2,r3,r4,kr,zp,zm,kz, \[CapitalUpsilon]r, \[CapitalUpsilon]z, qr, qz, \[Lambda]local ,qr0, qz0, rprime, zprime, \[CapitalDelta], \[CapitalSigma], \[Omega], utContra,urContra,u\[Theta]Contra,uzContra,u\[Phi]Contra, utCo, urCo, u\[Theta]Co, u\[Phi]Co}, (*Constants of Motion*) @@ -44,24 +44,21 @@ qz[\[Lambda]_] := \[Lambda] \[CapitalUpsilon]z + qz0; -If[index == "Contravariant", + utContra= Function[{Global`\[Lambda]},Evaluate[Sqrt[p/(-3+p)] ], Listable]; urContra:= Function[{Global`\[Lambda]},Evaluate[0],Listable]; u\[Theta]Contra = Function[{Global`\[Lambda]}, Evaluate[(Sqrt[((1-x^2)/(-3+p))] Sin[qz[Global`\[Lambda]]] )/(p Sqrt[1+(-1+x^2) Cos[qz[Global`\[Lambda]]]^2])],Listable]; -u\[Phi]Contra = Function[{Global`\[Lambda]},Evaluate[x/(Sqrt[-3+p] (p+p (-1+x^2) Cos[qz[Global`\[Lambda]]]^2))],Listable]; - -<|"\!\(\*SuperscriptBox[\(u\), \(t\)]\)"->utContra, "\!\(\*SuperscriptBox[\(u\), \(r\)]\)"->urContra, "\!\(\*SuperscriptBox[\(u\), \(\[Theta]\)]\)"-> u\[Theta]Contra, "\!\(\*SuperscriptBox[\(u\), \(\[Phi]\)]\)"-> u\[Phi]Contra|>, - -(*Else if Index \[Equal] Covariant*) +u\[Phi]Contra = Function[{Global`\[Lambda]},Evaluate[x/(Sqrt[-3+p] (p+p (-1+x^2) Cos[qz[Global`\[Lambda]]]^2))],Listable]; utCo = Function[{Global`\[Lambda]},Evaluate[-En], Listable]; urCo= Function[{Global`\[Lambda]},Evaluate[0],Listable]; u\[Theta]Co= Function[{Global`\[Lambda]},Evaluate[(p Sqrt[(1-x^2)/(-3+p)] Sin[qz[Global`\[Lambda]]])/ Sqrt[1+(-1+x^2) Cos[qz[Global`\[Lambda]]]^2]],Listable]; u\[Phi]Co= Function[{Global`\[Lambda]},Evaluate[L],Listable]; -<|"\!\(\*SubscriptBox[\(u\), \(t\)]\)"->utCo, "\!\(\*SubscriptBox[\(u\), \(r\)]\)"->urCo, "\!\(\*SubscriptBox[\(u\), \(\[Theta]\)]\)"-> u\[Theta]Co, "\!\(\*SubscriptBox[\(u\), \(\[Phi]\)]\)"-> u\[Phi]Co|> -] +<|"\!\(\*SuperscriptBox[\(u\), \(t\)]\)"->utContra, "\!\(\*SuperscriptBox[\(u\), \(r\)]\)"->urContra, "\!\(\*SuperscriptBox[\(u\), \(\[Theta]\)]\)"-> u\[Theta]Contra, "\!\(\*SuperscriptBox[\(u\), \(\[Phi]\)]\)"-> u\[Phi]Contra, +"\!\(\*SubscriptBox[\(u\), \(t\)]\)"->utCo, "\!\(\*SubscriptBox[\(u\), \(r\)]\)"->urCo, "\!\(\*SubscriptBox[\(u\), \(\[Theta]\)]\)"-> u\[Theta]Co, "\!\(\*SubscriptBox[\(u\), \(\[Phi]\)]\)"-> u\[Phi]Co|> + ] @@ -75,13 +72,13 @@ (*Generic (Mino)*) -KerrGeoVelocityMino[a_,p_,e_,x_,initPhases_,index_ ]:= Module[{En,L,Q,r,z,r1,r2,r3,r4,kr,zp,zm,kz, \[CapitalUpsilon]r, \[CapitalUpsilon]z, +KerrGeoVelocityMino[a_,p_,e_,x_,initPhases_]:= Module[{En,L,Q,r,z,r1,r2,r3,r4,kr,zp,zm,kz, \[CapitalUpsilon]r, \[CapitalUpsilon]z, qr, qz, \[Lambda]local ,qr0, qz0, rprime, zprime, \[CapitalDelta], \[CapitalSigma], \[Omega], utContra,urContra,u\[Theta]Contra,uzContra,u\[Phi]Contra, utCo, urCo, u\[Theta]Co, u\[Phi]Co}, (*Constants of Motion*) {En,L,Q}= {"\[ScriptCapitalE]","\[ScriptCapitalL]","\[ScriptCapitalQ]"}/.KerrGeoConstantsOfMotion[a,p,e,x]; -{r1,r2,r3,r4}=KerrGeodesics`OrbitalFrequencies`Private`KerrGeoRadialRoots[a, p, e, x]; +{r1,r2,r3,r4}=KerrGeodesics`OrbitalFrequencies`Private`KerrGeoRadialRoots[a, p, e, x,En,Q]; {zp,zm}= KerrGeodesics`OrbitalFrequencies`Private`KerrGeoPolarRoots[a, p, e, x]; @@ -113,52 +110,59 @@ \[Omega][qr_] := Sqrt[r[qr]^2+ a^2]; \[CapitalSigma][qr_,qz_] := r[qr]^2 + a^2 z[qz]^2; -If[index == "Contravariant", utContra= Function[{Global`\[Lambda]},Evaluate[1/\[CapitalSigma][qr[Global`\[Lambda]],qz[Global`\[Lambda]]] (\[Omega][qr[Global`\[Lambda]]]^2/\[CapitalDelta][qr[Global`\[Lambda]]] ( \[Omega][qr[Global`\[Lambda] ]]^2 En - a L) - a^2 (1-z[qz[Global`\[Lambda]]]^2)En + a L)], Listable]; urContra:= Function[{Global`\[Lambda]},Evaluate[( rprime[qr[Global`\[Lambda]]] \[CapitalUpsilon]r)/\[CapitalSigma][qr[Global`\[Lambda]],qz[Global`\[Lambda]]]],Listable]; u\[Theta]Contra = Function[{Global`\[Lambda]}, Evaluate[-(\[CapitalUpsilon]z zprime[qz[Global`\[Lambda]]])/(\[CapitalSigma][qr[Global`\[Lambda]],qz[Global`\[Lambda]]]Sqrt[1-z[qz[Global`\[Lambda]]]^2])],Listable]; u\[Phi]Contra = Function[{Global`\[Lambda]},Evaluate[1/\[CapitalSigma][qr[Global`\[Lambda]],qz[Global`\[Lambda]]] (a/\[CapitalDelta][qr[Global`\[Lambda]]] ( \[Omega][qr[Global`\[Lambda]]]^2 En - a L) - a En + L/(1-z[qz[Global`\[Lambda]]]^2))],Listable]; -<|"\!\(\*SuperscriptBox[\(u\), \(t\)]\)"->utContra, "\!\(\*SuperscriptBox[\(u\), \(r\)]\)"->urContra, "\!\(\*SuperscriptBox[\(u\), \(\[Theta]\)]\)"-> u\[Theta]Contra, "\!\(\*SuperscriptBox[\(u\), \(\[Phi]\)]\)"-> u\[Phi]Contra|>, - -(*Else if Index \[Equal] Covariant*) utCo = Function[{Global`\[Lambda]},Evaluate[-En], Listable]; urCo= Function[{Global`\[Lambda]},Evaluate[( rprime[qr[Global`\[Lambda]]] \[CapitalUpsilon]r)/\[CapitalDelta][qr[Global`\[Lambda]]]],Listable]; u\[Theta]Co= Function[{Global`\[Lambda]},Evaluate[-((\[CapitalUpsilon]z zprime[qz[Global`\[Lambda]]])/Sqrt[1-z[qz[Global`\[Lambda]]]^2])],Listable]; u\[Phi]Co= Function[{Global`\[Lambda]},Evaluate[L],Listable]; -<|"\!\(\*SubscriptBox[\(u\), \(t\)]\)"->utCo, "\!\(\*SubscriptBox[\(u\), \(r\)]\)"->urCo, "\!\(\*SubscriptBox[\(u\), \(\[Theta]\)]\)"-> u\[Theta]Co, "\!\(\*SubscriptBox[\(u\), \(\[Phi]\)]\)"-> u\[Phi]Co|> +<|"\!\(\*SuperscriptBox[\(u\), \(t\)]\)"->utContra, "\!\(\*SuperscriptBox[\(u\), \(r\)]\)"->urContra, +"\!\(\*SuperscriptBox[\(u\), \(\[Theta]\)]\)"-> u\[Theta]Contra, "\!\(\*SuperscriptBox[\(u\), \(\[Phi]\)]\)"-> u\[Phi]Contra, +"\!\(\*SubscriptBox[\(u\), \(t\)]\)"->utCo, "\!\(\*SubscriptBox[\(u\), \(r\)]\)"->urCo, +"\!\(\*SubscriptBox[\(u\), \(\[Theta]\)]\)"-> u\[Theta]Co, "\!\(\*SubscriptBox[\(u\), \(\[Phi]\)]\)"-> u\[Phi]Co|> ] -] - (* ::Subsection:: *) (*Equatorial (Darwin)*) -(* ::Subsubsection::Closed:: *) +(* ::Subsubsection:: *) (*Circular Case*) -KerrGeoVelocityDarwin[a_,p_,(0|0.),x_,initPhases_,index_ ]:= Module[{ut,ur,u\[Theta],u\[Phi], MinoVelocities,ut1,ur1,u\[Theta]1,u\[Phi]1}, +KerrGeoVelocityDarwin[a_,p_,(0|0.),x_,initPhases_]:= Module[{ut,ur,u\[Theta],u\[Phi], MinoVelocities,utContra,urContra,u\[Theta]Contra,u\[Phi]Contra, +utCo,urCo,u\[Theta]Co,u\[Phi]Co,utUp,urUp,u\[Theta]Up,u\[Phi]Up, utDown,urDown,u\[Theta]Down,u\[Phi]Down}, + +MinoVelocities = KerrGeoVelocityMino[a,p,0,x,{0,0}]; -MinoVelocities = KerrGeoVelocityMino[a,p,0,x,{0,0}, index]; +utUp="\!\(\*SuperscriptBox[\(u\), \(t\)]\)"; urUp="\!\(\*SuperscriptBox[\(u\), \(r\)]\)"; +u\[Theta]Up="\!\(\*SuperscriptBox[\(u\), \(\[Theta]\)]\)"; u\[Phi]Up="\!\(\*SuperscriptBox[\(u\), \(\[Phi]\)]\)"; +utDown="\!\(\*SubscriptBox[\(u\), \(t\)]\)"; urDown="\!\(\*SubscriptBox[\(u\), \(r\)]\)"; +u\[Theta]Down="\!\(\*SubscriptBox[\(u\), \(\[Theta]\)]\)"; u\[Phi]Down="\!\(\*SubscriptBox[\(u\), \(\[Phi]\)]\)"; -If[index == "Contravariant", - ut1="\!\(\*SuperscriptBox[\(u\), \(t\)]\)"; ur1="\!\(\*SuperscriptBox[\(u\), \(r\)]\)"; u\[Theta]1="\!\(\*SuperscriptBox[\(u\), \(\[Theta]\)]\)"; u\[Phi]1="\!\(\*SuperscriptBox[\(u\), \(\[Phi]\)]\)";, - ut1="\!\(\*SubscriptBox[\(u\), \(t\)]\)"; ur1="\!\(\*SubscriptBox[\(u\), \(r\)]\)"; u\[Theta]1="\!\(\*SubscriptBox[\(u\), \(\[Theta]\)]\)"; u\[Phi]1="\!\(\*SubscriptBox[\(u\), \(\[Phi]\)]\)"; -]; (*All components are Constants*) -ut = Function[{Global`\[Chi]},Evaluate[MinoVelocities [ut1][Global`\[Chi]]], Listable]; -ur = Function[{Global`\[Chi]},Evaluate[0],Listable]; -u\[Theta]= Function[{Global`\[Chi]},Evaluate[0],Listable]; -u\[Phi]= Function[{Global`\[Chi]},Evaluate[MinoVelocities [u\[Phi]1][Global`\[Chi]]],Listable]; +utContra = Function[{Global`\[Chi]},Evaluate[MinoVelocities [utUp][Global`\[Chi]]],Listable]; +urContra = Function[{Global`\[Chi]},Evaluate[0],Listable]; +u\[Theta]Contra = Function[{Global`\[Chi]}, Evaluate[0],Listable]; +u\[Phi]Contra = Function[{Global`\[Chi]}, Evaluate[MinoVelocities [u\[Phi]Up][Global`\[Chi]]],Listable]; -<|ut1-> ut, ur1-> ur, u\[Theta]1-> u\[Theta], u\[Phi]1-> u\[Phi] |> +utCo = Function[{Global`\[Chi]},Evaluate[MinoVelocities [utDown][Global`\[Chi]]],Listable]; +urCo = Function[{Global`\[Chi]},Evaluate[0],Listable]; +u\[Theta]Co = Function[{Global`\[Chi]}, Evaluate[0],Listable]; +u\[Phi]Co = Function[{Global`\[Chi]}, Evaluate[MinoVelocities [u\[Phi]Down][Global`\[Chi]]],Listable]; + +<|utUp ->utContra, urUp ->urContra, +u\[Theta]Up-> u\[Theta]Contra, u\[Phi]Up-> u\[Phi]Contra, +utDown->utCo, urDown->urCo, +u\[Theta]Down-> u\[Theta]Co, u\[Phi]Down-> u\[Phi]Co|> ] @@ -167,14 +171,15 @@ (*Eccentric Case*) -KerrGeoVelocityDarwin[a_,p_,e_,x_/;x^2==1,initPhases_,index_ ]:= Module[{En,L,Q,r,z,r1,r2,r3,r4,kr, \[CapitalUpsilon]r, \[CapitalLambda]r,yr,\[Lambda]0r,r01,\[CapitalLambda]r1,\[Lambda], -\[Chi]0,\[Nu], \[Chi]local ,qr0, qz0, rprime, zprime, \[CapitalDelta], \[CapitalSigma], \[Omega], ut,ur,u\[Theta],u\[Phi], MinoVelocities,ut1,ur1,u\[Theta]1,u\[Phi]1}, +KerrGeoVelocityDarwin[a_,p_,e_,x_/;x^2==1,initPhases_]:= Module[{En,L,Q,r,z,r1,r2,r3,r4,kr, \[CapitalUpsilon]r, \[CapitalLambda]r,yr,\[Lambda]0r,r01,\[CapitalLambda]r1,\[Lambda], +\[Chi]0,\[Nu], \[Chi]local ,qr0, qz0, rprime, zprime, \[CapitalDelta], \[CapitalSigma], \[Omega], ut,ur,u\[Theta],u\[Phi], MinoVelocities,utContra,urContra,u\[Theta]Contra,u\[Phi]Contra, +utCo,urCo,u\[Theta]Co,u\[Phi]Co,utUp,urUp,u\[Theta]Up,u\[Phi]Up, utDown,urDown,u\[Theta]Down,u\[Phi]Down}, (*Constants of Motion*) {En,L,Q}= {"\[ScriptCapitalE]","\[ScriptCapitalL]","\[ScriptCapitalQ]"}/.KerrGeoConstantsOfMotion[a,p,e,x]; (*Roots*) -{r1,r2,r3,r4}=KerrGeodesics`OrbitalFrequencies`Private`KerrGeoRadialRoots[a, p, e, x]; +{r1,r2,r3,r4}=KerrGeodesics`OrbitalFrequencies`Private`KerrGeoRadialRoots[a, p, e, x,En,Q]; kr = ((r1-r2)(r3-r4))/((r1-r3)(r2-r4)); @@ -197,47 +202,50 @@ \[Lambda][\[Nu]_]:=\[CapitalLambda]r Floor[\[Nu]/(2\[Pi])]+If[Mod[\[Nu],2\[Pi]]<=\[Pi], \[Lambda]0r[r[\[Nu]]]-\[CapitalLambda]r1,\[CapitalLambda]r-\[Lambda]0r[r[\[Nu]]]]; -MinoVelocities = KerrGeoVelocityMino[a,p,e,x,{0,0}, index]; +MinoVelocities = KerrGeoVelocityMino[a,p,e,x,{0,0}]; -If[index == "Contravariant", - ut1="\!\(\*SuperscriptBox[\(u\), \(t\)]\)"; ur1="\!\(\*SuperscriptBox[\(u\), \(r\)]\)"; u\[Theta]1="\!\(\*SuperscriptBox[\(u\), \(\[Theta]\)]\)"; u\[Phi]1="\!\(\*SuperscriptBox[\(u\), \(\[Phi]\)]\)";, - ut1="\!\(\*SubscriptBox[\(u\), \(t\)]\)"; ur1="\!\(\*SubscriptBox[\(u\), \(r\)]\)"; u\[Theta]1="\!\(\*SubscriptBox[\(u\), \(\[Theta]\)]\)"; u\[Phi]1="\!\(\*SubscriptBox[\(u\), \(\[Phi]\)]\)"; -]; +utUp="\!\(\*SuperscriptBox[\(u\), \(t\)]\)"; urUp="\!\(\*SuperscriptBox[\(u\), \(r\)]\)"; +u\[Theta]Up="\!\(\*SuperscriptBox[\(u\), \(\[Theta]\)]\)"; u\[Phi]Up="\!\(\*SuperscriptBox[\(u\), \(\[Phi]\)]\)"; +utDown="\!\(\*SubscriptBox[\(u\), \(t\)]\)"; urDown="\!\(\*SubscriptBox[\(u\), \(r\)]\)"; +u\[Theta]Down="\!\(\*SubscriptBox[\(u\), \(\[Theta]\)]\)"; u\[Phi]Down="\!\(\*SubscriptBox[\(u\), \(\[Phi]\)]\)"; -ut = Function[{Global`\[Chi]},Evaluate[MinoVelocities [ut1][\[Lambda][Global`\[Chi]-\[Chi]0]]],Listable]; -ur = Function[{Global`\[Chi]},Evaluate[MinoVelocities [ur1][\[Lambda][Global`\[Chi]-\[Chi]0]]],Listable]; -u\[Theta] = Function[{Global`\[Chi]}, Evaluate[0],Listable]; -u\[Phi] = Function[{Global`\[Chi]}, Evaluate[MinoVelocities [u\[Phi]1][\[Lambda][Global`\[Chi]-\[Chi]0]]],Listable]; +utContra = Function[{Global`\[Chi]},Evaluate[MinoVelocities [utUp][\[Lambda][Global`\[Chi]-\[Chi]0]]],Listable]; +urContra = Function[{Global`\[Chi]},Evaluate[MinoVelocities [urUp][\[Lambda][Global`\[Chi]-\[Chi]0]]],Listable]; +u\[Theta]Contra = Function[{Global`\[Chi]}, Evaluate[0],Listable]; +u\[Phi]Contra = Function[{Global`\[Chi]}, Evaluate[MinoVelocities [u\[Phi]Up][\[Lambda][Global`\[Chi]-\[Chi]0]]],Listable]; -<|ut1-> ut, ur1-> ur, u\[Theta]1-> u\[Theta], u\[Phi]1-> u\[Phi] |> +utCo = Function[{Global`\[Chi]},Evaluate[MinoVelocities [utDown][\[Lambda][Global`\[Chi]-\[Chi]0]]],Listable]; +urCo = Function[{Global`\[Chi]},Evaluate[MinoVelocities [urDown][\[Lambda][Global`\[Chi]-\[Chi]0]]],Listable]; +u\[Theta]Co = Function[{Global`\[Chi]}, Evaluate[0],Listable]; +u\[Phi]Co = Function[{Global`\[Chi]}, Evaluate[MinoVelocities [u\[Phi]Down][\[Lambda][Global`\[Chi]-\[Chi]0]]],Listable]; +<|utUp ->utContra, urUp ->urContra, +u\[Theta]Up-> u\[Theta]Contra, u\[Phi]Up-> u\[Phi]Contra, +utDown->utCo, urDown->urCo, +u\[Theta]Down-> u\[Theta]Co, u\[Phi]Down-> u\[Phi]Co|> ] -(* ::Section::Closed:: *) +(* ::Section:: *) (*KerrGeoFourVelocity Wrapper*) -Options[KerrGeoFourVelocity] = {"Covariant" -> False, "Parametrization"-> "Mino"} +Options[KerrGeoFourVelocity] = {"Parametrization"-> "Mino"} SyntaxInformation[KerrGeoFourVelocity] = {"ArgumentsPattern"->{_,_,_,_,OptionsPattern[]}}; -KerrGeoFourVelocity[a_,p_,e_,x_,initPhases:{_,_}:{0,0}, OptionsPattern[]]:= Module[{param, index}, +KerrGeoFourVelocity[a_,p_,e_,x_,initPhases:{_,_}:{0,0}, OptionsPattern[]]:= Module[{param}, param = OptionValue["Parametrization"]; - -If[OptionValue["Covariant"], index = "Covariant" , index="Contravariant", Message[KerrGeoFourVelocity::opttf,"Covariant",OptionValue["Covariant"]]; Return[] ]; - - If[param == "Darwin", If[ Abs[x]!=1, Message[KerrGeoFourVelocity::parametrization, "Darwin parameterization only valid for equatorial motion"]; Return[];, - Return[KerrGeoVelocityDarwin[a,p,e,x,initPhases, index]]]]; + Return[KerrGeoVelocityDarwin[a,p,e,x,initPhases]]]]; - If[param == "Mino", Return[KerrGeoVelocityMino[a,p,e,x,initPhases, index]]]; + If[param == "Mino", Return[KerrGeoVelocityMino[a,p,e,x,initPhases]]]; Message[KerrGeoFourVelocity::parametrization, "Unrecognized Paramaterization: " <> param]; From 29ddd77be0430a48ebe02216b03c41e306fa1ec6 Mon Sep 17 00:00:00 2001 From: Philip-Lynch Date: Wed, 2 Aug 2023 11:57:42 +0200 Subject: [PATCH 5/5] Using ?PossibleZeroQ and closing secitons #50 --- Kernel/FourVelocity.m | 18 +++++++++--------- Kernel/KerrGeoOrbit.m | 2 +- Kernel/OrbitalFrequencies.m | 10 +++++----- Kernel/SpecialOrbits.m | 4 ++-- 4 files changed, 17 insertions(+), 17 deletions(-) diff --git a/Kernel/FourVelocity.m b/Kernel/FourVelocity.m index dad7e0e..94a4d9d 100644 --- a/Kernel/FourVelocity.m +++ b/Kernel/FourVelocity.m @@ -17,14 +17,14 @@ Begin["`Private`"]; -(* ::Subsection:: *) +(* ::Subsection::Closed:: *) (*Error messages*) KerrGeoFourVelocity::parametrization = "Parameterization error: `1`" -(* ::Section:: *) +(* ::Section::Closed:: *) (*Schwarzschild*) @@ -32,7 +32,7 @@ (*Circular, Equatorial*) -KerrGeoVelocityMino[(0|0.),p_,(0|0.),x_,initPhases_ ]:= Module[{En,L,Q,r,z,r1,r2,r3,r4,kr,zp,zm,kz, \[CapitalUpsilon]r, \[CapitalUpsilon]z, +KerrGeoVelocityMino[a_?PossibleZeroQ,p_,e_?PossibleZeroQ,x_,initPhases_ ]:= Module[{En,L,Q,r,z,r1,r2,r3,r4,kr,zp,zm,kz, \[CapitalUpsilon]r, \[CapitalUpsilon]z, qr, qz, \[Lambda]local ,qr0, qz0, rprime, zprime, \[CapitalDelta], \[CapitalSigma], \[Omega], utContra,urContra,u\[Theta]Contra,uzContra,u\[Phi]Contra, utCo, urCo, u\[Theta]Co, u\[Phi]Co}, (*Constants of Motion*) @@ -64,7 +64,7 @@ ] -(* ::Section:: *) +(* ::Section::Closed:: *) (*Kerr*) @@ -130,7 +130,7 @@ -(* ::Subsection:: *) +(* ::Subsection::Closed:: *) (*Equatorial (Darwin)*) @@ -138,10 +138,10 @@ (*Circular Case*) -KerrGeoVelocityDarwin[a_,p_,(0|0.),x_,initPhases_]:= Module[{ut,ur,u\[Theta],u\[Phi], MinoVelocities,utContra,urContra,u\[Theta]Contra,u\[Phi]Contra, +KerrGeoVelocityDarwin[a_,p_,e_?PossibleZeroQ,x_,initPhases_]:= Module[{ut,ur,u\[Theta],u\[Phi], MinoVelocities,utContra,urContra,u\[Theta]Contra,u\[Phi]Contra, utCo,urCo,u\[Theta]Co,u\[Phi]Co,utUp,urUp,u\[Theta]Up,u\[Phi]Up, utDown,urDown,u\[Theta]Down,u\[Phi]Down}, -MinoVelocities = KerrGeoVelocityMino[a,p,0,x,{0,0}]; +MinoVelocities = KerrGeoVelocityMino[a,p,e,x,{0,0}]; utUp="\!\(\*SuperscriptBox[\(u\), \(t\)]\)"; urUp="\!\(\*SuperscriptBox[\(u\), \(r\)]\)"; u\[Theta]Up="\!\(\*SuperscriptBox[\(u\), \(\[Theta]\)]\)"; u\[Phi]Up="\!\(\*SuperscriptBox[\(u\), \(\[Phi]\)]\)"; @@ -167,7 +167,7 @@ ] -(* ::Subsubsection::Closed:: *) +(* ::Subsubsection:: *) (*Eccentric Case*) @@ -227,7 +227,7 @@ ] -(* ::Section:: *) +(* ::Section::Closed:: *) (*KerrGeoFourVelocity Wrapper*) diff --git a/Kernel/KerrGeoOrbit.m b/Kernel/KerrGeoOrbit.m index b4e3880..1b9926c 100644 --- a/Kernel/KerrGeoOrbit.m +++ b/Kernel/KerrGeoOrbit.m @@ -136,7 +136,7 @@ ] -(* ::Section:: *) +(* ::Section::Closed:: *) (*Kerr*) diff --git a/Kernel/OrbitalFrequencies.m b/Kernel/OrbitalFrequencies.m index cadffb5..d0e6ee6 100644 --- a/Kernel/OrbitalFrequencies.m +++ b/Kernel/OrbitalFrequencies.m @@ -16,7 +16,7 @@ Begin["`Private`"]; -(* ::Section:: *) +(* ::Section::Closed:: *) (*Roots of the radial and polar equations*) @@ -70,7 +70,7 @@ ] -(* ::Section:: *) +(* ::Section::Closed:: *) (*Orbital Frequencies*) @@ -121,11 +121,11 @@ KerrGeoProperFrequencyFactor[a_?PossibleZeroQ ,p_,e_,x_]:=(p^2 ((1+e) (28+4 e^2+(-12+p) p)-((1+e) (-4+p) (-6+2 e+p) EllipticE[(4 e)/(-6+2 e+p)]+2 (6+2 e-p) (3+e^2-p) EllipticPi[(2 e (-4+p))/((1+e) (-6+2 e+p)),(4 e)/(-6+2 e+p)])/EllipticK[(4 e)/(-6+2 e+p)]))/(2 (-1+e) (1+e)^2 (-4+p)^2) -(* ::Subsection:: *) +(* ::Subsection::Closed:: *) (*Kerr*) -(* ::Subsubsection:: *) +(* ::Subsubsection::Closed:: *) (*KerrGeoMinoFrequencyr*) @@ -147,7 +147,7 @@ -(* ::Subsubsection:: *) +(* ::Subsubsection::Closed:: *) (*KerrGeoMinoFrequency\[Theta]*) diff --git a/Kernel/SpecialOrbits.m b/Kernel/SpecialOrbits.m index cb4c3f4..82f5c72 100644 --- a/Kernel/SpecialOrbits.m +++ b/Kernel/SpecialOrbits.m @@ -8,7 +8,7 @@ (*Define usage for public functions*) -(* ::Section:: *) +(* ::Section::Closed:: *) (*Create Package*) @@ -602,7 +602,7 @@ ] -(* ::Section:: *) +(* ::Section::Closed:: *) (*Close the package*)