N-body problem

From Rosetta Code
This task has been flagged for clarification. Code on this page in its current state may be flagged incorrect once this task has been clarified. See this page's Talk page for discussion.
N-body problem is a draft programming task. It is not yet considered ready to be promoted as a complete task, for reasons that should be found in its talk page.

The -body problem is an inherent feature of a physical description of mechanical system of interacting objects. The system is described by Newton's Law

with continious combined force from other bodies

Exact formulation of first mechanical problem is, given initial coordinates and velocities , to find coordinates and velocities at with accuracy more then given relative value

As well known from physical background, only the choice of can be analytically solved.

Task

Write a simulation of three masses interacting under gravitation and show their evolution over a number of time-steps (at least 20).

Fortran[edit]

Interpretation[edit]

As stated, the task involves a general rendition of , in the sense that a mass is being accelerated (that is, its position is changing, and the second differential of position against time is the acceleration) and therefore there is a force, but the cause and nature of the acceleration is unstated. Then there is mention of masses mutually interacting according to Newton's law of gravitation, so the formula becomes for each i and j not equal

The bodies are presumed to be able to move freely (not sliding on a wire or across a surface, etc.) so at any position the forces can be calculated and thereby the accelerations, but, only via a function of position. What is desired however is to determine the positions as a function of time. Analysis of the formulae combine constraints that lead to the conclusion that the paths are conic sections: a circle, ellipse, parabola or hyperbola. Thus, for a small mass m in a circular orbit around a large mass M, the force required to bend the path into a circle is directed towards the circle's centre and is given by

where r is the radius of the orbit and v its orbital velocity. This assumes that the gravitational mass and inertial masses are the same - experimentally tested by Newton, and to great accuracy by Eötvös et seq. For a constant-velocity circular orbit, the time for one orbit to complete is

The value of m can be cancelled from both sides to give a limiting case where m is zero, a "test mass" (so this is almost a one-body problem) and

A fuller analysis allowing for elliptical orbits finds that

In the MKS system, G = 6·6742E-11 so for a one-second orbit around a one kilogram mass, r = 0·000119 metres, a tenth of a millimetre! A sphere of that radius has volume 7E-12 cubic metres so the density would have to be at least 1.4E+11 KG/cubic metre; osmium manages 2.25E+4, neutronium 4E+17. Alternatively, with two one-kilogram masses orbiting their centre of mass with r = 1 metre, T = 6·3 days... The force between the two spheres is just G, 6·6742E-11 Newtons. Preventing such a languid orbit from being disrupted by electrostatic forces (due to cosmic rays, radioactive disintegration, etc.) will be difficult. Determining G via an experiment in which two known masses orbit each other does not look promising.

For more than two bodies the possible behaviours become numerous while the constraints are too few. Notably, bodies can pass within infinitesimal distances of each other and thereby suffer disruptive accelerations. For three bodies certain arrangements remain easily solved: one body having zero mass, or a symmetric arrangement of all three may provide sufficient constraints such as equal masses at the points of an equilateral triangle with equal velocities. For more numerous collections, analysis is abandoned in favour of computation.

Numerical approach[edit]

The basic step is for each body, sum the forces on it exerted by every other body, then apply F = ma and divide by its mass to determine its acceleration. The only shortcut lies in noting that the force of body A on body B is exactly that of body B on body A (in the reverse direction along the vector joining them) so that the task can be halved. In Newtonian physics, there is no time lag across distance. Then, wrongly supposing those accelerations constant for some small time interval, calculate how they would affect the velocities and the positions over that time interval, using a step size that is small enough for this to be approximately true... Too small a step size not only means a lengthy calculation but introduces error by accumulation as in the formation of the sum of a very numerous collection of values.

The Fortran programme was written in the early 1990s and so employs F77. A F90 compiler was available on the IBM mainframe, but it must have been an early version because it was riddled with errors. A colleague tried its QUADRUPLE PRECISION facility, and found that it crashed the operating system! In-line comments were unavailable, and the twenty-four line IBM3278 display screen discouraged expending screen space on commentary, especially because they were non-scrolling. It was also an exploratory programme, so documenting details that were a variation and might soon be removed was a further discouragement. In other words, I now find it difficult to follow the code. (Stop laughing!) The initial effort was prompted by an article in Scientific American that listed the masses, positions and velocities of the twenty nearest stars and invited calculations. It soon became apparent that the stars were not gravitationally bound to each other, as they simply drifted apart along nearly straight lines.

The other area of interest was the performance of various methods for numerical approximation. The calculation effort is assessed on the basis of the number of evaluations of the differential equation required for each step: outside of textbook examples this is usually a large effort. Here for example it is proportional to the square of the number of bodies, and a globular cluster may contain not just hundreds but millions of stars... Thus, the first-order Euler method requires one calculation of accelerations per step, the second-order method two, and the Runge-Kutta method four. Only if the step size could be increased more than proportionally would higher-order methods be worthwhile - provided that accuracy was maintained! Error bounds can be calculated, both for an individual step and for the result after a sequence of steps, via the usual analysis for a polynomial solution function (and if it were a polynomial then numerical methods would not be needed) and as usual produces results that rely on there being an upper bound to a suitably high differential of the solution function over the interval. But in this problem, there is no such bound. Bodies, as points, can approach arbitrarily closely and the resulting accelerations are arbitrarily high, being 1/d2 as d approaches zero. Thus, no assurances are available, and a common method is to run a calculation once with a given step size, then again with half the step size, at a painful cost. The irresponsible make a guess at a suitable step size and worry no further.

All the straightforward methods attempt to assess the conditions over the step, perhaps briefly as with the Euler method using the conditions only at the start, whereas the classic fourth-order Runge-Kutta method first probes half a step forwards, uses those results to probe for a full step, then combines all results to make the full step. Such probing requires many evaluations. Rather than forgetting previous positions so painfully computed, the predictor-corrector methods instead rely on the recent past history as being a good indication of the near future - on the supposition of no step-discontinuities. This problem is slightly more difficult because it is second order (as for acceleration to velocity to position) rather than the first order (say, velocity to position) problems discussed in texts. Specifically, the predictor part is to fit a polynomial to the past few accelerations (e.g. at times t-2h, t-h and t) and integrate to obtain a provisional position for the end of the current time step at t+h. Evaluate the acceleration there and use it as the new value to perform the actual advance to the end of the time step, the corrector part. Since this is now the new position (and will differ from the provisional position based on polynomial extrapolation), recalculate the acceleration there to maintain coherence between position and acceleration. There are thus just two evaluations per step, and this applies even if more values are retained for higher-order extrapolation and integration methods.

This could be reduced to one evaluation per step: as before use a polynomial fitted to the past accelerations to enable integration so as to determine the position at t+h. Calculate the acceleration for that position (at time t+h) to complete the step, ready to start the next. A sense of unease should arise at this, made clear by asking "Why bother with the corrector at all?" - but that would mean not involving the actual differential equation! The predictor step involves extrapolating a polynomial fit over t-2h, t-h and t (all being accepted solutions for the differential equation), to t+h but the predicted acceleration at time t+h is likely to match the differential equation's value at the new position determined from it only if the solution is a simple polynomial. Put another way, the second-order method employs the differential equation twice (at both ends of the step), and does much better than the first-order method with one evaluation.

Two temptations are to be avoided: using ever-higher order polynomials for extrapolation and integration amounts to saying that the differential equation is a polynomial, and its is not - no polynomial has a vertical or horizontal asymptote and gravitation has both, so another possibility would be to try fitting the values with other functions (perhaps with negative powers: Laurent series?), not just polynomials. Secondly, avoid the "iteration heresy" (F.S. Acton, Numerical Methods that Work (Usually)) whereby there is a temptation to iterate the predictor-corrector cycle for each step until it converges. Alas, it will converge to the solution of a difference equation, and this will only be the solution of the differential equation after the step size is reduced to zero. Further, such iteration will only re-evaluate the accelerations at almost the same positions each time, leaving the rest of the step interval uninspected. Traversing that step via multiple smaller steps would be a much better use for all those extra evaluations, spreading them evenly.

The simple methods (Euler, second-order, Runge-Kutta) can easily accommodate changes to the step size, but guidance for these changes is not easily obtained. The Milne predictor-corrector method is much messier but contains an inbuilt assessment of the possibilities for changing the step size: at the new position at the end of the step, compare the predicted value for the acceleration with the final calculated value. With the "extrapolation to zero step size" methods of Gragg, Bulirsch, and Stoer, arithmetical analysis of the effect of different step sizes is central to its workings. With calculus the purpose is the analysis of the limiting behaviour as a step is reduced to zero with a view to obtaining results spanning some region of interest that may be ±infinity. Only with the GBS approach is there a corresponding analysis, an arithmetical analysis. It does not concern itself with the nature of the functions but only with the limited-precision inspection of values obtained via limited-precision evaluation.

On escalating to the Milne Predictor-Corrector method, there arose a large increase in administration, especially when the time step was to be doubled or halved. Previous methods had involved just a little juggling but now the juggling was so variable that introducing a multi-item stash with an allocation and freeing scheme reduced the strain. Under consideration were questions such as how to compare two vectors for being adequately close (as in deciding whether to change the step size) when their numerical value might vary over a wide range (astronomical units, or MKS?) yet one or both may be zero too, and whether to stick with halving/doubling or consider halving/tripling so that if (say) 2 was too small and 4 too big, intermediate values such as 3 could be reached, and whether this would be worth the floundering about.

Organisation of arrays[edit]

Aside from the details of the calculations and their method, organising the data structure is important. Accessing an array element is time-consuming, so a particular ploy was to de-reference the arrays: from three dimensions to two (via NEWT) and from two to one (via NEWTON) so that the indexing of the time-consuming computation would be simplified. In other words, the storage for X (position), V (velocity) and A (acceleration) are all 100 (to allow for N bodies) by 3 (for x, y, z components) by 14, this last being sufficient multiple sets of data for MILNE to juggle. It uses Runge-Kutta to initialise its march then proceeds, possibly doubling its step size (so discarding alternate saved historic position sets, thus needing to have eight so that it would be able to retain four) or halving its step size. Notably, for a circular orbit, MILNE developed coefficients equivalent to the first few terms of the series expansion of sine. From F90 there appear arrangements for manipulating arrays, and especially the FOR ALL statement, but their exact behaviour is poorly described. For instance, if the FOR ALL statement were to produce results in a work area then copy that to the destination area, performance may be impeded compared to the update-in-place of the straightforward statements due to the extra data transfer involved.

The arrays are dimensioned as 100,3,14 rather than say 14,3,100 because Fortran orders array elements so that the first index varies most rapidly for adjacent elements in storage - some languages are the other way around and I have never seen an explanation for why this choice was made for Fortran, as it is unhelpful for matrix arithmetic. Thus, element (i,j,k) is followed by element (i + 1,j,k). Accordingly, as NEWTON works along the N bodies, the values for consecutive bodies are adjacent. It is presented with separate X, Y, Z arrays even though these are actually parts of the same big array, so that it may use one-dimensional array indexing (and with the same index for all) rather than the much slower two-dimensional indexing. However, the storage locations of these arrays have fixed relationships with each other. Specifically, each are one hundred elements apart so that Y(i) is one hundred elements along from X(i), and Z(i) another hundred along from Y(i). Thus, there could instead be an array XYZ of 300 elements with the code referencing XYZ(i) to obtain X(i), XYZ(i + 100) for Y(i), and XYZ(i + 200) for Z(i). This would have the obvious advantage of maintaining one-dimensional indexing, and gain the possibility that the compiler might generate code that uses one index register for all the accesses rather than three. This can be achieved for "free" - suppose the determination of the effective address (in memory of a datum) is of the form (base address of XYZ) + (index register: the offset). Rather than calculating offsets from (i) and (i + 100), and (i + 200) the equivalent would be to use an offset of (i) every time, but with (XYZ) and (XYZ + 100) and (XYZ + 200), these all being constants.

This notion could also be extended to the 14 sets of 100 triples. In other words, any multi-dimensional array could be considered as equivalent to a single-dimension array of the same size, and indeed could be made so via an EQUIVALENCE statement. Thus, the notational and organisational conveniences of multi-dimensional arrays could be retained, with the use of single indexing reserved for places of desperate need for speed. However, in the absence of a PARAMETER statement to identify the various constants, any adjustment to the size and shape of the array will be difficult and simple mistakes will often be missed. Serious computational programmes often involve large and complex formulae, so the task is not small. Depending on one's ingenuity, there are many possible schemes to choose amongst and a great deal of time can vanish, possibly greater than any recovered by faster running...

All of this could, and indeed should, be done via the compiler's analysis rather than have a human disappear down a rabbit hole. First Fortran (1958) engaged in intensive analysis, guided by a Monte Carlo simulation possibly assisted by the programmer supplying hints via the FREQUENCY statement and produced surprisingly cunning code - in part because the (debugged) compiler would engage in complex arithmetic that a human programmer would avoid due to the risk of making a mistake. Subsequent compilers are often praised, but inspection of the code is less impressive, and the task is not well done. For instance, simple changes to the source file result in faster-running programmes, and these changes should not have made any difference. Thus, NEWTON puts values from arrays into simple variables rather than reference the same array element for each usage: the compiler should be able to notice this. There is certainly talk about "invariant expressions" and the like, but, the run times are different. It is also possible that the code produced by the "optimising" compiler runs slower than that without the "optimising" active, despite the longer compile time. This is not just me: the British Meteorological Office has admitted to similar experiences, during a job interview.

All calculations are in double precision. Test runs with near-approach paths demonstrated the need, even though the constant of gravitation is known to well less than single-precision accuracy. Startling plots resulted, because as a body approaches a mass its velocity builds up to a high value and thus, covering a lot of distance near to the mass in the same time step means that curvature is missed. Further, the build up from a small velocity to high velocities during the approach must be matched by their reduction during the departure, but limited precision means that the details of the low velocity have been lost to truncation/rounding while the number was large and so the departure path will not be the mirror of the approach path. For example, imagine that a single-precision variable holds the value of pi, then add 1, 10, 100, 1000, 10000, 100000, followed by subtracting 100000, 10000, ... , 1. The value of pi will have been badly damaged. Only in double precision would that single precision accuracy have been maintained.

Source[edit]

I have left the source file pretty much as it was, so F77 rules. This was written in part to exercise the graph-plotting facilities, which served a number of output devices (screen to paper) but in a page-only mode: no moving pictures. Rather than attempt to develop a library of plot assistance routines, for exploration it was easier to incorporate (and possibly fiddle) the most helpful source from other programmes - the Fortran compiler ran at about 50,000 lines/minute, and also I'd had odd experiences with the linkage loader. Those plotting routines are long gone, and there are no similar routines to hand now so they have here been made into dummy routines. Variable DIVE enables runs with plotting deactivated so that text output could be concentrated upon, and also suppressed tedious requests to name the plotting device.

There are also slight changes - the IBM MVS/XA with TSO system did not support the open-file-by-name protocol, so the source now contains an OPEN (IN,FILE="TCL.dat") to read the parameters. During a TSO session, one would assign a named file to a unit number (like a DD statement in JCL for batch jobs) and then run the programme as often as one wished. Similarly, as scrolling screens are now available, there are some additional output statements such as a confirmatory display of what was read from the input file. Previously, one would begrudge every output as it used up one more of the available twenty-three lines, each of seventy-nine characters. The IBM3270 (et al) display screens divided the screen space into display fields, each starting with a control field (stating input allowed or not, digits only, may be skipped, bright/dim, etc.) that took up a character space. If when viewing the next screen's output one wished to refer back to previous output, it was too late, there was no scrolling back... One could write helpful output to a text file, but, there was no provision for multiple "windows" on the screen to view the graph and the text together, and not much space anyway even if there were. Typically, one would hit the enter key until the "READY" was close to the bottom of the screen then start the run. This way the resulting output would spill over to a fresh screen and so enable as much as possible to be seen together. To assist in this, there was a facility to specify IST and LST, the first and last body for which output was to be shown, here set to 1 and 3 for the specific three-body example being run.

