%%HP: T(3)A(D)F(.);
@ NAV4, Celestial Navigation, by Tom Metcalf
DIR
  SOLVE
    \<< SAVES FFIX
DEG 0 0 0 0 0 GSUM
a0 \->NUM 'A0' STO a1
\->NUM 'A1' STO EV1
\->NUM DUP '\Ga1' STO
EIGEN 'E1' STO EV3
\->NUM DUP '\Ga3' STO
EIGEN 'E3' STO EV2
\->NUM DUP '\Ga2' STO
EIGEN 'E2' STO R E1
DOT '\Gb1' STO
      IF '\Ga1==0 AND
\Gb1==0'
      THEN
"AMBIGUOUS SOLUTION"
MESS KILL
      END R E2 DOT
'\Gb2' STO R E3 DOT
'\Gb3' STO 'G\Gm' '\Gm' {
\GmST LBND UBND }
ROOT DROP
      IF '\Gm>\Ga1 OR \Gm
<LBND'
      THEN
"ROOT ERROR"
      END UVW OUT
CLLCD "Update DR?"
2 DISP DUP2 \->STR 4
DISP \->STR 5 DISP
ASK
      IF 11.1 ==
      THEN DUP2
FMT\-> 'DRLAT' STO
FMT\-> 'DRLON' STO
      END RESTS
RESTS
    \>>
  ADDOB
    \<< SAVES DEG
RCLMENU 28 MENU \->
om
      \<<
"Time/Altitude
(hh.mmss)/"
FMT +
":Time: 
:H_s: " {
1 0 } 'V' 3 \->LIST
INPUT OBJ\-> DTAG
SWAP DTAG SWAP 0 \->
TM A n
        \<< TM HMS\->
'TM' STO
          IF TM T1
< TM T2 > BODY "T"
SAME NOT AND OR
          THEN
"Error:Bad Time
Press ENTER"
MESS om MENU KILL
          END A
CORRECT FMT\-> 'A'
STO TM GHA1 GHA2
INTERP 180 RANGE TM
DEC1 DEC2 INTERP
          IF 'SPD\=/0
'
          THEN TF
TM - SPD * 60 / CRS
RMOVE SWAP 180
RANGE SWAP
          END OBS
          IFERR
OBJ\->
          THEN 3
ROLLD A { 1 3 }
\->ARRY SWAP STO
          ELSE OBJ\->
ROT 1 + DUP 3 * 'n'
STO ROT ROT \->LIST n
ROLL n ROLL ROT A
SWAP \->ARRY 'OBS'
STO
          END
        \>> om MENU
      \>> RESTS
    \>>
  SETUP
    \<< RCLMENU 28
MENU \-> om
      \<< FFIX CLLCD
2 FREEZE MBODY
TMENU "BODY?"
PROMPT 'BODY' STO 0
MENU
        IF BODY "S"
SAME
        THEN
          DO
"SEMI-D? " FMT + SD
\->FMT \->STR 'V' 2
\->LIST INPUT OBJ\->
FMT\-> 'SEMI' STO
            IF '
SEMI>.55'
            THEN
"TOO LARGE:PRESS ENTER"
MESS
            END
          UNTIL '
SEMI\<=.55'
          END
        END
        IF BODY "M"
SAME BODY "VM" SAME
OR
        THEN
          DO
"HParallax? " FMT +
HP \->FMT \->STR 'V' 2
\->LIST INPUT OBJ\->
FMT\-> 'HP' STO
            IF 'HP>
1.2'
            THEN
"TOO LARGE:PRESS ENTER"
MESS
            END
          UNTIL 'HP
<1.2'
          END
        END
        IF BODY "M"
SAME BODY "S" SAME
OR
        THEN CLLCD
2 FREEZE MLIMB
TMENU "Limb?"
PROMPT 'LU' STO 0
MENU
        END
        DO
          IF BODY
"T" SAME
          THEN
"Star" ":GHA\Gg: " G\Gg
\->FMT \->STR +
"
:SHA: 
:DEC: 
" +
":TIM: " T\Gg \->HMS
\->STR + + { 1 0 }
'V' 3 \->LIST INPUT
OBJ\-> HMS\-> DUP 'T1'
STO DUP 'T\Gg' STO 1
+ 'T2' STO FMT\-> DUP
'DEC1' STO 'DEC2'
STO FMT\-> SWAP FMT\->
DUP 'G\Gg' STO + DUP
'GHA1' STO
15.041067 + 'GHA2'
STO
          ELSE
