(* 1: SMALL ANGLES *)

θ[t_, θ0_]:=θ0 Cos[(Sqrt[(g/r)])t]
x[t_, θ0_]:=Sin[θ[t, θ0]]
y[t_, θ0_]:= -Cos[θ[t, θ0]]

T=2π(Sqrt[(r/g)]);

g=10;r=1;θ1=-π/8; θ2=-π/6; θ3=-π/4;

Do[Print[Grid[{{Show[
Graphics[{Gray, Dashed,Circle[]},
PlotRange->{{-1.1,1.1},{-1.1,0}},
 Frame->True, ImageSize->420],
Graphics[{Gray, Line[{{0,0},{x[τ, θ1],y[τ, θ1]}}]}],
Graphics[{Gray, Line[{{0,0},{x[τ, θ2],y[τ, θ2]}}]}],Graphics[{Gray, Line[{{0,0},{x[τ, θ3],y[τ, θ3]}}]}],
ParametricPlot[{
{x[t, θ3],y[t, θ3]}, 
{x[t, θ2],y[t, θ2]},
{x[t, θ1],y[t, θ1]}
}, {t,τ-0.05,τ}, PlotStyle->{Red,Cyan,Blue}]
]},{"t"->Evaluate[τ]}},Alignment->Left]],{τ,0.05,2π(Sqrt[r/g])+0.05,0.1}]

Quit[]

(* 2: ARBITRARY ANGLES *)

g=10;r=1; θ1=π/4;θ2=π/2;θ3=3π/4;

set={"GlobalAdaptive","MaxErrorIncreases"->100,Method->"GaussKronrodRule"};n=100; int[f_,{x_,xmin_,xmax_}]:=Quiet[NIntegrate[f,{x,xmin,xmax},Method->set,MaxRecursion->n]];

t[φ_,θ0_]:=(Sqrt[(r/(2g))])int[(1/(Sqrt[Cos[θ]-Cos[θ0]])), {θ,φ,θ0}];

ξ[θ0_]:=2 g-2 g Cos[θ0];
ψ[τ_,θ0_]:=Re [2 JacobiAmplitude[((-(Sqrt[r]) τ (Sqrt[ξ[θ0]])+2 r EllipticF[((θ0)/2),((4 g)/(ξ[θ0]))])/(2 r)),((4 g)/(ξ[θ0]))]];
ω[τ_,θ0_]:=Re[(((Sqrt[ξ]) JacobiDN[((-(Sqrt[r]) (Sqrt[ξ]) τ+2 r EllipticF[((θ0)/2),((4 g)/ξ)])/(2 r)),((4 g)/ξ)])/(Sqrt[r]))];

x[τ_, θ0_]:=Quiet[+Sin[ψ[τ,θ0]]];
y[τ_, θ0_]:= Quiet[-Cos[ψ[τ,θ0]]];

Quiet[Do[Print[Rasterize[Grid[{{Show[
Graphics[{Gray,Dashed,Circle[]},PlotRange->{{-1.1 r,1.1 r},{-1.1 r,1.1 r}},
Frame->True,ImageSize->420],
Graphics[{Gray,Line[{{0,0},{x[τ,θ1],y[τ,θ1]}}]}],
Graphics[{Gray,Line[{{0,0},{x[τ,θ2],y[τ,θ2]}}]}],
Graphics[{Gray,Line[{{0,0},{x[τ,θ3],y[τ,θ3]}}]}],
ParametricPlot[{
{x[T,θ1],y[T,θ1]},{x[T,θ2],y[T,θ2]},{x[T,θ3],y[T,θ3]}},
{T, τ-0.1,τ}, 
PlotStyle->{
{Opacity[1],Red},{Opacity[1],Cyan},{Opacity[1],Blue}}]]},
{"t"->Evaluate[τ]},
{"δ"->Evaluate[ψ[τ,θ1]]},
{"ε"->Evaluate[ψ[τ,θ2]]},
{"κ"->Evaluate[ψ[τ,θ3]]}},
Alignment->Left]]],
{τ,0.2,4t[0,θ3],0.1}]]