More seriously, later Fortran has additional routines, and confusion can arise: thus subroutine FREE was renamed to SFREE, and array INDEX renamed to INDEXS, though calling it SINDEX was the first idea - but that would require additional declarations so as to keep it integer. The habit of not bothering with minor declarations lingers on with exploratory programmes...

 
SUBROUTINE PLOTS(DX,DY,DEVICE)
INTEGER DEVICE(10)
COMMON LINPR
WRITE (LINPR,*) "PlotS:",DX,DY,DEVICE
END
SUBROUTINE PLOT(X,Y,IHIC)
COMMON LINPR
WRITE (LINPR,*) "Plot:",X,Y,IHIC
END
SUBROUTINE FACTOR(F)
COMMON LINPR
WRITE (LINPR,*) "PlotFactor:",F
END
SUBROUTINE SYMBOL(X,Y,H,T,A,N)
INTEGER T(1)
COMMON LINPR
WRITE (LINPR,*) "PlotSymbol:",X,Y,H,T,A,N
END
SUBROUTINE NUMBER(X,Y,H,V,A,N)
COMMON LINPR
WRITE (LINPR,*) "PlotNumber:",X,Y,H,V,A,N
END
C==================The above suppresses attempts to access a long-lost plotting system
c FUNCTION CPUTIM(I)
c CALL INTVAL(-3,IWASTE)
c CPUTIM = FLOAT(IWASTE)/1000
c IF (I .EQ. 0) CALL STIME
c RETURN
c END
LOGICAL FUNCTION PRANGE(X1,X2,Y1,Y2)
LOGICAL ROTATE,DIVE
INTEGER DEVICE(10),CARDS,BLANK
COMMON /PLOTIT/ ROTATE,DIVE,DEVICE,BLOAT
COMMON LINPR,CARDS
DATA BLANK/' '/
PRANGE = DIVE
IF (DIVE) RETURN
IF (DEVICE(1).NE.BLANK) GO TO 10
WRITE (LINPR,1)
1 FORMAT (' Name your output device (TEK618,GDDM78,..)')
READ (CARDS,2) DEVICE(1),DEVICE(2)
2 FORMAT (2A4)
10 DEVICE(3) = 0
DEVICE(4) = 4*10
DX = X2 - X1
DY = Y2 - Y1
IF (.NOT.ROTATE) CALL PLOTS(DX,DY,DEVICE)
IF ( ROTATE) CALL PLOTS(DY,DX,DEVICE)
PRANGE = DEVICE(3).EQ.0
IF (PRANGE) GO TO 100
WRITE (LINPR,11) (DEVICE(I),I = 1,4)
11 FORMAT (' Muckup.',2A4,2I9)
RETURN
100 CALL PLOT(0.0,0.0,3)
D = AMAX1(DX,DY)
IF ( ROTATE) CALL FACTOR(BLOAT)
IF (.NOT.ROTATE) CALL PLOT(-X1,-Y1,-3)
IF ( ROTATE) CALL PLOT( Y2,-X1,-3)
RETURN
END
SUBROUTINE PLOTXY(X,Y,I)
LOGICAL ROTATE,DIVE
COMMON /PLOTIT/ ROTATE,DIVE
C (x,y)*(0,1) = (-y,x), a 90-degree rotation.
IF (DIVE) RETURN
IF (.NOT.ROTATE) CALL PLOT( X,Y,I)
IF ( ROTATE) CALL PLOT(-Y,X,I)
RETURN
END
SUBROUTINE SYMBXY(X,Y,H,T,A,N)
LOGICAL ROTATE,DIVE
INTEGER T(1)
COMMON /PLOTIT/ ROTATE,DIVE
IF (DIVE) RETURN
IF (.NOT.ROTATE) CALL SYMBOL(X,Y,H,T,A,N)
IF ( ROTATE) CALL SYMBOL(-Y,X,H,T,A + 90,N)
RETURN
END
SUBROUTINE NUMBXY(X,Y,H,V,A,N)
LOGICAL ROTATE,DIVE
COMMON /PLOTIT/ ROTATE,DIVE
IF (DIVE) RETURN
IF (.NOT.ROTATE) CALL NUMBER(X,Y,H,V,A,N)
IF ( ROTATE) CALL NUMBER(-Y,X,H,V,A + 90,N)
RETURN
END
SUBROUTINE DOBOX(X1,Y1,X2,Y2)
CALL PLOTXY(X1,Y1,3)
CALL PLOTXY(X2,Y1,2)
CALL PLOTXY(X2,Y2,2)
CALL PLOTXY(X1,Y2,2)
CALL PLOTXY(X1,Y1,2)
RETURN
END
C============Above are routines for producing plots.
SUBROUTINE SWAPI(I,J)
IT = I
I = J
J = IT
RETURN
END
SUBROUTINE NEWTON(X,Y,Z,AX,AY,AZ,M,N)
IMPLICIT REAL*8 (A-H,O-Z)
REAL*8 X(N),Y(N),Z(N),AX(N),AY(N),AZ(N),M(N)
REAL*8 MI,MJ
COMMON /CONST/ G,CLOSE
DO 1 I = 1,N
AX(I) = 0.0
AY(I) = 0.0
1 AZ(I) = 0.0
NL1 = N - 1
DO 3 I = 1,NL1
AXI = AX(I)
AYI = AY(I)
AZI = AZ(I)
MI = M(I)
XI = X(I)
YI = Y(I)
ZI = Z(I)
J = I + 1
DO 2 J = J,N
MJ = M(J)
DX = X(J) - XI
DY = Y(J) - YI
DZ = Z(J) - ZI
D2 = DZ*DZ + DY*DY + DX*DX
IF (D2 .LT. CLOSE) CLOSE = D2
F = G/(D2*DSQRT(D2))
AIJ = F*DX
AXI = AXI + MJ*AIJ
AX(J) = AX(J) - MI*AIJ
AIJ = F*DY
AYI = AYI + MJ*AIJ
AY(J) = AY(J) - MI*AIJ
AIJ = F*DZ
AZI = AZI + MJ*AIJ
2 AZ(J) = AZ(J) - MI*AIJ
AX(I) = AXI
AY(I) = AYI
3 AZ(I) = AZI
RETURN
END
SUBROUTINE NEWT(X,A,N)
IMPLICIT REAL*8 (A-H,O-Z)
REAL*8 X(100,3),A(100,3),M(100)
COMMON /CONST/ G,CLOSE,M
CALL NEWTON(X(1,1),X(1,2),X(1,3),A(1,1),A(1,2),A(1,3),M,N)
RETURN
END
SUBROUTINE PROBE(X,X2,V,A,N,DT)
C Looks ahead one time step.
IMPLICIT REAL*8 (A-H,O-Z)
REAL*8 X(100,3),V(100,3),A(100,3)
REAL*8 X2(100,3)
DO 1 I = 1,N
DO 1 J = 1,3
1 X2(I,J) = X(I,J) + (V(I,J) + 0.5*A(I,J)*DT)*DT
RETURN
END
SUBROUTINE EULER(K,L,N,T,DT)
Computes the first order advance. Uses A at T only.
IMPLICIT REAL*8 (A-H,O-Z)
COMMON /PLACE/ X(100,3,14),V(100,3,14),A(100,3,14)
CALL NEWT(X(1,1,K),A(1,1,K),N)
DO 2 I = 1,N
DO 2 J = 1,3
VIJ = V(I,J,K)
AIJDT = A(I,J,K)*DT
V(I,J,L) = VIJ + AIJDT
2 X(I,J,L) = X(I,J,K) + (VIJ + 0.5*AIJDT)*DT
T = T + DT
RETURN
END
SUBROUTINE LUNGE(K,L,N,T,DT)
Computes a second order advance (Huen's, or 2'nd order Euler).
C Uses A(t) to probe ahead to X(t + dt) to find A(t + dt)
C and then averages the two to advance one step.
IMPLICIT REAL*8 (A-H,O-Z)
COMMON /PLACE/ X(100,3,14),V(100,3,14),A(100,3,14)
CALL NEWT (X(1,1,K),A(1,1,K),N)
CALL PROBE(X(1,1,K),X(1,1,L),V(1,1,K),A(1,1,K),N,DT)
CALL NEWT (X(1,1,L),A(1,1,L),N)
DO 2 I = 1,N
DO 2 J = 1,3
VIJ = V(I,J,K)
AIJDT = (A(I,J,K) + A(I,J,L))*0.5*DT
V(I,J,L) = VIJ + AIJDT
2 X(I,J,L) = X(I,J,K) + (VIJ + 0.5*AIJDT)*DT
T = T + DT
RETURN
END
SUBROUTINE RUNGE(K,L,N,T,DT)
Classic Runge-Kutta fourth order advance.
C 1) Use A(t) to reach x2(t + dt/2) and compute a2(t + dt/2)
C 2) Use a2(t + dt/2) to reach x3(t + dt/2) and compute a3(t + dt/2)
C 3) Use a3(t + dt/2) to reach x4(t + dt) and compute a4(t + dt/2)
C 4) Use a weighted average of a,a2,a3,a4 to make the actual advance.
IMPLICIT REAL*8 (A-H,O-Z)
REAL*8 A3(100,3),A4(100,3)
COMMON /PLACE/ X(100,3,14),V(100,3,14),A(100,3,14)
CALL NEWT (X(1,1,K),A(1,1,K),N)
CALL PROBE(X(1,1,K),X(1,1,L),V(1,1,K),A(1,1,K),N,DT/2)
CALL NEWT (X(1,1,L),A(1,1,L),N)
CALL PROBE(X(1,1,K),X(1,1,L),V(1,1,K),A(1,1,L),N,DT/2)
CALL NEWT (X(1,1,L),A3,N)
CALL PROBE(X(1,1,K),X(1,1,L),V(1,1,K),A3,N,DT)
CALL NEWT (X(1,1,L),A4,N)
DO 2 I = 1,N
DO 2 J = 1,3
VIJ = V(I,J,K)
AIJ = (A(I,J,K) + 2.*(A(I,J,L) + A3(I,J)) + A4(I,J))/6.
A(I,J,L) = AIJ
AIJDT = AIJ*DT
V(I,J,L) = VIJ + AIJDT
2 X(I,J,L) = X(I,J,K) + (VIJ + 0.5*AIJDT)*DT
T = T + DT
RETURN
END
SUBROUTINE SCLEAR
COMMON /STORE/ N,INDEXS(14)
N = 0
DO 1 I = 1,14
1 INDEXS(I) = 14 - I + 1
RETURN
END
SUBROUTINE SGRAB(IT)
COMMON /STORE/ N,INDEXS(14)
IT = INDEXS(N)
N = N - 1
RETURN
END
SUBROUTINE SFREE(IT)
COMMON /STORE/ N,INDEXS(14)
IF (IT .LE. 0) RETURN
N = N + 1
INDEXS(N) = IT
IT = 0
RETURN
END
SUBROUTINE MILNE(N,T,T1,DT,EPS,NSTEP)
Chase along according to the Milne predictor-corrector scheme.
C 1) Predict: Fit a parabola to the last three a's. (k-2,k-1,k)
C Integrate from (k-3) to (k+1) giving v(k+1)
C Fit a parabola to the latest v's (k-1,k,k+1)
C Integrate from (k-1) to (k+1) giving x(k+1)
C Compute a(kp1) at x(k+1), i.e. a(t + dt).
C 2) Correct: Repeat the prediction step, using k-1,k,k+1.
C There are details. By integrating from (k-3) to (k+1) we have a
C symmetrical region of the parabola fitted to (k-1),(k),(k+1),
C which means that P4 is exact for cubics.
C Secondly, the correction step doesn't need to extrapolate
C because we have an estimate for (k+1). (The whole point!)
C 3) Check: The difference between the predicted and corrected a's.
C Instead of iterating the corrector until (pred - corr) is small,
C which involves repeated evaluations of the a's at the various
C corrected x's, all of which are more or less at the same point,
C the scheme here is to refine the sampling of the whole interval
C x(k) to x(k+1) by halving the step size, thereby sampling the
C behaviour at a more even spread of positions.
IMPLICIT REAL*8 (A-H,O-Z)
COMMON /STORE/ NAVAIL,INDEXS(14)
COMMON /PLACE/ X(100,3,14),V(100,3,14),A(100,3,14)
REAL*8 EXTRAP(100,3)
Compute assorted integrals.
P4(Y1,Y2,Y3) = 2.*(Y1 + Y3) - Y2
P3(Y1,Y2,Y3) = Y1 + Y3 + 4.*Y2
P24(Y1,Y2,Y3) = 2.*Y3 - Y1 + 11.*Y2
KMAX = 14
BB = 0
NSTEP = 0
C
Concoct a past history from which to extrapolate.
DO 1 K = 1,3
CALL RUNGE(K,K + 1,N,T,DT)
CALL JOIN(K,K + 1,N)
1 CONTINUE
KP1 = 5
K = 4
KL1 = 3
KL2 = 2
KL3 = 1
KL4 = 0
KL5 = 0
KL6 = 0
NAVAIL = 0
DO 2 I = 6,KMAX
NAVAIL = NAVAIL + 1
2 INDEXS(NAVAIL) = KMAX - I + 6
C
Cook up an estimate of the A's at KP1, one time step ahead.
10 H3 = DT/3
H4 = DT*4/3
C WRITE (6,666) NSTEP,T,DT, NAVAIL,KL6,KL5,KL4,KL3,KL2,KL1,K,KP1
666 FORMAT (I4,F7.2,F9.4,14X ,I3,':',8I3)
DO 11 I = 1,N
DO 11 J = 1,3
VT = V(I,J,KL3) + H4*P4(A(I,J,KL2),A(I,J,KL1),A(I,J,K))
V(I,J,KP1) = VT
X(I,J,KP1) = X(I,J,KL1) + H3*P3(V(I,J,KL1),V(I,J,K),VT)
11 CONTINUE
C
Compute the A's at the extrapolated position, thus involving the DE.
CALL NEWT(X(1,1,KP1),EXTRAP,N)
C
Correct the X's and V's now that the story at KP1 is known (sortof).
20 DO 21 I = 1,N
DO 21 J = 1,3
VT = V(I,J,KL1) + H3*P3(A(I,J,KL1),A(I,J,K),EXTRAP(I,J))
V(I,J,KP1) = VT
X(I,J,KP1) = X(I,J,KL1) + H3*P3(V(I,J,KL1),V(I,J,K),VT)
21 CONTINUE
C
Calculate new A's to ensure a coherent solution of the DE.
CALL NEWT(X(1,1,KP1),A(1,1,KP1),N)
C
Compare the provisional and the accepted A's.
30 B = 0
DO 32 I = 1,N
D = 0.
DP = 0.
DC = 0.
DO 31 J = 1,3
AP = EXTRAP(I,J)
AC = A(I,J,KP1)
D = D + (AP - AC)**2
DP = DP + AP*AP
DC = DC + AC*AC
31 CONTINUE
DPC = DP + DC
IF (DPC .LE. 0.0) DPC = 1
D = D/DPC
32 IF (D .GT. B) B = D
IF (B .GT. BB) BB = B
C WRITE (6,667) B,NAVAIL,KL6,KL5,KL4,KL3,KL2,KL1,K,KP1
667 FORMAT (20X, F14.11,I3,':',8I3)
IF (B .LT. EPS) GO TO 50
C
Chop the step size in half. Interpolate IL1, IL3
40 CALL SFREE(KL6)
CALL SFREE(KL5)
CALL SFREE(KL4)
CALL SFREE(KL3)
CALL SGRAB(IL3)
CALL SGRAB(IL1)
H24 = DT/24
DO 41 I = 1,N
DO 41 J = 1,3
AK = A(I,J,K)
AKL1 = A(I,J,KL1)
AKL2 = A(I,J,KL2)
VKL1 = V(I,J,KL1)
VIL1 = VKL1 + H24*P24(AKL2,AKL1,AK)
VIL3 = VKL1 - H24*P24(AK,AKL1,AKL2)
V(I,J,IL3) = VIL3
V(I,J,IL1) = VIL1
VK = V(I,J,K)
VKL2 = V(I,J,KL2)
XKL1 = X(I,J,KL1)
XIL1 = XKL1 + H24*P24(VKL2,VKL1,VK)
XIL3 = XKL1 - H24*P24(VK,VKL1,VKL2)
X(I,J,IL3) = XIL3
41 X(I,J,IL1) = XIL1
CALL NEWT(X(1,1,IL1),A(1,1,IL1),N)
CALL NEWT(X(1,1,IL3),A(1,1,IL3),N)
KL4 = KL2
KL3 = IL3
KL2 = KL1
KL1 = IL1
DT = DT/2
GO TO 10
C
Complete the step by advancing all fingers.
50 NSTEP = NSTEP + 1
T = T + DT
CALL SFREE(KL6)
KL6 = KL5
KL5 = KL4
KL4 = KL3
KL3 = KL2
KL2 = KL1
KL1 = K
K = KP1
CALL SGRAB(KP1)
CALL JOIN(KL1,K,N)
IF (T .GE. T1) GO TO 100
C
Consider doubling the step size.
60 IF (B .GE. EPS/36) GO TO 10
IF (KL4*KL5*KL6 .LE. 0) GO TO 10
C WRITE (6,668) NAVAIL,KL6,KL5,KL4,KL3,KL2,KL1,K,KP1
668 FORMAT (34X, I3,':',8I3)
CALL SFREE(KL1)
CALL SFREE(KL3)
CALL SFREE(KL5)
KL1 = KL2
KL2 = KL4
KL3 = KL6
KL4 = 0
KL5 = 0
KL6 = 0
DT = DT*2
GO TO 10
Completed.
100 CALL PLOTXY(0.0,0.0,999)
WRITE (6,*) "Bmax=",BB
CALL PRINT(X(1,1,K),V(1,1,K),1,N)
RETURN
END
SUBROUTINE JOIN(K,L,N)
IMPLICIT REAL*8 (A-H,O-Z)
REAL U,V
COMMON /PLACE/ X(100,3,14)
COMMON /SCOPE/ IU,IV,UMIN,VMIN,US,VS
DO 1 I = 1,N
U = (X(I,IU,K) - UMIN)*US
V = (X(I,IV,K) - VMIN)*VS
CALL PLOTXY(U,V,3)
U = (X(I,IU,L) - UMIN)*US
V = (X(I,IV,L) - VMIN)*VS
C CALL PLOTXY(U,V,2)
IT = MOD(I,14)
CALL SYMBXY(U,V,0.05,IT,0.0,-2)
1 CONTINUE
RETURN
END
SUBROUTINE PRINT(X,V,IST,LST)
IMPLICIT REAL*8 (A-H,O-Z)
REAL*8 X(100,3),V(100,3)
IF (IST.GT.LST) RETURN
DO 3 I = IST,LST
RXYZ = 0.0
VXYZ = 0.0
DO 1 J = 1,3
RXYZ = RXYZ + X(I,J)**2
1 VXYZ = VXYZ + V(I,J)**2
RXYZ = DSQRT(RXYZ)
VXYZ = DSQRT(VXYZ)
WRITE (6,2) I,(X(I,J),J = 1,3),RXYZ,(V(I,J),J = 1,3),VXYZ
2 FORMAT (I3,2(4F8.5,3X))
3 CONTINUE
RETURN
END
FUNCTION PE(N,L)
IMPLICIT REAL*8 (A-H,O-Z)
REAL*8 M(100)
COMMON /CONST/ G,CLOSE,M
COMMON /PLACE/ X(100,3,14)
T = 0
NL1 = 1
DO 2 I = 1,NL1
IP1 = I + 1
DO 2 J = IP1,N
R2 = 0.0
DO 1 K = 1,3
1 R2 = R2 + (X(I,K,L) - X(J,K,L))**2
2 T = T - M(I)*M(J)/DSQRT(R2)
PE = G*T
RETURN
END
REAL FUNCTION KE(N,L)
IMPLICIT REAL*8 (A-H,O-Z)
REAL*8 M(100)
COMMON /CONST/ G,CLOSE,M
COMMON /PLACE/ X(100,3,14),V(100,3,14)
T = 0
DO 2 I = 1,N
V2 = 0
DO 1 J = 1,3
1 V2 = V2 + V(I,J,L)**2
2 T = T + M(I)*V2
KE = T/2
RETURN
END
SUBROUTINE COM(N,L,TM,W,P)
Centre of mass.....
IMPLICIT REAL*8 (A-H,O-Z)
REAL*8 M(100),W(3),P(3)
COMMON /PLACE/ X(100,3,14),V(100,3,14)
COMMON /CONST/ G,CLOSE,M
DO 1 I = 1,3
W(I) = 0
1 P(I) = 0
TM = 0
DO 2 I = 1,N
TM = TM + M(I)
DO 2 J = 1,3
W(J) = W(J) + M(I)*X(I,J,L)
2 P(J) = P(J) + M(I)*V(I,J,L)
DO 3 J = 1,3
W(J) = W(J)/TM
3 P(J) = P(J)/TM
RETURN
END
IMPLICIT REAL*8 (A-H,O-Z)
LOGICAL PRANGE,ROTATE,DIVE
LOGICAL ASIS
INTEGER FANCY
INTEGER DEVICE(10),CARDS,BLANK
REAL*8 M(100)
REAL*8 XMIN(3),XMAX(3),W(3),P(3)
REAL XSIZE,YSIZE,B,BLOAT
COMMON /PLOTIT/ ROTATE,DIVE,DEVICE,BLOAT
COMMON /CONST/ G,CLOSE,M
COMMON /PLACE/ X(100,3,14),V(100,3,14),A(100,3,14)
COMMON /SCOPE/ IU,IV,UMIN,VMIN,US,VS
COMMON LINPR,CARDS
DATA BLANK/' '/
DIVE = .FALSE.
DIVE = .TRUE.
ASIS = .FALSE.
CARDS = 5
LINPR = 6
IN = 10
XSIZE = 9
YSIZE = 4.75
DEVICE(1) = BLANK
BLOAT = 10/(0.5 + 7.1)
WRITE (LINPR,1)
1 FORMAT (' Star Trails.')
IF (.NOT.DIVE) WRITE (LINPR,2)
2 FORMAT (' Enter size, (4.75 or 10.5)')
IF (.NOT.DIVE) READ (CARDS,*) XSIZE
YSIZE = XSIZE
IN = 10
OPEN (IN,FILE="TCL.dat")
READ (IN,*) N
WRITE (LINPR,*) N," bodies."
READ (IN,*) G
WRITE (LINPR,*) G," gravitational constant."
READ (IN,*) T1,DT
WRITE (LINPR,*) T1,DT," Run time, time step."
READ (IN,*) XMIN,XMAX
DO 3 I = 1,N
READ (IN,*) M(I),(X(I,J,1), J = 1,3),(V(I,J,1),J = 1,3)
DO 3 J = 1,3
A(I,J,1) = 0
3 CONTINUE
CLOSE (IN)
c WRITE (LINPR,4) N
IST = 1
LST = 3
4 FORMAT (' The first and last body to show (of',I3,')')
c READ (CARDS,*) IST,LST
FANCY = 1
WRITE (LINPR,5)
5 FORMAT (' Euler/2''nd/Runge/Milne (1/2/3/4)')
READ (CARDS,*) FANCY
c WRITE (LINPR,6)
c 6 FORMAT (' Centre of mass (T/F)')
c READ (CARDS,*) ASIS
ASIS = .NOT.ASIS
C
10 DO 11 I = 1,3
IF (XMIN(I) .GE. XMAX(I)) GO TO 12
11 CONTINUE
GO TO 15
12 DO 13 I = 1,3
XMIN(I) = X(1,I,1)
13 XMAX(I) = X(1,I,1)
DO 14 I = 1,N
DO 14 J = 1,3
XMIN(J) = DMIN1(XMIN(J),X(I,J,1))
14 XMAX(J) = DMAX1(XMAX(J),X(I,J,1))
15 CLOSE = 0
DO 16 I = 1,3
16 CLOSE = CLOSE + (XMAX(I) - XMIN(I))**2
IF (ASIS) GO TO 20
CALL COM(N,1,TM,W,P)
DO 17 I = 1,N
DO 17 J = 1,3
17 V(I,J,1) = V(I,J,1) - P(J)
C
20 IU = 1
IV = 2
UMIN = XMIN(IU)
VMIN = XMIN(IV)
B = 0.5
US = (XSIZE - 0)/(XMAX(IU) - UMIN)
VS = (YSIZE - 0)/(XMAX(IV) - VMIN)
IF (.NOT.PRANGE(-B,XSIZE + B,-B,YSIZE + B)) STOP
CALL DOBOX(0.0,0.0,XSIZE,YSIZE)
C
100 T0 = 0
T = T0
NSTEP = T1/DT + 0.5
IF (IST .LE. LST) WRITE (LINPR,101)
101 FORMAT (8X,'x y z R',
1 9X,'vx vy vz V')
IF (IST .LE. LST) CALL PRINT(X,V,IST,LST)
IF (FANCY .EQ. 4) GO TO 200
I1 = 1
I2 = 2
DO 110 I = 1,NSTEP
IF (FANCY .EQ. 1) CALL EULER(I1,I2,N,T,DT)
IF (FANCY .EQ. 2) CALL LUNGE(I1,I2,N,T,DT)
IF (FANCY .EQ. 3) CALL RUNGE(I1,I2,N,T,DT)
WRITE (LINPR,*) "T=",T
CALL JOIN(I1,I2,N)
CALL SWAPI(I1,I2)
IF (IST .LE. LST) CALL PRINT(X(1,1,I1),V(1,1,I1),1,N)
110 CONTINUE
GO TO 9000
C
200 EPS = 1
201 EPS = EPS/2
IF (1 + EPS .NE. 1) GO TO 201
EPS = EPS*2
CALL MILNE(N,T,T1,DT,EPS,NSTEP)
C
9000 IF (FANCY .NE. 4) CALL PLOTXY(0.0,0.0,999)
WRITE (LINPR,*) "Reached T=",T
WRITE (LINPR,*) "Target T=",T1
WRITE (LINPR,*) "Time step=",DT,"Nstep=",NSTEP
IF (FANCY .NE. 4) CALL PRINT(X(1,1,I1),V(1,1,I1),1,N)
CLOSE = DSQRT(CLOSE)
WRITE (LINPR,9001) CLOSE
9001 FORMAT (' Closest approach:',E15.6)
END
 