"Linear Interp 1" {
":GHA1: 
:DEC1: 
:TIM1: "
{ 1 0 } V } INPUT
OBJ\-> HMS\-> 'T1' STO
FMT\-> 'DEC1' STO
FMT\-> 'GHA1' STO
"Linear Interp 2" {
":GHA2: 
:DEC2: 
:TIM2: "
{ 1 0 } V } INPUT
OBJ\-> HMS\-> 'T2' STO
FMT\-> 'DEC2' STO
FMT\-> 'GHA2' STO
          END
          IF 'T1\>=T2
'
          THEN
"Err:T1\>=T2:Press ENTER"
MESS
          END
          IF 'GHA1>
GHA2'
          THEN
"GHA1>GHA2:Hit ENTER"
MESS
          END
        UNTIL 'T1<
T2 AND GHA1\<=GHA2'
        END
        IF 'SPD\=/0'
        THEN DR 4
FIX
"TIME OF FIX? (hms)"
TF \->HMS \->STR 'V' 2
\->LIST INPUT OBJ\->
HMS\-> 'TF' STO FFIX
        END om MENU
      \>>
    \>>
  INIT
    \<< RCLMENU 28
MENU \-> om
      \<< FFIX { {
"INDEX" {
        \<< 0 MENU
"INDEX? " FMT +
INDX \->FMT "INDEX"
\->TAG \->STR { 1 0 }
'V' 3 \->LIST INPUT
OBJ\-> FMT\-> 'INDX'
STO 0 CONT
        \>> } } {
"HEIGHT" {
        \<< 0 MENU
"HEIGHT? (m)" HGT
"HGT" \->TAG \->STR { 1
0 } 'V' 3 \->LIST
INPUT OBJ\-> '1_m'
DOUNIT 'HGT' STO 0
CONT
        \>> } } {
"C/S" {
        \<< 0 MENU
"Motion? (True/Knots)"
":COURSE: " CRS
\->FMT \->STR +
"
:SPEED: " SPD
\->STR + + { 1 0 }
'V' 3 \->LIST INPUT
OBJ\-> '1_knot'
DOUNIT 'SPD' STO
FMT\-> 180 RANGE
'CRS' STO 0 CONT
        \>> } } {
"P/T" {
        \<< 0 MENU
"ENTER for std cond"
{
":PRESS (mb): 1010
:TEMPER (C): 10"
-14 V } INPUT OBJ\->
'1_\^oC' DOUNIT
'TMPTR' STO '1_mbar
' DOUNIT 'PRESS'
STO 0 CONT
        \>> } } {
"FORMAT" {
        \<< 0 MENU
FFMT 1 +
          IF DUP 3
==
          THEN DROP
0
          END
'FFMT' STO
          CASE '
FFMT==2'
            THEN
"(decimal)"
            END '
FFMT==1'
            THEN
"(dd.mmt)"
            END '
FFMT==0'
            THEN
"(dd.mmss)"
            END
          END 'FMT'
STO FFIX 0 CONT
        \>> } } {
"EXIT" {
        \<< 1 CONT
        \>> } } }
TMENU
        DO CLLCD
"INDEX  " INDX \->FMT
\->STR + 2 DISP
"HEIGHT " HGT \->STR
"m" + + 3 DISP 1
FIX "MOTION " CRS
\->FMT \->STR + "T " +
SPD \->STR + "kn" + 4
DISP "P/T    "
PRESS \->STR "mb " +
TMPTR \->STR + "C" +
+ 5 DISP FFIX
"FORMAT "
          CASE '
FFMT==2'
            THEN
"Decimal"
            END '
FFMT==1'
            THEN
"HMT"
            END '
FFMT==0'
            THEN
"HMS"
            END "?"
          END + 6
DISP 3 FREEZE HALT
0 MENU
        UNTIL
        END om MENU
      \>>
    \>>
  ADDDR
    \<< SAVES 0
RCLMENU 28 MENU \-> n
om
      \<< OBS
        IFERR OBJ\->
        THEN DROP 0
        ELSE OBJ\->
DROP DROP
        END 'n' STO
FMT DRLAT \->FMT
"DR_LAT" \->TAG \->STR
"
" + DRLON \->FMT
"DR_LON" \->TAG \->STR
+ { 1 0 } 'V' 3
\->LIST 28 MENU INPUT
0 MENU OBJ\-> DTAG
FMT\-> SWAP DTAG FMT\->
90 n 1 + 3 2 \->LIST
\->ARRY 'OBS' STO om
MENU
      \>> RESTS
    \>>
  DR
    \<< RCLMENU 28
