(50g) Week day / Season begin / Mean / True ecliptic / Julian Day / Astron Nutation

[Gil]

Here are the codes.

—>epsilon
\<< "
2 Inputs
:
. 
y.mmdd

. 
h.mmsss 
[in TD]
" DROP DEG \->T \->D \->M \->M\180 \->F \->\GW \->\GD\165 \->\Ge0 \->\GD\Ge \Ge0 \GD\Ge HMS+ DUP '\Ge' STO "\Ge.True D.mmss" \->TAG
\>>


—>T
\<< \->JD + 2451545 - 36525 / \->NUM DUP 'T' STO "T" \->TAG
\>>

—>D
\<< '297.85036+445267.11148*T-.0019142*T^2+T^3/189474' \->NUM 360 MOD \->HMS DUP 'D' STO "D D.mmss" \->TAG
\>>

—>M
\<< '357.52772+35999.05034*T-.0001603*T^2-T^3/300000.' \->NUM 360 MOD \->HMS DUP 'M' STO "M D.mmss" \->TAG
\>>

—>M'
\<< '134.96298+477198.867398*T+.0086972*T^2+T^3/56250' \->NUM 360 MOD \->HMS DUP 'M\180' STO "M\180 D.mmss" \->TAG
\>>

—>F
\<< '93.27191+483202.017538*T-.0036825*T^2+T^3/327270' \->NUM 360 MOD \->HMS DUP 'F' STO "F D.mmss" \->TAG
\>>

—>GW
\<< '125.04452-1934.136261*T+.0020708*T^2+T^3/450000.' \->NUM 360 MOD \->HMS DUP '\GW' STO "\GW D.mmss" \->TAG
\>>


—>¥
\<< D HMS\-> M HMS\-> M\180 HMS\-> F HMS\-> \GW HMS\-> \-> D M M\180 F \GW
\<< 0 1 63
FOR i D T22A { i 1 } GET * M T22A { i 2 } GET * + M\180 T22A { i 3 } GET * + F T22A { i 4 } GET * + \GW T22A { i 5 } GET * + SIN T22A { i 6 } GET T22A { i 7 } GET T * + * +
NEXT 10000 / DUP '\GD\165' STO "\GD\165.Nut.Long s.ss" \->TAG
\>>
\>>

T22A
[[ 0 0 0 0 1 -171996 -174.2 92025 8.9 ]
[ -2 0 0 2 2 -13187 -1.6 5736 -3.1 ]
[ 0 0 0 2 2 -2274 -.2 977 -.5 ]
[ 0 0 0 0 2 2062 .2 -895 .5 ]
[ 0 1 0 0 0 1426 -3.4 54 -.1 ]
[ 0 0 1 0 0 712 .1 -7 0 ]
[ -2 1 0 2 2 -517 1.2 224 -.6 ]
[ 0 0 0 2 1 -386 -.4 200 0 ]
[ 0 0 1 2 2 -301 0 129 -.1 ]
[ -2 -1 0 2 2 217 -.5 -95 .3 ]
[ -2 0 1 0 0 -158 0 0 0 ]
[ -2 0 0 2 1 129 .1 -70 0 ]
[ 0 0 -1 2 2 123 0 -53 0 ]
[ 2 0 0 0 0 63 0 0 0 ]
[ 0 0 1 0 1 63 .1 -33 0 ]
[ 2 0 -1 2 2 -59 0 26 0 ]
[ 0 0 -1 0 1 -58 -.1 32 0 ]
[ 0 0 1 2 1 -51 0 27 0 ]
[ -2 0 2 0 0 48 0 0 0 ]
[ 0 0 -2 2 1 46 0 -24 0 ]
[ 2 0 0 2 2 -38 0 16 0 ]
[ 0 0 2 2 2 -31 0 13 0 ]
[ 0 0 2 0 0 29 0 0 0 ]
[ -2 0 1 2 2 29 0 -12 0 ]
[ 0 0 0 2 0 26 0 0 0 ]
[ -2 0 0 2 0 -22 0 0 0 ]
[ 0 0 -1 2 1 21 0 -10 0 ]
[ 0 2 0 0 0 17 -.1 0 0 ]
[ 2 0 -1 0 1 16 0 -8 0 ]
[ -2 2 0 2 2 -16 .1 7 0 ]
[ 0 1 0 0 1 -15 0 9 0 ]
[ -2 0 1 0 1 -13 0 7 0 ]
[ 0 -1 0 0 1 -12 0 6 0 ]
[ 0 0 2 -2 0 11 0 0 0 ]
[ 2 0 -1 2 1 -10 0 5 0 ]
[ 2 0 1 2 2 -8 0 3 0 ]
[ 0 1 0 2 2 7 0 -3 0 ]
[ -2 1 1 0 0 -7 0 0 0 ]
[ 0 -1 0 2 2 -7 0 3 0 ]
[ 2 0 0 2 1 -7 0 3 0 ]
[ 2 0 1 0 0 6 0 0 0 ]
[ -2 0 2 2 2 6 0 -3 0 ]
[ -2 0 1 2 1 6 0 -3 0 ]
[ 2 0 -2 0 1 -6 0 3 0 ]
[ 2 0 0 0 1 -6 0 3 0 ]
[ 0 -1 1 0 0 5 0 0 0 ]
[ -2 -1 0 2 1 -5 0 3 0 ]
[ -2 0 0 0 1 -5 0 3 0 ]
[ 0 0 2 2 1 -5 0 3 0 ]
[ -2 0 2 0 1 4 0 0 0 ]
[ -2 1 0 2 1 4 0 0 0 ]
[ 0 0 1 -2 0 4 0 0 0 ]
[ -1 0 1 0 0 -4 0 0 0 ]
[ -2 1 0 0 0 -4 0 0 0 ]
[ 1 0 0 0 0 -4 0 0 0 ]
[ 0 0 1 2 0 3 0 0 0 ]
[ 0 0 -2 2 2 -3 0 0 0 ]
[ -1 -1 1 0 0 -3 0 0 0 ]
[ 0 1 1 0 0 -3 0 0 0 ]
[ 0 -1 1 2 2 -3 0 0 0 ]
[ 2 -1 -1 2 2 -3 0 0 0 ]
[ 0 0 3 2 2 -3 0 0 0 ]
[ 2 -1 0 2 2 -3 0 0 0 ]]