Results[edit]

TCL matching?[edit]

I have been unable to follow the exact workings of the TCL example in the absence of annotations, in particular whether I am looking at x1 x2 x3 y1 y2 y3 z1 z2 z3 or, x1 y1 z1, etc. My file TCL.dat is as follows:

3                    Bodies
0.01                 Gravitational constant.
0.2, 0.01            Run time, time step.
-2 -2 -2, +2 +2 +2   xyzmin, xyzmax for plot scaling
1,      0 0 0,  0.01  0     0          Mass, xyz Position, xyz Velocity
0.1,    1 1 0,  0     0     0.02
0.001   0 1 1,  0.01 -0.01 -0.01

This relies on Fortran's free-format reading looking only for the requested count of numbers on a line, so that what follows is ignored and so can be annotation. More generally, with this style of input a / character indicates an in-line comment and is treated as end-of-line for the reading of values. Output:

 Star Trails.
           3  bodies.
  1.000000000000000E-002  gravitational constant.
  0.200000000000000       1.000000000000000E-002  Run time, time step.
 Euler/2'nd/Runge/Milne (1/2/3/4)
1
        x       y       z       R         vx      vy      vz       V
  1 0.00000 0.00000 0.00000 0.00000    0.01000 0.00000 0.00000 0.01000
  2 1.00000 1.00000 0.00000 1.41421    0.00000 0.00000 0.02000 0.02000
  3 0.00000 1.00000 1.00000 1.41421    0.01000-0.01000-0.01000 0.01732
 T=  1.000000000000000E-002
  1 0.00010 0.00000 0.00000 0.00010    0.01000 0.00000 0.00000 0.01000
  2 1.00000 1.00000 0.00020 1.41421   -0.00004-0.00004 0.02000 0.02000
  3 0.00010 0.99990 0.99990 1.41407    0.01000-0.01004-0.01004 0.01737
 T=  2.000000000000000E-002
  1 0.00020 0.00000 0.00000 0.00020    0.01001 0.00001 0.00000 0.01001
  2 1.00000 1.00000 0.00040 1.41421   -0.00007-0.00007 0.02000 0.02000
  3 0.00020 0.99980 0.99980 1.41393    0.01001-0.01007-0.01008 0.01741
 T=  3.000000000000000E-002
  1 0.00030 0.00000 0.00000 0.00030    0.01001 0.00001 0.00000 0.01001
  2 1.00000 1.00000 0.00060 1.41421   -0.00011-0.00011 0.02000 0.02000
  3 0.00030 0.99970 0.99970 1.41379    0.01001-0.01011-0.01012 0.01746
 T=  4.000000000000000E-002
  1 0.00040 0.00000 0.00000 0.00040    0.01001 0.00001 0.00000 0.01001
  2 1.00000 1.00000 0.00080 1.41421   -0.00014-0.00014 0.02000 0.02000
  3 0.00040 0.99960 0.99960 1.41364    0.01001-0.01014-0.01016 0.01750
 T=  5.000000000000000E-002
  1 0.00050 0.00000 0.00000 0.00050    0.01002 0.00002 0.00000 0.01002
  2 1.00000 1.00000 0.00100 1.41421   -0.00018-0.00018 0.02000 0.02000
  3 0.00050 0.99950 0.99950 1.41350    0.01002-0.01018-0.01019 0.01755
 T=  6.000000000000000E-002
  1 0.00060 0.00000 0.00000 0.00060    0.01002 0.00002 0.00000 0.01002
  2 0.99999 0.99999 0.00120 1.41421   -0.00021-0.00021 0.02000 0.02000
  3 0.00060 0.99939 0.99939 1.41336    0.01002-0.01021-0.01023 0.01759
 T=  7.000000000000001E-002
  1 0.00070 0.00000 0.00000 0.00070    0.01002 0.00003 0.00000 0.01002
  2 0.99999 0.99999 0.00140 1.41420   -0.00025-0.00025 0.02000 0.02000
  3 0.00070 0.99929 0.99929 1.41321    0.01002-0.01025-0.01027 0.01764
 T=  8.000000000000000E-002
  1 0.00080 0.00000 0.00000 0.00080    0.01003 0.00003 0.00000 0.01003
  2 0.99999 0.99999 0.00160 1.41420   -0.00028-0.00028 0.02000 0.02000
  3 0.00080 0.99919 0.99919 1.41307    0.01003-0.01028-0.01031 0.01768
 T=  9.000000000000000E-002
  1 0.00090 0.00000 0.00000 0.00090    0.01003 0.00003 0.00000 0.01003
  2 0.99999 0.99999 0.00180 1.41419   -0.00032-0.00032 0.02000 0.02001
  3 0.00090 0.99909 0.99908 1.41292    0.01003-0.01032-0.01035 0.01773
 T=  0.100000000000000
  1 0.00100 0.00000 0.00000 0.00100    0.01004 0.00004 0.00000 0.01004
  2 0.99998 0.99998 0.00200 1.41419   -0.00035-0.00035 0.02000 0.02001
  3 0.00100 0.99898 0.99898 1.41277    0.01004-0.01035-0.01039 0.01777
 T=  0.110000000000000
  1 0.00110 0.00000 0.00000 0.00110    0.01004 0.00004 0.00000 0.01004
  2 0.99998 0.99998 0.00220 1.41418   -0.00039-0.00039 0.02000 0.02001
  3 0.00110 0.99888 0.99888 1.41263    0.01004-0.01039-0.01043 0.01782
 T=  0.120000000000000
  1 0.00120 0.00000 0.00000 0.00120    0.01004 0.00004 0.00000 0.01004
  2 0.99997 0.99997 0.00240 1.41418   -0.00042-0.00042 0.02000 0.02001
  3 0.00120 0.99877 0.99877 1.41248    0.01004-0.01042-0.01047 0.01786
 T=  0.130000000000000
  1 0.00130 0.00000 0.00000 0.00130    0.01005 0.00005 0.00000 0.01005
  2 0.99997 0.99997 0.00260 1.41417   -0.00046-0.00046 0.02000 0.02001
  3 0.00130 0.99867 0.99867 1.41233    0.01005-0.01046-0.01051 0.01791
 T=  0.140000000000000
  1 0.00140 0.00000 0.00000 0.00140    0.01005 0.00005 0.00000 0.01005
  2 0.99997 0.99997 0.00280 1.41417   -0.00050-0.00050 0.02000 0.02001
  3 0.00140 0.99857 0.99856 1.41218    0.01005-0.01050-0.01055 0.01795
 T=  0.150000000000000
  1 0.00150 0.00000 0.00000 0.00150    0.01005 0.00005 0.00000 0.01005
  2 0.99996 0.99996 0.00300 1.41416   -0.00053-0.00053 0.02000 0.02001
  3 0.00150 0.99846 0.99846 1.41203    0.01005-0.01053-0.01058 0.01800
 T=  0.160000000000000
  1 0.00160 0.00000 0.00000 0.00160    0.01006 0.00006 0.00000 0.01006
  2 0.99995 0.99995 0.00320 1.41415   -0.00057-0.00057 0.02000 0.02002
  3 0.00160 0.99835 0.99835 1.41188    0.01006-0.01057-0.01062 0.01805
 T=  0.170000000000000
  1 0.00171 0.00001 0.00000 0.00171    0.01006 0.00006 0.00000 0.01006
  2 0.99995 0.99995 0.00340 1.41415   -0.00060-0.00060 0.02000 0.02002
  3 0.00171 0.99825 0.99824 1.41173    0.01006-0.01060-0.01066 0.01809
 T=  0.180000000000000
  1 0.00181 0.00001 0.00000 0.00181    0.01006 0.00006 0.00000 0.01006
  2 0.99994 0.99994 0.00360 1.41414   -0.00064-0.00064 0.02000 0.02002
  3 0.00181 0.99814 0.99814 1.41158    0.01006-0.01064-0.01070 0.01814
 T=  0.190000000000000
  1 0.00191 0.00001 0.00000 0.00191    0.01007 0.00007 0.00000 0.01007
  2 0.99994 0.99994 0.00380 1.41413   -0.00067-0.00067 0.02000 0.02002
  3 0.00191 0.99804 0.99803 1.41143    0.01007-0.01067-0.01074 0.01818
 T=  0.200000000000000
  1 0.00201 0.00001 0.00000 0.00201    0.01007 0.00007 0.00000 0.01007
  2 0.99993 0.99993 0.00400 1.41412   -0.00071-0.00071 0.02000 0.02002
  3 0.00201 0.99793 0.99792 1.41128    0.01007-0.01071-0.01078 0.01823
 Reached T=  0.200000000000000
 Target  T=  0.200000000000000
 Time step=  1.000000000000000E-002 Nstep=          20
  1 0.00201 0.00001 0.00000 0.00201    0.01007 0.00007 0.00000 0.01007
  2 0.99993 0.99993 0.00400 1.41412   -0.00071-0.00071 0.02000 0.02002
  3 0.00201 0.99793 0.99792 1.41128    0.01007-0.01071-0.01078 0.01823
 Closest approach:   0.140874E+01

Preparing parameters[edit]

Another possible run is for the earth's orbit. For a circular orbit, taking the unit of distance being its radius, the unit of mass being the sun, and the unit of time being a year, G comes out as though not as a pure number, its has the usual dimensions. Finding a coherent set of values for the Sun-Earth-Moon system was frustrating as the internet is littered with different values. Referring to the CRC handbook (87'th edition, 2006-7), G = 6·6742(10)±0·0031 E-11, Ms = 1·98844E30 Kg, Me = 5·9742E24 Kg, Mm = 7·3483E22 Kg, Re = 1AU = 1·49597870E11 metres (actually the semi-major axis), Rm = 3·844E8 metres. However, the handbook also contains varying values, such as for the mass of the sun. Notoriously, the value of G is both difficult to measure and varying in result. My copy of Resnick & Halliday (1966) has 6·670±0·015 for example.

The idea was to start with an initial state having the Sun, Earth and Moon all in a straight line along the x-axis, but after some ad-hoc messing about, confusions escalated to the degree that an ad-hoc calculation prog. was in order. This turns out to need a cube root function, and a proper solution for this raises again the utility of palindromic functions. Later Fortran supplies intrinsic functions such as EXPONENT(x) which returns the exponent part of the floating-point number, x and extracting this would be useful in devising an initial value for an iterative refinement calculation. Clearly, one wants power/3 for this, and so being able to write something like EXPONENT(t) = EXPONENT(x)/3 would help, along with similar usage of the FRACTION(x) function - omitting details such as the remainder when the power is divided by three. The same ideas arise with the square root function, though here, SQRT is already supplied. Alas, only the SUBSTR intrinsic function of pl/i has palindromic usage.

 
Calculate some parameters for the solar system of Sun, Earth and Moon.
IMPLICIT REAL*8 (A-Z) !No integers need apply.
CBRT(X) = SIGN(EXP(LOG(ABS(X))/3),X) !Crude. Fails for zero.
PI = 4*ATAN(1D0)
G = 6.674210D-11 !Gravitational constant, MKS units.
MS = 1.98844D+30 !Mass of the sun.
ME = 5.9742D+24 !Mass of the earth.
MM = 7.3483D+22 !Mass of the moon.
RE = 1.49597870D+11 !Radius of the earth's orbit around the sun. 1 Astronomical Unit = semi-major axis.
RM = 3.844D+8 !Radius of the moon's orbit around the earth.
YS = 31556925.9747D0 !Earth's tropical year, in seconds. This includes precession.
Y = YS/24/3600 !In days. This is *not* the proper orbit-repetition time!
 
WRITE (6,*) Y,"Tropical year, days."
WRITE (6,*) "Earth's orbit taken as circular, but using Rmax."
WRITE (6,*) 2*PI*SQRT(RE**3/(G*MS))/3600/24,"Year, in days"
WRITE (6,*) 2*PI*SQRT(RE**3/(G*(MS + ME)))/3600/24,"Me included."
RC = CBRT(G*(MS + ME)*YS**2/(4*PI**2))
WRITE (6,*) "Circular orbit of period one tropical year."
WRITE (6,*) RC,"Rc: Earth's circular orbit radius."
WRITE (6,*) RE,"Re: Actual semi-major axis."
WRITE (6,*) RE - RC,"Re - Rc"
OS = RC*ME/MS
WRITE (6,*) OS ,"Os: Sun's offset from CoM due to Earth at Rc."
VE = 2*PI*RC/YS
WRITE (6,*) VE,"Ve: Earth's circular orbit velocity."
WS = 2*PI*OS/YS
WRITE (6,*) WS,"Ws: Sun's circular orbit velocity due to Earth."
 
WRITE (6,*)
WRITE (6,*) RM,"Rm: radius of the moon's orbit around the earth."
TM = 2*PI*SQRT(RM**3/(G*(ME + MM)))/3600/24
WRITE (6,*) TM,"Tm: time for the moon's circular orbit, days."
OE = RM*MM/ME
WRITE (6,*) OE,"Oe: Earth's offset from CoM due to Moon at Rm."
VM = 2*PI*RM/(TM*3600*24)
WRITE (6,*) VM,"Vm: Moon's circular orbit velocity."
WE = 2*PI*OE/(TM*3600*24)
WRITE (6,*) WE,"We: Earth's circular orbit velocity due to Moon."
Combine the offsets and wobbles for the Sun-----Earth-Moon in a straight line
WRITE (6,*)
WRITE (6,*) " (CoM)"
WRITE (6,*) "Sun--0-----------------------------Earth--Moon-->x"
RC = CBRT(G*(MS + ME + MM)*YS**2/(4*PI**2))
WRITE (6,*) RC," Rc: Earth's circular orbit for Sun+Earth+Moon."
SX = -(ME*(RC - OE) + MM*(RC + RM))/MS
WRITE (6,*) SX," Sx: Sun's x-position, offset by Earth+Moon."
SVY = 2*PI*SX/YS
WRITE (6,*) SVY,"SVy: Sun's y-velocity."
EX = RC - OE
WRITE (6,*) EX," Ex: Earth's x-position, offset by Moon."
EVY = VE - WE
WRITE (6,*) EVY,"EVy: Earth's y-velocity."
MX = RC + RM
WRITE (6,*) MX," Mx: Moon's x-position."
MVY = VE + VM
WRITE (6,*) MVY,"MVy: Moon's y-velocity."
Convert to 'AU', being one earth orbit radius for a circular orbit taking one year.
WRITE (6,10)
10 FORMAT (/," Time in years, masses in suns, distances in 'AU'",
1 /,12X,"Solar masses x-position y-velocity.")
WRITE (6,11) "Sun",1.0,SX/RC,SVY/RC*YS
WRITE (6,11) "Earth",ME/MS,EX/RC,EVY/RC*YS
WRITE (6,11) "Moon",MM/MS,MX/RC,MVY/RC*YS
11 FORMAT (A6,3F18.14)
WRITE (6,*)
WRITE (6,*) 4*PI**2,"4Pi^2: G in AU/year units."
WRITE (6,*) 2*PI,"2Pi: distance per year for R = 1."
END
 

Notably, wanting a circular orbit to ease inspection of the results meant that the actual semi-major axis of the earth's elliptical orbit could not be used as in the first trials. Instead, the orbital period was taken as a year (wrongly so, as this includes the precession of the earth's axis of revolution, with a period of about 26,000 years) and the radius of a circular orbit having that period determined. This however is affected by whether the calculation is for the sun alone (so, a massless Earth), or, the sun and the earth together, or the sun, earth and moon together. As well, there is no z-action: the moon's orbital plane is deemed the same as that of the earth and it isn't. Results:

  365.242198781250      Tropical year, days.
Earth's orbit taken as circular, but using Rmax.
  365.256591252027      Year, in days
  365.256042552793      Me included.
Circular orbit of period one tropical year.
  149594089981.644      Rc: Earth's circular orbit radius.
  149597870000.000      Re: Actual semi-major axis.
  3780018.35565186      Re - Rc
  449450.329086289      Os: Sun's offset from CoM due to Earth at Rc.
  29785.1377845590      Ve: Earth's circular orbit velocity.
 8.948842819120138E-002 Ws: Sun's circular orbit velocity due to Earth.

  384400000.000000      Rm: radius of the moon's orbit around the earth.
  27.2801498336002      Tm: time for the moon's circular orbit, days.
  4728141.87673663      Oe: Earth's offset from CoM due to Moon at Rm.
  1024.71419780640      Vm: Moon's circular orbit velocity.
  12.6040429509235      We: Earth's circular orbit velocity due to Moon.

   (CoM)
Sun--0-----------------------------Earth--Moon-->x
  149594091824.393       Rc: Earth's circular orbit for Sun+Earth+Moon.
 -454978.599317466       Sx: Sun's   x-position, offset by Earth+Moon.