MENU \-> om
      \<< FFIX
"Dead Reckoning? 
"
FMT + DRLAT \->FMT
"DR_LAT" \->TAG \->STR
"
" + DRLON \->FMT
"DR_LON" \->TAG \->STR
+ { 1 0 } 'V' 3
\->LIST INPUT OBJ\->
FMT\-> 'DRLON' STO
FMT\-> 'DRLAT' STO om
MENU
      \>>
    \>>
  PLOTP
    \<< SAVES DEG
      IF DEPTH 2 <
      THEN
"LON/LAT NOT ON STACK"
MESS KILL
      END 2 DUPN
FMT\-> 'LAT' STO FMT\->
'LON' STO 0 0 0 0 0
0 0 0 0 0 0 0 0 0 0
\-> g d a l n N sc
sc\Gl ssz d0 d1 ll lm
top bot
      \<<
"Scale? (NMiles)" {
"9" -1 V } INPUT
OBJ\-> ABS '1_nmi'
DOUNIT
        IF DUP 0 ==
        THEN DROP
"SCALE\=/0 PLEASE"
MESS KILL
        END 120 /
DUP 'sc' STO LAT
COS / 2.0469 * 180
MIN NEG 'sc\Gl' STO
ERASE { # 0h # 0h }
PVIEW LON sc\Gl + LON
RANGE LAT sc + 90
MIN DUP 'top' STO
DUP 3 ROLLD R\->C
PMAX LON sc\Gl - LON
RANGE LAT sc - -90
MAX DUP 'bot' STO
DUP 3 ROLLD R\->C
PMIN - 2 / 'sc' STO
OBS OBJ\-> OBJ\-> DROP2
DUP 'N' STO 3 *
DROPN 1 N
        FOR n DEPTH
'd0' STO OBS { n 1
} GET 'g' STO OBS {
n 2 } GET 'd' STO
OBS { n 3 } GET 'a'
STO
          IF 'LAT-
sc>d+90-a OR LAT+sc
<d-90+a'
          THEN
          ELSE top
d 90 a - +
            IF DUP
90 >
            THEN
180 SWAP -
            END MIN
bot d 90 a - -
            IF DUP
-90 <
            THEN
180 + NEG
            END MAX
            IF LAT
d <
            THEN
SWAP
            END
DUP2 SWAP - DUP
SIGN
            IF DUP
0 ==
            THEN
DROP 1
            END
SWAP ABS 90 a -
PSCALE sc 32 / MAX
* 'ssz' STO DUP
'lm' STO SWAP DUP
'll' STO - ssz /
CEIL 0 SWAP
            FOR l g
d a l ssz * ll +
DUP lm
              IF '
ssz<0'
              THEN
SWAP
              END
              IF >
              THEN
DROP lm
              END
LOP DUP C\->R SWAP g
- NEG g + LON RANGE
SWAP R\->C DEPTH d0 -
ROLLD
            NEXT
DEPTH d0 - 2 / 2 +
'd1' STO
            WHILE
DEPTH d0 - DUP 1 >
            REPEAT
              IF d1
\=/
              THEN
OVER SWAP
              END
LIMIT LINE
            END
DEPTH d0 - DROPN
          END
        NEXT LAT
COS DUP LON
.0083333 ROT / -
LAT R\->C SWAP LON
.0083333 ROT / +
LAT R\->C LINE LON
LAT .0083333 - R\->C
LON LAT .0083333 +
R\->C LINE
      \>> { } PVIEW
RESTS
    \>>
  ADV
    \<< SAVES DEG
RCLMENU 28 MENU \->
om
      \<< 0 0 0 0 0 0
\-> \Gh d \Gl l n n3
        \<<
"Motion? (nmi,deg true)"
{
":DISTANCE: 
:COURSE: "
{ 1 0 } V } INPUT
OBJ\-> FMT\-> 180 RANGE
'\Gh' STO '1_nmi'
DOUNIT
          IF 'SPD\=/0
'
          THEN DUP
SPD / 'TF' STO+
          END 60 /
'd' STO 2 FIX CLLCD
"Old DR: " DRLAT
\->FMT \->STR + " " +
DRLON \->FMT \->STR + 4
DISP OBS
          IFERR
OBJ\->
          THEN DROP
          ELSE OBJ\->
DROP SWAP DUP 'n'
STO * 'n3' STO 1 n
            FOR I I
1 DISP 3 ROLLD 'l'
STO '\Gl' STO \Gl l d \Gh
RMOVE SWAP 180
RANGE SWAP ROT n3
ROLLD n3 ROLLD n3
ROLLD
            NEXT {
n 3 } \->ARRY 'OBS'
STO
          END DRLON
DRLAT d \Gh CCMOVE
'DRLAT' STO 'DRLON'
STO "New DR: "
DRLAT \->FMT \->STR +
" " + DRLON \->FMT
\->STR + 5 DISP FFIX
2 FREEZE
        \>> om MENU
      \>> RESTS
    \>>
  SAIL
    \<< SAVES RCLMENU
28 MENU \-> om
      \<< DEG 0 0 \->
fr\Gl frl
        \<< "From? "
FMT + DRLAT \->FMT
"Lat" \->TAG \->STR "
"
+ DRLON \->FMT "Lon"
\->TAG \->STR + { 1 0 }
'V' 3 \->LIST INPUT
OBJ\-> FMT\-> 'fr\Gl' STO
FMT\-> 'frl' STO
"TO? " FMT + tol
\->FMT "Lat" \->TAG
\->STR "
" + to\Gl \->FMT
"Lon" \->TAG \->STR + {
1 0 } 'V' 3 \->LIST
INPUT OBJ\-> FMT\->
'to\Gl' STO FMT\->
'tol' STO CLLCD 2
FREEZE { { "RHUMB"
          \<< 0 MENU
frl fr\Gl tol to\Gl
RHUMB 0 CONT
          \>> } {
"GC"
          \<< 0 MENU
frl fr\Gl tol to\Gl GC
0 CONT
          \>> } {
"WAY"
          \<< 0 MENU
"Scale? (nmi)" { ""
V } INPUT OBJ\-> '1_
nmi' DOUNIT 60 /
frl fr\Gl tol to\Gl WAY
0 CONT
          \>> } {
"VERT"
          \<< 0 MENU
frl fr\Gl tol to\Gl
VERTEX 0 CONT
          \>> } {
"COMP"
          \<< 0 MENU
"Composite" {
":Lat Limit: 
:Scale: "
{ 1 0 } V } INPUT
OBJ\-> '1_nmi' DOUNIT
60 / SWAP FMT\-> frl
fr\Gl tol to\Gl COMP 0
CONT
          \>> } {
"EXIT"
          \<< 1 CONT
          \>> } }
TMENU
          DO
"Type?" PROMPT 0
MENU
          UNTIL
          END
        \>> om MENU
      \>> RESTS
    \>>
  WVIEW
    \<< 2 FIX { }
SWAP { } 1 1 1 1
"Lat Lon Crs " FMT
+ 5 \->LIST DBR
      IF 1 \=/
      THEN DROP2
      ELSE SWAP
DROP SWAP DUP ROT
GET
      END FFIX
    \>>
  ERROR
    \<< SAVES DEG 0 0
0 0 0 0 0 0 \-> H1 H2
D1 D2 G1 G2 DT DH
      \<< OBS { 1 3 }
GET 'H1' STO OBS {
N 3 } GET 'H2' STO
OBS { 1 2 } GET
'D1' STO OBS { N 2
} GET 'D2' STO OBS
{ 1 1 } GET 'G1'
STO OBS { N 1 } GET
'G2' STO T2 T1 -
GHA2 GHA1 - / G2 G1
- * 'DT' STO H2 H1
- 'DH' STO 1 DT / N
\v/ / 57.3 H1 H2 + 2
/ COS * * 225 D1 D2
+ 2 / COS SQ * DH
DT / SQ - \v/ / "ERR"
\->TAG
      \>> RESTS
    \>>
  DRLAT
37.0204655112
  DRLON
51.455945662
  CORRECT
    \<< DEG FMT\-> INDX
+ HGT \v/ .0293 * -
DUP DUP REFRACT
SWAP COS
      CASE BODY "S"
SAME
        THEN
.002443 * SEMI
        END BODY
"M" SAME
        THEN HP *
HP .272476 *
        END BODY
"VM" SAME
        THEN HP * 0
        END 0 * 0
      END LU * +
SWAP - + \->FMT
    \>>
  RHUMB
    \<< \-> frl fr\Gl tol
to\Gl
      \<< DEG to\Gl fr\Gl
RANGE 'to\Gl' STO 'LN
(TAN(45+tol/2)/TAN(
45+frl/2))' \->NUM '-
\pi/180*(to\Gl-fr\Gl)'
\->NUM R\->C ARG 180
RANGE DUP \->FMT
"COURSE" \->TAG SWAP
        IF DUP COS
ABS .0001 >
        THEN COS
tol frl - SWAP /
        ELSE to\Gl
fr\Gl - tol frl + 2 /
COS * SWAP SIN /
ABS
        END 60 *
"DIST" \->TAG
      \>>
    \>>
  GC
    \<< \-> frl fr\Gl tol
to\Gl
      \<< DEG 'COS(
frl)*TAN(tol)-SIN(
frl)*COS(to\Gl-fr\Gl)'
\->NUM 'SIN(fr\Gl-to\Gl)'
\->NUM R\->C ARG 180
RANGE \->FMT "COURSE"
\->TAG 'ACOS(SIN(frl)
*SIN(tol)+COS(frl)*
COS(tol)*COS(to\Gl-
fr\Gl))' \->NUM 60 *
"DIST" \->TAG
      \>>
    \>>
  COMP
    \<< 0 0 0 0 0 0 0
