3D orbits and inaccuracy over time

Some frames from my version of the animation:

orbiting planets

Here's the code I used:

orbit[posStart_?VectorQ, derStart_?VectorQ] := 
     Block[{c = -Rationalize[6.672*^-11*7*^17], x, y, z, t},
           {x, y, z} /. First @ NDSolve[
           Join[Thread[{x''[t], y''[t], z''[t]} == 
                       c {x[t], y[t], z[t]}/Norm[{x[t], y[t], z[t]}]^3], 
                Thread[{x[0], y[0], z[0]} == posStart], 
                Thread[{x'[0], y'[0], z'[0]} == derStart]],
           {x, y, z}, {t, 0, ∞},
           Method -> {"EventLocator", Direction -> 1,
                      "Event" -> {x'[t], y'[t], z'[t]}.({x[t], y[t], z[t]} - posStart),
                      "EventAction" :> Throw[Null, "StopIntegration"], 
                      Method -> {"SymplecticPartitionedRungeKutta", 
                                 "PositionVariables" -> {x[t], y[t], z[t]}}}, 
           WorkingPrecision -> 20]]

{x[1], y[1], z[1]} = orbit[{1000, 1000, 1000}, {0, -100, 0}];
tf1 = x[1]["Domain"][[1, -1]];

{x[2], y[2], z[2]} = orbit[{500, -1000, -1000}, {-110, 100, 0}];
tf2 = x[2]["Domain"][[1, -1]];

{x[3], y[3], z[3]} = orbit[{0, 100, 500}, {350, -100, 0}];
tf3 = x[3]["Domain"][[1, -1]];

orbit1[t_] := Through[{x[1], y[1], z[1]}[tf1 Mod[t/tf1, 1]]];
orbit2[t_] := Through[{x[2], y[2], z[2]}[tf2 Mod[t/tf2, 1]]];
orbit3[t_] := Through[{x[3], y[3], z[3]}[tf3 Mod[t/tf3, 1]]];

Animate[Show[
        ParametricPlot3D[{orbit1[t], orbit2[t], orbit3[t]}, {t, -$MachineEpsilon, a}], 
        Graphics3D[{{Yellow, Sphere[{0, 0, 0}, 100]},
                    {Green, Sphere[orbit1[a], 50]},
                    {Blue, Sphere[orbit2[a], 50]},
                    {Purple, Sphere[orbit3[a], 50]}}],
                   AxesLabel -> {x, y, z}, 
                   PlotRange -> {{-1600, 1600}, {-1600, 1600}, {-1600, 1600}}],
        {a, 0, ∞, 2}]

The only non-basic idea here is the use of event detection in conjunction with a symplectic integrator; briefly, one should certainly use a symplectic integrator when integrating a Hamiltonian system, and that you can use event detection to detect periodic behavior when the solutions of a system of differential equations is known to be periodic.


This is too long for a comment, but it isn't an answer.

Perhaps you would like to consider a more compact way to write down your equations:

m = -(6.672*10^-11) (7*10^17) ;
st = {{1000, 1000, 1000, 0, -100, 0},
      {500, -1000, -1000, -110, 100, 0},
      {0, 100, 500, 350, -100, 0}};
r = {x @ t, y @ t, z @ t};

o[n_] := NDSolve[Join[{Equal @@ Join[(D[r, {t, 2}]/r), {m/Norm @ r^3}]},
                       Thread[{x[0], y[0], z[0], x'[0], y'[0], z'[0]} == st[[n]]]],
                 r, {t, 0, 1000}]

And the plotting part gets to:

d = {d1, d2, d3} = Evaluate[r /. o /@ {1, 2, 3}];
Animate[Show[{
  ParametricPlot3D[d /. t -> u, {u, 0, a}, PlotRange -> 1600 {{-1, 1}, {-1, 1}, {-1, 1}}], 
  Graphics3D[MapThread[{#1, Sphere[#2 /. t -> a, #3]} &, {{Yellow, Green, Blue, Purple}, 
                                            {{0, 0, 0}, d1, d2, d3}, 50 {2, 1, 1, 1}}]]}], 
{a, 0, 100, 0.1}]