-9.058914206677031E-002 SVy: Sun's   y-velocity.
  149589363682.517       Ex: Earth's x-position, offset by Moon.
  29772.5337416081      EVy: Earth's y-velocity.
  149978491824.393       Mx: Moon's  x-position.
  30809.8519823654      MVy: Moon's  y-velocity.

Time in years, masses in suns, distances in 'AU'
           Solar masses        x-position        y-velocity.
  Sun  1.00000000000000 -0.00000304142091 -0.00001910981119
Earth  0.00000300446581  0.99996839352531  6.28052640251386
 Moon  0.00000003695510  1.00256962019898  6.49934904809141

  39.4784176043574      4Pi^2: G in AU/year units.
  6.28318530717959      2Pi: distance per year for R = 1.

Sun-Earth-Moon[edit]

This leads to file SEM.dat, as follows:

3                    Bodies
39.478417604357434   G = 4Pi**2: Solar mass = 1, Earth's circular equivalent-time orbit radius = 1, time unit = 1 year.
1.0, 0.001           Run time, time step. (years)
-2 -2 -2, +2 +2 +2   xyzmin, xyzmax for plot scaling
1,               -0.00000304142091 0 0,   0 -0.00001910981119 0      Solar Mass,  xyz Position, xyz Velocity
3.00446581E-6,    0.99996839352531 0 0,   0  6.28052640251386 0      Earth completes one circle of radius 1 in 1 year, so V = 2Pi AU/year.
3.69551E-8,       1.00256962019898 0 0,   0  6.49934904809141 0      Sun-Earth-Moon in a straight line along the x-axis.

The initial results...

 Star Trails.
           3  bodies.
   39.4784176043574       gravitational constant.
   1.00000000000000       1.000000000000000E-003  Run time, time step.
 Euler/2'nd/Runge/Milne (1/2/3/4)
3
        x       y       z       R         vx      vy      vz       V
  1 0.00000 0.00000 0.00000 0.00000    0.00000-0.00002 0.00000 0.00002
  2 0.99997 0.00000 0.00000 0.99997    0.00000 6.28053 0.00000 6.28053
  3 1.00257 0.00000 0.00000 1.00257    0.00000 6.49935 0.00000 6.49935
 T=  1.000000000000000E-003
  1 0.00000 0.00000 0.00000 0.00000    0.00000-0.00002 0.00000 0.00002
  2 0.99995 0.00628 0.00000 0.99997   -0.03927 6.28041 0.00000 6.28053
  3 1.00254 0.00650 0.00000 1.00256   -0.05678 6.49849 0.00000 6.49873
 T=  2.000000000000000E-003
  1 0.00000 0.00000 0.00000 0.00000    0.00000-0.00002 0.00000 0.00002
  2 0.99989 0.01256 0.00000 0.99997   -0.07853 6.28007 0.00000 6.28056
  3 1.00246 0.01300 0.00000 1.00254   -0.11343 6.49590 0.00000 6.49689
 T=  3.000000000000000E-003
  1 0.00000 0.00000 0.00000 0.00000    0.00000-0.00002 0.00000 0.00002
  2 0.99979 0.01884 0.00000 0.99997   -0.11780 6.27949 0.00000 6.28060
  3 1.00231 0.01949 0.00000 1.00250   -0.16981 6.49162 0.00000 6.49384
 T=  4.000000000000000E-003
  1 0.00000 0.00000 0.00000 0.00000    0.00000-0.00002 0.00000 0.00002
  2 0.99965 0.02512 0.00000 0.99997   -0.15706 6.27869 0.00000 6.28065
  3 1.00212 0.02598 0.00000 1.00245   -0.22579 6.48567 0.00000 6.48960
 T=  5.000000000000000E-003
  1 0.00000 0.00000 0.00000 0.00000    0.00000-0.00002 0.00000 0.00002
  2 0.99948 0.03140 0.00000 0.99997   -0.19633 6.27765 0.00000 6.28072
  3 1.00186 0.03246 0.00000 1.00239   -0.28125 6.47811 0.00000 6.48422
 T=  6.000000000000000E-003
  1 0.00000 0.00000 0.00000 0.00000    0.00000-0.00002 0.00000 0.00002
  2 0.99926 0.03767 0.00000 0.99997   -0.23559 6.27638 0.00000 6.28080
  3 1.00155 0.03893 0.00000 1.00231   -0.33606 6.46900 0.00000 6.47772
 T=  7.000000000000000E-003
  1 0.00000 0.00000 0.00000 0.00000    0.00000-0.00002 0.00000 0.00002
  2 0.99901 0.04395 0.00000 0.99997   -0.27486 6.27488 0.00000 6.28090
  3 1.00119 0.04540 0.00000 1.00222   -0.39013 6.45840 0.00000 6.47017
 T=  8.000000000000000E-003
  1 0.00000 0.00000 0.00000 0.00000    0.00000-0.00002 0.00000 0.00002
  2 0.99871 0.05022 0.00000 0.99997   -0.31412 6.27314 0.00000 6.28100
  3 1.00077 0.05185 0.00000 1.00212   -0.44335 6.44639 0.00000 6.46162
 T=  9.000000000000001E-003
  1 0.00000 0.00000 0.00000 0.00000    0.00000-0.00002 0.00000 0.00002
  2 0.99838 0.05650 0.00000 0.99998   -0.35339 6.27117 0.00000 6.28112
  3 1.00031 0.05829 0.00000 1.00200   -0.49563 6.43307 0.00000 6.45214
 T=  1.000000000000000E-002
  1 0.00000 0.00000 0.00000 0.00000    0.00000-0.00002 0.00000 0.00002
  2 0.99801 0.06277 0.00000 0.99998   -0.39265 6.26897 0.00000 6.28125
  3 0.99978 0.06472 0.00000 1.00188   -0.54689 6.41853 0.00000 6.44179

etc...

 T=  0.998000000000001     
  1 0.00000 0.00000 0.00000 0.00000    0.00000-0.00002 0.00000 0.00002
  2 0.99995-0.01262 0.00000 1.00003    0.07901 6.28523 0.00000 6.28573
  3 0.99728-0.01296 0.00000 0.99736    0.10301 6.07537 0.00000 6.07625
 T=  0.999000000000001     
  1 0.00000 0.00000 0.00000 0.00000    0.00000-0.00002 0.00000 0.00002
  2 1.00001-0.00633 0.00000 1.00003    0.03933 6.28558 0.00000 6.28570
  3 0.99737-0.00688 0.00000 0.99739    0.07940 6.07848 0.00000 6.07899
 T=   1.00000000000000     
  1 0.00000 0.00000 0.00000 0.00000    0.00000-0.00002 0.00000 0.00002
  2 1.00003-0.00005 0.00000 1.00003   -0.00034 6.28565 0.00000 6.28565
  3 0.99744-0.00080 0.00000 0.99744    0.05550 6.08257 0.00000 6.08283
 Reached T=   1.00000000000000     
 Target  T=   1.00000000000000     
 Time step=  1.000000000000000E-003 Nstep=        1000
  1 0.00000 0.00000 0.00000 0.00000    0.00000-0.00002 0.00000 0.00002
  2 1.00003-0.00005 0.00000 1.00003   -0.00034 6.28565 0.00000 6.28565
  3 0.99744-0.00080 0.00000 0.99744    0.05550 6.08257 0.00000 6.08283
 Closest approach:   0.260123E-02

Using instead the first-order method, a year into the calculation the results are not so good:

 T=  0.998000000000001     
  1 0.00000 0.00000 0.00000 0.00000    0.00000-0.00002 0.00000 0.00002
  2 1.02057-0.19728 0.00000 1.03947    1.16628 6.04742 0.00000 6.15886
  3 1.01296-0.09530 0.00000 1.01743    0.58893 6.20845 0.00000 6.23632
 T=  0.999000000000001     
  1 0.00000 0.00000 0.00000 0.00000    0.00000-0.00002 0.00000 0.00002
  2 1.02172-0.19123 0.00000 1.03947    1.13041 6.05436 0.00000 6.15898
  3 1.01353-0.08909 0.00000 1.01744    0.55096 6.21201 0.00000 6.23640
 T=   1.00000000000000     
  1 0.00000 0.00000 0.00000 0.00000    0.00000-0.00002 0.00000 0.00002
  2 1.02284-0.18518 0.00000 1.03946    1.09449 6.06108 0.00000 6.15911
  3 1.01406-0.08288 0.00000 1.01744    0.51297 6.21534 0.00000 6.23647
 Reached T=   1.00000000000000     
 Target  T=   1.00000000000000     
 Time step=  1.000000000000000E-003 Nstep=        1000
  1 0.00000 0.00000 0.00000 0.00000    0.00000-0.00002 0.00000 0.00002
  2 1.02284-0.18518 0.00000 1.03946    1.09449 6.06108 0.00000 6.15911
  3 1.01406-0.08288 0.00000 1.01744    0.51297 6.21534 0.00000 6.23647
 Closest approach:   0.163788E-02

The earth and moon go wandering. With too large a step size, the situation between steps can be very different from those at the start and stop of a step. The predictor-corrector scheme does better:

 Star Trails.
           3  bodies.
   39.4784176043574       gravitational constant.
   1.00000000000000       1.000000000000000E-003  Run time, time step.
 Euler/2'nd/Runge/Milne (1/2/3/4)
        x       y       z       R         vx      vy      vz       V
  1 0.00000 0.00000 0.00000 0.00000    0.00000-0.00002 0.00000 0.00002
  2 0.99997 0.00000 0.00000 0.99997    0.00000 6.28053 0.00000 6.28053
  3 1.00257 0.00000 0.00000 1.00257    0.00000 6.49935 0.00000 6.49935
 Bmax=  8.092753583528147E-010
  1 0.00000 0.00000 0.00000 0.00000    0.00000-0.00002 0.00000 0.00002
  2 1.00003-0.00007 0.00000 1.00003    0.00061 6.28576 0.00000 6.28576
  3 0.99733 0.00007 0.00000 0.99733   -0.01260 6.07555 0.00000 6.07556
 DTmin=  3.906250000000000E-006 , DTmax=  2.000000000000000E-003
 Reached T=   1.00001171874997     
 Target  T=   1.00000000000000     
 Time step=  5.000000000000000E-004 Nstep=        1755
 Closest approach:   0.260123E-02

Notice that it tries an increased time step but also a much smaller time step, in the end requiring 1,755 steps. Part of the project was to assess various schemes for changing the step size and on what basis. This also means that the calculation may well not produce results at desired times, not just because repeated addition of a floating-point number such as 0.001 may not produce a value such as 5.755 exactly, but also because the varying step size might hop past it.

More generally, when two bodies approach closely the resulting curvature forces a smaller step size, which is wasted when calculating details for widely-separated bodies. One ploy is to treat such pairs via two-body formulae (in their centre-of-mass coordinates) for the time of their closeness, retaining a larger time step for the rest of the calculation. This can be further generalised into clumping nearby bodies into a single mass when considering their effect on far-distant bodies. In all of this, the administration requirements become ever-more complex.

J[edit]

Although in general the n-body problem doesn’t have an explicit solution, certain configurations do, and these 'nice' configurations can be used to validate and perform unbiased comparisons of numeric solvers. A fairly simple configuration with an exact explicit solution is a radially symmetric system of three bodies orbiting at constant velocity around a central axis:

    Given:
  • n = 3 -- number of bodies
  • g = 1 -- gravitational constant
  • m = 1 -- mass per body
  • r = 1 -- radius
    Then:
  • f = (1/3)^(1/2) -- centripetal force
  • a = (1/3)^(1/2) -- centripetal acceleration
  • v = (1/3)^(1/4) -- velocity

This is a variation on the [Klemperer rosette[1]].

Implementing the physics

  • The problem space is a collection of objects.
  • Object is { id, mass, position, velocity }.
  • Position is { x, y, z }.
  • Velocity is { vx, vy, vz }.