0 \-> scl ll frl fr\Gl
tol to\Gl vl v\Gl fc\Gl
tc\Gl n d d0 sn
      \<< DEG frl fr\Gl
tol to\Gl VERTEX fr\Gl
RANGE 'v\Gl' STO 'vl'
STO to\Gl fr\Gl RANGE
'tc\Gl' STO
        IF 'vl*SIGN
(ll)\<=ABS(ll)' 'ABS(
v\Gl-(fr\Gl+tc\Gl)/2)>ABS
((fr\Gl-tc\Gl)/2)AND
ABS(vl)\=/90 AND ABS(
ll-(frl+tol)/2)\>=ABS
((frl-tol)/2)' OR
        THEN
"GC is OK: Hit ENTER"
MESS
        ELSE DEPTH
'd0' STO to\Gl fr\Gl
RANGE fr\Gl
          IF <
          THEN 1
          ELSE -1
          END 'sn'
STO
          IFERR ll
TAN INV DUP frl TAN
* ACOS NEG sn * fr\Gl
+ 0 RANGE 'fc\Gl' STO
tol TAN * ACOS sn *
to\Gl + 0 RANGE 'tc\Gl'
STO
          THEN
DEPTH d0 - DROPN
"No sol'n: Hit ENTER"
MESS
          ELSE scl
