%%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 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 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