g  =: 1
I =: 0&{"1
M =: 1&{"1
IM =: 0 1&{"1
D =: 3 : 0"1
2 3 4{y
:
2 3 4{y-x
)
V =: 5 6 7&{"1
D3 =: 4 : '(%:+/*:x D y)^3'"1
F =: 3 : 0"1
y F/y
:
g*(M x)*(M y)*(y D x) % (x D3 y)
)
A =: 3 : 0
ff =. y F/y
f =. +/ff
f % (M y)
)
NEXT =: 4 : 0
dt =. x
im =. IM y
p0 =. D y
v0 =. V y
f =. +/(F/~y)
a =. f%M y
v1 =. v0 + dt * a
p1 =. p0 + dt * (v0 + v1)%2
z =. |: ((|: im),(|: p1),(|: v1))
out =: out,D z
z
)

Integrator

Iterate over a time interval. Plot the results (x and y coordinates over time).

dt =: 0.001
maxn =: 20000
require'plot'
ITER =: 3 : 0
maxn ITER y
:
out =: (0,(#y),3)$0
dt NEXT^:x y
plot 0 1 { |: out
)

Configurations

Configuration generator

Generate a radially symmetrical configuration for a given number of bodies and an initial rotational velocity

require'trig'
GEN =: 3 : 0
1 GEN y
:
m =. 1
r =. 1
p =. r*(|:(2,y)$(cos,sin)(i.y)*2*pi%y),.0
v =. x*(|:(2,y)$(cos,sin)(pi%2)+(i.y)*2*pi%y),.0
(i.y),.(y#m),.p,.v
)
 
Generate a few cases.

The 3-body static equilibrium case is proposed as the basis for validation, and for comparison of alternative methods.

cases =: 3 : 0
case =. 3 : 'y;".y'
r =. 0 2 $ a:
r =. r, case 'GEN 4'
r =. r, case '0.75 GEN 3'
r =. r, case '((1%3)^(1%4)) GEN 3'
)
<[cases''
+------------------------------------------------------------------------------+
¦GEN 4 ¦0 1 1 0 0 6.12323e_17 1 0¦
¦ ¦1 1 6.12323e_17 1 0 _1 1.22465e_16 0¦
¦ ¦2 1 _1 1.22465e_16 0 _1.83697e_16 _1 0¦
¦ ¦3 1 _1.83697e_16 _1 0 1 _2.44929e_16 0¦
+-------------------+----------------------------------------------------------¦
¦0.75 GEN 3 ¦0 1 1 0 0 4.59243e_17 0.75 0 ¦
¦ ¦1 1 _0.5 0.866025 0 _0.649519 _0.375 0 ¦
¦ ¦2 1 _0.5 _0.866025 0 0.649519 _0.375 0 ¦
+-------------------+----------------------------------------------------------¦
¦((1%3)^(1%4)) GEN 3¦0 1 1 0 0 4.65265e_17 0.759836 0 ¦
¦ ¦1 1 _0.5 0.866025 0 _0.658037 _0.379918 0 ¦
¦ ¦2 1 _0.5 _0.866025 0 0.658037 _0.379918 0 ¦
+------------------------------------------------------------------------------+
 
Static equilibrium case.

Bodies orbit with constant kinetic energy.

maxn ITER z0 =: ((1%3)^(1%4)) GEN 3

[sinusoidal curves of constant amplitude[2]]

Determine orbital period, and compare configuration after two rotations vs. initial position.

 
v =: (1%3)^(1%4)
dt =: 0.001
<[rot2 =: (>. (4 * pi) % (v * dt)) NB. two rotations
+-----+
¦16539¦
+-----+
rot2 ITER v GEN 3
<[({.out)-{:out
+------------------------+
¦_0.00559932 0.0897287 0¦
| _0.0749077 _0.0497135 0¦
¦ 0.080507 _0.0400152 0¦
+------------------------+
 
Dynamic equilibrium case.

Within a narrow range of initial velocities, the bodies orbit, maintaining symetry and swapping kinetic and potential energy back and forth. The ideal system is stable, but an integrating solver will not be, due to numerical precision.

maxn ITER z1 =: 0.6 GEN 3

[sinusoidal curves of varying amplitudes [3]]

Perturbed case.

Any perturbation from symmetry, however small, will eventually cause the bodies to escape. Note that the effect demonstrated here is due to the physics of the problem, independently of the numerical precision and increment size of the solver.

maxn ITER z2 =: (0.001+6{0{z0)(<0 6)}z0

[curves start out nice then get jumbled and diverge [4]]

n>3

We can generate and execute tests for radially symmetrical configurations of any number of bodies, run the simulations, and compare the results with an explicitly determined result:

r  =. 4 : '%:+/*:(1-cos 2*pi*y%x),sin 2*pi*y%x'     NB. distance to nth body
f0 =. 4 : '1%((x r y)^2)' NB. force due to nth body
f =. 4 : '(x f0 y)*(1-cos 2*pi*y%x)%x r y'"0 NB. centripetal component of force
a =. 3 : '+/(y f i. y)' NB. centripetal acceleration
GENM =: 3 : 0"0 NB. accumulated discrepancy over one rotation for n bodies
N =: y NB. number of bodies
VS =: (a N)^0.5 NB. velocity for static equilibrium
TS =: 2*pi%VS NB. rotational time
dt =: 0.001 NB. time increment for simulation
IS =: >.2*pi%VS*dt NB. number of steps for simulation
IS ITER VS GEN N NB. run the simulation
E =: >./>./({.out)-{:out NB. get max difference between initial and final state
N;VS;TS;E NB. return the results
)
smoutput ' n';'velocity';' period';' error'
smoutput GENM 3+i.17
+-----------------------------+
¦ n¦velocity¦ period¦ error¦
+--+--------+-------+---------¦
¦3 ¦0.759836¦8.26914¦0.0225829¦
+--+--------+-------+---------¦
¦4 ¦0.978318¦6.42243¦0.0293585¦
+--+--------+-------+---------¦
¦5 ¦1.17319 ¦5.35563¦0.0354237¦
+--+--------+-------+---------¦
¦6 ¦1.3518 ¦4.64803¦0.0400031¦
+--+--------+-------+---------¦
¦7 ¦1.51815 ¦4.13872¦0.0467118¦
+--+--------+-------+---------¦
¦8 ¦1.67477 ¦3.75166¦0.0505916¦
+--+--------+-------+---------¦
¦9 ¦1.82341 ¦3.44584¦0.0553926¦
+--+--------+-------+---------¦
¦10¦1.96531 ¦3.19704¦0.0586112¦
+--+--------+-------+---------¦
¦11¦2.10142 ¦2.98997¦0.0650293¦
+--+--------+-------+---------¦
¦12¦2.23248 ¦2.81445¦0.0669045¦
+--+--------+-------+---------¦
¦13¦2.35906 ¦2.66342¦0.0706303¦
+--+--------+-------+---------¦
¦14¦2.48166 ¦2.53185¦0.0763112¦
+--+--------+-------+---------¦
¦15¦2.60067 ¦2.41599¦0.0802535¦
+--+--------+-------+---------¦
¦16¦2.71641 ¦2.31305¦0.0802621¦
+--+--------+-------+---------¦
¦17¦2.82918 ¦2.22085¦0.0864611¦
+--+--------+-------+---------¦
¦18¦2.93922 ¦2.13771¦0.0898613¦
+--+--------+-------+---------¦
¦19¦3.04673 ¦2.06227¦0.0916438¦
+-----------------------------+
Sensitivity to discretization

Although the static-equilibrium configuration is stable, its simulation is not, due to discretization and numerical precision. We can examine the sensitivity to time increment, taking position error after one rotation as a stability metric:

GENDT =: 3 : 0"0
dt =: y
GENDT0 3
)
GENDT0 =: 3 : 0"0
N=:y
VS =: (a N)^0.5
IS=:>.2*pi%VS*dt
IS ITER VS GEN N
E =: >./>./({.out)-{:out
dt;E
)
smoutput 'dt ';'error '
smoutput (GENDT"0) 10^_4+i.5
+-----------------+
¦dt ¦error ¦
+-----------------+
¦0.0001¦0.00227764¦
+------+----------¦
¦0.001 ¦0.0225829 ¦
+------+----------¦
¦0.01 ¦0.228495 ¦
+------+----------¦
¦0.1 ¦1.54637 ¦
+------+----------¦
¦1 ¦6.0354 ¦
+-----------------+

K[edit]

The simulation is meant to be viewed in-browser, using a Javascript implementation of (a nice subset of) K, plus graphics primitives, here: [http://johnearnest.github.io/ok/ike/ike.html]; just paste the code into the code window and push the go button. Playing with the parameters in this interactive and immediate environment gives a feel for the system beyond what you are likely to get from tables or graphs.

configuration generator

The configurations shown here are based on those in the J task.

sq:{pow[x;2]};sqrt:{pow[x;0.5]};pi:3.14159265   / math stuff
cs:{(cos 2*pi*x%y;sin 2*pi*x%y)} / positions
sc:{(sin 2*pi*x%y;-cos 2*pi*x%y)} / velocities

static equilibrium configuration

The system is stable for an initial velocity for which centrifugal and gravitational forces are in balance

n::3;m::n#1;p::cs\:[!n;n];v::sc\:[!n;n]         / count, masses, positions, velocities
g::1;vs::pow[1%3;1%4];v*::vs / gravitational constant, initial velocity
t::0;dt::0.01;rot:2 / time, time increment, rotational period

dynamic equilibrium

Within a narrow range of initial velocities the system oscillates between more and less kinetic and potential energy.

/ as for static case, plus:
/ v*::0.7;rot::2

unstable

The slightest perturbation from symmetry causes the system to become unstable.

/ as for static case, plus:
/ v+::(0 0;0 0;0 0.0001);rot:4 / wait for it ... wait for it ...

physics

DV:{p[x]-p[y]};DS:{sqrt[+/sq'DV[x;y]]}            / nth body position vector and magnitude
A1:{$[x=y;0;g*m[y]*DV[x;y]%pow[DS[x;y];3]]} / nth body centripetal acceleration component
A:{+/{A1/:[x;!n]}'!n} / total centripetal acceleration
tmax::2*pi*rot%vs / duration of simulation
N:{[dt] / increment
v0:v;v+::dt*A[];p+::dt*0.5*v+v0 / update velocities and positions
t+::dt;$[t>tmax;do[msg::,"[";tick::{}];0] / update time, detect end of time
}

events and graphics

s::n#3                                            / size of sprite bitmap
sc:1.25;P::{w*0.5*1+(1%sc)*x} / display units
wh::(w;h);C::wh%2 / viewbox
RGB:("#f00";"#0f0";"#00f") / color palette
BW:("#000";"#fff") / monochrome palette
msg::,":" / initial position marker
tick::{N[dt]} / time increment callback
draw::{ / display callback
r:(,:'P[p]-s%2),'`RGB,',:'(2#'s)#'!n / plot the bodies
r,:,(P[1 0];BW;~,/'+text@`i$msg) / plot the initial position marker
}

3D

Although the animation is limited to two dimensions, we can verify that the implementation really does support three, by changing the axis of rotation in the initialization function:

cs:{(0;cos 2*pi*x%y;sin 2*pi*x%y)}     / x-axis
sc:{(0;sin 2*pi*x%y;-cos 2*pi*x%y)} / objects on screen move up and down
 
cs:{(cos 2*pi*x%y;0;sin 2*pi*x%y)} / y-axis
sc:{(sin 2*pi*x%y;0;-cos 2*pi*x%y)} / objects on screen move left and right
 
cs:{(cos 2*pi*x%y;sin 2*pi*x%y;0)} / z-axis
sc:{(sin 2*pi*x%y;-cos 2*pi*x%y;0)} / objects on screen go round and round

Octave[edit]

Translation of: Perl 6

We'll show only the positions in the output.

global G = 6.674e-11;   # gravitational constant
global au = 150e9; # astronomical unit
 
global ma = 2e30; # mass of the Sun
global mb = 6e24; # mass of Earth
global mc = 7.34e22; # mass of the Moon
 
function ret = ABCdot(ABC, t)
global G au ma mb mc
ret = ABC;
ret(1:9) = ABC(10:18);
 
a = ABC(1:3);
b = ABC(4:6);
c = ABC(7:9);
 
ab = norm(a - b);
bc = norm(b - c);
ca = norm(c - a);
 
ret(10:12) = G*(mb/ab^3*(b - a) + mc/ca^3*(c - a));
ret(13:15) = G*(ma/ab^3*(a - b) + mc/bc^3*(c - b));
ret(16:18) = G*(ma/ca^3*(a - c) + mb/bc^3*(b - c));
 
endfunction;
 
seconds_in_a_month = 60*60*24*27;
seconds_in_a_year = 60*60*24*365.25;
t = (0:0.05:1);
ABC = vec(
[
0 0 0 # Sun position
au 0 0 # Earth position
0.998*au 0 0 # Moon position
0 0 0 # Sun speed
0 2*pi*au/seconds_in_a_year 0 # Earth speed
0 2*pi*(au/seconds_in_a_year + 0.002*au/seconds_in_a_month) 0 # Moon speed
]'
);
 
 
disp(lsode('ABCdot',ABC, t)(1:20,1:9));
 
Output:
   0.0000e+00   0.0000e+00   0.0000e+00   1.5000e+11   0.0000e+00   0.0000e+00   1.4970e+11   0.0000e+00   0.0000e+00
   2.2520e-11   1.8822e-19   0.0000e+00   1.5000e+11   1.4933e+03   0.0000e+00   1.4970e+11   1.5337e+03   0.0000e+00
   9.0080e-11   1.3338e-18   0.0000e+00   1.5000e+11   2.9865e+03   0.0000e+00   1.4970e+11   3.0673e+03   0.0000e+00
   2.0268e-10   3.1665e-18   0.0000e+00   1.5000e+11   4.4798e+03   0.0000e+00   1.4970e+11   4.6010e+03   0.0000e+00
   3.6032e-10   6.7638e-18   0.0000e+00   1.5000e+11   5.9731e+03   0.0000e+00   1.4970e+11   6.1347e+03   0.0000e+00
   5.6300e-10   1.2128e-17   0.0000e+00   1.5000e+11   7.4663e+03   0.0000e+00   1.4970e+11   7.6683e+03   0.0000e+00
   8.1072e-10   1.9549e-17   0.0000e+00   1.5000e+11   8.9596e+03   0.0000e+00   1.4970e+11   9.2020e+03   0.0000e+00
   1.1035e-09   3.0116e-17   0.0000e+00   1.5000e+11   1.0453e+04   0.0000e+00   1.4970e+11   1.0736e+04   0.0000e+00
   1.4413e-09   4.3249e-17   0.0000e+00   1.5000e+11   1.1946e+04   0.0000e+00   1.4970e+11   1.2269e+04   0.0000e+00
   1.8241e-09   1.0985e-16   0.0000e+00   1.5000e+11   1.3439e+04   0.0000e+00   1.4970e+11   1.3803e+04   0.0000e+00
   2.2520e-09   1.8655e-16   0.0000e+00   1.5000e+11   1.4933e+04   0.0000e+00   1.4970e+11   1.5337e+04   0.0000e+00
   2.7249e-09   2.7013e-16   0.0000e+00   1.5000e+11   1.6426e+04   0.0000e+00   1.4970e+11   1.6870e+04   0.0000e+00
   3.2429e-09   3.6059e-16   0.0000e+00   1.5000e+11   1.7919e+04   0.0000e+00   1.4970e+11   1.8404e+04   0.0000e+00
   3.8059e-09   4.5794e-16   0.0000e+00   1.5000e+11   1.9412e+04   0.0000e+00   1.4970e+11   1.9938e+04   0.0000e+00
   4.4139e-09   5.6217e-16   0.0000e+00   1.5000e+11   2.0906e+04   0.0000e+00   1.4970e+11   2.1471e+04   0.0000e+00
   5.0670e-09   6.7328e-16   0.0000e+00   1.5000e+11   2.2399e+04   0.0000e+00   1.4970e+11   2.3005e+04   0.0000e+00
   5.7651e-09   7.9128e-16   0.0000e+00   1.5000e+11   2.3892e+04   0.0000e+00   1.4970e+11   2.4539e+04   0.0000e+00
   6.5083e-09   9.1616e-16   0.0000e+00   1.5000e+11   2.5386e+04   0.0000e+00   1.4970e+11   2.6072e+04   0.0000e+00
   7.2965e-09   1.0479e-15   0.0000e+00   1.5000e+11   2.6879e+04   0.0000e+00   1.4970e+11   2.7606e+04   0.0000e+00
   8.1297e-09   1.1866e-15   0.0000e+00   1.5000e+11   2.8372e+04   0.0000e+00   1.4970e+11   2.9140e+04   0.0000e+00

Pascal[edit]

This was written in Turbo Pascal, prompted by an article in an astronomy magazine about the orbit of an asteroid about a planet about a sun. It expects to receive command-line parameters for the run, and wants to use the screen graphics to animate the result. Alas, the turbo .bgi protocol no longer works on modern computers that have screens with many more dots. It contains options to select different methods for computation. An interesting point is that if the central mass is fixed in position (rather than wobbling about the centre of mass, as it does), then the Trojan orbit positions are not stable.

 
{$N+ Crunch only the better sort of numbers, thanks.}
{$M 50000,24000,24000] {Stack,minheap,maxheap.}
Program Swirl; Uses Graph, Crt;
{ Calculates and displays the orbit of an asteroid around a sun and a planet,
as described in the article by C.C. Foster, in Sky & Telescope, September 1994,
which included the source code of a programme written in basic, so some changes here.
 
The situation: the asteroid is at X = (AX,AY) with velocity V = (VAX,VAY)
and suffers acceleration from the central sun and the steadily orbiting planet.
If the acceleration at the start of a time step is A = (acX,acY)
then X = (A.dt/2 + V)dt + X at the end of a time step, A presumed constant.
and V = A.dt + V (so update X before altering V)
But that is a first-order method. The whole point is that A is not constant.
Accordingly, use this X as an estimate of the position at the end of a time step,
and calculate a fresh A at the new position. Use the average of this and the
first A to perform the actual step.
The next step in the escalation is the classic fourth-order Runge-Kutta method
that alas involves a lot of repetitious code, or else trickery with loops.
Whichever, there are four evaluations per step: at the start, then using that to
probe ahead a half step, then again a half step, then a full step probe, then
a weighted average to perform the step. While this gives fifth-order accuracy
for each step, and thus fourth order accuracy at the end of a sequence of steps,
this is rather painful. This is to say that halving the step size would
reduce the upper bound of the error in a single step by a factor of 2**5, and
that for the result after a sequence of steps by a factor of 2**4. However,
this requires an upper bound on the value of the higher order derivatives of
the function over the entirety of the area of interest, and for this problem,
it does not exist, for the acceleration is unbounded above as a particle approaches
a mass. It varies by 1/r**2 and as r approaches zero, there can be surprises.
Unfortunately, the next stages, say Milne's Predictor-Corrector (which has
the advantage of maintaining the recent history, just what procedure Apastron
needs), followed by the extrapolation to zero stepsize methods of Bulirsch and
Stoer require heavy administration.
This programme uses a few tricks to enable a step size of 1 so that no actual
multiplication need be made, and likewise takes G as being one. It is the work
of moments to change the step size with these methods, but the difficulty lies
in when to change the step size and by how much. Remember that with a large step,
singularities can be stepped over without noticing them, whereas a small step
involves not just more work but also accumulating round-off. The predictor-
corrector methods offer a good check on the step size (if you bother to compare
the difference between the predicted and corrected values) but require a lot
of administrative effort when changing it. However, this is not all to the bad
as you might as well add some checks that the step size is not being changed
too enthusiastically while you're at it. The problem is that the step size is
being changed according to the behaviour of the results, but the behaviour of
the results depends on the step size as well as the current region.
Rather than pursue this matter (and make the effort) I have retained the
fixed size step (but perhaps an option sometime later?) to allow comparison
with the original article in Sky & Telescope (and also to make things easy
for procedure Apastron). For close comparison you will need to fix the central
sun (i.e. Wobble is false) and use Euler's method. The article however uses
units convenient to its programme: the planet is at radius 200, the asteroid
at 100, both starting on the x-axis. The planet has a mass of 5 to the sun's
mass of 70 (which is more like that of a companion sun than a planet), with
a year of 920 steps and the asteroid has an initial velocity in the y-direction
of 0.7. (See why you shouldn't use full stops as decimal points!)
These conditions result in the asteroid having successive periods of 466,
452, 477, 437, etc steps in the original article, and the invocation
 
WANDER 920 0.0714285 0.5 0 0.0 1.1 r f
 
meaning
920 steps to the planet's orbit,
a planetary mass of 5/70 of the sun
asteroid's radial distance being half that of the planet
at zero degrees (i.e. on the x-axis)
zero radial velocity
circular velocity of 1.1 (an estimate from trials) times that of a circular
orbit at the asteroid's initial radius
Runge-Kutta method
Sun fixed at the centre of mass
 
Is about as close as I can get, giving an asteroid period of 390 or so.
But the orbit is very unstable. With Euler's method, the picture is even worse
with the asteroid spiralling outwards. I think that this is due to too large a
step size and a low-order method, as test runs with the planetary mass set zero
behave better, provided that there are many steps to an asteroid orbit and that it
doesn't pass close to a mass. StepSize control would help, but it would mean
more programming effort. Alternatively, I could have blundered, but I've stared
at this so long that if there is a blunder, I can't see it.
I prefer to believe that the step size is the problem. In a different programme
on a different machine, a circular orbit of 90 mins about the earth (just above
the atmosphere) with full units for G, etc, and a step size of one second (thus
no multiply) so that there were 5,400 steps to an orbit, Euler's method after
one orbit had the radial distance 2% high and increasing steadily, whereas the
2'nd order Euler's method with a two second step size (so the same number of
evaluations, as two per step) and also no multiplication (i.e. (a + a')/2 *dt) gave
an error of one part on 6,000,000 (the precision of the 32-bit floating point
numbers on an IBM1130) and oscillating.
On the other hand, a simple arrangement such as the asteroid in a Trojan
orbit with respect to the planet works well enough. Here the asteroid is in the
same orbit as the planet, but leading (or lagging) by sixty degrees, thus:
 
WANDER 920 0.001 1 +60 0 1
 
Test runs give an unstable orbit unless the planet is much smaller than 5/70
of the sun's mass, and also require that the sun not be fixed to the centre of
mass. Having lots more steps per orbit doesn't change this. Thus, even though
the sun's wobble is small, it is necessary and anyway, physically correct.
In the case of a more massive planet, the obvious extension is to three equal
masses in mutual orbit and invoking symmetry, a nice circular orbit would have
them spaced at a hundred and twenty degrees.
Incidentally, no attempt is made to spot occasions when the asteroid's position
is exactly that of some attracting mass, so zero divisions can cause dismay.
Except that they won't happen as a result of a computed step unless you are very
unlucky, especially if the floating-point hardware is available, with eighteen
digits that must all coincide. On the other hand, you can easily specify an
initial position that will provoke a division by zero so if that is what you
have asked for, then that is what you will receive.}

 
 
{Perpetrated by R.N.McLean (whom God preserve), Victoria University, Feb. VMMI.}
 
Type Grist = {$IFOPT N+} extended {$ELSE} real {$ENDIF};
Type Chaff = {$IFOPT N+} single {$ELSE} real {$ENDIF};
const esc = #27;
var colour,lastcolour,xmax,ymax,txtheight: integer;
var stretch: grist;
Var Asitwas: Word;
Type AnyString = string[80];
 
Function Min(i,j: integer): integer; BEGIN if i <= j then min:=i else min:=j; END;
Function Max(i,j: integer): integer; BEGIN if i >= j then max:=i else max:=j; END;
Procedure Beep(f,t: integer); BEGIN Sound(f); delay(t); NoSound; END;
Procedure Croak(Gasp: string); {A lethal word.}
BEGIN
TextMode(Asitwas);
WriteLn;
Writeln(Gasp);
HALT;
END;
 
Function MemGrab(Var p: pointer;s: word): boolean;
BEGIN
p:=nil;
if s > 0 then GetMem(p,s);
MemGrab:=p<>nil;
END;
Procedure MemDrop(Var p: pointer;s: word);
BEGIN
if (s > 0) and (p <> nil) then FreeMem(p,s);
p:=nil; {Oh that all usage would first check!}
END;
 
FUNCTION Trim(S : anystring) : anystring;
var L1,L2 : integer;
BEGIN
L1 := 1;
WHILE (L1 <= LENGTH(S)) AND (S[L1] = ' ') DO INC(L1);
L2 := LENGTH(S);
WHILE (S[L2] = ' ') AND (L2 > L1) DO DEC(L2);
IF L2 >= L1 THEN Trim := COPY(S,L1,L2 - L1 + 1) ELSE Trim := '';
END; {Of Trim.}
 
FUNCTION Ifmt(Digits : longint) : anystring;
var S : anystring;
BEGIN
STR(Digits,S);
Ifmt := Trim(S);
END; { Ifmt }
 
FUNCTION Ffmt(Digits: grist; Width,Decimals: integer): anystring;
var
S : anystring;
L : integer; { a finger }
BEGIN
if digits = 0 then begin Ffmt:='0'; exit; end; {Mumble.}
IF Abs(Digits) < 0.0000001 THEN STR(Digits,S)
ELSE STR(Digits:Width:Decimals,S);
s:=trim(s);
if copy(s,1,2) = '0.' then s:=copy(s,2,Length(s) - 1);
if copy(s,1,3) = '-0.' then s:=concat('-',copy(s,3,Length(s) - 2));
l:=Length(s);
if pos('.',s) > 0 then while (l > 0) and (s[l] = '0') do l:=l - 1;
if s[l] = '.' then l:=l - 1; {No non-zero fractional part!}
S := COPY(S,1,L); {Drop trailing boredom.}
l:=Pos('.',S); {Avoid sequences such as 3.1415.}
if l > 0 then s[l]:=chr(249); {By using decimal points, please.}
Ffmt := S;
END; { Ffmt }
 
Function Atan2(x,y: grist): grist;
var a: grist;
BEGIN
if x = 0 then
if y > 0 then atan2:=pi/2
else if y < 0 then atan2:=-pi/2
else atan2:=0
else if x > 0 then if y >= 0 then atan2:=arctan(y/x) else atan2:=2*pi + arctan(y/x)
else atan2:=pi - arctan(-y/x);
END;
 
Procedure PrepareTheCanvas;
Var mode: integer;
Var SavedResultCode: integer;
Var ax,ay: word;
Function BGIFound(Here: Anystring): boolean;
Var driver: integer;
BEGIN
Driver:=Detect;
InitGraph(driver,mode,Here);
SavedResultCode:=GraphResult; {Mumble!}
BGIFound:=SavedResultCode = 0; {Missing file gives -3.}
END; {Of BGIFound.}
Var aplace: anystring;
Var Palette: paletteType;
BEGIN
Mode:=0;
if not BGIFound('') then
if not BGIFound('C:\TP7\BGI') then
if not BGIFound('D:\TP4') then
begin
WriteLn;
WriteLn('Trouble with Borland''s Graphic Interface!');
WriteLn('Message: ',GraphErrorMsg(SavedResultCode));
WriteLn('I''ve tried "", "C:\TP4", and "D:\TP4"...');
Repeat
Write('Another place to look? (e.g. a:\bgiset)');
ReadLn(Aplace); {As opposed to Read. weird.}
If Aplace = '' then
begin
writeln;
write('No .bgi, no piccy.');
halt;
end;
until BGIFound(Aplace);
end;
SetViewPort(0,0,GetMaxX,GetMaxY,True); {Clipping on, thanks. No apparent slowdown.}
SetGraphMode(Mode);
GetPalette(Palette);
LastColour := Palette.Size - 1; {Colours are 0:15, 16 thereof.}
if LastColour <= 0 then LastColour:=1;
xmax:=GetMaxX; ymax:=GetMaxY;
txtheight:=TextHeight('I');
GetAspectRatio(ax,ay); stretch:=ay/ax; {I hope this handles the screen's physical dimensions}
END; {as well as the number of dots in the x and y directions.}
 
Procedure Splot(x,y:integer; bumf: anystring);
var l: integer;
BEGIN
l:=TextWidth(Bumf);
if x + l > xmax then x:=xmax - l;
SetFillStyle(EmptyFill,Black); Bar(x,y,x + l,y + txtheight - 1);
OutTextXY(x,y,bumf);
END;
 
Procedure FlashHint(msg: string);
var i,h,ph,pl,y0,rt: integer;
var l1,l2,nl: integer;
var board: pointer; BoardSize: word;
BEGIN
nl:=0; pl:=0; l2:=1;
repeat
l1:=l2;
while (l2 <= Length(msg)) and (msg[l2] <> '%') do l2:=l2 + 1;
nl:=nl + 1; pl:=max(pl,TextWidth(Copy(Msg,l1,l2 - l1)));
l2:=l2 + 1;
until l2 > Length(msg);
h:=TextHeight('Idiotic') + 1;
ph:=1 + nl*h;
y0:=GetMaxY div 6 + h;
BoardSize:=ImageSize(0,0,pl,ph);
If BoardSize <= 0 then begin Beep(6666,200); exit; end;
if KeyPressed then exit; {Last chance to cut and run.}
if not memgrab(board,BoardSize) then
begin
OutTextXY(0,y0,'Memory shortage...');
Beep(8888,200);
exit; {Thus save on too many "if"s below.}
end;
GetImage(0,y0,pl,y0 + ph,board^); {Doesn't check that Board is not nil!&^$#@!}
SetFillStyle(EmptyFill,Black); Bar(0,y0,pl,y0 + ph);
SetColor(White);
i:=0; l2:=1;
repeat
l1:=l2;
while (l2 <= Length(msg)) and (msg[l2] <> '%') do l2:=l2 + 1;
OutTextXY(0,y0 + 1 + i*h,Copy(Msg,l1,l2 - l1));
i:=i + 1; l2:=l2 + 1;
until l2 > Length(msg);
rt:=28 + Length(msg); {Read time, more for longer messages.}
i:=0; while not KeyPressed and (i < rt) do
begin
delay(100);
i:=i + 1;
end;
PutImage(0,y0,board^,NormalPut);
MemDrop(board,BoardSize);
END;
 
PROCEDURE LurkWith(Msg: string);
Var t,w: integer;
BEGIN
w:=111;
repeat
for t:=0 to w do
begin
if KeyPressed then exit;
delay(100);
end;
FlashHint(msg);
w:=222;
until KeyPressed;
END;
 
Function KeyFondle: char; {Equivalent to ReadKey, except...}
Var ticker: integer; { after a delay, it gives a hint.}
BEGIN {Screen and keyboard are connected by a computer...}
Ticker:=666; {A delay counter.}
While not KeyPressed do {If nothing has happened, }
begin { twiddle my thumbs.}
ticker:=ticker - 1; {My patience is being exhausted.}
if ticker > 0 then Delay(60) {Another irretrievable loss.}
else FlashHint('Press a key!'); {Hullo sailor!}
end; {Eventually, a key is pressed.}
KeyFondle:=ReadKey {Yum.}
END;
 
 
Var Wobble,Dotty: boolean;
Var Style: integer;
Var Year,PM,SM,AR,AA,ARV,ACV: grist;
Var n: longint;
Procedure WanderAlong;
const suncolour = Yellow;
const planetcolour = LightGreen;
const asteroidcolour = White;
const anglecolour = cyan;
const periodcolour = LightRed;
Const radiuscolour = LightBlue;
Const KeplerColour = Magenta;
Const EnergyColour = White;
Const dt = 1;
var
W,P,T,
SX,SY,RS,
PX,PY,RP,
AX,AY,VAX,VAY,acX,acY,
DSX,DSY,DS2,DS3,
DPX,DPY,DP2,DP3: grist;
var cxp,cyp,sxp,syp,pxp,pyp,axp,ayp: integer;
var bxp,txp,byp,typ: integer;
var nturn: longint;
var T1,T2: grist;
var pAX,pAY,ppAX,ppAY,D2,pD2,ppD2: grist;
Var nstep: longint;
var stepwise,bored: boolean;
 
Function AsteroidEnergy: grist; {The asteroid mass is considered divided out.}
BEGIN {Thus, 1/2 mv**2 becomes 1/2 v**2.}
AsteroidEnergy:=(VAX*VAX + VAY*VAY)/2
- SM/sqrt((AX - SX)*(AX - SX) + (AY - SY)*(AY - SY))
- PM/sqrt((AX - PX)*(AX - PX) + (AY - PY)*(AY - PY));
END; {Likewise, potential Energy = -G*M1*M2/r12 }
 
Procedure SplotStep;
BEGIN
SetColor(LightBlue);
Splot(0,0,'Steps: ' + ifmt(nstep));
Splot(4*cxp div 3,0,'R='+ffmt(sqrt(AX*AX + AY*AY),8,2));
SetColor(EnergyColour);
Splot(4*cxp div 3,Txtheight,'E/m: '+ ffmt(AsteroidEnergy,8,2) + ' ');
END;
 
const types = 5;
Const tummy = 666;
var v: array[1..types,1..tummy] of Chaff;
var vmax,vmin,vs: array[1..types] of Chaff;
var show,varies: array[1..types] of boolean;
const vcolour: array[1..types] of byte = (anglecolour,periodcolour,radiuscolour,KeplerColour,EnergyColour);
var nv: integer;
 
Procedure Splash;
var i,j: integer;
BEGIN
SetFillStyle(EmptyFill,Black); Bar(bxp,byp,txp,typ);
SetColor(Green);
Line(bxp,byp,txp,byp); line(txp,byp,txp,typ);
Line(txp,typ,bxp,typ); Line(bxp,typ,bxp,byp);
for i:=1 to types do
if show[i] and varies[i] then
if dotty then for j:=1 to nv-1 do putpixel(bxp + round((v[i,j] - vmin[i])*vs[i]),byp+j,vcolour[i])
else
begin
setcolor(vcolour[i]);
MoveTo(bxp + round((v[i,1] - vmin[i])*vs[i]),byp+1);
for j:=2 to nv-1 do LineTo(bxp + round((v[i,j] - vmin[i])*vs[i]),byp+j);
end;
END;
 
Procedure DealWith(ch: char);
var redraw: boolean;
BEGIN
Case upcase(ch) of
ESC: bored:=true;
'J': Dotty:=not Dotty;
'A': show[1]:=not show[1];
'P': show[2]:=not show[2];
'R': show[3]:=not show[3];
'K': show[4]:=not show[4];
'E': show[5]:=not show[5];
'S':stepwise:=not stepwise;
'?':FlashHint('Pressing a key may help.%APRK or E selects dots to plot%S for Stepwise%ESC to quit.');
end;
if pos(upcase(ch),'JAPRKE') > 0 then splash;
END;
 
Procedure Swallow(v1,v2,v3,v4,v5: grist);
var i,j,l: integer;
var hic,flux: boolean;
BEGIN
flux:=nv = 3;
if (nv >= typ - byp) or (nv >= tummy) then
begin
flux:=true;
l:=nv div 3;
for i:=1 to types do
for j:=l+1 to nv do v[i,j - l]:=v[i,j];
nv:=nv - l;
for i:=1 to types do begin vmin[i]:=v[i,1]; vmax[i]:=v[i,1]; end;
for i:=1 to types do
for j:=2 to nv do
begin
if v[i,j] > vmax[i] then vmax[i]:=v[i,j];
if v[i,j] < vmin[i] then vmin[i]:=v[i,j];
end;
for i:=1 to types do
begin
varies[i]:=vmax[i] <> vmin[i];
if varies[i] then vs[i]:=(txp - bxp)/(vmax[i] - vmin[i]);
end;
end;
nv:=nv + 1;
v[1,nv]:=v1; v[2,nv]:=v2; v[3,nv]:=v3; v[4,nv]:=v4; v[5,nv]:=v5;
if nv = 1 then for i:=1 to types do begin varies[i]:=false; vmax[i]:=v[i,1]; vmin[i]:=v[i,1]; end
else for i:=1 to types do
begin
hic:=false;
if v[i,nv] > vmax[i] then begin vmax[i]:=v[i,nv]; hic:=true; end;
if v[i,nv] < vmin[i] then begin vmin[i]:=v[i,nv]; hic:=true; end;
if hic then vs[i]:=(txp - bxp)/(vmax[i] - vmin[i]);
if not varies[i] then varies[i]:=vmax[i] <> vmin[i];
flux:=flux or hic;
end;
if nv > 3 then
begin
if flux then splash;
for i:=1 to types do
if show[i] and varies[i] then
if dotty then putpixel(bxp + round((v[i,nv] - vmin[i])*vs[i]),byp+nv,vcolour[i])
else
begin
setcolor(vcolour[i]);
Line(bxp + round((v[i,nv-1] - vmin[i])*vs[i]),byp+nv-1,bxp + round((v[i,nv] - vmin[i])*vs[i]),byp+nv);
end;
end;
END; {of Swallow.}
Procedure Apastron;
{Given: at the last three time steps, DS2, pD2, and ppD2, being (squares of)
the distances from the centre of mass, and further, DS2 < pD2, pD2 > ppD2.
Wanted: the time of greatest distance from the sun.
So, fit a parabola to the three equally spaced values ppD2, pD2, DS2,
differentiate and set to zero for the extremum, solving for x.
y = ax**2 + bx + c, and why not have x = -1, 0, +1
Thus c = y0, y-1 is ppD2 so c = pD2
b = (y1 - y-1)/2 y0 is pD2 b = (DS2 - ppD2)/2
a = (y1 + y-1 - 2y0)/2 y1 is DS2. a = (DS2 + ppD2 - 2pDS2)/2
The extremum is when 2ax + b = 0
so x = -b/2a when y is an extremum, call this h.
and x = 0 corresponds to the middle time, which was one back, so T-dt
Having found the time of greatest distance, a small adjustment from T
gives the location of the asteroid then (only a small change from time T)
and thus the direction of the apastron. Since the acceleration is at right
angles to the velocity it won't have much effect on the angle, and being
minimal, not much effect on the distance. But, I'm not doing the arithmetic.}

Var X,Y,a,r,h,k,e: grist;
BEGIN
{splot(0,20,'ppD2:'+ffmt(ppD2,15,2)+' ');}
{splot(0,30,' pD2:'+ffmt(pD2,15,3)+'> ');}
{splot(0,40,' D2:'+ffmt(D2,15,3)+' ');}
h:=(ppD2 - DS2)/(DS2 + ppD2 - 2*pD2) /2;
{splot(0,50,' h:'+ffmt(h,15,3+' '));}
t2:=T + (h - 1){*dt};
x:=((AX + ppAX - 2*pAX)/2*h + (AX - ppAX)/2)*h + pAX;
y:=((AY + ppAY - 2*pAY)/2*h + (AY - ppAY)/2)*h + pAY;
r:=sqrt(x*x + y*y);
SetColor(AngleColour); Line(cxp,cyp, cxp + round(x),cyp - round(y/stretch));
a:=atan2(x,y)*180/pi;
nturn:=nturn + 1;
h:=(t2 - t1)/P*Year; {Use the planet's 'year'.}
k:=8*r*r*r/h/h; {Kepler's law: G(m + m')/4pi = d**3/t**2}
e:=(VAX*VAX + VAY*VAY)/2
- SM/sqrt((x - SX)*(x - SX) + (y - SY)*(y - SY))
- PM/sqrt((x - PX)*(x - PX) + (y - PY)*(y - PY));
Splot(0,0 + 1*TxtHeight,'Orbits: ' + ifmt(nturn));
SetColor(AngleColour); Splot(0,ymax - 1*txtheight,'Apastron: ' + ffmt(a,8,3) + 'ø ');
SetColor(PeriodColour); Splot(0,ymax - 2*txtheight,'Period: ' + ffmt(h,12,3)+' ');
SetColor(RadiusColour); Splot(cxp*4 div 3,ymax - 1*txtheight,'Rmax: ' + ffmt(r,12,4)+' ');
SetColor(KeplerColour); Splot(cxp*4 div 3,ymax - 2*txtheight,'Kepler: ' + ffmt(k,12,3)+' ');
Swallow(a,h,r,k,e);
t1:=t2;
END; {of Apastron.}
 
Const Methodname: array[1..3] of string = ('Euler','Euler2','RK4');
var nSX,nSY,nPX,nPY,nAX,nAY: grist;
Procedure EulerStep; {First-order.}
BEGIN
DSX:=SX - AX; DSY:=SY - AY;
DS2:=DSX*DSX + DSY*DSY; DS3:=sqrt(DS2)*DS2;
DPX:=PX - AX; DPY:=PY - AY;
DP2:=DPX*DPX + DPY*DPY; DP3:=sqrt(DP2)*DP2;
acX:=SM*DSX/DS3 + PM*DPX/DP3; acY:=SM*DSY/DS3 + PM*DPY/DP3;
END;
Procedure SecondOrder; {Modified Euler, 2nd order predictor-corrector, etc..}
BEGIN
EulerStep;
nAX:=AX + (0.5*acX{*dt} + VAX){*dt}; nAY:=AY + (0.5*acY{*dt} + VAY){*dt};
DSX:=nSX - nAX; DSY:=nSY - nAY;
DS2:=DSX*DSX + DSY*DSY; DS3:=sqrt(DS2)*DS2;
DPX:=nPX - nAX; DPY:=nPY - nAY;
DP2:=DPX*DPX + DPY*DPY; DP3:=sqrt(DP2)*DP2;
acX:=(acX + SM*DSX/DS3 + PM*DPX/DP3)/2; acY:=(acY + SM*DSY/DS3 + PM*DPY/DP3)/2;
END;
Procedure RungeKutta4; {The classic.}
var h2,hsx,hsy,hpx,hpy,tax,tay,k1x,k1y,k2x,k2y,k3x,k3y: grist;
BEGIN
EulerStep; {The story at 0.}
h2:=dt/2; {Half a time step.}
hSX:=(SX + nSX)/2; hSY:=(SY + nSY)/2; {I'm not calling for a fresh sin and cos.}
hPX:=(PX + nPX)/2; hPY:=(PY + nPY)/2; {Halfway will do.}
tAX:=AX + (0.5*acX*h2 + VAX)*h2; tAY:=AY + (0.5*acY*h2 + VAY)*h2;
DSX:=hSX - tAX; DSY:=hSY - tAY;
DS2:=DSX*DSX + DSY*DSY; DS3:=sqrt(DS2)*DS2;
DPX:=hPX - tAX; DPY:=hPY - tAY;
DP2:=DPX*DPX + DPY*DPY; DP3:=sqrt(DP2)*DP2;
k1x:=SM*DSX/DS3 + PM*DPX/DP3; k1y:=SM*DSY/DS3 + PM*DPY/DP3;
tAX:=AX + (0.5*k1X*h2 + VAX)*h2; tAY:=AY + (0.5*k1Y*h2 + VAY)*h2;
DSX:=hSX - tAX; DSY:=hSY - tAY;
DS2:=DSX*DSX + DSY*DSY; DS3:=sqrt(DS2)*DS2;
DPX:=hPX - tAX; DPY:=hPY - tAY;
DP2:=DPX*DPX + DPY*DPY; DP3:=sqrt(DP2)*DP2;
k2x:=SM*DSX/DS3 + PM*DPX/DP3; k2y:=SM*DSY/DS3 + PM*DPY/DP3;
tAX:=AX + (0.5*k2X{*dt} + VAX){*dt}; tAY:=AY + (0.5*k2Y{*dt} + VAY){*dt};
DSX:=nSX - tAX; DSY:=nSY - tAY;
DS2:=DSX*DSX + DSY*DSY; DS3:=sqrt(DS2)*DS2;
DPX:=nPX - tAX; DPY:=nPY - tAY;
DP2:=DPX*DPX + DPY*DPY; DP3:=sqrt(DP2)*DP2;
k3x:=SM*DSX/DS3 + PM*DPX/DP3; k3y:=SM*DSY/DS3 + PM*DPY/DP3;
acX:=(acX + 2*(k1x + k2x) + k3x)/6; acY:=(acY + 2*(k1y + k2y) + k3y)/6;
END;
Const BlobSize = 8;
var r,vcirc: grist;
var d,m,distant2: grist;
var coswt,sinwt: grist;
var rsp,rpp: integer; {Radius of Sun in Pixels, and of Planet.}
var pspix,pppix,pswas,ppwas: pointer;{Points to Sun pix, Planet pix.}
var szspix,szppix: word; {Sizes of the pix map.}
var i1,i2: integer;
Var ch: char;
Var text: string;
BEGIN
bored:=false;
Dotty:=true;
Stepwise:=false;
for i1:=1 to types do show[i1]:=true;
bxp:=xmax; pyp:=round(ymax*stretch);
if pyp < bxp then bxp:=pyp; {Oh for square dots!##$%$#!}
cxp:=bxp div 2; cyp:=round(bxp/stretch/2); {The centre of mass on the screen.}
bxp:=bxp + 1; txp:=xmax; {Base and top of a side box.}
byp:=0; typ:=ymax; {Wherein will appear a plot.}
nv:=0; {No values saved for the box.}
R:=cxp - blobsize; {Available space on the screen, with safety.}
RP:=R; {All for the planet's radius.}
RS:=0; {If the sun is motionless.}
M:=SM + PM; {Total mass of the system.}
if pm = 0 then wobble:=false; {The asteroid is as if massless.}
if wobble then {But if the sun wobbles, }
begin { then a re-adjustment.}
RS:=R*PM/M; {Both orbit about the centre of mass.}
RP:=R*SM/M; {RS + RP = R.}
t:=RS; if RP > t then t:=RP; {Re-scale to fill the screen.}
RS:=RS*R/t; RP:=RP*R/t;
end;
D:=RS + RP; {Distance between planet and sun.}
Distant2:=6*D*D; {A long way out.}
M:=4*pi*pi*D*D*D/({G}year*year) /M; {Use the proper orbital period, with G = 1.}
SM:=SM*M; PM:=PM*M; M:=SM + PM; {Rescale so as to allow dt = 1.}
P:=year;
W:=2*Pi/P; {2Pi radians in one orbit, needing time P}
{dt:=P/year; {'Year' Timesteps complete one P.}
rsp:=Round(BlobSize*Sqrt(SM/M)); rpp:=Round(BlobSize*Sqrt(PM/M));
if rsp < 1 then rsp:=1; if rpp < 1 then rpp:=1;
{Prepare a solar disc.}
sxp:=cxp - round(RS); syp:=cyp - 0;
szspix:=ImageSize(sxp-rsp,syp-rsp,sxp+rsp,syp+rsp);
if not(MemGrab(pspix,szspix) and MemGrab(pswas,szspix)) then croak('Can''t grab memory for the solar disc.');
GetImage(sxp-rsp,syp-rsp,sxp+rsp,syp+rsp,pswas^);
SetColor(SunColour); Circle(sxp,syp,rsp);
SetFillStyle(SolidFill,SunColour); FloodFill(sxp,syp,SunColour);
GetImage(sxp-rsp,syp-rsp,sxp+rsp,syp+rsp,pspix^);
PutImage(sxp-rsp,syp-rsp,pswas^,0); {Remove the sun during preparation.}
{Prepare a planetary disc.}
pxp:=cxp + round(RP); pyp:=cyp + 0;
szppix:=ImageSize(pxp-rpp,pyp-rpp,pxp+rpp,pyp+rpp);
If not(MemGrab(pppix,szppix) and MemGrab(ppwas,szppix)) then Croak('Can''t grab memory for the planetary disc.');
GetImage(pxp-rpp,pyp-rpp,pxp+rpp,pyp+rpp,ppwas^);
SetColor(PlanetColour); Circle(pxp,pyp,rpp);
SetFillStyle(SolidFill,PlanetColour); {FloodFill(pxp,pyp,PlanetColour);}
GetImage(pxp-rpp,pyp-rpp,pxp+rpp,pyp+rpp,pppix^);
PutImage(pxp-rpp,pyp-rpp,ppwas^,0);
{Place some geometry.}
SetColor(1); Line(cxp - round(rp),cyp,cxp + round(rp),cyp);
Line(cxp,cyp + round(rp/stretch),cxp,cyp - round(rp/stretch));
Circle(cxp,cyp,Round(RP));
SetColor(5); Line(cxp-1,cyp,cxp+1,cyp); Line(cxp,cyp-1,cxp,cyp+1);
GetImage(sxp-rsp,syp-rsp,sxp+rsp,syp+rsp,pswas^); {+Geometry, no sun.}
GetImage(pxp-rpp,pyp-rpp,pxp+rpp,pyp+rpp,ppwas^); {+Geometry, no planet.}
PutImage(sxp-rsp,syp-rsp,pspix^,0);
SetColor(LightBlue); Splot(0,0+2*txtheight,'Method: ' + methodname[style]);
if wobble then text:='Wobble' else text:='Fixed';
setcolor(SunColour); Splot(0,0+3*txtheight,text);
 
SX:=0; SY:=0; {Place the sun at the centre of mass.}
PX:=RP; PY:=0; {Place the planet on the x-axis.}
if wobble then SX:=-RS; {Opposite sides.}
nSX:=SX; nSY:=SY; {In case it doesn't wobble.}
axp:=0; ayp:=0; {Previous asteroid place.}
D:=RP*AR; {Distance out from the C of M.}
AX:=D*Cos(AA); AY:=D*Sin(AA);
VCirc:=D*2*Pi/Sqrt(4*pi*pi*D*D*D/M); {Velocity of circular orbit.}
VAX:=VCirc*(-ACV*Sin(AA) + ARV*Cos(AA));
VAY:=VCirc*(+ACV*Cos(AA) + ARV*Sin(AA));
pAX:=AX; ppAX:=AX; pAY:=AY;ppAY:=AY;{Shouldn't be needed, but fear uninitialisation.}
D2:=AX*AX + AY*AY; {Distance from the centre of mass.}
pD2:=D2;ppD2:=D2; {We start at the Apastron.}
T1:=0;
nturn:=0;
nstep:=0;
{The story at time T, the start of a time step dt:
The sun's mass SM at (SX,SY) and (nSX,nSY) at the end of the time step.
The planet PM (PX,PY) (nPX,nPY)
The asteroid (AX,AY) velocity (VAX,VAY)
To compute its acceleration (acX,acY)
and therefrom a new value for (AX,AY) and (VAX,VAY).}

 
repeat
nstep:=nstep + 1; {Well, it is about to be made.}
t:=nstep{*dt}; {This time is after the step has been made.}
CosWT:=Cos(W*T); SinWT:=Sin(W*T); {The compiler probably does a poor job.}
nPX:=RP*Coswt;nPY:=RP*sinwt; {And at the end of the step.}
if wobble then {In proper centre-of-mass arrangements?}
begin {Yes. The sun is wobbling.}
nSX:=-RS*CosWT; nSY:=-RS*SinWT; {And at the end of the time step.}
end; {Enough fooling around. Now for the real task.}
Case style of
1:EulerStep;
2:SecondOrder;
3:RungeKutta4;
end;
AX:=AX + (0.5*acX{*dt} + VAX){*dt}; AY:=AY + (0.5*acY{*dt} + VAY){*dt};
VAX:=VAX + acX{*dt}; VAY:=VAY + acY{*dt};
PX:=nPX; PY:=nPY;
if wobble then begin SX:=nSX; SY:=nSY; end; {Thus attain the end of the time step.}
PutPixel(axp,ayp,0); {Scrub the old asteroidal spot.}
axp:=cxp + round(AX); ayp:=cyp - Round(AY/stretch);
PutPixel(axp,ayp,AsteroidColour); {Place the new asteroidal spot.}
PutImage(pxp-rpp,pyp-rpp,ppwas^,0); {Scrub the old planetary spot.}
pxp:=cxp + round(PX); pyp:=cyp - round(PY/stretch);
GetImage(pxp-rpp,pyp-rpp,pxp+rpp,pyp+rpp,ppwas^);
PutImage(pxp-rpp,pyp-rpp,pppix^,0); {Place the new planetary spot.}
if wobble then {The sun might be mobile, too.}
begin {So see if it has moved noticeably.}
i1:=cxp + round(SX); i2:=cyp - round(SY/stretch);
if (i1 <> sxp) or (i2 <> syp) then {At least a whole dot in some direction?}
begin {Yep.}
PutImage(sxp-rsp,syp-rsp,pswas^,0); {Restore what was there.}
sxp:=i1; syp:=i2; {And jump to the new position.}
GetImage(sxp-rsp,syp-rsp,sxp+rsp,syp+rsp,pswas^);
PutImage(sxp-rsp,syp-rsp,pspix^,0); {Splot.}
end; {So much for a noticeable move.}
end; {So much for sun movement.}
D2:=AX*AX + AY*AY; {The new position.}
if (D2 < pD2) and (pD2 > ppD2) then Apastron;
ppAX:=pAX; ppAY:=pAY; pAX:=AX; pAY:=AY; ppD2:=pD2; pD2:=D2;
if stepwise or (nstep mod 100 = 0) then splotstep;
if D2 > Distant2 then {Too distant for close interactions?}
if AsteroidEnergy > 0 then {Yeah, perhaps a getaway is in progress.}
begin
SplotStep;
Splot(cxp,cyp div 3,'Escaping!');
Bored:=true;
end;
if stepwise or keypressed then dealwith(KeyFondle);
until bored;
 
repeat
Text:='';
if nv > 3 then text:='Adjust dots, or%';
text:=text + 'ESC to quit.';
LurkWith(Text);
ch:=KeyFondle;
if ch <> esc then dealwith(ch);
until ch = esc;
 
MemDrop(pspix,szspix); MemDrop(pswas,szspix);
MemDrop(pppix,szppix); MemDrop(ppwas,szppix);
END; {Of WanderAlong.}
 
Procedure Grunt(n: integer);
Var i: integer;
Var Unflushed: boolean;
Procedure Z(Text: string); {Roll some text.}
BEGIN {With screen pauses.}
if unflushed then ClrEol; {Perhaps bumf lurks on this line.}
WriteLn(Text); i:=i + 1; {Writes only to the end of text, not eol.}
if i >= Hi(WindMax) then {Have we reached the bottom?}
begin {Yes, the display would soon scroll up.}
if unflushed then clreol; {A last remnant.}
unflushed:=false; {Once scrolling starts, new lines are blank.}
Write('(Press a key)'); {A hint, offering out-by-one possibilities.}
if ReadKey = #0 then if ReadKey = esc then; {Ignore a key.}
GoToXY(1,wherey); ClrEol; {Scrub the hint.}
i:=0; {Restart the count.}
end; {So much for a screen full.}
END; {So much for that line.}
BEGIN
i:=n; Unflushed:=true;
Z(' A massive planet is in a fixed circular orbit about its sun.');
Z('Between it and the sun is an asteroid that wanders as it can.');
Z('Although this problem is (just) within the scope of analytic methods,');
Z('the asteroid''s movement is computed by numerical integration, with one');
Z('step per ''day'' of the planet''s orbital period. As the simulation proceeds,');
Z('various attributes of its orbit are plotted in a box to the side of the screen');
Z('for each completed orbit. This is taken to be when it reaches a maximum');
Z('distance from the centre of mass, or in other words, starts to fall back.');
Z('No attempt is made to identify other orbital centres, such as the planet');
Z('or the Trojan points of its orbit or whatever other stabilities exist, nor');
Z('more baroque orbits such as about both the sun and the planet.');
Z(' The attributes plotted (radius, angle of apastron, etc) can be selected');
Z('or unselected by pressing the key for the first letter of the name, thus the');
Z('plot of the successive values for the Apastron may be suppressed by pressing');
Z('the A key, and so on. The plots appear as separate dots for each value, but if');
Z('you prefer Joined-up plots, pressing the J key will switch states.');
Z(' The S key switches between Stepwise and continual execution; pressing some');
Z('other key (e.g. Return) then advances the calculation one step each time.');
Z(' Everything depends on the initial state, and a distressingly long list of');
Z('parameters only begins to explore the opportunities, as follows:');
Z('');
Z(' YearLength: days in the planet''s year, e.g. 1000');
Z(' PlanetMass: as a fraction of the sun''s mass, e.g. 0.0125');
Z(' AsteroidR: as a fraction of the planet''s distance from the C of M');
Z(' AsteroidA: angle with the x-axis (in degrees)');
Z(' AsteroidRV: radial velocity as a factor of the circular orbit velocity');
Z(' AsteroidCV: circular orbit velocity factor');
Z(' Style: E = Euler, M = Euler 2''nd, R = Runge-Kutta.');
Z(' SunMotion: W = wobble about C of M, F = (improperly) fixed at C of M.');
Z('');
Z(' You need not supply all of these, but as they are not named, there can be');
Z('no gap in the list. Thus, if you supply the third parameter then you must');
Z('also supply the first and second, but need not supply those past the third.');
Z('If no parameters are offered, the default is equivalent to');
Z('');
Z(' WANDER 1000 0.15 0.5 0 0.0 -0.75 R W');
Z('');
Z(' This will use the classic fourth-order Runge-Kutta scheme for numerical');
Z('integration of a differential equation for the case where a massive planet');
Z('(the Earth''s mass is 1/300000 of the mass of the Sun) orbits in a fixed');
Z('circle having a thousand one-day steps, and a (massless) asteroid starts off');
Z('on the x-axis halfway between the planet and the centre of mass with an');
Z('initial velocity straight down of three quarters of the speed a circular orbit');
Z('of that radius would require in the absence of planetary perturbations.');
Z('');
Z(' Don''t forget the leading 0 in 0.15 that turbo pascal demands...');
Z(' ESC to quit.');
END;
 
Procedure Reject(Gripe: anystring);
BEGIN
Writeln;
Writeln('Unsavoury: ',Gripe);
Writeln;
Grunt(3);
Halt;
END;
Const Usage: array[1..8] of string = (
'Steps in a planetary year',
'Planetary mass ratio',
'Asteroid''s initial radial distance',
'Asteroid''s initial angular position',
'Asteroid''s initial outwards velocity',
'Asteroid''s initial orbital velocity',
'Numerical Integration Method',
'Fixed or Wobbling Sun position');
Procedure Scrog(i: integer; var v: grist);
var hic: integer;
BEGIN
hic:=-666;
if paramstr(i) <> '' then Val(Paramstr(i),v,hic);
if hic <> 0 then Reject(paramstr(i) + ' for ' + usage[i]);
END;
Function ScrogT(i: integer; var n: integer; List: string): boolean;
var c: char;
var stupid: string[1];
BEGIN
if paramstr(i) = '' then scrogt:=false
else
begin
stupid:=copy(Paramstr(i),1,1);
c:=char(hi(integer(stupid)));
n:=Pos(upcase(c),List);
if n <= 0 then Reject(paramstr(i) + ' not one of ' + list + ' for ' + usage[i]);
scrogt:=true;
end;
END;
 
 
{$F+} Function HeapFull(Size: word): integer; {$F-}
Begin HeapFull:=1; End; {Sez "If full, return a null pointer" to GetMem.}
{Damnit, Turbo pascal's pointer using procedures don't check for null pointers!}
var i: Integer;
BEGIN {The main programme at last.}
HeapError:=@HeapFull; {Memory shortages?}
AsItWas:=LastMode;
Writeln(' A Wanderer in an unstable orbit.');
Style:=3;
Wobble:=true;
Year:=1000;
SM:=1; PM:=0.15;
AR:=0.5; AA:=0;
ARV:=0; ACV:=-0.75;
if paramcount > 0 then
begin
if paramstr(1) = '?' then begin Grunt(1); exit; end;
Scrog(1,year); year:=round(year); {Whole steps only!}
Scrog(2,PM);
Scrog(3,AR);
Scrog(4,AA);
Scrog(5,ARV);
Scrog(6,ACV);
if ScrogT(7,Style,'EMR') then style:=max(1,min(style,3));
if ScrogT(8,i,'FW') then Wobble:=i = 2;
end;
AA:=Pi*AA/180;
PrepareTheCanvas;
WanderAlong;
TextMode(AsItWas);
END.
 

Relativistic orbits[edit]

Another magazine article described a calculation for orbits twisted by the gravity around black holes. Only a two-body problem, and only just, because the orbiting body's mass is ignored.

 
{$N+ Crunch only the better sort of numbers, thanks.}
Program Swirl; Uses Graph, Crt;
{ Calculates and displays orbits strongly twisted by gravity, as described
in the article by J. Gallmeier et al, in Sky & Telescope, October 1995, which
included the source code of a programme written in basic, so some changes here.
An actual pulsar in orbit about another compact body has parameters
EC = .61713 and SG = .000025, resulting in a precession of .0037 degrees/orbit.
More fierce relativistic effects involve close passages by a black hole.
A dark disc appears corresponding to the event horizon diameter for a
non-rotating black hole (the screen is normally 'black' so the black hole is
not depicted as black) and a circle at twice its diameter is drawn; particles
venturing within that bound will not repeat their orbit as they are either on
the way down the drain, or else on a hyperbolic flypast.
This calculation is for orbits that continue indefinitely, and the authors
have used the classic Runge-Kutta fourth-order method to numerically integrate
the relativistic equations twisting the axes of the orbit.}

 
{Perpetrated by R.N.McLean (whom God preserve), Victoria University, Nov. VMM.}
 
Type Grist = {$IFOPT N+} extended {$ELSE} real {$ENDIF};
const esc = #27;
var colour,lastcolour,xmax,ymax,txtheight: integer;
var stretch: grist;
Type AnyString = string[80];
 
FUNCTION Trim(S : anystring) : anystring;
var L1,L2 : integer;
BEGIN
L1 := 1;
WHILE (L1 <= LENGTH(S)) AND (S[L1] = ' ') DO INC(L1);
L2 := LENGTH(S);
WHILE (S[L2] = ' ') AND (L2 > L1) DO DEC(L2);
IF L2 >= L1 THEN Trim := COPY(S,L1,L2 - L1 + 1) ELSE Trim := '';
END; {Of Trim.}
 
FUNCTION Ifmt(Digits : longint) : anystring;
var S : anystring;
BEGIN
STR(Digits,S);
Ifmt := Trim(S);
END; { Ifmt }
 
FUNCTION Ffmt(Digits: grist; Width,Decimals: integer): anystring;
var
S : anystring;
L : integer; { a finger }
BEGIN
if digits = 0 then begin Ffmt:='0'; exit; end; {Mumble.}
IF Abs(Digits) < 0.0000001 THEN STR(Digits,S)
ELSE STR(Digits:Width:Decimals,S);
s:=trim(s);
if copy(s,1,2) = '0.' then s:=copy(s,2,Length(s) - 1);
if copy(s,1,3) = '-0.' then s:=concat('-',copy(s,3,Length(s) - 2));
l:=Length(s);
if pos('.',s) > 0 then while (l > 0) and (s[l] = '0') do l:=l - 1;
if s[l] = '.' then l:=l - 1; {No non-zero fractional part!}
S := COPY(S,1,L); {Drop trailing boredom.}
l:=Pos('.',S); {Avoid sequences such as 3.1415.}
if l > 0 then s[l]:=chr(249); {By using decimal points, please.}
Ffmt := S;
END; { Ffmt }
 
Procedure Rogbiv;
BEGIN;
SetPalette( 0,Black);
SetPalette( 1,DarkGray); {Looks navy blue to me.}
SetPalette( 2,Blue);
SetPalette( 3,LightBlue);
SetPalette( 4,LightCyan);
SetPalette( 5,Cyan);
SetPalette( 6,LightGreen);
SetPalette( 7,Green);
SetPalette( 8,LightGray); {Looks light brown to me.}
SetPalette( 9,Yellow);
SetPalette(10,Brown); {Looks yellow to me.}
SetPalette(11,Red);
SetPalette(12,LightRed);
SetPalette(13,Magenta);
SetPalette(14,LightMagenta);
SetPalette(15,White);
END; {Of Rogbiv.}
 
Procedure PrepareTheCanvas;
Var mode: integer;
Var SavedResultCode: integer;
Var ax,ay: word;
Function BGIFound(Here: Anystring): boolean;
Var driver: integer;
BEGIN
Driver:=Detect;
InitGraph(driver,mode,Here);
SavedResultCode:=GraphResult; {Mumble!}
BGIFound:=SavedResultCode = 0; {Missing file gives -3.}
END; {Of BGIFound.}
Var aplace: anystring;
Var Palette: paletteType;
BEGIN
Mode:=0;
if not BGIFound('') then
if not BGIFound('C:\TP7\BGI') then
if not BGIFound('D:\TP4') then
begin
WriteLn;
WriteLn('Trouble with Borland''s Graphic Interface!');
WriteLn('Message: ',GraphErrorMsg(SavedResultCode));
WriteLn('I''ve tried "", "C:\TP4", and "D:\TP4"...');
Repeat
Write('Another place to look? (e.g. a:\bgiset)');
ReadLn(Aplace); {As opposed to Read. weird.}
If Aplace = '' then
begin
writeln;
write('No .bgi, no piccy.');
halt;
end;
until BGIFound(Aplace);
end;
SetViewPort(0,0,GetMaxX,GetMaxY,True); {Clipping on, thanks. No apparent slowdown.}
SetGraphMode(Mode);
GetPalette(Palette);
LastColour := Palette.Size - 1; {Colours are 0:15, 16 thereof.}
if LastColour <= 0 then LastColour:=1;
if LastColour = 15 then Rogbiv;
xmax:=GetMaxX; ymax:=GetMaxY;
txtheight:=TextHeight('I');
GetAspectRatio(ax,ay); stretch:=ay/ax; {I hope this handles the screen's physical dimensions}
END; {as well as the number of dots in the x and y directions.}
 
Procedure Splot(x,y:integer; bumf: anystring);
var l: integer;
BEGIN
l:=TextWidth(Bumf);
if x + l > xmax then x:=xmax - l;
SetFillStyle(EmptyFill,Black); Bar(x,y,x + l,y + txtheight - 1);
OutTextXY(x,y,bumf);
END;
 
Var nstep: longint;
Procedure SplotStep;
BEGIN
Splot(xmax,0 + TxtHeight,'Stepcount: ' + ifmt(nstep));
END;
 
 
Var EC,SG,SS,SA: grist;
Var n: longint;
Procedure PrecessRelativistically;
var
SX,SY,
C0,C2,RH,
Q,SN,QN,DN,HN,DP,SP,
K1,K2,K3,K4,L1,L2,L3,L4: grist;
var xc,yc,px,py: integer;
Procedure Fullturn;
BEGIN
Line(xc,yc, round(PX),round(PY));
n:=n + 1;
Splot(xmax,0,'Completed orbits ' + ifmt(n));
SplotStep;
if n = 1 then {First time round?}
begin {Yep. DP and DN straddle zero. Find S where D = 0.}
SA:=(SP - DP*(SN - SP)/(DN - DP))*180/Pi - 360;
Splot(xmax,ymax - txtheight,'Precession per orbit ' + ffmt(SA,15,5) + 'ø');
end; {y:x=0 given (x1,y1) and (x2,y2): y = y1 - x1*(y2 - y1)/(x2 - x1)}
colour:=colour + 1;
if colour > Lastcolour then colour:=3;
setcolor(colour);
END;
Var ch: char;
BEGIN
Splot(0,0,'Eccentricity ' + ffmt(EC,9,6));
Splot(0,ymax - txtheight,'Relativistic Factor ' + ffmt(SG,9,6));
Splot(xmax,0 + 2*txtheight,'StepSize ' + ffmt(SS,8,3));
xc:=xmax div 2; yc:=ymax div 2;
n:=0; nstep:=0;
SS:=0.0009*(SS - 0.9)*(1 - 0.9*exp(10*EC - 9)); {Step size stuff...}
SY:=yc/(1 + EC); SX:=SY*stretch;
C0:=(1 - SG*(3 + EC*EC)/(6 + 2*EC))/(1 - EC*EC);
RH:=SG*(1 - EC*EC)/(3 + EC);
C2:=1.5*RH;
SA:=0;
Colour:=1; SetColor(Colour); Circle(xc,yc,round(SX*RH));
SetFillStyle(SolidFill,Colour); FloodFill(xc,yc,Colour);
Circle(xc,yc,round(SX*RH*2));
Colour:=2; SetColor(Colour); Line(0,yc, xmax,yc); Line(xc,0, xc,ymax);
Colour:=3; SetColor(Colour);
SN:=0; QN:=1/(1 + EC); DN:=0;
repeat
DP:=DN; SP:=SN;
HN:=SS*QN*QN;
Q:=QN; K1:=(C0 - Q + C2*Q*Q)*HN; L1:=HN*DN;
Q:=QN + L1/2; K2:=(C0 - Q + C2*Q*Q)*HN; L2:=HN*(DN + K1/2);
Q:=QN + L2/2; K3:=(C0 - Q + C2*Q*Q)*HN; L3:=HN*(DN + K2/2);
Q:=QN + L3; K4:=(C0 - Q + C2*Q*Q)*HN; L4:=HN*(DN + K3);
QN:=QN + (L1 + (L2 + L3)*2 + L4)/6;
DN:=DN + (K1 + (K2 + K3)*2 + K4)/6;
SN:=SN + HN;
px:=xc + Round(SX*cos(SN)/QN); py:=yc - Round(SY*sin(SN)/QN);
PutPixel(px,py,Colour);
nstep:=nstep + 1;
if (DN > 0) and (DP < 0) then fullturn
else if nstep mod 250 = 0 then splotstep;
until keypressed;
if readkey <> esc then repeat until keypressed;
END; {Of PrecessRelativistically.}
 
Procedure Grunt;
BEGIN
WriteLn('Draws orbits under relativistic conditions.');
WriteLn('Activate with two parameters:');
WriteLn(' Orbital Eccentricity (0 to 0ù9),');
WriteLn(' Relativistic factor (0 to 0ù999)');
WriteLn('An optional third parameter is the step size (1 to 10, e.g. 5).');
WriteLn('(If no parameters are supplied, an example run results)');
WriteLn('Eg. Swirl 0.5 0.5 5');
WriteLn('Don''t forget the leading zeroes that turbo pascal demands...');
WriteLn('ESC to quit.');
END;
 
Procedure Reject(Gripe: anystring);
BEGIN
Writeln;
Writeln('Unsavoury: ',Gripe);
Writeln;
Grunt;
Halt;
END;
 
Var AsItWas: word;
Var i: integer;
Var Hic: array[1..3] of integer;
BEGIN
AsItWas:=LastMode;
Writeln(' Precession of Elliptical Orbits.');
EC:=0.8; SG:=0.3826057; SS:=5; {These values result in 72 degrees/orbit...}
if paramcount > 0 then
begin
if paramstr(1) = '?' then begin Grunt; exit; end;
Val(ParamStr(1),EC,hic[1]);
Val(ParamStr(2),SG,hic[2]);
hic[3]:=0; if paramcount >= 3 then Val(paramstr(3),SS,Hic[3]);
for i:=1 to 3 do if hic[i] > 0 then Reject('Parameter ' + ifmt(i) + ': ' + paramstr(i));
end;
if (ec < 0) or (ec >= 1) then Reject('an eccentricity of ' + ffmt(ec,15,5));
if (sg < 0) or (sg >= 1) then Reject('a relativistic factor of ' + ffmt(sg,15,5));
if ss <= 0 then Reject('a step size of ' + ffmt(ss,15,5));
PrepareTheCanvas;
PrecessRelativistically;
TextMode(AsItWas);
WriteLn('Orbital eccentricity:',EC:15:5);
WriteLn('Relativistic factor :',SG:15:5);
WriteLn('Precession per orbit:',SA:15:5);
WriteLn('Orbits completed: ',n);
WriteLn('Calculation steps:',nstep);
END.
 

Perl 6[edit]

We'll try to simulate the Sun+Earth+Moon system, with plausible astronomical values.

We use a 18-dimension vector . The first nine dimensions are the positions of the three bodies. The other nine are the velocities. This allows us to write the dynamics as a first-temporal derivative equation, since

and thus

# Simple Vector implementation
multi infix:<+>(@a, @b) { @a Z+ @b }
multi infix:<->(@a, @b) { @a Z- @b }
multi infix:<*>($r, @a) { $r X* @a }
multi infix:</>(@a, $r) { @a X/ $r }
sub norm { sqrt [+] @_ X** 2 }
 
# Runge-Kutta stuff
sub runge-kutta(&yp) {
return -> \t, \y, \δt {
my $a = δt * yp( t, y );
my $b = δt * yp( t + δt/2, y + $a/2 );
my $c = δt * yp( t + δt/2, y + $b/2 );
my $d = δt * yp( t + δt, y + $c );
($a + 2*($b + $c) + $d) / 6;
}
}
 
# gravitational constant
constant G = 6.674e-11;
# astronomical unit
constant au = 150e9;
 
# time constants in seconds
constant year = 365.25*24*60*60;
constant month = 21*24*60*60;
 
# masses in kg
constant $ma = 2e30; # Sun
constant $mb = 6e24; # Earth
constant $mc = 7.34e22; # Moon
 
my &dABC = runge-kutta my &f = sub ( $t, @ABC ) {
my @a = @ABC[0..2];
my @b = @ABC[3..5];
my @c = @ABC[6..8];
 
my $ab = norm(@a - @b);
my $ac = norm(@a - @c);
my $bc = norm(@b - @c);
 
return [
flat
@ABC[@(9..17)],
map G * *,
$mb/$ab**3 * (@b - @a) + $mc/$ac**3 * (@c - @a),
$ma/$ab**3 * (@a - @b) + $mc/$bc**3 * (@c - @b),
$ma/$ac**3 * (@a - @c) + $mb/$bc**3 * (@b - @c);
];
}
 
loop (
my ($t, @ABC) = 0,
0, 0, 0, # Sun position
au, 0, 0, # Earth position
0.998*au, 0, 0, # Moon position
0, 0, 0, # Sun speed
0, 2*pi*au/year, 0, # Earth speed
0, 2*pi*(au/year + 0.002*au/month), 0 # Moon speed
;
$t < 1;
$t, @ABC »Z[+=]« .01, dABC($t, @ABC, .01)
) {
printf "t = %.02f : %s\n", $t, @ABC.fmt("%+.3e");
}
Output:
t = 0.00 : +0.000e+00 +0.000e+00 +0.000e+00 +1.500e+11 +0.000e+00 +0.000e+00 +1.497e+11 +0.000e+00 +0.000e+00 +0.000e+00 +0.000e+00 +0.000e+00 +0.000e+00 +2.987e+04 +0.000e+00 +0.000e+00 +3.090e+04 +0.000e+00
t = 0.01 : +9.008e-13 +5.981e-22 +0.000e+00 +1.500e+11 +2.987e+02 +0.000e+00 +1.497e+11 +3.090e+02 +0.000e+00 +1.802e-10 +1.794e-19 +0.000e+00 -5.987e-05 +2.987e+04 +0.000e+00 -1.507e-05 +3.090e+04 +0.000e+00
t = 0.02 : +3.603e-12 +4.785e-21 +0.000e+00 +1.500e+11 +5.973e+02 +0.000e+00 +1.497e+11 +6.181e+02 +0.000e+00 +3.603e-10 +7.177e-19 +0.000e+00 -1.197e-04 +2.987e+04 +0.000e+00 -3.014e-05 +3.090e+04 +0.000e+00
t = 0.03 : +8.107e-12 +1.615e-20 +0.000e+00 +1.500e+11 +8.960e+02 +0.000e+00 +1.497e+11 +9.271e+02 +0.000e+00 +5.405e-10 +1.615e-18 +0.000e+00 -1.796e-04 +2.987e+04 +0.000e+00 -4.521e-05 +3.090e+04 +0.000e+00
t = 0.04 : +1.441e-11 +3.828e-20 +0.000e+00 +1.500e+11 +1.195e+03 +0.000e+00 +1.497e+11 +1.236e+03 +0.000e+00 +7.206e-10 +2.871e-18 +0.000e+00 -2.395e-04 +2.987e+04 +0.000e+00 -6.028e-05 +3.090e+04 +0.000e+00
t = 0.05 : +2.252e-11 +7.476e-20 +0.000e+00 +1.500e+11 +1.493e+03 +0.000e+00 +1.497e+11 +1.545e+03 +0.000e+00 +9.008e-10 +4.486e-18 +0.000e+00 -2.993e-04 +2.987e+04 +0.000e+00 -7.535e-05 +3.090e+04 +0.000e+00
t = 0.06 : +3.243e-11 +1.292e-19 +0.000e+00 +1.500e+11 +1.792e+03 +0.000e+00 +1.497e+11 +1.854e+03 +0.000e+00 +1.081e-09 +6.460e-18 +0.000e+00 -3.592e-04 +2.987e+04 +0.000e+00 -9.041e-05 +3.090e+04 +0.000e+00
t = 0.07 : +4.414e-11 +2.051e-19 +0.000e+00 +1.500e+11 +2.091e+03 +0.000e+00 +1.497e+11 +2.163e+03 +0.000e+00 +1.261e-09 +8.792e-18 +0.000e+00 -4.191e-04 +2.987e+04 +0.000e+00 -1.055e-04 +3.090e+04 +0.000e+00
t = 0.08 : +5.765e-11 +3.062e-19 +0.000e+00 +1.500e+11 +2.389e+03 +0.000e+00 +1.497e+11 +2.472e+03 +0.000e+00 +1.441e-09 +1.148e-17 +0.000e+00 -4.789e-04 +2.987e+04 +0.000e+00 -1.206e-04 +3.090e+04 +0.000e+00
t = 0.09 : +7.296e-11 +4.360e-19 +0.000e+00 +1.500e+11 +2.688e+03 +0.000e+00 +1.497e+11 +2.781e+03 +0.000e+00 +1.621e-09 +1.453e-17 +0.000e+00 -5.388e-04 +2.987e+04 +0.000e+00 -1.356e-04 +3.090e+04 +0.000e+00
t = 0.10 : +9.008e-11 +5.981e-19 +0.000e+00 +1.500e+11 +2.987e+03 +0.000e+00 +1.497e+11 +3.090e+03 +0.000e+00 +1.802e-09 +1.794e-17 +0.000e+00 -5.987e-04 +2.987e+04 +0.000e+00 -1.507e-04 +3.090e+04 +0.000e+00
t = 0.11 : +1.090e-10 +7.961e-19 +0.000e+00 +1.500e+11 +3.285e+03 +0.000e+00 +1.497e+11 +3.399e+03 +0.000e+00 +1.982e-09 +2.171e-17 +0.000e+00 -6.586e-04 +2.987e+04 +0.000e+00 -1.658e-04 +3.090e+04 +0.000e+00
t = 0.12 : +1.297e-10 +1.034e-18 +0.000e+00 +1.500e+11 +3.584e+03 +0.000e+00 +1.497e+11 +3.709e+03 +0.000e+00 +2.162e-09 +2.584e-17 +0.000e+00 -7.184e-04 +2.987e+04 +0.000e+00 -1.808e-04 +3.090e+04 +0.000e+00
t = 0.13 : +1.522e-10 +1.314e-18 +0.000e+00 +1.500e+11 +3.882e+03 +0.000e+00 +1.497e+11 +4.018e+03 +0.000e+00 +2.342e-09 +3.032e-17 +0.000e+00 -7.783e-04 +2.987e+04 +0.000e+00 -1.959e-04 +3.090e+04 +0.000e+00
t = 0.14 : +1.766e-10 +1.641e-18 +0.000e+00 +1.500e+11 +4.181e+03 +0.000e+00 +1.497e+11 +4.327e+03 +0.000e+00 +2.522e-09 +3.517e-17 +0.000e+00 -8.382e-04 +2.987e+04 +0.000e+00 -2.110e-04 +3.090e+04 +0.000e+00
t = 0.15 : +2.027e-10 +2.019e-18 +0.000e+00 +1.500e+11 +4.480e+03 +0.000e+00 +1.497e+11 +4.636e+03 +0.000e+00 +2.702e-09 +4.037e-17 +0.000e+00 -8.980e-04 +2.987e+04 +0.000e+00 -2.260e-04 +3.090e+04 +0.000e+00
t = 0.16 : +2.306e-10 +2.450e-18 +0.000e+00 +1.500e+11 +4.778e+03 +0.000e+00 +1.497e+11 +4.945e+03 +0.000e+00 +2.883e-09 +4.593e-17 +0.000e+00 -9.579e-04 +2.987e+04 +0.000e+00 -2.411e-04 +3.090e+04 +0.000e+00
t = 0.17 : +2.603e-10 +2.938e-18 +0.000e+00 +1.500e+11 +5.077e+03 +0.000e+00 +1.497e+11 +5.254e+03 +0.000e+00 +3.063e-09 +5.186e-17 +0.000e+00 -1.018e-03 +2.987e+04 +0.000e+00 -2.562e-04 +3.090e+04 +0.000e+00
t = 0.18 : +2.919e-10 +3.488e-18 +0.000e+00 +1.500e+11 +5.376e+03 +0.000e+00 +1.497e+11 +5.563e+03 +0.000e+00 +3.243e-09 +5.814e-17 +0.000e+00 -1.078e-03 +2.987e+04 +0.000e+00 -2.712e-04 +3.090e+04 +0.000e+00
t = 0.19 : +3.252e-10 +4.102e-18 +0.000e+00 +1.500e+11 +5.674e+03 +0.000e+00 +1.497e+11 +5.872e+03 +0.000e+00 +3.423e-09 +6.477e-17 +0.000e+00 -1.138e-03 +2.987e+04 +0.000e+00 -2.863e-04 +3.090e+04 +0.000e+00

Tcl[edit]

Works with: Tcl version 8.6
package require Tcl 8.6
 
set G 0.01
set epsilon 1e-12
 
proc acceleration.gravity {positions masses} {
global G epsilon
set i -1
lmap position $positions mass $masses {
incr i
set dp2 [lmap p $position {expr 0.0}]
set j -1
foreach pj $positions mj $masses {
if {[incr j] == $i} continue
set dp [lmap p1 $position p2 $pj {expr {$p1-$p2}}]
set d3 [expr {
sqrt(
[tcl::mathop::+ {*}[lmap p $dp {expr {$p ** 2}}]]
+ $epsilon
) ** 3
}]
# Add epsilon here?
set dp2 [lmap a $dp2 b $dp {expr {$a - $G*$mj*$b/$d3}}]
}
set dp2
}
}
 
# The rest of the system; simple numeric solution of differential equations
proc velocity {velocities accelerations} {
lmap v $velocities a $accelerations {
lmap vi $v ai $a {expr {$vi + $ai}}
}
}
proc position {positions velocities} {
lmap p $positions v $velocities {
lmap pi $p vi $v {expr {$pi + $vi}}
}
}
proc timestep {masses positions velocities} {
set accelerations [acceleration.gravity $positions $masses]
set velocities [velocity $velocities $accelerations]
set positions [position $positions $velocities]
list $positions $velocities
}
 
# Combine to make a simulation engine
proc simulate {masses positions velocities {steps 10}} {
set p $positions
set v $velocities
for {set i 0} {$i < $steps} {incr i} {
lassign [timestep $masses $p $v] p v
puts [lmap pos $p {format (%.5f,%.5f,%.5f) {*}$pos}]
}
}

Demonstrating for 20 steps:

set m {1 .1 .001}
set p {{0 0 0} {1 1 0} {0 1 1}}
set v {{0.01 0 0} {0 0 0.02} {0.01 -0.01 -0.01}}
simulate $m $p $v 20
Output:
(0.01035,0.00036,0.00000) (0.99646,0.99646,0.02000) (0.01035,0.98646,0.98611)
(0.02107,0.00108,0.00002) (0.98934,0.98931,0.03994) (0.02108,0.96930,0.96822)
(0.03214,0.00218,0.00005) (0.97856,0.97843,0.05973) (0.03221,0.94837,0.94617)
(0.04359,0.00367,0.00011) (0.96402,0.96368,0.07928) (0.04377,0.92350,0.91977)
(0.05544,0.00557,0.00021) (0.94559,0.94487,0.09851) (0.05581,0.89447,0.88875)
(0.06768,0.00790,0.00036) (0.92308,0.92176,0.11729) (0.06837,0.86100,0.85279)
(0.08036,0.01070,0.00057) (0.89626,0.89406,0.13548) (0.08152,0.82271,0.81146)
(0.09350,0.01400,0.00086) (0.86482,0.86136,0.15292) (0.09535,0.77910,0.76420)
(0.10714,0.01786,0.00126) (0.82839,0.82318,0.16939) (0.10996,0.72951,0.71025)
(0.12133,0.02234,0.00179) (0.78643,0.77885,0.18457) (0.12552,0.67304,0.64858)
(0.13614,0.02754,0.00251) (0.73827,0.72746,0.19806) (0.14224,0.60833,0.57768)
(0.15167,0.03357,0.00346) (0.68293,0.66775,0.20924) (0.16048,0.53332,0.49521)
(0.16805,0.04065,0.00476) (0.61899,0.59779,0.21710) (0.18075,0.44439,0.39722)
(0.18551,0.04908,0.00659) (0.54422,0.51449,0.21990) (0.20386,0.33411,0.27581)
(0.20445,0.05946,0.00934) (0.45470,0.41210,0.21398) (0.22971,0.17975,0.10892)
(0.22573,0.07337,0.01421) (0.34228,0.27744,0.18934) (0.19746,-0.27259,-0.30685)
(0.25165,0.09535,0.02601) (0.18355,0.06171,0.09512) (0.16823,-0.69092,-0.69109)
(0.21467,0.08626,0.10162) (0.65371,0.15666,-0.63735) (0.13969,-1.10220,-1.06883)
(0.17838,0.07727,0.17608) (1.11702,0.25051,-1.35831) (0.11149,-1.51049,-1.44390)
(0.14224,0.06831,0.25028) (1.57874,0.34406,-2.07666) (0.08347,-1.91722,-1.81757)