frl fr\Gl ll fc\Gl WAY
DROP 'd' STO+ OBJ\->
'n' STO
            IF 'RND
(fc\Gl,6)\=/RND(tc\Gl,6)'
            THEN
OBJ\-> SWAP DROP ll
fc\Gl ll tc\Gl RHUMB
'd' STO+ SWAP \->LIST
            ELSE
DROP -1 'n' STO+
            END scl
ll tc\Gl tol to\Gl WAY
DROP 'd' STO+ OBJ\->
n + \->LIST d "DIST"
\->TAG
          END
        END
      \>>
    \>>
  VERTEX
    \<< 0 \-> frl fr\Gl
tol to\Gl C
      \<< DEG frl fr\Gl
tol to\Gl GC DROP
FMT\-> DUP 'C' STO
DUP SIN frl COS *
ABS ACOS frl 0 \>= 1
-1 IFTE *
        IF DUP 0 ==
        THEN SWAP
DROP 0
        ELSE DUP
ROT COS SWAP SIN /
ASIN NEG
          IF 'C>180
'
          THEN NEG
          END fr\Gl +
          IF 'ABS(
tol)>ABS(frl)AND
SIGN(tol)\=/SIGN(frl)
'
          THEN 180
+ SWAP NEG SWAP
          END 0
RANGE
        END \->FMT
"V_Lon" \->TAG SWAP
\->FMT "V_Lat" \->TAG
SWAP
      \>>
    \>>
  WAY
    \<< \-> scl frl fr\Gl
tol to\Gl
      \<< DEG 0 frl
fr\Gl tol to\Gl GC SWAP
DROP 60 / frl fr\Gl
GETV DUP tol to\Gl
GETV CROSS DUP ABS
        IF DUP 0 ==
        THEN DROP2
          IF 'RND(
frl,6)\=/RND(tol,6)OR
RND(fr\Gl,6)\=/RND(to\Gl,
6)'
          THEN
