|
1 | 1 | ;;; Based on 2.zig |
2 | 2 | ;;; Converted to Common Lisp by Bela Pecsek - 2021-12-04 |
3 | | -;;; * Code cleanup and refactoring - 2021-12-06 |
| 3 | +;;; * Code cleanup and refactoring - 2021-12-06 |
| 4 | +;;; * Slight optimization - 2021-12-07 |
4 | 5 | (declaim (optimize (speed 3) (safety 0) (debug 0))) |
5 | 6 |
|
6 | 7 | (eval-when (:compile-toplevel :load-toplevel :execute) |
|
15 | 16 | (declaim (inline x y z vx vy vz mass make-body)) |
16 | 17 | (defstruct (body (:type (vector f64)) |
17 | 18 | (:conc-name nil) |
18 | | - (:constructor make-body (x y z fill1 vx vy vz fill2 mass))) |
19 | | - x y z fill1 vx vy vz fill2 mass) |
| 19 | + (:constructor make-body (x y z fill1 vx vy vz fill2 mas))) |
| 20 | + x y z fill1 vx vy vz fill2 mas) |
20 | 21 |
|
21 | 22 | (declaim (ftype (function (body) f64.4) pos vel) |
22 | | - (inline pos vel mass set-pos (setf pos) set-vel (setf vel) (setf mass))) |
| 23 | + (inline pos vel mass set-pos (setf pos) set-vel (setf vel) set-mass (setf mass))) |
23 | 24 | (defun pos (body) |
24 | 25 | (f64.4-aref body 0)) |
25 | 26 | (defun vel (body) |
|
81 | 82 |
|
82 | 83 | ;; Helper functions |
83 | 84 | (declaim (ftype (function (f64.4 f64.4) f64) dot) |
84 | | - (inline dot scale length-sq length_)) |
| 85 | + (inline dot length-sq length_)) |
85 | 86 | (defun dot (a b) |
86 | 87 | (f64.4-hsum (f64.4* a b))) |
87 | 88 |
|
88 | | -(declaim (ftype (function (f64.4) f64) length-sq)) |
| 89 | +(declaim (ftype (function (f64.4) f64) length-sq length_)) |
89 | 90 | (defun length-sq (a) |
90 | 91 | (dot a a)) |
91 | 92 |
|
92 | | -(declaim (ftype (function (f64.4) f64) length_)) |
93 | 93 | (defun length_ (a) |
94 | 94 | (sqrt (length-sq a))) |
95 | 95 |
|
|
115 | 115 | (loop for (bi . rest) on system do |
116 | 116 | (dolist (bj rest) |
117 | 117 | (let* ((pd (f64.4- (pos bi) (pos bj))) |
118 | | - (dsq (f64.4 (dot pd pd))) |
| 118 | + (dsq (f64.4 (length-sq pd))) |
119 | 119 | (dst (f64.4-sqrt dsq)) |
120 | | - (mag (f64.4/ (f64.4* dsq dst)))) |
121 | | - (declare (type f64.4 dsq dst mag)) |
122 | | - (f64.4-decf (vel bi) (f64.4* pd (f64.4* (mass bj) mag))) |
123 | | - (f64.4-incf (vel bj) (f64.4* pd (f64.4* (mass bi) mag)))))) |
| 120 | + (mag (f64.4/ (f64.4* dsq dst))) |
| 121 | + (pd-mag (f64.4* pd mag))) |
| 122 | + (f64.4-decf (vel bi) (f64.4* pd-mag (mass bj))) |
| 123 | + (f64.4-incf (vel bj) (f64.4* pd-mag (mass bi)))))) |
124 | 124 | (loop for b in system do |
125 | 125 | (f64.4-incf (pos b) (vel b))))) |
126 | 126 |
|
127 | 127 | ;; Output the total energy of the system. |
128 | 128 | (declaim (ftype (function (list) null) energy)) |
129 | 129 | (defun energy (system) |
130 | | - (loop with e of-type f64 = 0d00 |
131 | | - for (bi . rest) on system do |
132 | | - ;; Add the kinetic energy for each body. |
133 | | - (incf e (f64* 0.5d0 (mass bi) (length-sq (vel bi)))) |
134 | | - (dolist (bj rest) |
135 | | - (declare (type body bj)) |
136 | | - ;; Add the potential energy between this body and every other bodies |
137 | | - (decf e (f64/ (f64* (mass bi) (mass bj)) |
138 | | - (length_ (f64.4- (pos bi) (pos bj)))))) |
139 | | - finally (format t "~,9f~%" e))) ;; Output the total energy of the system. |
| 130 | + (loop for (bi . rest) on system |
| 131 | + with e of-type f64 = 0d0 |
| 132 | + ;; Add the kinetic energy for each body. |
| 133 | + do (incf e (f64* 0.5d0 (mass bi) (length-sq (vel bi)))) |
| 134 | + (dolist (bj rest) |
| 135 | + (declare (type body bj)) |
| 136 | + ;; Add the potential energy between this body and every other bodies |
| 137 | + (decf e (f64/ (f64* (mass bi) (mass bj)) |
| 138 | + (length_ (f64.4- (pos bi) (pos bj)))))) |
| 139 | + finally (format t "~,9f~%" e))) |
140 | 140 |
|
141 | 141 | ;; Rescale certain properties of bodies. That allows doing |
142 | 142 | ;; consequential advances as if dt were equal to 1.0d0. |
|
155 | 155 | (let ((system *system*)) |
156 | 156 | (offset-momentum system) |
157 | 157 | (energy system) ;; Output initial energy of the system |
158 | | - (scale-bodies system +DT+) ;; Scale bodies to use time step of 1.0d0 |
| 158 | + (scale-bodies system +DT+) ;; Scale bodies to use unity time step |
159 | 159 | (advance system n-times) ;; Advance system n times |
160 | 160 | (scale-bodies system +RECIP-DT+) ;; Rescale bodies back to original |
161 | 161 | (energy system))) ;; Output final energy of the system |
|
0 commit comments