From comp.sys.handhelds Mon Jan 28 16:08:39 1991
Path: mentor.cc.purdue.edu!purdue!news.cs.indiana.edu!samsung!zaphod.mps.ohio-state.edu!ncar!ames!uhccux!akala!metcalf
From: metcalf@akala.ifa.hawaii.edu (Tom Metcalf)
Newsgroups: comp.sys.handhelds
Subject: Re: Celestial Navigation with HP-48SX
Summary: Version 4.2 fixes bug in 4.0
Message-ID: <11161@uhccux.uhcc.Hawaii.Edu>
Date: 28 Jan 91 19:20:48 GMT
References: <11126@uhccux.uhcc.Hawaii.Edu>
Sender: news@uhccux.uhcc.Hawaii.Edu
Followup-To: comp.sys.handhelds
Organization: Institute For Astronomy, Hawaii
Lines: 1335


Last week I posted version 4.0 of my sight reduction program.  There was
a bug in the ADV program which caused it to crash when the speed from the
INIT menu was set to zero.  Here is version 4.2 which corrects this 
problem.  The instructions are unchanged and I have not reposted them.

The program with instructions is available via anonymous ftp from the machine
mamane.ifa.hawaii.edu in the directory pub/metcalf.

Sorry for any inconvenience!

Tom Metcalf
metcalf@uhifa.ifa.hawaii.edu


----------------------- CUT HERE AND AT BOTTOM ------------------
%%HP: T(3)A(D)F(.);
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
''
----------------------- CUT HERE AND AT TOP ------------------