"Ambiguous Sol'n" 3
DISP
          END 0 fr\Gl
90 - GETV
        ELSE /
        END NEG 0 0
\-> d gcd r n d0 dsum
        \<< DEPTH
'd0' STO
          WHILE 'd<
gcd OR d==0'
          REPEAT n
r d SMOVE V\-> ASIN 3
ROLLD R\->C ARG 'd'
scl STO+
          END tol
to\Gl gcd scl / FLOOR
2 + 'n' STO DUP2
"N/A" ROT \->FMT ROT
\->FMT ROT 3 \->LIST
DEPTH d0 - ROLLD 1
n 1 -
          START 4
DUPN RHUMB 'dsum'
STO+ 3 ROLLD DROP2
3 ROLLD DUP2 5 ROLL
ROT \->FMT ROT \->FMT
ROT 3 \->LIST DEPTH
d0 - ROLLD
          NEXT
DROP2 n \->LIST dsum
DUP "DIST" \->TAG
SWAP gcd 60 * - '1_
nmi' \->UNIT "ADDD"
\->TAG
        \>>
      \>>
    \>>
  DOUNIT
    \<< -55 CF
      IFERR CONVERT
      THEN DROP
      END UVAL
    \>>
  SD
    \<< 0 \-> x
      \<< DATE DUP
100 * FP 100 / 1.01
+ SWAP DDAYS 183 -
183 / 'x' STO '(
15.762145+x*(
-.02513+x*(1.15068+
x*(.02604+x*-.62672
))))/60' \->NUM
      \>>
    \>>
  RMOVE
    \<< 0 0 0 0 \-> \Gl l
d \Gh d\Gl dl n\Gl nl
      \<< DRLON DRLAT
d \Gh CCMOVE DUP 'nl'
STO DRLAT - 'dl'
STO DUP 'n\Gl' STO
DRLON - 'd\Gl' STO l
\Gl d\Gl + GETV n\Gl 90 +
DUP COS SWAP SIN 0
\->V3 SWAP dl SMOVE
V\-> ASIN 3 ROLLD R\->C
ARG SWAP
      \>>
    \>>
  SMOVE
    \<< \-> n r d
      \<< d COS r * n
n r DOT * 1 d COS -
* + r n CROSS d SIN
* +
      \>>
    \>>
  CCMOVE
    \<< 0 \-> \Gl l d \Gh
l2
      \<< l d \Gh MER l
+ DUP 'l2' STO
        IF DUP ABS
90 \>=
        THEN SIGN
90 * \Gl SWAP
        ELSE
          IF 'ABS(
COS(\Gh))<.0001'
          THEN '
-.998208257*d*SIN(\Gh
)/COS((l+l2)/2)*\v/(1
-(ee*SIN((l+l2)/2))
^2)' \->NUM
          ELSE l l2
\Gh DLo
          END \Gl +
SWAP
        END
      \>>
    \>>
  MER
    \<< \-> l1 d \Gh
      \<< '
.998208256722/(1-ee
^2)*\.S(l1,l1+d*COS(\Gh
),(1-(ee*SIN(l))^2)
^1.5,l)' \->NUM
      \>>
    \>>
  DLo
    \<< 0 0 \-> l1 l2 \Gh
sl1 sl2
      \<< l1 SIN
'sl1' STO l2 SIN
'sl2' STO '
-57.2957795131*TAN(
\Gh)*(ATANH((sl2-sl1)
/(1-sl1*sl2))-ee*
ATANH(ee*(sl2-sl1)/
(1-ee^2*sl2*sl1)))'
\->NUM
      \>>
    \>>
  GETV
    \<< \-> l \Gl
      \<< l COS \Gl COS
* l COS \Gl SIN * l
SIN \->V3
      \>>
    \>>
  ee
8.18188106628E-2
  FMT "(dd.mmt)"
  FFMT 1
  FFIX
    \<<
      IF 'FFMT==1'
      THEN 3 FIX
      ELSE 4 FIX
      END
    \>>
  FMT\->
    \<<
      CASE 'FFMT==1
'
        THEN HMT\->
        END 'FFMT==
0'
        THEN HMS\->
        END
      END
    \>>
  \->FMT
    \<<
      CASE 'FFMT==1
'
        THEN \->HMT
        END 'FFMT==
0'
        THEN \->HMS
        END
      END
    \>>
  \->HMT
    \<< 4 RND DUP IP