Quit[]

(* 3: INITIAL VELOCITIES *)

g=98/10;r=1; θ0=π; θi=17/18π; ωi=1;  

F[θ_]:=(Sqrt[2g(Cos[θ]-Cos[θ0])/r+(ω^2)]);

x[т_]:=Quiet[+Sin[ψ[т]]] r;
y[т_]:=Quiet[-Cos[ψ[т]]] r;

κ=r ((ωi)^2)-2 g Cos[θi]+2 g Cos[φ];
ξ=2 g+r ((ωi)^2)-2 g Cos[θi];

t[φ_]:=((2 (Sqrt[((r ((ωi)^2))/ξ)]) EllipticF[((θi)/2),((4 g)/ξ)])/(Sqrt[((ωi)^2)]))-((2 (Sqrt[(κ/ξ)]) EllipticF[(φ/2),((4 g)/ξ)])/(Sqrt[(κ/r)]));
ψ[τ_]:=2 JacobiAmplitude[((-(Sqrt[r]) τ (Sqrt[ξ])+2 r EllipticF[((θi)/2),((4 g)/ξ)])/(2 r)),((4 g)/ξ)];

ω[τ_]:=(((Sqrt[ξ]) JacobiDN[((-(Sqrt[r]) (Sqrt[ξ]) τ+2 r EllipticF[((θi)/2),((4 g)/ξ)])/(2 r)),((4 g)/ξ)])/(Sqrt[r]));

tu=t[θi-2π]; "Umlaufzeit"->N@tu "sek"

Do[Print[Rasterize[Grid[{{Show[
Graphics[{Gray,Line[{{0,0},{x[τ],y[τ]}}]},
PlotRange->{{-1.1 r,1.1 r},{-1.1 r,1.1 r}},Frame->True,ImageSize->420],
Graphics[{Gray,Dashed,Circle[]}],
ParametricPlot[{{x[T],y[T]}},
{T, τ-0.1,τ}, 
PlotStyle->{{Opacity[1],Red}}]]},
{"t"->Evaluate[N[Re[τ]]]},
{"x"->Evaluate[N[Re[x[τ]]]]},
{"y"->Evaluate[N[Re[y[τ]]]]},
{"ψ"->Evaluate[N[Re[ψ[τ]]]]},
{"ω"->Evaluate[N[Re[ω[τ]]]]}},Alignment->Left]]],
{τ,0,tu,0.1}]

Quit[]

(* 4. DIFFERENTIAL *)

g=98/10;r=1;θi=17/18 π;ωi=1;

