RK4 Gravity Simulator

You can write your own algorithm and use it from NDSolve. For example, for RK4:

CRK4[]["Step"[rhs_, t_, h_, y_, yp_]] := Module[{k0, k1, k2, k3 },
  k0 = h yp;
  k1 = h rhs[t + h/2, y + k0/2];
  k2 = h rhs[t + h/2, y + k1/2];
  k3 = h rhs[t + h/2, y + k2];
  {h, (k0 + 2 k1 + 2 k2 + k3)/6}]

CRK4[___]["DifferenceOrder"] := 4

CRK4[___]["StepMode"] := Fixed

Then call NDSolve[..., Method-> CRK4] after setting the options as you wish.


Your problem is caused by a simple mistake. To solve a set of 2nd order ODEs with RK4, we need to rewrite the ODEs into a set of 1st order ODEs, like:

$$u'(t)=\frac{G m x(t)}{(x(t)^2+y(t)^2)^{3/2}}$$ $$v'(t)=\frac{G m y(t)}{(x(t)^2+y(t)^2)^{3/2}}$$ $$x'(t)=u(t)$$ $$y'(t)=v(t)$$

Then compare the above equations with the corresponding part in your code, it's easy to see that you've mixed up f, g and u, v, so the easiest way to fix your code is to exchange the position of f, g and u, v in the definition of them i.e.

(*du/dt=d^2x/dt^2=*)u[t_, x_, y_, dx_, dy_] := -((G m x)/(x^2 + y^2)^(3/2));
(*dv/dt=d^2y/dt^2=*)v[t_, x_, y_, dx_, dy_] := -((G m y)/(x^2 + y^2)^(3/2));
(*dx/dt=*)f[t_, x_, y_, dx_, dy_] := dx;
(*dy/dt=*)g[t_, x_, y_, dx_, dy_] := dy;

BTW, you've chosen too small a step size, something like h = 100; tmax = 50; is quite enough, the following is the corresponding result:

enter image description here


Data

Remove["Global`*"]
G = 6.672*10^-11;(*Gravitational constant*)
m = 5.97219*10^24;(*Mass of Earth*)
r = 6.37101*10^6;(*Earth mean equatorial radius*)
delT = 0.005;(*Step size*)
nSteps = 10000;

NDSolve result

Clear[x, y, t];
soln = First@NDSolve[{
     x''[t] == -((G m x[t])/(x[t]^2 + y[t]^2)^(3/2)),
     y''[t] == -((G m y[t])/(x[t]^2 + y[t]^2)^(3/2)),
     x[0] == 0,
     y[0] == r + 300000,
     x'[0] == Sqrt[(G m)/(r + 300000)],
     y'[0] == 0},
    {x[t], y[t], x'[t], y'[t]}, {t, 0, nSteps*delT}, 
       Method -> "StiffnessSwitching", MaxSteps -> 10000000];

Grid[{{
   Plot[Evaluate[x[t] /. soln], {t, 0, nSteps*delT}, PlotLabel -> "x(t)"],
   Plot[Evaluate[x'[t] /. soln], {t, 0, nSteps*delT}, PlotLabel -> "x'(t)"]},
  {Plot[Evaluate[y[t] /. soln], {t, 0, nSteps*delT}, PlotLabel -> "y(t)"],
   Plot[Evaluate[y'[t] /. soln], {t, 0, nSteps*delT}, PlotLabel -> "y'(t)"]}
  }]

Mathematica graphics

RK4 results

x = Table[0, {i, nSteps}, {j, 4}];
x[[1, 1]] = 0;(*Initial x-position*)
x[[1, 2]] = Sqrt[(G m)/(r + 300000)];(*Initial x-velocity*)
x[[1, 3]] = r + 300000;(*Initial y-position*)
x[[1, 4]] = 0;(*Initial y-velocity*)

f[{x1_, x2_, x3_, x4_}] := {x2, -(G m x1)/(x1^2 + x3^2)^(3/2), x4, 
         -(G m x3)/(x1^2 + x3^2)^(3/2)};

Do[k1 = f[x[[n]]];
   k2 = f[  x[[n]] + delT  k1/2 ];
   k3 = f[ x[[n]] + delT  k2/2];
   k4 = f[  x[[n]] + delT  k3 ];
   x[[n + 1]] = x[[n]] + delT/6 (k1 + 2 k2 + 2 k3 + k4), {n, 1, nSteps - 1}] ;

Plot it

t = Table[i*delT, {i, 0, nSteps - 1}];
Grid[{{
   ListPlot[Transpose[{t, x[[All, 1]]}], PlotLabel -> "x(t)"],
   ListPlot[Transpose[{t, x[[All, 2]]}], PlotLabel -> "x'(t)"]},
  {ListPlot[Transpose[{t, x[[All, 3]]}], PlotLabel -> "Y(t)"],
   ListPlot[Transpose[{t, x[[All, 4]]}], PlotLabel -> "Y'(t)"]}
  }]

Mathematica graphics

Notes: There is no need to break the system as you did. You can treat it as state space formulation. $x'(t) = f(x,t)$ where $x'(t)$ is vector, and $f(x,t)$ is the RHS. Hence you solve it as if it was one linear equation or 20 linear equations. It is the same method. only need to use $k1,k2,k3,k4$. I used $x_1$ for $x(t)$, and $x_2$ for $x'(t)$, and $x_3$ for $y(t)$ and $x_4$ for $y'(t)$ since this is very common way to do it in control systems.