SWAP FP .6 * +
    \>>
  HMT\->
    \<< DUP IP SWAP
FP 1.66666667 * +
    \>>
  SVSTK {
# 81388003E00FF4h
# 0h }
  RESTS
    \<< SVSTK STOF
FFIX
    \>>
  SAVES
    \<< RCLF 'SVSTK'
STO -20 CF -21 CF
-22 SF -55 CF
    \>>
  \GmST
    \<< 0 0 0 \-> s2 s3
s4
      \<< 2 SK 's2'
STO 3 SK 's3' STO 4
SK 's4' STO '(-s3+\v/
(s3^2-3*s4*(s2-1)))
/(3*s4)' \->NUM RE
UBND MIN
      \>>
    \>>
  UBND
    \<< \Ga1 \Gb1 ABS -
\Ga2 \Gb2 ABS - \Ga3 \Gb3
ABS - MIN MIN
    \>>
  LBND
    \<< \Ga1
1.73205080757 \Gb1
ABS * - \Ga2
1.73205080757 \Gb2
ABS * - \Ga3
1.73205080757 \Gb3
ABS * - MIN MIN
    \>>
  SK
    \<< \-> k
      \<< '\Gb1^2/\Ga1^k+
\Gb2^2/\Ga2^k+\Gb3^2/\Ga3^k
' \->NUM
      \>>
    \>>
  G\Gm
    \<< \Gb1 \Ga1 \Gm - /
SQ \Gb2 \Ga2 \Gm - / SQ +
\Gb3 \Ga3 \Gm - / SQ + 1
-
    \>>
  ASK
    \<< { "YES" "" ""
"" "" "NO" } TMENU
0
      DO DROP -1
WAIT
      UNTIL DUP {
11.1 16.1 } SWAP
POS DUP
        IF NOT
        THEN 880 .1
BEEP
        END
      END 0 MENU
    \>>
  MLIMB { { "LL"
    \<< 1 CONT
    \>> } "" { "UL"
    \<< -1 CONT
    \>> } "" { "CENT"
    \<< 0 CONT
    \>> } "" }
  MBODY { { "SUN"
    \<< "S" CONT
    \>> } { "MOON"
    \<< "M" CONT
    \>> } { "VENUS"
    \<< "VM" CONT
    \>> } { "MARS"
    \<< "VM" CONT
    \>> } { "PLANET"
    \<< "P" CONT
    \>> } { "STAR"
    \<< "T" CONT
    \>> } }
  PSCALE
    \<< \-> s a
      \<<
        IF 's\=/0'
        THEN 'a/(
360+a/s)' \->NUM
        ELSE 0
        END
      \>>
    \>>
  tol 10
  to\Gl 10
  LON 89.7214000014
  LAT 10.5730000011
  IERR
1.6606266327E-3
  LIMIT
    \<< 0 0 0 0 0 0 \->
g1 g2 d1 d2 d180 up
      \<< DUP2 C\->R
'd1' STO 'g1' STO
C\->R 'd2' STO 'g2'
STO
        IF 'ABS(g1-
g2)>180'
        THEN DROP2
LON 180
          IF 'g1>
LON'
          THEN +
          ELSE -
          END 'up'
STO 'd1+(up-g1)*(d1
-d2)/(g1-g2)' \->NUM
'd180' STO g2 d2
R\->C up 360
          IF 'up>
LON'
          THEN -
          ELSE +
          END d180
R\->C up d180 R\->C g1
d1 R\->C LINE
        END
      \>>
    \>>
  RANGE
    \<< \-> \Gl
      \<<
        WHILE DUP
180 \Gl + >
        REPEAT 360
-
        END
        WHILE DUP
-180 \Gl + <
        REPEAT 360
+
        END
      \>>
    \>>
  LOP
    \<< \-> g d a l
      \<<
        IF 'ABS(l)\=/
90'
        THEN 'g+
ACOS((SIN(a)-SIN(l)
*SIN(d))/(COS(l)*
COS(d)))' \->NUM
        ELSE g
        END DUP IM
        IF 0 \=/
        THEN DROP g
        END
        IF 'ABS(l)>
90-ABS(d)+a'
        THEN 180 +
        END LON
RANGE l R\->C
      \>>
    \>>
  CST { SOLVE ADDOB
SETUP INIT ADV
ADDDR DR PLOTP SAIL
WVIEW ERROR TIME }
  REFRACT
    \<< 0 \-> h rp
      \<< '1/TAN(h+