sol=NDSolve[{φ''[t]==-g/r Sin[φ[t]],φ'[0]==-ωi,φ[0]==θi},φ,{t,-8,8}, 
MaxSteps->Infinity,
Method->{"ImplicitRungeKutta","DifferenceOrder"->20},
InterpolationOrder->All];

ψ[t_]:=Evaluate[φ[t]/.sol][[1]];
x[t_]:=+Sin[ψ[t]] r;
y[t_]:=-Cos[ψ[t]] r;

grid[k_]:=Table[n k,{n,-10,10}];

Plot[Evaluate[φ[t]/.sol],
{t,-8,8},
PlotRange->All,Frame->True,
GridLines->{None,grid[π]},
ImageSize->420,PlotStyle->Red]

Do[Print[Rasterize[Grid[{{Show[
Graphics[{Gray,Dashed,Circle[]},
PlotRange->{{-1.1 r,1.1 r},{-1.1 r,1.1 r}},
Frame->True,ImageSize->420],
Graphics[{Gray,Line[{{0,0},{x[τ],y[τ]}}]}],
ParametricPlot[{{x[T],y[T]}},{T,τ-0.1,τ},
PlotStyle->{{Opacity[1],Red}}]]},
{"t"->Evaluate[τ]},
{"x"->Evaluate[x[τ]]},
{"y"->Evaluate[y[τ]]},
{"ψ"->Evaluate[ψ[τ]]},
{"ω"->Evaluate[-ψ'[τ]]}},
Alignment->Left]]],
{τ,0,2.2,10}]

Quit[]

(* Vergleich DIFFERENTIAL *)

g=98/10;r=1;θi=17/18 π;ωi=1;
sol=NDSolve[{φ''[τ]==-g/r Sin[φ[τ]],φ'[0]==-ωi,φ[0]==θi},φ,{τ,-100,100}, MaxSteps->Infinity,
Method->{"ImplicitRungeKutta","DifferenceOrder"->20},
InterpolationOrder->All, PrecisionGoal->16];
ψ[t_]:=N[φ[t]/.sol, 16][[1]];
ω[t_]:=N[-φ'[t]/.sol, 16][[1]];
t[φ_]:=Quiet[FindRoot[ψ[T]-φ, {T,0}, PrecisionGoal->16]][[1]][[2]];
Quiet[Do[Print[{"ψ"->N[ψ[o], 16],"ω"->N[ω[o], 16], "t"->N[o, 16]}], {o,-100,100,20}]];

Quit[]

(* Vergleich INTEGRAL *)

g=98/10;r=1; θ0=π; θi=17/18π; ωi=1;  
Clear[ω]; int[f_,{x_,xmin_,xmax_}]:=Quiet[NIntegrate[f,{x,xmin,xmax},Method->{"GlobalAdaptive","MaxErrorIncreases"->10,Method->"GaussKronrodRule"},MaxRecursion->10, PrecisionGoal->16]];
F[θ_,θ0_]:=(Sqrt[2g(Cos[θ]-Cos[θ0])/r+(ω^2)]);
τ[φ_,θ0_]:=int[((F[θ,θ0])^(-1)), {θ,φ,θ0}];
α[т_,θ0_]:=Quiet[Re[λ/.FindRoot[τ[λ,θ0]-т, {λ,θ0}, PrecisionGoal->16]]];
ω=Solve[F[θi, θ0]==ωi, ω][[1]][[1]][[2]];
tu=2τ[0,θ0];
ti=τ[θi,θ0];
ψ[t_]:=Quiet[α[t+ti,θ0]];
t[ψ_]:=τ[ψ,θ0]-ti;
Quiet[Do[Print[{"ψ"->N[ψ[o], 16],"ω"->N[F[ψ[o],θi], 16], "t"->N[o, 16]}], {o,-100,100,20}]];

Quit[]

(* Vergleich ELLIPTISCH *)

g=98/10; r=1; θi=17/18π; ωi=1;
κ=r ((ωi)^2)-2 g Cos[θi]+2 g Cos[φ];
ξ=2 g+r ((ωi)^2)-2 g Cos[θi];

t[φ_]:=Re[((2 (Sqrt[((r ((ωi)^2))/ξ)]) EllipticF[((θi)/2),((4 g)/ξ)])/(Sqrt[((ωi)^2)]))-((2 (Sqrt[(κ/ξ)]) EllipticF[(φ/2),((4 g)/ξ)])/(Sqrt[(κ/r)]))];
ψ[τ_]:=Re[2 JacobiAmplitude[((-(Sqrt[r ξ]) τ +2 r EllipticF[((θi)/2),((4 g)/ξ)])/(2 r)),((4 g)/ξ)]];
ω[τ_]:=Re[(((Sqrt[ξ]) JacobiDN[((-(Sqrt[r ξ])  τ+2 r EllipticF[((θi)/2),((4 g)/ξ)])/(2 r)),((4 g)/ξ)])/(Sqrt[r]))];
Quiet[Do[Print[{"ψ"->N[ψ[o], 16],"ω"->N[ω[o], 16], "t"->N[o, 16]}], {o,-100,100,20}]];