1 files changed, 69 insertions(+), 0 deletions(-)

A jdn.fs

@@ 0,0 1,69 @@
+\ jdn.fs --- Julian Day Number calculator
+\
+\ Formula (taken from Wikipedia article about Julian Day):
+\
+\ JDN = (1461 × (Y + 4800 + (M - 14)/12))/4
+\     - (3 × ((Y + 4900 + (M - 14)/12)/100))/4
+\     + (367 × (M − 2 − 12 × ((M - 14)/12)))/12
+\     + D
+\     - 32075
+\
+\ Substituting (M - 14)/12 with M' we get:
+\
+\ JDN = (1461 × (4800 + Y + M'))/4
+\     - (3 × ((4900 + Y + M')/100))/4
+\     + (367 × (M − 2 − 12 × M'))/12
+\     + D
+\     - 32075
+\
+
+\ Symmetric integer division.
+: /symdiv ( m n -- m/n )
+     /
+     dup 0 < if 1 + then ;
+
+: month-factor ( month -- M' )
+    14 - 12 /symdiv ;
+
+: Y-part ( Y+M' -- Y-part )
+    dup
+    4800 + 1461 * 4 /symdiv
+    swap
+    4900 + 100 /symdiv 3 * 4 /symdiv
+    - ;
+
+: M-part ( M -- M-part )
+    dup
+    month-factor -12 * + 2 -
+    367 * 12 /symdiv ;
+
+: julian-day ( d m y - j )
+    over month-factor +		\ leaves Y + M' at the top
+    Y-part swap			\ Y-part month
+    M-part +
+    +				\ add D
+    32075 - ;
+
+: date-dup ( d m y -- d m y d m y )
+    2 pick				\ D
+    2 pick				\ M
+    2 pick ;				\ Y
+
+: show-date ( d m y -- d m y )
+    date-dup ." Date: " . . . cr ;
+
+: equal? ( x y - )
+    2dup <>
+    if 2dup ." Expected " . ." but got " . ." (Difference: " - . ." )"
+    else 2drop ." OK"
+    then cr ;
+
+: test
+    \ Example values calculated with an online conversion utility
+    \ provided by NASA:
+    \ https://core2.gsfc.nasa.gov/time/julian.html
+    16 3 2020 show-date julian-day 2458925 equal?
+    21 12 2021 show-date julian-day 2459570 equal? ;
+
+test
+bye