7.31/(h+4.4))' \->NUM
'rp' STO 'rp*((
PRESS-80)/930)/(1+
.00008*(rp+39)*(
TMPTR-10))' \->NUM 60
/
      \>>
    \>>
  MESS
    \<< 3 DISP 7
FREEZE 0 WAIT DROP
    \>>
  PPAR {
(90.5890052687,10.1563333344)
(88.8537947341,10.9896666678)
X 0 (0,0) FUNCTION
Y }
  T\Gg 6
  G\Gg 231.103333334
  PRESS 1010
  TMPTR 10
  a0 '-(G12*G23-G13
*G22)*G13+(G11*G23-
G12*G13)*G23-(G11*
G22-G12^2)*G33'
  a1 'G11*G22-G12^2
+G11*G33-G13^2+G22*
G33-G23^2'
  TF 213.112966667
  CRS 320
  SPD 0
  EV3 '-2*\v/Q*COS((\Gh
+360)/3)+N/3'
  EV2 'N-\Ga1-\Ga3'
  EV1 '-2*\v/Q*COS(\Gh/
3)+N/3'
  \Gm -.178280167539
  \Gb3 2.75456498847
  \Gb2
4.61233514353E-2
  \Gb1
1.14190212639E-2
  E3
[ .338319152137 .168945881156 .925741562499 ]
  E2
[ .676618904731 .64002613719 -.364078839641 ]
  E1
[ -.65400841667 .749549086407 .102221123028 ]
  INTERP
    \<< \-> T V1 V2
      \<< V1 V2 V1 -
T2 T1 - / T T1 - *
+
      \>>
    \>>
  GSUM
    \<< \-> DS DC GS GC
HS
      \<< 0 'G11' STO
0 'G12' STO 0 'G13'
STO 0 'G22' STO 0
'G23' STO { 3 } 0
CON 'R' STO OBS
OBJ\-> OBJ\-> DROP DROP
'N' STO 1 N
        START SIN
'HS' STO DUP SIN
'DS' STO COS 'DC'
STO DUP SIN 'GS'
STO COS 'GC' STO DS
SQ 'G11' STO+ DS DC
GC * * 'G12' STO+
DS DC GS * * 'G13'
STO+ DC SQ GC SQ *
'G22' STO+ DC SQ GS
GC * * 'G23' STO+ R
OBJ\-> DROP DC GS HS
* * + ROT DS HS * +
ROT DC GC HS * * +
ROT { 3 } \->ARRY 'R'
STO
        NEXT N G11
G22 + - 'G33' STO
      \>>
    \>>
  OUT
    \<< OBJ\-> DROP \-> U
V W
      \<<
        IF 'ABS(U)>
1'
        THEN U SIGN
'U' STO
        END U ASIN
V W R\->C ARG \->FMT
"LON" \->TAG SWAP
\->FMT "LAT" \->TAG
      \>>
    \>>
  UVW
    \<< \Gb1 \Ga1 \Gm - /
E1 * \Gb2 \Ga2 \Gm - / E2
* \Gb3 \Ga3 \Gm - / E3 *
+ +
    \>>
  EIGEN
    \<< \-> EV
      \<< 'G12*G23-
G13*G22+G13*EV'
\->NUM 'G13*G12-G11*
G23+G23*EV' \->NUM '
G11*G22-SQ(G12)-(
G11+G22)*EV+SQ(EV)'
\->NUM { 3 } \->ARRY
DUP ABS
        IF DUP 0 \=/
        THEN /
        ELSE DROP
        END
      \>>
    \>>
  \Ga2 .38067798101
  \Ga3 2.58992744633
  \Ga1 .029394572665
  \Gh 'ACOS(R1/Q^1.5)
'
  R1 'A0/2+N/3*(A1/
6-Q)'
  Q '(N/3)^2-A1/3'
  N 3
  A0
-2.89809425646E-2
  A1 1.07324802832
  G33 2.27032850246
  R
[ .955661886936 .50345167658 2.53439002533 ]
  G23 .318611864541
  G22 .246376558567
  G13 .715412834112
  G12 .298478592826
  G11 .483294938977
  GHA2
60.5550000011
  DEC2
22.0816666668
  T2 12
  GHA1
45.5566666678
  DEC1
22.0750000002
  T1 11
  LU 1
  SEMI .26333333386
  HP .9333333352
  HGT 3.048
  INDX 0
  BODY "S"
END