—>GD\Ge
\<< D HMS\-> M HMS\-> M\180 HMS\-> F HMS\-> \GW HMS\-> \-> D M M\180 F \GW
\<< 0 1 63
FOR i D T22A { i 1 } GET * M T22A { i 2 } GET * + M\180 T22A { i 3 } GET * + F T22A { i 4 } GET * + \GW T22A { i 5 } GET * + COS T22A { i 8 } GET T22A { i 9 } GET T * + * +
NEXT 100000000 / DUP '\GD\Ge' STO 10000 * "\GD\Ge.Nut.Obl s.ss" \->TAG
\>>
\>>

—>Ge0
\<< T 100 / \-> U '-4680.93*U-1.55*U^2+1999.25*U^3-51.38*U^4-249.67*U^5-39.05*U^6+7.12*U^7+27.87*U^8+5.79*U^9+2.45*U^10' \->NUM 10000 / 23.2621448 + DUP '\Ge0' STO "\Ge0.Mean D.mmss" \->TAG
\>>

—>delta.T
\<< \-> t
\<< t 2005 < t 2050 > OR
IF
THEN "Form.NOT.avail"
ELSE t 2000 - 't' STO '62.92+.32217*t+.005589*t^2' EVAL 2 RND "\GDT(s)=TAI-TUC" \->TAG
END
\>>
\>>

—>JD
\<< "
2 Inputs
:
. 
y.mmddd

. 
h.mmsss 
[in TD]
" DROP STD DUP2 SWAP 0 0 \-> h.mmsss date A B
\<< date IP date FP 100 * ABS DUP FP 100 * SWAP IP SWAP \-> y m d
\<<
IF m 2 \<=
THEN y 1 - 'y' STO m 12 + 'm' STO
END y 100 / IP 'A' STO
IF date 1582.1004 \<=
THEN 0
ELSE 2 A - A 4 / IP +
END 'B' STO 365.25 y 4716 + * IP 30.6001 m 1 + * IP + d + B + 1524.5 - h.mmsss 12 \>=
IF
THEN .5 + "JD" \->TAG h.mmsss 12 -
ELSE IP "JD" \->TAG h.mmsss 12 +
END HMS\-> 24 / "+JD" \->TAG
\>>
\>>
\>>

JD—>
\<< "
2 Inputs
:

 
. 
JD 
IP!


. 
JD 
FP!


" DROP STD DUP2 \-> Z F
\<< .5 F + DUP FP 'F' STO 'Z' STO+ 0 0 0 0 0 0 0 0 0 0 \-> \Ga A B C D E m d y s
\<<
IF Z 2291161 <
THEN Z
ELSE Z 1867216.25 - 36524.25 / IP '\Ga' STO Z 1 + \Ga + \Ga 4 / IP -
END 'A' STO A 1524 + 'B' STO B 122.1 - 365.25 / IP 'C' STO 365.25 C * IP 'D' STO B D - 30.6001 / IP 'E' STO B D - 30.6001 E * IP - IP 'd' STO
IF E 14 <
THEN E 1 -
ELSE E 13 -
END 'm' STO m 2 >
IF
THEN C 4716 -
ELSE C 4715 -
END 'y' STO y SIGN 's' STO y ABS 'y' STO y m 100 / + d 10000 / + s * "y.mmddd" \->TAG F 24 * \->HMS "+ TD h.mmss" \->TAG
\>>
\>>
\>>

SEASON
\<< \-> y
\<< y -1000 < y 3000 > OR "Not very accurate" 1 IFTE DEG y 1000. /
[[ 485 ]
[ 203 ]
[ 199 ]
[ 182 ]
[ 156 ]
[ 136 ]
[ 77 ]
[ 74 ]
[ 70 ]
[ 58 ]
[ 52 ]
[ 50 ]
[ 45 ]
[ 44 ]
[ 29 ]
[ 18 ]
[ 17 ]
[ 16 ]
[ 14 ]
[ 12 ]
[ 12 ]
[ 12 ]
[ 9 ]
[ 8 ]]
[[ 324.96 ]
[ 337.23 ]
[ 342.08 ]
[ 27.85 ]
[ 73.14 ]
[ 171.52 ]
[ 222.54 ]
[ 296.72 ]
[ 243.58 ]
[ 119.81 ]
[ 297.17 ]
[ 21.02 ]
[ 247.54 ]
[ 325.15 ]
[ 60.93 ]
[ 155.12 ]
[ 288.79 ]
[ 198.04 ]
[ 199.76 ]
[ 95.39 ]
[ 287.11 ]
[ 320.81 ]
[ 227.73 ]
[ 15.45 ]]
[[ 1934.136 ]
[ 32964.467 ]
[ 20.186 ]
[ 445267.112 ]
[ 45036.886 ]
[ 22518.443 ]
[ 65928.934 ]
[ 3034.906 ]
[ 9037.513 ]
[ 33718.147 ]
[ 150.678 ]
[ 2281.226 ]
[ 29929.562 ]
[ 31555.956 ]
[ 4443.417 ]
[ 67555.328 ]
[ 4562.452 ]
[ 62894.029 ]
[ 31436.921 ]
[ 14577.848 ]
[ 31931.756 ]
[ 34777.259 ]
[ 1222.114 ]
[ 16859.074 ]] 0 { } { } { } { } \-> Y A B C JDE0 T W \GD\Gl S
\<<
IF y 1000 \<=
THEN '1721139.29189+365242.1374*Y+.06134*Y^2+.00111*Y^3-.00071*Y^4' EVAL '1721233.25401+365241.72562*Y-.05323*Y^2+.00907*Y^3+.00025*Y^4' EVAL '1721325.70455+365242.49558*Y-.11677*Y^2-.00297*Y^3+.00074*Y^4' EVAL '1721414.39987+365242.88257*Y-.00769*Y^2-.00933*Y^3-.00006*Y^4' EVAL
ELSE Y 2 - 'Y' STO '2451623.80984+365242.37404*Y+.05169*Y^2-.00411*Y^3-.00057*Y^4' EVAL '2451716.56767+365241.62603*Y+.00325*Y^2+.00888*Y^3-.0003*Y^4' EVAL '2451810.21715+365242.01767*Y-.11575*Y^2+.00337*Y^3+.00078*Y^4' EVAL '2451900.05952+365242.74049*Y-.06223*Y^2-.00823*Y^3+.00032*Y^4' EVAL
END 4 \->LIST 'JDE0' STO 1 4
FOR i T JDE0 i GET 2451545 - 36525 / + 'T' STO W T i GET 35999.373 * 2.47 - + 'W' STO \GD\Gl 1 .0334 W i GET COS * + .0007 W i GET 2 * COS * + + '\GD\Gl' STO S 0 1 24
FOR j A j GET B j GET C j GET T i GET * + COS * +
NEXT + 'S' STO JDE0 i GET S i GET .00001 * \GD\Gl i GET / + DUP IP SWAP FP JD\-> 4 ROLL 4 ROLL DROP2 2 \->LIST
NEXT
\>>
\>> 5 ROLL DUP 1 == DROPN
\>>

Regards,
Gil