Cls leecgf ' ' ENUMERATIONS ' Global Const af% = 1 Global Const bf% = 2 Global Const cf%

= 3 Global Const df% = 4 Global Const ef% = 5 Global Const ff% = 6 ' Global Const luz% = 1 Global Const topoluna% = 2 Global Const dra_osc_geo% = 3 Global Const dra_osc_topo_asc% = 4 Global Const dra_osc_topo_desc% = 5 Global Const dra_mean_bari% = 6 Global Const dra_mean_geo_asc% = 7 Global Const dra_mean_geo_desc% = 8 Global Const dra_mean_topo_asc% = 9 Global Const dra_mean_topo_desc% = 10 Global Const apo_osc_geo% = 11 Global Const apo_osc_topo% = 12 Global Const peri_osc_topo% = 13 Global Const foco_osc_topo% = 14 Global Const apo_mean_bari% = 15 Global Const apo_mean_geo% = 16 Global Const peri_mean_geo% = 17 Global Const foco_mean_geo% = 18 Global Const apo_mean_topo% = 19 Global Const peri_mean_topo% = 20 Global Const foco_mean_topo% = 21 Global Const iper% = 22 Global Const iapo% = 23 Global Const dark_SF% = 24 Global Const dark_SE% = 25 Global Const draconis% = 25 ' Global Const ax% = 1 Global Const vl% = 2 Global Const ec% = 3 Global Const pn% = 4 Global Const cl% = 5 Global Const an% = 6 Global Const vn% = 7 Global Const vp% = 8 Global Const orbita% = 8 ' Global Const con% = 1 Global Const opo% = 2 Global Const cua% = 3 Global Const tri% = 4 Global Const sex% = 5 Global Const qux% = 6 Global Const sm_c% = 7 Global Const sqc% = 8 Global Const sms% = 9 Global Const qtl% = 10 Global Const bi5% = 11

Global Global Global Global Global Global Global Global Global Global Global Global Global Global Global Global Global Global ' Global Global Global Global Global Global ' Global Global Global Global Global Global ' Global Global Global Global Global Global Global Global Global ' Global Global Global Global Global ' Global Global Global Global Global Global Global Global ' Global Global

Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const

sm5% = 12 sq5% = 13 sep% = 14 bi7% = 15 tr7% = 16 sm7% = 17 sq7% = 18 ss7% = 19 a15% = 20 b15% = 21 c15% = 22 d15% = 23 a16% = 24 b16% = 25 c16% = 26 d16% = 27 nov% = 28 aspecto% = 28 hlon% = 1 hlat% = 2 hdis% = 3 hdb% = 4 hdr% = 5 heliocentrico% = 5 ecliptica% = 1 ecuador% = 2 horizonte% = 3 planoinvariable% = 4 eqgalactico% = 5 planoreferencia% = 5 epocafecha% epocaj2000% B1950J2000% fechaj2000% fechaepoca% j2000epoca% j2000b1950% j2000fecha% rotacion% = = = = = = = = = 8 1 2 3 4 5 6 7 8

mbpresion% = 1 mbvapor% = 2 ctemperatura% = 3 mtaltitud% = 4 atmosfera% = 4 greenwich% = 1 hnormal% = 2 verano% = 3 local% = 4 solar% = 5 orto% = 6 ocaso% = 7 huso% = 7

Const lun% = 1 Const sol% = 2

Global Const mer% = Global Const ven% = Global Const mar% = Global Const jup% = Global Const sat% = Global Const ura% = Global Const nep% = Global Const plu% = ' named centaurs Global Const qui% = Global Const fol% = Global Const nes% = Global Const asb% = Global Const cha% = Global Const hil% = Global Const pil% = Global Const oki% = Global Const pel% = Global Const ela% = Global Const cil% = Global Const bie% = Global Const the% = Global Const gb1% = Global Const go9% = Global Const ec8% = ' named tno's Global Const wr6% = Global Const cao% = Global Const rha% = Global Const deu% = Global Const huy% = Global Const ixi% = Global Const qua% = Global Const sed% = Global Const orc% = Global Const log% = Global Const cr6% = Global Const fx8% = Global Const teh% = Global Const ub3% = Global Const fy9% = Global Const el1% = ' Pluto steeds Global Const bu8% = Global Const ox3% = Global Const qb3% = Global Const xa5% = Global Const pn4% = ' long range sdo's Global Const tl6% = Global Const td1% = Global Const cy8% = Global Const cz8% = Global Const gq1% = Global Const cf9% = Global Const rd5% = Global Const rz4% = Global Const rz5% = Global Const cr5% = Global Const om7% =

3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58

Global Const oo7% = 59 Global Const pj3% = 60 Global Const fp5% = 61 Global Const fz7% = 62 Global Const gb2% = 63 Global Const vq4% = 64 Global Const hb7% = 65 Global Const yq9% = 66 Global Const pb2% = 67 Global Const rm3% = 68 Global Const sa8% = 69 ' bright tno's Global Const to6% = 70 Global Const ur3% = 71 Global Const aw7% = 72 Global Const kx4% = 73 Global Const ms4% = 74 Global Const tc3% = 75 Global Const tx3% = 76 Global Const ux5% = 77 Global Const az8% = 78 Global Const mw2% = 79 Global Const op2% = 80 Global Const vs2% = 81 Global Const gv9% = 82 Global Const sb6% = 83 Global Const xr9% = 84 Global Const ty4% = 85 Global Const rn3% = 86 Global Const rr3% = 87 Global Const qb1% = 88 ' other centaurs Global Const xx3% = 89 Global Const co4% = 90 Global Const fz5% = 91 Global Const gm7% = 92 Global Const bl4% = 93 Global Const kf7% = 94 Global Const sq3% = 95 Global Const xz5% = 96 Global Const dh5% = 97 Global Const gz2% = 98 Global Const vr3% = 99 Global Const co1% = 100 Global Const qd2% = 101 Global Const wl7% = 102 Global Const rl3% = 103 Global Const uj8% = 104 ' Global Const aries% = 105 Global Const nodo% = 106 Global Const BML% = 107 Global Const asc% = 108 Global Const m_c% = 109 Global Const planeta% = m_c% Global Const aux% = aries% Global Const allplanets% = 120 Global Const lim% = Succ(allplanets%) Global Const finpl% = Pred(aries%) Global Const ceres% = 0

Global Global Global Global Global Global ' Global Global Global Global Global ' Global Global Global Global ' Global Global Global Global Global Global Global Global Global Global Global Global Global Global Global Global Global Global Global Global Global Global Global Global Global Global Global Global Global Global ' Global Global Global Global Global ' Global Global Global Global Global

Const damocles% = 0 Const astraea% = 110 Const nombrados% = ub3% maximo% = finpl% ultimo% = finpl% brinca% = Succ(td1%) Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const xpi% = 1 xqi% = 2 vsol% = 3 rsol% = 4 planoorbita% = 4 xi% = 1 yi% = 2 zi% = 3 xyz% = 3 decima% = 1 undecima% = 2 duodecima% = 3 primera% = 4 segunda% = 5 tercera% = 6 cuarta% = 7 quinta% = 8 sexta% = 9 setima% = 10 octava% = 11 novena% = 12 ascendente% = 13 mediocielo% = 14 vertex% = 15 fortuna% = 16 m10% = 17 m11% = 18 m12% = 19 m1% = 20 m2% = 21 m3% = 22 m4% = 23 m5% = 24 m6% = 25 m7% = 26 m8% = 27 m9% = 28 middle% = 16 puntacasa% = 28 elong% = 1 arglat% = 2 anomalia% = 3 anomsol% = 4 argdelaunay% = 4 gx% = 1 gy% = 2 gz% = 3 lat% = 4 latrx% = 5

Global Global Global Global Global Global Global Global ' Global Global Global Global Global Global Global Global Global Global Global Global Global ' Global Global Global Global Global Global Global Global Global Global Global Global Global Global Global Global ' Global Global Global Global ' Global Global Global Global Global Global Global Global Global ' Global Global Global Global Global

Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const

lon% = 6 lonrx% = 7 geoc% = 8 usin% = 9 ucos% = 10 rvg% = 11 dl% = 12 geodesico% = 12 longitud% = 1 latitud% = 2 rvector% = 3 ascensionrecta% = 4 declinacion% = 5 velocidad% = 6 distancia% = 7 semidiametro% = 8 veloar% = 9 veldec% = 10 velorv% = 11 velobl% = 12 vector% = 12 esin% = 1 ecos% = 2 oblicuidad% = 3 lnut% = 4 enut% = 5 dt% = 6 eqt% = 7 tse% = 8 ecsol% = 9 vlsol% = 10 vlluna% = 11 vlnodo% = 12 svp% = 13 ayanamsa% = 14 precspeed% = 15 coordenada% = 15 etrue% = 1 emedio% = 2 e2000% = 3 e1950% = 4 rp% = 1 t0% = 2 t1% = 3 t2% = 4 t3% = 5 t4% = 6 t5% = 7 t6% = 8 polinomio% = 8 kfase% = 1 iangulo% = 2 lbrillo% = 3 vmagnitud% = 4 elon% = 5

Global ' Global Global Global Global ' Global Global Global Global Global Global Global Global Global Global Global ' Global Global Global Global Global Global Global Global Global Global Global Global Global Global Global ' Global Global Global Global Global Global Global Global Global ' Disk Global Global Global Global Global Global ' Menu Global Global Global Global Global Global Global Global

Const luminosidad% = 5 Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const vmag% = 1 fmag% = 2 semidiam% = 3 definicion% = 3 rsemana% = 1 rcaldea% = 2 rhora% = 3 rdia% = 4 rmes% = 5 rano% = 6 rnsos% = 7 rlat% = 8 rlon% = 9 rcodigo% = 10 fechas% = 10 white% = RGB(220, 220, 220) blue% = RGB(0, 0, 173) cyan% = RGB(0, 200, 200) brcyan% = RGB(0, 255, 255) green% = RGB(0, 160, 0) yellow% = RGB(255, 255, 64) grey% = RGB(80, 80, 80) brwhite% = RGB(255, 255, 255) black% = 0 pink% = RGB(200, 160, 144) brblue% = RGB(160, 160, 255) purple% = RGB(170, 0, 170) crema% = RGB(255, 204, 153) caf% = RGB(153, 102, 51) basefondo% = black% disco% = 1 menu1% = 2 uraniano% = 3 efemeris% = 4 constel% = 5 reporte% = 6 dom% = 7 esp% = 8 hlp% = 9 lsam% = 10 ldat% = 11 sdat% = 12 edat% = 13 res% = 14 quit% = 15 rad% asp% csp% prg% arc% quo% com% rel% = = = = = = = = 16 17 18 19 20 21 22 23

Global Const tcv% = 24 Global Const rvs% = 25 Global Const rvl% = 26 Global Const pri% = 27 Global Const nue% = 28 ' Alternative Global Const all% = 29 Global Const eje% = 30 Global Const pun% = 31 Global Const nor% = 32 Global Const alt% = 33 Global Const arm% = 34 Global Const mic% = 35 Global Const cmp% = 36 Global Const plc% = 37 Global Const sab% = 38 Global Const ora% = 39 ' Tables Global Const fdj% = 40 Global Const dig% = 41 Global Const bal% = 42 Global Const orb% = 43 Global Const est% = 44 Global Const fag% = 45 Global Const cul% = 46 Global Const ast% = 47 Global Const tno% = 48 Global Const swk% = 49 Global Const swe% = 50 Global Const tst% = 51 ' Graphics Global Const nat% = 52 Global Const oct% = 53 Global Const hel% = 54 Global Const ctl% = 55 Global Const hrz% = 56 Global Const esf% = 57 Global Const bru% = 58 Global Const car% = 59 Global Const gpr% = 60 ' Options Global Const sid% = 61 Global Const como% = 62 Global Const todo% = 63 Global Const cgf% = 64 Global Const obj% = 65 Global Const pan% = 66 ' Houses Global Const pla% = 67 Global Const cam% = 68 Global Const reg% = 69 Global Const alc% = 70 Global Const sva% = 71 Global Const apc% = 72 Global Const goh% = 73 Global Const tpc% = 74 Global Const prf% = 75 Global Const jbm% = 76 Global Const zar% = 77 Global Const hor% = 78

Global Const Global Const Global Const ' Special Global Const Global Const Global Const Global Const Global Const ' Help Global Const Global Const Global Const Global Const Global Const ' ' CONST ' Global Const Global Const Global Const ' Global Const E406 *** Global Const LUNAR *** Global Const GRS-80 *** Global Const *** Global Const GAUSS *** Global Const *** ' Global Const Global Const Global Const Global Const Global Const Global Const Global Const Global Const Global Const Global Const Global Const Global Const Global Const Global Const Global Const Global Const Global Const Global Const Global Const ' Global Global Global Global Const Const Const Const

igu% = 79 zod% = 80 geo% = 81 tbc% efm% q2z% scu% fen% = = = = = 82 83 84 85 86

htm% = 87 home% = 88 mail% = 89 as87% = 90 barras% = 90

caldeo% = 7 zodiaco% = 13 cuantas% = 1078 au As Double = 149597870.691 ' *** UNIDAD ASTRONOMICA EN KM D

axlu As Double = 384747.9806448954 ' *** SEMIEJE MAYOR DE LA ORBITA eqr As Double = 6378.137 emr As Double = 0.012300034 kg As Double = 0.01720209895 ab As Double = 0.005775518304412 ' *** RADIO ECUATORIAL TERRESTRE ' *** MASS RATIO MOON and EARTH ' *** CONSTANTE GRAVITACIONAL DE ' *** CONSTANTE DE ABERRACION

j1900 As Double = 693931 j2000 As Double = 730456 b1950 As Double = 712193.42345905 D2018 As Double = 737283.5 D1702 As Double = 621283.5 D2103 As Double = 768218.5 Dlong As Double = -181.5 jp As Double = 1721089 B1875 As Double = 2405889.25855 - jp lowmin As Double = 1939842.5 - jp ' 1-1-599 lowmax As Double = 2963249.5 - jp ' 1-1-3401 piso1700 As Double = 2341972.5 piso0600 As Double = 1720107.5 ips2max As Double = 2633670.5 - jp ' Aug 23 ips2min As Double = 1903670.5 - jp ' Dec 20 plutomax As Double = 2811150.5 - jp ' Jul 26 plutomin As Double = 626150.5 - jp ' Apr 23 fin409 As Double = 2817407.5 - jp ' Sep 13 vsopmax = 8000 j5 As Double = jq As Double = dpi2 As Double d2pi As Double 365.25 36525 = 1.570796326794896 = 6.283185307179586

2498 499 2984 -2998 3001

Global Global Global Global ' Global Global Global Global Global Global Global Global Global Global Global Global Global Global Global Global Global Global Global Global Global Global Global Global Global Global Global Global Global Global Global Global Global Global Global Global Global Global Global Global Global Global Global Global Global Global Global Global Global ' Global ' Global Global Global

Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const Const

darcsec As Double = 2.777777777778E-4 rsec As Double = 4.8481368110953599359E-6 dtr As Double = 1.7453292519943295769E-2 rtd As Double = 5.7295779513082320877E+1 k2% = 12 k3% = 30 k4% = 24 k5% = 150 kc5% = 45 k8% = 180 k6% = 60 k9% = 90 kg% = 360 kd% = 10 kc% = 100 kl% = 1000 kz% = 10000 d0 As Double = 0 d1 As Double = 1 d2 As Double = 2 d3 As Double = 3 d4 As Double = 4 d5 As Double = 5 d6 As Double = 6 p1 As Double = 1e-1 p2 As Double = 1e-2 p3 As Double = 1e-3 p4 As Double = 1e-4 p5 As Double = 1e-5 p6 As Double = 1e-6 p7 As Double = 1e-7 p8 As Double = 1e-8 p9 As Double = 1e-9 p10 As Double = 1e-10 p11 As Double = 1e-11 p12 As Double = 1e-12 p13 As Double = 1e-13 md As Double = 10 mc As Double = 100 ml As Double = 1000 mz As Double = 10000 n2 As Double = 12 n3 As Double = 30 n4 As Double = 24 n5 As Double = 15 n6 As Double = 60 n7 As Double = 270 n8 As Double = 180 n9 As Double = 90 ng As Double = 360 ns As Double = 3600 c5 As Double = 45 z5 As Double = 0.5

Const cancela% = 1 Const nul$ = "" Const deg1$ = Chr$(248) Const deg2$ = Chr$(176)

Global Const deg3$ = "," Global Const sec$ = Chr$(34) '" Global Const esc$ = Chr$(VK_ESCAPE) Global Const rt$ = Chr$(VK_RETURN) Global Const crlf$ = rt$ + Chr$(10) Global Const spc$ = Chr$(VK_SPACE) Global Const bar1$ = Chr$(179) Global Const bar2$ = Chr$(124) Global Const range$ = " OUT OF RANGE" ' Global Const srPeriAfe As Integer = 1 Global Const srHeliDis As Integer = 2 Global Const srHeliLat As Integer = 3 Global Const srHeliLon As Integer = 4 Global Const srCeroLat As Integer = 5 Global Const srMaxiLat As Integer = 6 Global Const srCeroDec As Integer = 7 Global Const srMaxiDec As Integer = 8 Global Const srApoPeri As Integer = 9 Global Const srStation As Integer = 10 Global Const srAspects As Integer = 11 Global Const srIngress As Integer = 12 Global Const srOutBoun As Integer = 13 Global Const srParalel As Integer = 14 Global Const srGCalign As Integer = 15 Global Const srUserPos As Integer = 16 Global Const srPlcentr As Integer = 17 Global Const srTrueAng As Integer = 18 Global Const srBariSun As Integer = 19 Global Const srLastOne As Integer = 19 ' Global Const SE_ASTER_NOM% = 13722 Dim num_names%(SE_ASTER_NOM%) Dim swedata(6) As Double ' ' VAR ' Option Base 1 Dim sp(allplanets%, 7) As Double Dim vc(allplanets%, vector%) As Double Dim radix(allplanets%, vector%) As Double Dim vc2(Succ(allplanets%)) As Double Dim rx2(allplanets%, vector%) As Double Dim cuspide(puntacasa%) As Double Dim cusprx(puntacasa%) As Double Dim fagan(Mul(allplanets%, 2), 2) As Double Dim r(xyz%) As Double, v(xyz%) As Double, g(xyz%) As Double, p(xyz%) As Double ' Dim octo(k2%) As Double Dim cd(coordenada%) As Double Dim rxcd(coordenada%) As Double Dim dla(argdelaunay%) As Double Dim mppdla(14) As Double Dim dragon(draconis%) As Double Dim geos(geodesico%) As Double ' Dim cnt(atmosfera%) As Double cnt(ctemperatura%) = 20 ' temperatura en grados Celsius cnt(mbpresion%) = 13.25 ' presion standard al nivel del mar cnt(mbvapor%) = d0 ' presion del vapor de agua

cnt(mtaltitud%) = 1.162 ' altura en Km de San Jose, C.R. ' Dim helior(allplanets%, xyz%) As Double Dim heliov(allplanets%, xyz%) As Double Dim heliop(allplanets%, heliocentrico%) As Double Dim heliorx(allplanets%, heliocentrico%) As Double Dim pldef(maximo%, definicion%) As Double Dim lum(finpl%, luminosidad%) As Double Dim masa(allplanets%) As Double Dim pq(planoorbita%, xyz%) As Double Dim sec(aux%, orbita%, polinomio%) As Double Dim main(560, 5), pert(883, 15) Dim vsopm(45832 * 3) As Double 'Dim ips2m(39698 * 3) As Double Dim ipsplu(659 * 3) As Double Dim vf(80, ff%) As Double Dim osc(allplanets%, orbita%) As Double Dim prec(xyz%, xyz%) As Double Dim de118(xyz%, xyz%) As Double Dim nut(xyz%, xyz%) As Double Dim rxnut(xyz%, xyz%) As Double Dim kp(8, 9) As Double, ca(8, 9) As Double, sa(8, 9) As Double Dim kq(8, 10) As Double, cl(8, 10) As Double, sl(8, 10) As Double ' Dim eq(4, 2) As Double eq(e1950%, esin%) = Sin(84404.81641 * rsec) eq(e1950%, ecos%) = Cos(84404.81641 * rsec) eq(e2000%, esin%) = Sin(84381.4119 * rsec) eq(e2000%, ecos%) = Cos(84381.4119 * rsec) ' Dim pr1950(xyz%, xyz%) As Double Dim fk5(xyz%, xyz%) As Double Dim sumasen(t6%) As Double Dim sumacos(t6%) As Double Dim pt(t6%) As Double Dim punta(zodiaco%) As Double Dim puntarx(zodiaco%) As Double Dim sideral(zodiaco%) As Single Dim flunar(6, 16) As Double Dim apo(63, 5) As Double Dim sol(4, 50) As Double ' Type catalogo ar2000 As Single dc2000 As Single movar As Integer16 movdc As Integer16 paralax As Integer16 radvel As Integer16 mag As Integer16 nombre As String*21 EndType Dim usnostars(1078) As catalogo ' Type limites ral As Double rau As Double decl As Double con As String*3 EndType

Dim IAU_constel(357) As limites ' Dim oa%(m9%) ArrayFill oa%() = -1 Dim sinodico%(allplanets%) ArrayFill sinodico%() = 3 ' Dim deltat%(400) Dim cfnut%(77, 11) Dim orbes%(aspecto%, 2) Dim meses%(zodiaco%, 2) Dim pluto%(211392) Dim pptl%(plu%, rvector%, t5%), ipsl%(plu%, rvector%, t5%) Dim nombre|(43) Dim spx%(13000), spi%(13000), spj%(13000) Dim indicepl%(allplanets%, 4), almuten%(allplanets%), regen%(zodiaco%, 10) Dim xmenu%(barras%) Dim glifos%(allplanets%) Dim prohibe%(allplanets%) ' Dim planets_in_wheel?(allplanets%), pl_test_vec?(allplanets%) Dim mpcnumber%(Succ(allplanets%)) ' For pl% = lun% To allplanets% pl_test_vec?(pl%) = False If pl% <= ub3% planets_in_wheel?(pl%) = True Else planets_in_wheel?(pl%) = False EndIf Next pl% planets_in_wheel?(nodo%) = True ' Dim plaux$(Succ(allplanets%)), plfont$(allplanets%) Dim aspaux$(aspecto%), elem$(9), vcfecha$(fechas%) Dim casa$(puntacasa%), hdom$(15) Dim fila$(13000), spk$(13000) Dim mes$(zodiaco%), sgaux$(zodiaco%), sgfont$(zodiaco%) Dim xcasa$(puntacasa%), rxcasa$(puntacasa%) Dim fontcasa$(puntacasa%), rxfntcasa$(puntacasa%) Dim xplan$(allplanets%), rxplan$(allplanets%) Dim fontplan$(allplanets%), rxfntplan$(allplanets%) Dim dia$(caldeo%), esen$(caldeo%, 2) Dim titulos$(120) Dim fondo As Picture Dim sysdlg As New CommDlg Dim zsideral$(10) Dim cuadro$(kg%, 3) ' Dim retr$(4) retr$(1) = "r " retr$(2) = "sr" retr$(3) = " " retr$(4) = "sd" ' Global xv%, yv%, hv%, av%, xcentro%, ycentro%, n%, cusp%, i%, j%, ix%, iy%, mili secs% Global fh%, fbh%, fa%, fba%, k%, dummy%, pl% Global nk|, jd|, jm|, ja%, signo%, orden%, status%, asptop% Global armonica, bandera%, contador%, opcion%, brblanco%, atras% = basefondo%

Global basecaldea%, basecodigo%, basefaselunar%, basesemana% Global k$, q$, q2$, nombre$, titulo$, basetitulo$ Global aborta?, buffer?, polar?, ambiguo?, prueba?, latgeoc?, blanco?, granventa na? Global Double dj, ano, tu, tanlat, etanz, mesl, jt, js, vs, acc, naibod, solis, w5, w2, er, ae, pr Global Double vlsolx, anomsolx, svpx, ayanx, ts, tx = d0 Global Double se, lm, ex, ph, na, in, ra, rb, asol, psol Global npaux$ = "Damocles", srchUser$ = "194.057983" Global Double seaux = 11.83687238, lmaux = 125.009960, exaux = 0.86698950 Global Double phaux = 191.225338, naaux = 314.148021, inaux = 62.050837, j0aux = 2453400.5 Global bar$ = bar1$, deg$ = deg1$, saletexto$, low? Global Integer rmargin = 80, mx0, my0, mx1, my1 Global skqclip$ = nul$, nuevalinea$ = Str$(" ", rmargin), columna$ Global dglat$ = zlat$, dglon$ = zlon$, dgtime$ = nul$, dgdate$ = nul$, dgnom$ = nul$ ' Dim bplan(planeta%) As Integer64 ArrayFill bplan() = 0 For pl% = lun% To planeta% bplan(pl%) = Bset8(bplan(pl%), Pred(pl%)) Next pl% ' Global Int Compatibility_CFFORMAT, Compatibility_ClipMem = 0 Global desk_X As Integer = Screen.Width \ Screen.TwipsPerPixelX Global desk_Y As Integer = Screen.Height \ Screen.TwipsPerPixelY ' Global basedom% = pla% Global sistema% = Sub(basedom%, Pred(pla%)) Global lfk% ' Global basefonts? = False Global baseimpresora? = False Global basegregoriano? = True Global baseprinter? = False Global terminar? = False Global baselow? = False Global basenodo? = True Global basenamed? = False Global ingress? = True Global alta? = True Global suspendwrite? = False Global salvar? = True Global skipdate? = False 'Global ips2? = False ' ' --------------------------------------------------------------------' Declare FunctionA ShellExecute Lib "shell32" _ (ByVal hwnd As Long, _ ByVal lpOperation As String, _ ByVal lpFile As String, _ ByVal lpParameters As String, _ ByVal lpDirectory As String, _ ByVal nShowCmd As Int) As Long ' ' --------------------------------------------------------------------' SWISS EPEHEMERIS: Global flag As Long, eb As String

Global Const SE_min = -5400 Global Const SE_max = +5399 Global Const SE_asterlongmin = -3000 Global Const SE_asterlongmax = +3000 Global Const SE_astermin = 1500 Global Const SE_astermax = 2100 Global Const SE_START_DATE = -251291.5 - jp Global Const SE_END_DATE = 3693368.5 - jp Global Const SE_JPLEPH As Int = 1 ' use JPL ephemeris Global Const SE_SWIEPH As Int = 2 ' use SWISSEPH ephemeris, default Global Const SE_MOSEPH As Int = 4 ' use Moshier ephemeris Global Const SE_HELCTR As Int = 8 ' return heliocentric position Global Const SE_TRUEPOS As Int = 16 ' return true positions, not apparent Global Const SE_J2000 As Int = 32 ' no precession, i.e. give J2000 equinox Global Const SE_NONUT As Int = 64 ' no nutation, i.e. mean equinox of date Global Const SE_SPEED As Int = 256 ' high precision speed (analyt. comp.) Global Const SE_NOABERR As Int = 1024 ' turn off 'annual' aberration of light Global Const SE_XYZ As Int = 4096 ' cartesian, not polar, coordinates Global Const SE_BARYCTR As Int = 16384 ' barycentric positions Global Const SE_SIDEREAL As Int = 65536 Global Const SE_SIDM_USER As Int = 255 Global Const SE_SIDBIT_ECL_T0 As Int = 256 Global Const SE_INTP_APOG = 21 Global Const SE_INTP_PERG = 22 ' Declare Function swe_calc Lib "swedll32.dll" _ Alias "_swe_calc@24" ( _ ByVal tjd As Double, _ ByVal ipl As Long, _ ByVal iflag As Long, _ ByRef x As Double, _ ByVal serr As String _ ) As Long Declare Sub swe_set_ephe_path Lib "swedll32.dll" _ Alias "_swe_set_ephe_path@4" ( _ ByVal path As String _ ) Declare Function swe_close Lib "swedll32.dll" _ Alias "_swe_close@0" ( _ ) As Long Declare Sub swe_get_planet_name Lib "swedll32.dll" _ Alias "_swe_get_planet_name@8" ( _ ByVal ipl As Long, _ ByVal pname As String _ ) Declare Function swe_houses Lib "swedll32.dll" _ Alias "_swe_houses@36" ( _ ByVal tjd_ut As Double, _ ByVal geolat As Double, _ ByVal geolon As Double, _ ByVal ihsy As Long, _ ByRef hcusps As Double, _ ByRef ascmc As Double _ ) As Long ' ' --------------------------------------------------------------------' lecturas If @initwin() cargador

abreventana0 @txt(white%) drawmenu nuevo informacion Repeat principal If opcion% = quit% guardedatos(True) Alert 2, "Are you sure you|want to exit Riyal?", 1, " &Yes | &No! ", n% Else n% = cancela% EndIf Until n% = cancela% EndIf endwin Quit ' ' >Function initwin() As Boolean prueba? = SystemParametersInfo(SPI_SETKEYBOARDDELAY, 0, Null, SPIF_UPDATEINIFI LE) prueba? = SystemParametersInfo(SPI_SETKEYBOARDSPEED, 31, Null, SPIF_UPDATEINIF ILE) Return True EndFunc Procedure endwin '##E# @swe_close() Menu Kill CloseW 1 @swe_close() End EndProc ' ' ###################################################################### ' IMPLEMENTATION MODULE MAux ' ###################################################################### ' >Procedure abralostodos(abrir?) If abrir? Open ExecPath + "centaurs.fle" for Input As # 2 If baselong? Then Open ExecPath + "long.fle" for Input As # 5 Open ExecPath + "asteroid.fle" for Input As # 6 Else Close # 3 Close # 2 If baselong? Then Close # 5 Close # 6 EndIf EndProc ' >Procedure guardedatos(ask?) Local lt$, ln$ salvar? = salvar? And tx <> d0 If salvar? And ask? q$ = "You haven't saved your data|Do you want to save it?" Alert 2, q$, 1, " NO |Yes!", n% Else

n% = 2 EndIf If n% <> 0 If (n% = 2 Or Not ask?) And salvar? dgnom$ = @evento() If dgnom$ <> nul$ Open ExecPath + "charts.csv" for Append As # 10 freal(dj, 7, 6, 0, q$) freal(geos(latrx%), 3, 4, 0, lt$) freal(geos(lonrx%), 4, 4, 0, ln$) Write # 10, q$, lt$, ln$, dgnom$ Close # 10 salvar? = False menuapaga(sdat%) EndIf EndIf EndIf EndProc ' >Sub lv_KeyPress(Ascii&) If lv.SelectedCount And Ascii& = 13 aborta? = False prueba? = True ElseIf (Ascii& = 27 Or Ascii& = 32) aborta? = True EndIf >Sub lv_DblClick If lv.SelectedCount Then prueba? = True >Sub lv_MouseDown(Button&, Shift&, x!, y!) aborta? = (Button& = MK_RBUTTON) EndSub >Procedure carguedatos Local s1$, s2$, s3$, s4$, lvit As ListItem s1$ = ExecPath + "charts.csv" s2$ = ExecPath + "sample.csv" If opcion% = ldat% Or opcion% = lsam% guardedatos(True) EndIf aborta? = False prueba? = Exist(s1$) If (prueba? And opcion% = ldat%) Or (prueba? And opcion% <> ldat% And opcion% <> lsam%) Open s1$ for Input As # 10 ElseIf Exist(s2$) And opcion% = lsam% Open s2$ for Input As # 10 Else Alert 1, "|NO DATABASE FILE!", 1, " ENTER ", n% aborta? = True EndIf If Not aborta? prueba? = False lv.Clear lv.Visible = True lv.Height = Sub(hv%, 55) While Not EOF(# 10) On Error Resume Next Input # 10, s1$, s2$, s3$, s4$ If Err = 0 Set lvit = lv.Add

lvit.AllText = s4$ + ";" + s1$ + ";" + s2$ + ";" + s3$ Else lv.Visible = False Alert 1, "YOUR PERSONAL|DATABASE IS|CORRUPT!", 1, " ENTE R ", n% aborta? = True Exit If aborta? EndIf Wend If Not aborta? lv.Sort 0, True Do : Sleep : Until prueba? Or aborta? lv.Visible = False If Not aborta? dgnom$ = lv.SelectedItem.SubItems(0) dj = Val(lv.SelectedItem.SubItems(1)) getfecha(dj, jd|, jm|, ja%) If jd| < kd% Then s1$ = "0" + Str$(jd|, 1) Else s1$ = Str$(jd|, 2) If jm| < kd% Then s2$ = "0" + Str$(jm|, 1) Else s2$ = Str$(jm|, 2) dgdate$ = s1$ + spc$ + s2$ + spc$ + Str$(Abs(ja%), 4) fsegundos(k4%, 1, tu, 0, dgtime$) If tu < md Then dgtime$ = "0" + Trim$(dgtime$) geos(lat%) = Val(lv.SelectedItem.SubItems(2)) geos(lon%) = Val(lv.SelectedItem.SubItems(3)) geos(dl%) = d0 nortesur(geos(lat%), 0, dglat$) esteoeste(geos(lon%), 0, dglon$) basegregoriano? = (dj + jp) > 2299160.5 basecodigo% = greenwich% If opcion% = ldat% Or opcion% = lsam% encabezado(" RADIX") nombre$ = titulo$ bandera% = 1 efemerides(sol%, ultimo%) vcangulos domificacion igualizar(0) llenastrings salvar? = False pantalla Else skipdate? = True EndIf EndIf EndIf Close # 10 EndIf EndProc ' >Procedure redir2file If Not baseimpresora? FileSelect "*.txt", "riyaldat.txt", saletexto$ If Len(saletexto$) q$ = " OK | Cancel " Alert 4, "RIYAL will write to:|" + saletexto$ + "|", 1, q$, n% If n% = 1 Open saletexto$ for Append As # 1 baseprinter? = False baseimpresora? = True menufree(todo%)

menucheck(como%) EndIf EndIf Else baseimpresora? = False menufree(como%) On Error Resume Next Close # 1 EndIf EndProc >Procedure redir2printer If Not baseprinter? Try sysdlg.CancelError = True sysdlg.pgTop = 0 sysdlg.Flags = cdpDisablePrintToFile sysdlg.ShowPageSetup Set Printer = sysdlg baseprinter? = True menucheck(todo%) menufree(como%) Catch Inc dummy EndCatch Else baseprinter? = False menufree(todo%) Output = Win_1 EndIf baseimpresora? = baseprinter? EndProc >Procedure sayredir If baseimpresora? Cls pb.Refresh pb.Top = 0 pb.Visible = True pb.Value = d0 Print AT(2, 3); "OUTPUT REDIRECTED TO "; If baseprinter? Then Print "PRINTER" If Not baseprinter? Then Print saletexto$ Print suspendwrite? = True EndIf EndProc ' >Procedure CLIPCOPY(ByVal h As Int, ByVal a As Int) Local hMem As Handle Local Int hOwnerWnd, hResult, d If Me Is Nothing Then hOwnerWnd = 0 Else hOwnerWnd = Me.hWnd Switch Compatibility_CFFORMAT Case CF_TEXT, CF_OEMTEXT, CF_UNICODETEXT If a = 0 Message "No Text Len in Param a" Exit Sub Else hMem = GlobalAlloc(GPTR, a) If !hMem Message "Memory Allocation Error in CLIPCOPY" : Exit Sub EndIf

d = GlobalLock(hMem) MemCpy(h, d, a) ~GlobalUnlock(hMem) EndIf Default hMem = h EndSwitch hResult = OpenClipboard(hOwnerWnd) If hResult = 0 Message "Clipboard Error."#13 + _ "GetLastError returned: " + Format(GetLastError()) Else ~SetClipboardData(Compatibility_CFFORMAT, hMem) ~CloseClipboard() EndIf EndProc >Procedure CLIPFORMAT(ByVal data As Int) Compatibility_CFFORMAT = data EndProcedure >Procedure CLIPPASTE(ByRef h As Int, ByRef a As Int) Local hMem As Handle Local Int hOwnerWnd, hResult, d, s If Me Is Nothing Then hOwnerWnd = 0 Else hOwnerWnd = Me.hWnd hResult = OpenClipboard(hOwnerWnd) If hResult = 0 Message "Clipboard Error."#13 + "GetLastError returned: " + Format(GetLastEr ror()) Else hMem = GetClipboardData(Compatibility_CFFORMAT) If !hMem Message "Clipboard Error on GetClipBoardData."#13 + "GetLastError returned : " + Format(GetLastError()) h = 0 : ~CloseClipboard() Exit Sub EndIf Switch Compatibility_CFFORMAT Case CF_TEXT, CF_OEMTEXT, CF_UNICODETEXT Compatibility_ClipMem = GlobalAlloc(GPTR, GlobalSize(hMem)) If !Compatibility_ClipMem Message "Memory Allocation Error in CLIPPASTE" : h = 0 : Exit Sub EndIf d = GlobalLock(Compatibility_ClipMem) s = GlobalLock(hMem) MemCpy(s, d, GlobalSize(hMem)) ~GlobalUnlock(hMem) ~GlobalUnlock(Compatibility_ClipMem) h = Compatibility_ClipMem Default h = hMem EndSwitch ~CloseClipboard() EndIf EndProcedure >Procedure CLIPFREE If Compatibility_ClipMem ~GlobalFree(Compatibility_ClipMem) EndIf EndProcedure >Procedure CLRCLIP

Local Int hOwnerWnd, hResult If Me Is Nothing Then hOwnerWnd = 0 Else hOwnerWnd = Me.hWnd hResult = OpenClipboard(hOwnerWnd) If hResult = 0 Message "Clipboard Error."#13 + "GetLastError returned: " + Format(GetLastEr ror()) Else ~EmptyClipboard() ~CloseClipboard() EndIf EndProcedure ' >Function DirExists(Fle$) As Boolean Const vbDirectory = 16 Local Dim A% On Error Resume Next A% = GetAttr(Fle$) If Err = 0 Then If (A And vbDirectory) = vbDirectory Then Return True Else Return False Else Return False EndIf EndFunc ' '####################################################################### ' IMPLEMENTATION MODULE MCarga '####################################################################### ' >Procedure cargador Local t% ' Restore aqui For i% = 1 To 9 Read zsideral$(i%) Next i% aqui: Data Fagan/Bradley Data Lahiri Data Raman Data Babylonian/Mercier Data Sasanian Data Galactic Center 0 Sag Data Sundara Rahan Data Krishnamurti Data user-defined ' For i% = con% To nov% Read aspaux$(i%), orbes%(i%, 1), orbes%(i%, 2) Next i% Data CON, 0,1000 Data OPP, 18000,1000 Data SQU, 9000, 700 Data TRI, 12000, 700 Data SEX, 6000, 400 Data QUX, 15000, 200 Data smQ, 4500, 150 Data sqQ, 13500, 150 Data smS, 3000, 100 Data Qtl, 7200, 100 Data bi5, 14400, 100

Data sm5, 3600, 50 Data sq5, 10800, 50 Data Sep, 5143, 100 Data bi7, 10286, 100 Data tr7, 15429, 100 Data sm7, 2571, 50 Data sq7, 7714, 50 Data ss7, 12857, 50 Data a15, 1500, 50 Data b15, 7500, 50 Data c15, 10500, 50 Data d15, 16500, 50 Data a16, 2250, 50 Data b16, 6750, 50 Data c16, 11250, 50 Data d16, 15750, 50 Data Nov, 4000, 50 ' For pl% = sol% To plu% Read masa(pl%) masa(pl%) = kg * (d1 + d1 / masa(pl%)) Next pl% Data 328900.5 Data 6023600 Data 408523.5 Data 3098710 Data 1047.355 Data 3498.5 Data 22869 Data 19314 Data 0.1352E9 For pl% = qui% To allplanets% masa(pl%) = kg Next pl% ' For pl% = lun% To plu% Read glifos%(pl%) Read pldef(pl%, vmag%), pldef(pl%, fmag%), pldef(pl%, semidiam%) Next pl% Data 161, 0.21, 0.0260, 2.396246682927 Data 162, -3.90, 0,959.63 Data 163, -0.42, 0.0380, 3.36 Data 164, -4.40, 0.0009, 8.34 Data 165, -1.52, 0.0160, 4.68 Data 166, -9.40, 0.0050, 98.44 Data 167, -8.88, 0.0440, 82.73 Data 168, -7.19, 0, 35.02 Data 169, -6.87, 0, 33.50 Data 170, -0.92, 0, 2.07 For pl% = qui% To finpl% Read glifos%(pl%), pldef(pl%, vmag%) pldef(pl%, fmag%) = 0.15 pldef(pl%, semidiam%) = 0.1 Next pl% Data 171, 6.50 ' 11- Chiron Data 172, 7.00 ' 12- Pholus Data 173, 9.60 ' 13- Nessus Data 174, 9.00 ' 14- Asbolus Data 177, 6.40 ' 15- Chariklo Data 176, 8.00 ' 16- Hylonome

Data Data Data Data Data Data Data Data Data Data Data Data Data Data Data Data Data Data Data Data Data Data Data Data Data Data Data Data Data Data Data Data Data Data Data Data Data Data Data Data Data Data Data Data Data Data Data Data Data Data Data Data Data Data Data Data Data Data Data Data

175, 199, 180, 182, 178, 202, 181, 188, 184, 203, 189, 211, 212, 213, 214, 190, 196, 209, 206, 216, 185, 217, 218, 215, 201, 207, 179, 183, 186, 210, 205, 198, 197, 220, 219, 63, 63, 63, 63, 63, 63, 63, 221, 63, 63, 63, 63, 195, 63, 63, 63, 63, 63, 63, 63, 191, 63, 63, 193, 192,

11.43 11.30 10.40 10.10 9.30 7.60 9.00 7.80 9.10 9.50 3.70 4.90 6.70 6.60 4.70 3.20 2.60 1.60 2.30 6.60 7.20 6.30 5.50 -1.20 -0.30 0.20 7.20 6.80 8.20 11.20 8.20 5.40 8.80 8.65 7.84 5.20 7.30 7.38 7.72 7.80 6.20 6.70 9.20 8.00 6.10 6.20 7.41 8.80 7.49 7.48 7.18 4.40 6.20 4.50 4.20 3.30 4.40 3.85 3.90 3.30

' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '

171819202122232425262728293031323334353637383940414243444546474849505152535455565758596061626364656667686970717273747576-

Pylenor Okyrhoe Pelion Elatus Cyllaruss Bienor Thereus Amycus Crantor Echeclus Varuna Chaos Rhadamanthus Deucalion Huya Ixion Quaoar Sedna Orcus Logos Typhon Ceto Teharonhiawako Eris 2005 FY9 2003 EL61 BU48 OX3 QB243 XA255 PN34 TL66 TD10 CY118 CZ118 GQ21 CF119 RD215 RZ214 RZ215 CR105 OM67 OO67 PJ30 FP185 FZ173 GB32 VQ94 HB57 YQ179 PB112 RM43 SA278 TO66 UR163 AW197 KX14 MS4 TC302 TX300

Data 194, 3.60 ' 77- UX25 Data 63, 3.80 ' 78- AZ84 Data 63, 3.72 ' 79- MW12 Data 63, 4.10 ' 80- OP32 Data 63, 4.20 ' 81- VS2 Data 63, 4.00 ' 82- GV9 Data 63, 4.40 ' 83- SB60 Data 63, 4.47 ' 84- XR190 Data 63, 4.50 ' 85- TY364 Data 63, 3.75 ' 86- RN43 Data 63, 3.98 ' 87- RR43 Data 63, 7.20 ' 88- QB1 Data 187, 8.60 ' 89- XX143 Data 63, 10.08 ' 90- CO104 Data 63, 11.41 ' 91- FZ53 Data 200, 14.29 ' 92- GM137 Data 204, 11.70 ' 93- BL41 Data 63, 9.50 ' 94- KF77 Data 63, 9.60 ' 95- SQ73 Data 63, 11.13 ' 96- XZ255 Data 208, 10.12 ' 97- DH5 Data 63, 6.80 ' 98- GZ32 Data 63, 11.00 ' 99- VR130 Data 63, 8.90 ' 100- CO1 Data 63, 10.73 ' 101- QD112 Data 63, 8.70 ' 102- WL7 Data 63, 8.40 ' 103- RL43 Data 63, 10.50 ' 104- UJ438 For pl% = nodo% To m_c% Read glifos%(pl%) Next pl% Data 229,230,231,232 tambien: Restore tambien For i% = 1 To k2% Read sgaux$(i%), sideral(i%), mes$(i%), meses%(i%, 1), meses%(i%, 2) sgfont$(i%) = Chr$(Add(144, i%)) For j% = 1 To 8 Read regen%(i%, j%) Next j% Next i% Data Ari,24.7308,January, 31, 0, 5, 4, 2, 7, 5, 4, 2, 7 Data Tau,36.7239,February, 29, 31, 4, 5, 1, 0, 4,10, 1, 0 Data Gem,27.8489,March, 31, 60, 3, 6, 0, 0, 3, 6,19, 0 Data Can,20.0511,April, 30, 91, 1, 7, 6, 5, 1, 7, 6, 5 Data Leo,35.8139,May, 31,121, 2, 7, 0, 0, 2, 8, 0, 0 Data Vir,43.9611,June, 30,152, 3, 6, 3, 4, 3, 9, 3, 4 Data Lib,22.9067,July, 31,182, 4, 5, 7, 2, 4, 5, 7, 2 Data Sco,25.5222,August, 31,213, 5, 4, 0, 1, 10, 4, 0, 1 Data Sag,33.4069,September,30,244, 6, 3, 0, 0, 6, 3, 0,19 Data Cap,27.8325,October, 31,274, 7, 1, 5, 6, 7, 1, 5, 6 Data Aqu,24.4617,November, 30,305, 7, 2, 0, 0, 8, 2, 0, 0 Data Pis,36.7403,December, 31,335, 6, 3, 4, 3, 9, 3, 4, 3 ' For pl% = lun% To lim% Read plaux$(pl%), mpcnumber%(pl%) If pl% > plu% And Not @inrange(pl%, nodo%, m_c%) Then Add mpcnumber%(pl%), k z% If pl% <= planeta% Then plfont$(pl%) = Chr$(glifos%(pl%))

Next pl% Data "Moon ",1,"Sun Data "Jupiter ",5,"Saturn ' NAMED CENTAURS Data "Chiron ",2060 Data "Pholus ",5145 Data "Nessus ",7066 Data "Asbolus ",8405 Data "Chariklo ",10199 Data "Hylonome ",10370 Data "Pylenor ",20016 Data "Okyrhoe ",52872 Data "Pelion ",49036 Data "Elatus ",31824 Data "Cyllarus ",52975 Data "Bienor ",54598 Data "Thereus ",32532 Data "Amycus ",55565 Data "Crantor ",83982 Data "Echeclus ",60558 ' NAMED TNO'S Data "Varuna ",20000 Data "Chaos ",19521 Data "Radamantu",38083 Data "Deucalion",53311 Data "Huya ",38628 Data "Ixion ",28978 Data "Quaoar ",50000 Data "Sedna ",90377 Data "Orcus ",90482 Data "Logos ",58534 Data "Typhon ",42355 Data "Ceto ",65489 Data "Teharonhi",88611 Data "Eris ",136199 Data "FY9 ",136472 Data "EL61 ",136108 ' PLUTO STEEDS Data "BU48 ",33128 Data "OX3 ",44594 Data "QB243 ",87555 Data "XA255 ",148975 Data "PN34 ",73480 ' LONG RANGE SDO'S Data "TL66 ",15874 Data "TD10 ",29981 Data "CY118 ",0 Data "CZ118 ",0 Data "GQ21 ",26181 Data "CF119 ",0 Data "RD215 ",0 Data "RZ214 ",0 Data "RZ215 ",91554 Data "CR105 ",148209 Data "OM67 ",118702 Data "OO67 ",87269 Data "PJ30 ",54520 Data "FP185 ",82158 Data "FZ173 ",82155 Data "GB32 ",0

",0,"Mercury ",2,"Venus ",3,"Mars ",6,"Uranus ",7,"Neptune ",8,"Pluto

",4 ",9

Data "VQ94 ",0 Data "HB57 ",0 Data "YQ179 ",0 Data "PB112 ",0 Data "RM43 ",145451 Data "SA278 ",145474 ' BRIGHT TNO'S + QB1 Data "TO66 ",19308 Data "UR163 ",42301 Data "AW197 ",55565 Data "KX14 ",119951 Data "MS4 ",0 Data "TC302 ",84522 Data "TX300 ",55636 Data "UX25 ",55637 Data "AZ84 ",0 Data "MW12 ",0 Data "OP32 ",120178 Data "VS2 ",84922 Data "GV9 ",90568 Data "SB60 ",120347 Data "XR190 ",0 Data "TY364 ",120348 Data "RN43 ",145452 Data "RR43 ",145453 Data "QB1 ",15760 ' OTHER CENTAURS Data "XX143 ",121725 Data "CO104 ",999004 Data "FZ53 ",0 Data "GM137 ",0 Data "BL41 ",63252 Data "KF77 ",88269 Data "SQ73 ",119315 Data "XZ255 ",0 Data "DH5 ",0 Data "GZ32 ",95626 Data "VR130 ",119976 Data "CO1 ",120061 Data "QD112 ",0 Data "WL7 ",136204 Data "RL43 ",0 Data "UJ438 ",145486 ' chart points Data "Aries ",0,"Node ' UN-NAMED DAMOCLOIDS Data "LE31 ",0 Data "RG33 ",15504 Data "VU2 ",37117 Data "QF6 ",0 Data "CE10 ",0 Data "RP120 ",65407 Data "CC22 ",0 Data "WN188 ",0 Data "DA62 ",0 Data "PA44 ",154783 Data "96PW ",20003 Data "Vertex ",0 ' For i% = 1 To caldeo%

",11,"Apogee

",13,"Ascend

",0,"Midheav ",0

Read dia$(i%), esen$(i%, 1), elem$(i%) Next i% elem$(8) = "exten" elem$(9) = "inten" Data Monday,"domicile ",common Data Tuesday,"detriment ",cardinal Data Wednesday,"exaltation",fixed Data Thursday,"fall ",water Data Friday,"reception ",fire Data Saturday,"dispositor",earth Data Sunday,"singletone",air ' For cusp% = decima% To puntacasa% Read casa$(cusp%) Next cusp% Data "X ","XI ","XII ","I ","II ","III ","IV ","V ","VI ","VII ","VI II","IX " Data "Ascendant ","Midheaven ","Vertex ","Fortuna D." ' Data "10.5","11.5","12.5"," 1.5"," 2.5"," 3.5"," 4.5"," 5.5"," 6.5"," 7.5"," 8 .5"," 9.5" ' For i% = 1 To 43 Read nombre|(i%) Next i% Data 32,82,73,89,65,76,32,102,114,101,101,32,118,101,114,115,105,111,110,32 Data 98,121,32,74,117,97,110,32,65,110,116,111,110,105,111,32,82,101,118,105,1 08,108,97 ' For i% = lun% To plu% For j% = longitud% To rvector% For t% = rp% To t5% Read pptl%(i%, j%, t%) Next t% Next j% Next i% Data 218, 275,173, 66, 2, 0, 0, 188, 69, 64, 19, 0, 0, 0, 154, 115, 68, 3 0, 2, 0, 0 Data 1, 843,491,204, 18,15, 6, 0, 854,496,202, 17,15, 6, 0, 178,120, 5 3, 12, 6, 2 Data 3539,1449,792,299, 54,15,10, 0,1438,782,299, 59,15,10, 0, 598,351,14 3, 28,10,07 Data 9898, 548,338, 99, 5, 4, 3, 0, 565,325, 99, 5, 4, 3, 0, 190,108, 4 5, 10, 3, 3 Data 12255,1584,956,387,135,41,21, 0,1612,969,384,136,44,21, 0, 355,232,12 2, 51,16, 7 Data 19328,1055,488,255,140,58,11, 0,1037,499,259,136,60,11, 0, 216,104, 6 5, 27,10, 3 Data 23762,1652,892,481,215,87,31, 0,1658,917,465,201,88,32, 0, 420,217, 8 7, 44,19, 6 Data 31274,1464,649,249, 84,12, 0, 0,1447,649,249, 84,12, 0, 0, 235, 98, 3 3, 12, 0, 0 Data 36563, 772,330,102, 33, 7, 0, 0, 746,325, 97, 34,07, 0, 0, 133, 37, 1 1, 2, 0, 0 Data 39199,1293,816,461,206,84,34, 0,1291,814,470,206,87,34, 0, 376,243,12 3, 61,26,09 ' For i% = sol% To plu% For j% = longitud% To rvector% For t% = rp% To t5% Read ipsl%(i%, j%, t%)

Next t% Next j% Next i% Data 1, 793,596,185, 17, 9, 5, 0, 804, 600,184, 17, 9, 5, 0, 154,168, 46 , 10, 3, 2 Data 3608, 884,490,129, 15, 9, 1, 0, 878, 492,129, 15, 9, 0, 0, 466,244, 39 , 11, 6, 0 Data 7425, 547,515, 97, 5, 4, 3, 0, 561, 512, 97, 5, 4, 3, 0, 190,174, 45 , 9, 3, 2 Data 10201,1584,995,387,134,37,16, 0,1612,1005,384,134,37,16, 0, 355,358,122 , 51,16, 4 Data 17448,1055,631,255,140,58,11, 0,1037, 640,259,136,60,11, 0, 216,216, 65 , 27,10, 3 Data 22278,1652,948,481,215,87,31, 0,1658, 966,465,201,88,32, 0, 420,426, 87 , 44,19, 6 Data 30104,1464,750,249, 84,12, 0, 0,1447, 760,255, 80,12, 0, 0, 235,237, 33 , 12, 0, 0 Data 35734, 772,618,102, 33, 7, 0, 0, 746, 611, 97, 34, 7, 0, 0, 133,133, 11 , 2, 0, 0 Data 1, 193, 26, 13, 0, 0, 0, 0, 183, 29, 14, 0, 0, 0, 0, 170, 20, 11 , 0, 0, 0 'Data 39040, 193, 26, 13, 0, 0, 0, 0, 183, 29, 14, 0, 0, 0, 0, 170, 20, 1 1, 0, 0, 0 ' Mat Read flunar() Mat Mul flunar(), p5 Data -40720,17241,1608,1039,739, -514, 208,-111,-57,56,-42, 42, 38,-24,-17, -7 Data -40614,17302,1614,1043,734, -515, 209,-111,-57,56,-42, 42, 38,-24,-17, -7 Data -62801,17172, 862, 804,454,-1183, 204,-180,-70,27,-40, 32, 32,-34,-17,-28 Data -40750,17210,1610,-970,730, -500, 210,-230,120,60,-40,-30,-20,-20,-20, 0 Data -40650,17270,1610,-970,730, -500, 210,-230,120,60,-40,-30,-20,-20,-20, 0 Data 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 ' Mat Read apo() Data 2, 0, 0, 0.4392,-1.6769 Data 4, 0, 0, 0.0684, 0.4589 Data 0, 1, 0, 0.0456, 0.0502 Data 2,-1, 0, 0.0426,-0.0773 Data 0, 0, 2, 0.0212, 0.0129 Data 1, 0, 0,-0.0189, 0.0237 Data 6, 0, 0, 0.0144,-0.1856 Data 4,-1, 0, 0.0113, 0.0422 Data 2, 0, 2, 0.0047,-0.0053 Data 1, 1, 0, 0.0036,-0.0032 Data 8, 0, 0, 0.0035, 0.0883 Data 6,-1, 0, 0.0034,-0.0256 Data 2, 0,-2,-0.0034, 0.0000 Data 2,-2, 0, 0.0022,-0.0027 Data 3, 0, 0,-0.0017,-0.0112 Data 4, 0, 2, 0.0013, 0.0027 Data 8,-1, 0, 0.0011, 0.0162 Data 4,-2, 0, 0.0010, 0.0024 Data 10, 0, 0, 0.0009,-0.0460 Data 3, 1, 0, 0.0007, 0.0014 Data 0, 2, 0, 0.0006, 0.0007 Data 2, 1, 0, 0.0005, 0.0040 Data 2, 2, 0, 0.0005, 0.0005 Data 6, 0, 2, 0.0004,-0.0014 Data 6,-2, 0, 0.0004,-0.0021 Data 10,-1, 0, 0.0004,-0.0104

Data 5, 0, 0,-0.0004, 0.0066 Data 4, 0,-2,-0.0004,-0.0014 Data 0, 1, 2, 0.0003, 0.0000 Data 12, 0, 0, 0.0003, 0.0253 Data 2,-1, 2, 0.0003, 0.0000 Data 1,-1, 0,-0.0003,-0.0004 Data 14, 0, 0, 0,-0.0145 Data 16, 0, 0, 0, 0.0086 Data 12,-1, 0, 0, 0.0069 Data 18, 0, 0, 0,-0.0052 Data 14,-1, 0, 0,-0.0046 Data 7, 0, 0, 0,-0.0041 Data 20, 0, 0, 0, 0.0032 Data 16,-1, 0, 0, 0.0031 Data 4, 1, 0, 0,-0.0029 Data 9, 0, 0, 0, 0.0027 Data 22, 0, 0, 0,-0.0021 Data 18,-1, 0, 0,-0.0021 Data 6, 1, 0, 0, 0.0019 Data 11, 0, 0, 0,-0.0018 Data 8, 1, 0, 0,-0.0014 Data 5, 1, 0, 0,-0.0014 Data 13, 0, 0, 0, 0.0013 Data 20,-1, 0, 0, 0.0013 Data 3, 2, 0, 0, 0.0011 Data 4,-2, 2, 0,-0.0011 Data 1, 2, 0, 0,-0.0010 Data 22,-1, 0, 0,-0.0009 Data 0, 0, 4, 0,-0.0008 Data 6, 0,-2, 0, 0.0008 Data 2, 1,-2, 0, 0.0008 Data 0,-1, 2, 0, 0.0007 Data 2, 0, 4, 0, 0.0007 Data 0,-2, 2, 0,-0.0006 Data 2, 2,-2, 0,-0.0006 Data 24, 0, 0, 0, 0.0006 Data 4, 0,-4, 0, 0.0005 ' Mat Read de118() ' *** DE118-DE200 SEGUN STANDISH, A&A 114, 298 (1982) *** Data 0.9999256791774783,-0.0111815116768724,-0.0048590038154553 Data 0.0111815116959975, 0.9999374845751042,-0.0000271625775175 Data 0.0048590037714450,-0.0000271704492210, 0.9999881946023742 Mat Read pr1950() Data 0.9999257161356,-0.0121886058223,-0.0000099451944 Data 0.0121886046153, 0.9999257097546,-0.0001135310248 Data 0.0000113282240, 0.0001134013732, 0.9999999935059 ' For i% = disco% To as87% Read xmenu%(i%) Next i% Data 1,10,27,43,60,73,82,99,106,2,3,4,5,6,8 Data 11,12,13,14,15,16,18,19,20,21,22,23,25 Data 28,30,31,32,34,35,36,37,38,40,41 Data 44,45,46,48,49,50,51,53,54,55,57,58 Data 61,62,63,65,66,67,69,70,71 Data 74,75,76,78,79,80 Data 83,84,85,86,87,88,89,90,91,92,93,94,95,96,97 Data 100,101,102,103,104,107,108,109,110 '

For i% = 1 To 111 Read n%, titulos$(i%) Next i% Data 1," Disk " Data 2,"sample database" Data 3,"personal database" Data 4,"save data" Data 5,"edit data" Data 6,"extend screen" Data 7,"-" Data 8," EXIT" Data 9,"" Data 10," Menu " Data 11,"Radix" Data 12,"Aspectarian" Data 13,"House Cusps" Data 14,"Progressed" Data 15,"Solar Arcs" Data 16,"Quotidian" Data 17,"-" Data 18,"Comparison" Data 19,"Relationship" Data 20,"Transits" Data 21,"Solar Return" Data 22,"Lunar Return" Data 23,"Primaries" Data 24,"-" Data 25," ERASE" Data 26,"" Data 27," Alternative " Data 28,"Sort All" Data 29,"-" Data 30,"Midpoint Pictures" Data 31,"Midpoint Pairs" Data 32,"Midpoint Sequence" Data 33,"-" Data 34,"Alternative Zodiac" Data 35,"Harmonics" Data 36,"Microscope" Data 37,"Composite" Data 38,"Planetocentric" Data 39,"-" Data 40,"Degree Symbols" Data 41,"Sabian Oracle" Data 42,"" Data 43," Tables " Data 44,"Astronomical Data" Data 45,"Planetary Weighting" Data 46,"Elements and Qualities" Data 47,"-" Data 48,"Full Display" Data 49,"Fixed Stars" Data 50,"Paranatellontas" Data 51,"Speculum" Data 52,"-" Data 53,"All Named Asteroids" Data 54,"All Distant Objects" Data 55,"Unusual Deep Space" Data 56,"-" Data 57,"Swiss Ephemeris"

Data 58,"test position accuracy" Data 59,"" Data 60," Graphics " Data 61,"Natal Chart" Data 62,"Octoscope" Data 63,"Heliocentric" Data 64,"-" Data 65,"Constellations" Data 66,"Horizon" Data 67,"Sphere" Data 68,"-" Data 69,"Compass" Data 70,"Cartography" Data 71,"Graphic Transits" Data 72,"" Data 73," Options " Data 74,"calendar" Data 75,"file output" Data 76,"printer output" Data 77,"-" Data 78,"edit riyal.cgf" Data 79,"selection of planets" Data 80,"global defaults" Data 81,"" Data 82," Houses " Data 83,"Placidus" Data 84,"Campanus" Data 85,"Regiomontanus " Data 86,"Alchabitius" Data 87,"Svarogich" Data 88,"Abenragel-APC" Data 89,"Koch (GOH)" Data 90,"Topocentric " Data 91,"Porphyry" Data 92,"J.B.Morin" Data 93,"Meridian" Data 94,"Horizontal" Data 95,"Equal House" Data 96,"Zodiacal" Data 97,"Geodetic" Data 98,"" Data 99," Special " Data 100,"Table of Houses" Data 101,"Generate Ephemerides" Data 102,"Coordinates Conversion" Data 103,"Input Orbital elements" Data 104,"Phenomena (search)" Data 105,"" Data 106," Info " Data 107,"readme" Data 108,"homepage" Data 109,"e-mail" Data 110,"about... " Data 111,"","" ' For i% = 1 To Sub(xmenu%(geo%), xmenu%(dom%)) hdom$(i%) = Trim$(titulos$(Add(i%, xmenu%(dom%)))) If zdom$ = Upper(Left(hdom$(i%), 4)) basedom% = Add(Pred(pla%), i%) sistema% = Sub(basedom%, Pred(pla%))

EndIf Next i% ' EndProc ' ' ###################################################################### ' IMPLEMENTATION MODULE MDesk ' ###################################################################### ' '##B# >Procedure abreventana0 ParentW # 1 altaresolucion StarsVIEW ' ################################## Ocx ListView lv .Visible = False .Left = 1 .Top = 1 .Width = Add(av% Div 4, 20) .Appearance = WS_EX_CLIENTEDGE .BackColor = brwhite% .TextBackColor = brwhite% .View = 2 .BorderStyle = basThick .ForeColor = black% .FontBold = False .FullRowSelect = True .FontSize = 10 .LabelEdit = False .MultiSelect = False .GridLines = True .ColumnHeaders.Add( , , "name").Width = 3200 .ColumnHeaders.Add( , , "julian day").Width = 1680 .ColumnHeaders.Add( , , "latitude").Width = 1000 .ColumnHeaders.Add( , , "longitude").Width = 1000 .MousePointer = 1 ' ################################## Ocx ListView elements .Visible = False .Left = 1 .Top = 1 .Width = Add(av% Div 4) .Appearance = WS_EX_CLIENTEDGE .BackColor = brwhite% .TextBackColor = brwhite% .View = 2 .BorderStyle = basThick .ForeColor = black% .FontBold = True .FullRowSelect = True .FontSize = 10 .LabelEdit = False .MultiSelect = False .GridLines = True .ColumnHeaders.Add( , , "name").Width = 1500 .ColumnHeaders.Add( , , "jd").Width = 1800 .ColumnHeaders.Add( , , "AX").Width = 1800 .ColumnHeaders.Add( , , "VL").Width = 1800 .ColumnHeaders.Add( , , "EC").Width = 1800

.ColumnHeaders.Add( , , "PN").Width = 1800 .ColumnHeaders.Add( , , "CL").Width = 1800 .ColumnHeaders.Add( , , "AN").Width = 1800 .MousePointer = 1 ' ################################## Ocx TextBox tb .Visible = False .Left = 0 .Top = 30 .Width = av% .Height = Sub(hv%, 115) .SetFont "terminal", 14, , , , , OEM_CHARSET .BackColor = atras% .ForeColor = white% .MultiLine = True .ScrollBars = basNoScroll .ReadOnly = True .MousePointer = 1 ' ################################## Ocx RichEdit rtb .Visible = False .Move Win_1.ScaleWidth * .01, Win_1.ScaleHeight / 30, Win_1.ScaleWidth * .99, Win_1.ScaleHeight * .845 .SetFont "terminal", 14, , , , , OEM_CHARSET .BackColor = atras% .ForeColor = white% .MultiLine = True .ScrollBars = basNoScroll .ReadOnly = True .MousePointer = 1 ' ################################## Ocx ProgressBar pb .Visible = False .Left = 0 .Width = av% .Top = 0 .Height = 15 .Smooth = False .BorderStyle = basThick ' ################################## If basesideral? Then version$ = version$ + " (Sidereal - " + zsideral$(baseaya namsa%) + ")" With Win_1 .SetFont "terminal", 14, , , , , OEM_CHARSET .BackColor = atras% .ForeColor = white% .FontBold = False .AutoRedraw = True .Sizeable = False .ControlBox = True .Caption = version$ .MaxButton = False .PrintScroll = True .Show EndWith cambiafont(14) xcentro% = Add(xv%, av% \ 2) ycentro% = Add(yv%, hv% \ 2) ' ################################## Ocx Label toFile = "output sent to file", 300, Sub(ycentro%, 20), 180, 24

.Visible = False .BackColor = crema% .ForeColor = black% .Alignment = 2 .Appearance = 2 .BorderStyle = basThick .FontSize = 9 .FontBold = 0 ' ################################## Ocx Label cmdEsc = "cancel", 240, Sub(hv%, 82), 99, 24 .Visible = False .BackColor = RGB(0, 188, 255) .Alignment = 2 .Appearance = 4 .BorderStyle = basFixedSingle .FontSize = 9 .FontBold = 0 ' ################################## Ocx Label cmdPasa = "continue", 340, Sub(hv%, 82), 99, 24 .Visible = False .BackColor = RGB(0, 188, 255) .Alignment = 2 .Appearance = 4 .BorderStyle = basFixedSingle .FontSize = 9 .FontBold = 0 ' ################################## Ocx Label cmdOptions = "right-click", 440, Sub(hv%, 82), 99, 24 .Visible = False .BackColor = RGB(0, 188, 255) .Alignment = 2 .Appearance = 4 .BorderStyle = basFixedSingle .FontSize = 9 .FontBold = 0 ' ################################## Ocx Label cmdStop = "space = STOP", 330, Sub(hv%, 82), 129, 24 .Visible = False .BackColor = green% .Alignment = 2 .Appearance = 4 .BorderStyle = basFixedSingle .FontSize = 9 .FontBold = 0 EndProc >Sub Win_1_KeyPress(key&) k$ = Upper$(Chr(key&)) If k$ = esc$ Then aborta? = True Else aborta? = False If Not (opcion% = ldat% Or opcion% = lsam%) If k$ = rt$ Or k$ = spc$ Then prueba? = True Else prueba? = False EndIf simulatecla(VK_INSERT) >Sub Win_1_MouseDown(a&, b&, c!, d!) status% = a& If (opcion% = ldat% Or opcion% = lsam%) And a& = MK_RBUTTON Then aborta? = Tru e mx0 = c! my0 = d! >Sub Win_1_MouseUp(a&, b&, c!, d!) status% = -1

>Sub Win_1_Close(Cancel?) aborta? = True endwin EndSub ' >Procedure StarsVIEW ' For i% = 1 To 8 Ocx ListView SV(i%) = , 0, 0, Sub(av%, 5), Sub(hv%, 40) SV(i%).Visible = False SV(i%).GridLines = True SV(i%).SetFont "fixedsys" SV(i%).ForeColor = black% SV(i%).TextBackColor = brwhite% SV(i%).MousePointer = 1 SV(i%).Appearance = WS_EX_CLIENTEDGE SV(i%).BackColor = brwhite% SV(i%).View = 3 SV(i%).FullRowSelect = True SV(i%).HideSelection = False SV(i%).MultiSelect = True Next i% For i% = 1 To 2 SV(i%).GridLines = False SV(i%).ForeColor = yellow% SV(i%).TextBackColor = atras% SV(i%).BackColor = atras% Next i% ' ' Swiss Ephemeris SV(7).ColumnHeaders.Add( , , "NAME (NUMBER)").Width = 3200 SV(7).ColumnHeaders.Add( , , "LONGITUDE").Width = 1700 SV(7).ColumnHeaders.Add( , , "ZODIACAL").Width = 1600 SV(7).ColumnHeaders.Add( , , "VELOCITY").Width = 1700 SV(7).ColumnHeaders.Add( , , "LATITUDE").Width = 1700 SV(7).ColumnHeaders.Add( , , "DISTANCE").Width = 1700 For i% = 2 To 6 SV(7).ColumnHeaders(i%).Alignment = 2 Next i% ' ' Error Test SV(8).ColumnHeaders.Add( , , "DATE").Width = 2000 SV(8).ColumnHeaders.Add( , , "APPARENT (GEO)").Width = 2300 SV(8).ColumnHeaders.Add( , , "J2000 (HELIO)").Width = 2300 SV(8).ColumnHeaders.Add( , , "description").Width = 5000 For i% = 1 To 4 SV(8).ColumnHeaders(i%).Alignment = 2 Next i% ' ' deep space objects SV(6).ColumnHeaders.Add( , , "NAME").Width = 2650 SV(6).ColumnHeaders.Add( , , "LONGITUDE").Width = 1500 SV(6).ColumnHeaders.Add( , , "ZODIACAL").Width = 2100 SV(6).ColumnHeaders.Add( , , "IAU").Width = 800 SV(6).ColumnHeaders.Add( , , "LATITUDE").Width = 1450 SV(6).ColumnHeaders.Add( , , "DECLINAT").Width = 1450 SV(6).ColumnHeaders.Add( , , "M.C.").Width = 1400 SV(6).ColumnHeaders.Add( , , "I.C.").Width = 1400 SV(6).ColumnHeaders.Add( , , "ASC.").Width = 1500 SV(6).ColumnHeaders.Add( , , "DESC.").Width = 1500

SV(6).ColumnHeaders.Add( , , " ").Width = 23000 For i% = 1 To 10 SV(6).ColumnHeaders(i%).Alignment = 2 Next i% ' ' distant objects SV(5).ColumnHeaders.Add( , , "NAME").Width = 1650 SV(5).ColumnHeaders.Add( , , "NUMBER").Width = 1100 SV(5).ColumnHeaders.Add( , , "CLASS").Width = 1600 SV(5).ColumnHeaders.Add( , , "LONGITUDE").Width = 1500 SV(5).ColumnHeaders.Add( , , "ZODIACAL").Width = 2000 SV(5).ColumnHeaders.Add( , , "IAU").Width = 800 SV(5).ColumnHeaders.Add( , , "LATITUDE").Width = 1450 SV(5).ColumnHeaders.Add( , , "DECLINAT").Width = 1450 SV(5).ColumnHeaders.Add( , , "YEARS").Width = 1450 SV(5).ColumnHeaders.Add( , , "HELIO R").Width = 1350 SV(5).ColumnHeaders.Add( , , "APHEL").Width = 1300 SV(5).ColumnHeaders.Add( , , "PERIHEL").Width = 1300 SV(5).ColumnHeaders.Add( , , "KM").Width = 1150 SV(5).ColumnHeaders.Add( , , "CEU (" + sec$ + ")").Width = 1600 SV(5).ColumnHeaders.Add( , , "T (" + sec$ + ")").Width = 1600 SV(5).ColumnHeaders.Add( , , "PEAK (" + sec$ + ")").Width = 1600 SV(5).ColumnHeaders.Add( , , "NAME").Width = 1650 SV(5).ColumnHeaders.Add( , , nul$).Width = 0 For i% = 1 To 17 SV(5).ColumnHeaders(i%).Alignment = 2 Next i% ' ' asteroides SV(4).ColumnHeaders.Add( , , "NAME").Width = 2650 SV(4).ColumnHeaders.Add( , , "LONGITUDE").Width = 1500 SV(4).ColumnHeaders.Add( , , "ZODIACAL").Width = 2300 SV(4).ColumnHeaders.Add( , , "IAU").Width = 800 SV(4).ColumnHeaders.Add( , , "LATITUDE").Width = 1450 SV(4).ColumnHeaders.Add( , , "DECLINAT").Width = 1450 SV(4).ColumnHeaders.Add( , , "YEARS").Width = 1450 SV(4).ColumnHeaders.Add( , , nul$).Width = 0 ' INDICE For i% = 1 To 7 SV(4).ColumnHeaders(i%).Alignment = 2 Next i% ' ' estrellas fijas SV(3).ColumnHeaders.Add( , , "NAME").Width = 2750 SV(3).ColumnHeaders.Add( , , "RIGHT ASCENSION").Width = 2000 SV(3).ColumnHeaders.Add( , , "DECLINATION").Width = 1680 SV(3).ColumnHeaders.Add( , , "LONGITUDE").Width = 2200 SV(3).ColumnHeaders.Add( , , "LATITUDE").Width = 1200 SV(3).ColumnHeaders.Add( , , "MERIDIAN").Width = 1200 SV(3).ColumnHeaders.Add( , , "AZIMUTH").Width = 1680 SV(3).ColumnHeaders.Add( , , "ALTITUDE").Width = 1680 SV(3).ColumnHeaders.Add( , , "M.C.").Width = 1400 SV(3).ColumnHeaders.Add( , , "I.C.").Width = 1400 SV(3).ColumnHeaders.Add( , , "ASC.").Width = 1500 SV(3).ColumnHeaders.Add( , , "DESC.").Width = 1500 For i% = 1 To 12 SV(3).ColumnHeaders(i%).Alignment = 2 Next i% ' ' aspectario Ocx ListView SV(1) = , 0, 0, Sub(av%, 5), Sub(hv%, 65)

SV(1).Visible = False SV(1).GridLines = False SV(1).SetFont "fixedsys" SV(1).ForeColor = yellow% SV(1).TextBackColor = atras% SV(1).MousePointer = 1 SV(1).Appearance = WS_EX_CLIENTEDGE SV(1).BackColor = atras% SV(1).View = 3 SV(1).FullRowSelect = True SV(1).HideSelection = False SV(1).MultiSelect = True SV(1).ColumnHeaders.Add( , , "planet 1").Width = 1600 SV(1).ColumnHeaders.Add( , , "planet 2").Width = 1600 SV(1).ColumnHeaders.Add( , , "phase").Width = 1200 SV(1).ColumnHeaders.Add( , , "true").Width = 1700 SV(1).ColumnHeaders.Add( , , "zodiacal").Width = 1700 SV(1).ColumnHeaders.Add( , , "aspect").Width = 1100 SV(1).ColumnHeaders.Add( , , "orb").Width = 1240 SV(1).ColumnHeaders.Add( , , "parallel").Width = 1400 For i% = 1 To 8 SV(1).ColumnHeaders(i%).Alignment = 2 Next i% ' ' normas planetarias - ejes comunes SV(2).ColumnHeaders.Add( , , "PLANET 1").Width = 1300 SV(2).ColumnHeaders.Add( , , "PLANET 2").Width = 1300 SV(2).ColumnHeaders.Add( , , "MIDPOINT").Width = 2000 SV(2).ColumnHeaders.Add( , , "CIRCLE").Width = 1200 SV(2).ColumnHeaders.Add( , , "PLANET 3").Width = 1300 SV(2).ColumnHeaders.Add( , , "PLANET 4").Width = 1300 SV(2).ColumnHeaders.Add( , , "MIDPOINT").Width = 2000 SV(2).ColumnHeaders.Add( , , "ORB").Width = 1150 For i% = 1 To 8 SV(2).ColumnHeaders(i%).Alignment = 2 Next i% ' EndProc ' >Sub SV_ColumnClick(Index%, ColumnHeader As ColumnHeader) Static Int spalte, istsort = 1 spalte = ColumnHeader.Index - 1 SV(Index%).Sort spalte, istsort >Sub SV_KeyPress(Index%, Ascii&) k$ = Upper$(Chr(Ascii&)) If k$ = esc$ Then aborta? = True Else aborta? = False If k$ = rt$ Or k$ = spc$ Then prueba? = True Else prueba? = False simulatecla(VK_INSERT) >Sub SV_MouseDown(Index%, Button&, Shift&, x!, y!) If Button& = 2 Then prueba? = True EndSub ' >Procedure cierre_bigw Win_1.Visible = False Win_1.Sizeable = True If desk_Y > 600 If alta? SizeW 1, av%, hv% Else SizeW 1, 800, 600

EndIf Else alta? = False SizeW 1, 800, 576 EndIf Win_1.Center 0 Win_1.Visible = True EndProc ' >Procedure altaresolucion Local j%, yres% Win_1.Sizeable = True yres% = Sub(desk_Y, 50) If desk_Y > 600 And opcion% = res% Clip Off If Not alta? alta? = True SizeW 1, 800, yres% tb.Height = Sub(yres%, 110) For j% = 3 To 7 SV(j%).Height = Sub(yres%, 40) Next j% For j% = 1 To 2 SV(j%).Height = Sub(yres%, 65) Next j% rtb.Move Win_1.ScaleWidth * .01, Win_1.ScaleHeight / 30, Win_1.ScaleWidth * .99, Win_1.ScaleHeight * .88 Else SizeW 1, 800, 600 alta? = False If opcion% = res% tb.Height = Sub(600, 110) For j% = 3 To 7 SV(j%).Height = Sub(600, 40) Next j% For j% = 1 To 2 SV(j%).Height = Sub(600, 65) Next j% rtb.Move Win_1.ScaleWidth * .01, Win_1.ScaleHeight / 30, Win_1.ScaleWidt h * .99, Win_1.ScaleHeight * .845 EndIf EndIf Else If desk_Y > 600 And alta? SizeW 1, 800, yres% Set fondo = LoadPicture("ancient.bmp") Else cierre_bigw EndIf EndIf low? = Not alta? Win_1.Center 0 Win_1.Sizeable = False GetWinRect 1, xv%, yv%, av%, hv% EndProc ' >Function limite() As Int Local rango% rango% = 6 If desk_Y > 863 Then rango% = 13

If desk_Y > 959 Then rango% = 18 Select opcion% Case prg% limite = Sub(Add(22, low?), Mul(rango%, alta?)) Case fag% limite = Sub(Add(26, low?), Mul(rango%, alta?)) Case eje%, orb%, tbc%, arc%, pri%, sab% limite = Sub(Add(23, low?), Mul(rango%, alta?)) Case cul% limite = Sub(Add(23, low?), Mul(rango%, alta? Or Not baseasteroides?)) Case pun% limite = Sub(Add(22, low?), Mul(rango%, alta?)) Case asp% limite = Sub(Add(45, low?), Mul(Mul(rango%, 2), alta?)) Case rvs% limite = Sub(Add(21, low?), Mul(Pred(rango%), alta?)) Case nor% limite = Sub(Add(72, low?), Mul(Add(rango%, k2%), alta?)) Case dig% limite = Sub( Add(9, low?), Mul(Add(rango%, 2), ultimo% > plu%)) Case efm% limite = Sub(Add(27, low?), Mul(Pred(rango%), alta?)) Case bal% limite = Sub(Add(29, low?), Mul(rango%, alta?)) EndSelect EndFunc ' >Procedure nuevo tx = d0 Mat Clr vc() Mat Clr radix() Mat Clr cd() ArrayFill spx%(), 0 For i% = asp% To gpr% menuapaga(i%) Next i% basegregoriano? = True menuapaga(sdat%) menuactiva(ora%) menuactiva(rvs%) menuactiva(gpr%) menuactiva(tst%) ingress? = True EndProc ' >Procedure abrepapel Lprint nul$ Printer.SetFont "verdana", 12, True Lprint Space$(Add(@centro(dgnom$), 15)); Upper(dgnom$); Printer.FontBold = False Lprint Printer.FontSize = 8 GraphMode R2_XORPEN Lprint String$(96, "_") Printer.SetFont "fixedsys" EndProc >Procedure cierrapapel Lprint Printer.SetFont "verdana", 8 Lprint String$(96, "_")

Printer.SetFont "fixedsys" Printer.FontItalic = True Lprint Date$; "-"; Time$; Space$(28); "Riyal Calculation Software" Printer.FontItalic = False Printer.EndPage Printer.EndDoc EndProc ' >Procedure cambiacasas(cual%) menufree(basedom%) menucheck(cual%) If cual% = geo% sistema% = Sub(basedom%, Pred(pla%)) Else sistema% = Sub(cual%, Pred(pla%)) EndIf basedom% = cual% If @lleno% vcangulos domificacion EndIf EndProc ' >Procedure pantalla If Not aborta? cmdPasa.Visible = True cmdEsc.Visible = True cmdOptions.Visible = True toquemouse cmdPasa.Visible = False cmdEsc.Visible = False cmdOptions.Visible = False Else Cls EndIf @txt(white%) contador% = 0 tb.Text = nul$ If baseimpresora? Then baja(xi%) EndProc >Sub rtb_KeyPress(Ascii&) If Ascii& = 13 aborta? = False prueba? = True EndIf If Ascii& = 27 Then aborta? = True >Sub tb_KeyPress(Ascii&) If Ascii& = 13 aborta? = False prueba? = True EndIf If Ascii& = 27 Then aborta? = True >Sub toFile_Click toFile.Visible = False >Sub cmdEsc_Click aborta? = True prueba? = False >Sub cmdPasa_Click aborta? = False prueba? = True

>Sub cmdOptions_Click opciones(True) >Sub cmdStop_Click pausa? = True EndSub ' >Procedure opciones(pasa?) Local caso%, r% = 0 If status% = 2 Or pasa? ' *** RIGHT-CLICK *** q$ = "copy to Clipboard = 'C'" If granventana? caso% = 1 q$ = q$ + "|Save as bmp = 'S'" If blanco? Then caso% = 2 q$ = q$ + "|send White wheel to printer = 'W'" EndIf Else caso% = 3 EndIf PopUp q$ + "|cancel = 'Esc'|continue...", MouseX, MouseY, -1, r% Inc r% status% = 0 EndIf pasa? = (k$ = spc$) Or (k$ = esc$) Or (k$ = rt$) Or k$ = "P" If Not pasa? If (k$ = "W" Or r% = 3) And blanco? Lprint nul$; Output = Printer PaintPicture Win_1.Image, 0, 0 Output = Win_1 Printer.EndPage Printer.EndDoc EndIf If (k$ = "S" Or r% = 2) And granventana? FileSelect "*.bmp", nombre$ + ".bmp", q$ If Len(q$) SavePicture Win_1.Image, q$ EndIf EndIf If (k$ = "C" Or r% = 1) CLRCLIP If Not granventana? CLIPFORMAT CF_TEXT CLIPCOPY V:skqclip$, Len(skqclip$) Else ~keybd_event(VK_MENU, 0, 0, 0) ~keybd_event(VK_SNAPSHOT, 0, 0, 0) ~keybd_event(VK_SNAPSHOT, 0, KEYEVENTF_KEYUP, 0) ~keybd_event(VK_MENU, 0, KEYEVENTF_KEYUP, 0) EndIf EndIf Select caso% Case 1 aborta? = (r% = 3) pasa? = (r% = 4) Case 2 aborta? = (r% = 4) pasa? = (r% = 5) Case 3

aborta? = (r% = 2) pasa? = (r% = 3) EndSelect k$ = nul$ EndIf prueba? = pasa? EndProc ' >Procedure toquemouse skqclip$ = skqclip$ + nuevalinea$ + rt$ nuevalinea$ = Str$(" ", rmargin) aborta? = False prueba? = False k$ = nul$ columna$ = nul$ status% = 0 Do Sleep Exit If prueba? Or aborta? opciones(False) Until Me Is Nothing toFile.Visible = False skqclip$ = nul$ q$ = nul$ q2$ = nul$ nuevalinea$ = nul$ lfk% = 0 Cls EndProc ' >Sub dlginfo_Click prueba? = True >Sub dlginfo_KeyPress(Ascii&) prueba? = True >Procedure informacion titulosoff prueba? = False aborta? = False Cls LoadForm dlginfo Do Sleep Exit If aborta? Or prueba? Until Me Is Nothing dlginfo.Close Win_1.ToTop tituloson EndProc ' >Function lleno% If tx = d0 Return 0 Else If Abs(dj - tx) < p6 Return 1 Else Return 2 EndIf EndIf EndFunc

' >Procedure llamador(opcion%) If baseprinter? And Not granventana? Then abrepapel If @lleno% = 2 And Not ingress? Select opcion% Case asp%, csp%, arc%, pri%, all% To swe% Alert 2, "|Which of the 2 radicals?", 2, " radix | sa me ", n% Case prg%, com% To rvl% n% = 1 Default n% = 0 EndSelect If n% = 1 llenaradix EndIf EndIf EndProc ' >Procedure dispenser Local escoge% For escoge% = lsam% To as87% If xmenu%(escoge%) = Succ(MENU(0)) opcion% = escoge% EndIf Next escoge% granventana? = (opcion% >= nat% And opcion% <= gpr%) Or opcion% = bal% If opcion% <> quit% Select opcion% Case res% altaresolucion Case ldat%, lsam% carguedatos Case sdat% guardedatos(False) Case htm% Exec "explorer.exe", ExecPath + "readme.html" Case cgf% Exec "notepad.exe", ExecPath + "riyal.cgf" Case edat% If Exist(ExecPath + "charts.csv") Exec "notepad.exe", ExecPath + "charts.csv" Else Alert 1, "|NO PERSONAL CHARTS FILE!", 1, Space(30) + "Enter" + Space(30) , n% EndIf Case as87% informacion Case home% ShellExecute(0, "Open", "http://www.expreso.co.cr/centaurs/", nul$, nul$, SW_SHOW) Case mail% ShellExecute(0, "open", "mailto:[email protected]", nul$, nul$, SW_SHOW) Case nue% guardedatos(True) q$ = "Do you really want to erase your|data and start a new radix?" Alert 2, q$, 1, " Yes |No!", n% If n% = 1 nuevo EndIf

Case pan% globalpanel Case obj% chooseobjects Case como% redir2file Case sid% calendario Case todo% redir2printer Case pla% To geo% cambiacasas(opcion%) Default llamador(opcion%) On Sub(opcion%, Pred(rad%)) Call mapanatal, aspectario, cuspides, progresa do, arcospr, quotidian, conversos, relacion, transitsearch, revolsolar, revollun ar, primarias On Sub(opcion%, Pred(all%)) Call uranianos, ejescomunes, normasi, normasii , altzodiac, harmonics, microscope, composite, planetocentric, simbolos, simbolo s On Sub(opcion%, Pred(fdj%)) Call astronomicas, dignidades, elemcuali, disp lay, estrellas, paranes, speculum, asteroides, distant, Sedgwick, SwissEphem, Ri yal_test_error On Sub(opcion%, Pred(nat%)) Call grnatal, octoscopio, grhelio, constelacio nes, grhorizonte, esfera, brujula, cartography, grprogresado On Sub(opcion%, Pred(tbc%)) Call tabladecasas, paranatellontas, eqt2zod, i nputosc, search If baseprinter? And Not granventana? Then cierrapapel EndSelect EndIf EndProc ' >Procedure principal Repeat aborta? = False prueba? = True blanco? = False suspendwrite? = False granventana? = False k$ = nul$ deg$ = deg1$ lfk% = 0 armonica = d1 bandera% = 0 opcion% = 0 If baseasteroides? If basenamed? Then ultimo% = nombrados% Else ultimo% = maximo% Else ultimo% = plu% EndIf Color white%, atras% Cls If alta? PaintPicture fondo, 165, Sub(Sub(hv%, 655) Div 2, 25) EndIf ' GetWinRect 1, xv%, yv%, av%, hv% xcentro% = Add(xv%, av% \ 2) ycentro% = Add(yv%, hv% \ 2) cmdPasa.Top = Sub(hv%, 82)

cmdEsc.Top = Sub(hv%, 82) cmdEsc.Left = 240 cmdOptions.Top = Sub(hv%, 82) toFile.Top = Sub(ycentro%, 24) SV(3).Width = Sub(av%, 5) SV(5).Width = Sub(av%, 5) SV(6).Width = Sub(av%, 5) Win_1.SetFont "terminal", 14, , , , , OEM_CHARSET ' tb.Visible = False tb.ScrollBars = basNoScroll tb.Text = nul$ ' rtb.Visible = False rtb.ScrollBars = basNoScroll rtb.Text = nul$ ' pb.Visible = False pb.Top = 0 ' tituloson Repeat GetEvent Until MENU(1) = 20 Or MENU(11) = WM_KEYDOWN titulosoff If baseimpresora? And Not baseprinter? Then Open saletexto$ for Append As # 1 If MENU(1) = 20 dispenser Else teclas EndIf If @lleno If opcion% = rad% Or opcion% = ldat% Or opcion% = lsam% Or (opcion% = rvs% And ingress?) For i% = asp% To gpr% menuactiva(i%) Next i% menuactiva(q2z%) menuactiva(sdat%) menuapaga(quo%) ingress? = False EndIf EndIf If baseimpresora? And Not baseprinter? Print # 1 Close # 1 EndIf Until opcion% = quit% Or terminar? EndProc ' >Procedure teclas Local fun|, tec|, buf? fun| = LoByte(HiCard(MENU(13))) If @lleno% Select fun| Case 60 ' *********************** opcion% = fdj% ' *** F2 astronomicas *** llamador(opcion%) ' *********************** astronomicas

Case 61 ' *********************** opcion% = orb% ' *** F3 Full Display *** llamador(opcion%) ' *********************** display Case 62 ' ******************* opcion% = all% ' *** F4 Sort All *** llamador(opcion%) ' ******************* uranianos Case 63 ' *************************** opcion% = nat% ' *** F5/F6 grafico natal *** granventana? = True ' ************************* grnatal Case 64 opcion% = nat% blanco? = True granventana? = True grnatal blanco? = False Case 65 ultimo% = plu% ' ************************** opcion% = nat% '*** F7/F8 sin centauros *** granventana? = True ' ************************ grnatal ultimo% = Pred(brinca%) Case 66 ultimo% = plu% opcion% = nat% blanco? = True granventana? = True grnatal blanco? = False ultimo% = Pred(brinca%) Default Inc dummy% EndSelect EndIf Select fun| Case 59 ' ****************** nuevo ' *** F1 radical *** opcion% = rad% ' ****************** llamador(opcion%) mapanatal Case 67 ' ************************* opcion% = pan% ' *** F9 global options *** llamador(opcion%) ' ************************* globalpanel Case 1 ' **************** opcion% = quit% ' *** Esc=Quit *** Default ' **************** Inc dummy% EndSelect If baseprinter? And Not (opcion% = nat% Or opcion% = quit%) Then cierrapapel EndProc ' >Procedure menuactiva(q%) Menu Pred(xmenu%(q%)), MF_ENABLED, titulos$(xmenu%(q%)) EndProc >Procedure menuapaga(q%) Menu Pred(xmenu%(q%)), MF_GRAYED, titulos$(xmenu%(q%)) EndProc

>Procedure menucheck(q%) Menu Pred(xmenu%(q%)), MF_CHECKED, titulos$(xmenu%(q%)) EndProc >Procedure menufree(q%) Menu Pred(xmenu%(q%)), MF_UNCHECKED, titulos$(xmenu%(q%)) EndProc >Procedure menuoff(q%) Menu Pred(xmenu%(q%)), MF_DISABLED, titulos$(xmenu%(q%)) EndProc ' >Procedure tituloson For i% = disco% To hlp% menuactiva(i%) Next i% EndProc >Procedure titulosoff For i% = disco% To hlp% menuoff(i%) Next i% EndProc ' >Procedure drawmenu Local i% Menu titulos$() menufree(todo%) menufree(como%) If baseprinter? menucheck(todo%) EndIf If baseimpresora? And Not baseprinter? menucheck(como%) EndIf menucheck(basedom%) EndProc ' >Function menustring$(q%) Return titulos$(xmenu%(q%)) EndFunc ' >Function withinrange(pl%) As Boolean Naked Select pl% Case aux% Return True Case lun% To nep%, nodo% To m_c% If baseswephem? Return (ano < SE_max) And (ano > SE_min) Else Return (ano < vsopmax) EndIf Case plu% If baseswephem? Return (ano < SE_max) And (ano > SE_min) Else Return dj < plutomax And dj > plutomin EndIf Case qui% To finpl% If baseswephem? If pl% <= nombrados% Return (ano < SE_asterlongmax) And (ano > SE_asterlongmin) Else

Return (ano < SE_astermax) And (ano > SE_astermin) EndIf Else If baselong? And pl% <= td1% Return (dj < D2103 And dj > Dlong) Else Return (dj < D2018 And dj > D1702) EndIf EndIf Default If baseswephem? Return (ano < SE_astermax) And (ano > SE_astermin) Else Return (dj < D2018 And dj > D1702) EndIf EndSelect EndFunc ' >Procedure astercheck(ByRef last%) If @withinrange(nombrados%) And (baseasteroides?) brinca% = Succ(nombrados%) If @withinrange(td1%) brinca% = Succ(td1%) If @withinrange(finpl%) Then brinca% = Succ(finpl%) EndIf Else brinca% = Succ(plu%) EndIf If basenamed? And baseasteroides? If @withinrange(nombrados%) brinca% = Succ(nombrados%) Else brinca% = Succ(plu%) EndIf EndIf If brinca% = Succ(plu%) And Not @withinrange(plu%) Then Dec brinca% ultimo% = Pred(brinca%) If last% > ultimo% Then last% = ultimo% EndProc ' >Procedure chooseobjects Local pl1%, pl2% dlgplanetas("the planets or points (maximum=48) to display", pl1%, pl2%, finpl %, 48) For pl1% = 1 To allplanets% If is_in_seq(pl1%) Then planets_in_wheel?(pl1%) = True Else planets_in_wheel ?(pl1%) = False Next pl1% If tx <> d0 Then llenaradix EndProc ' ' ###################################################################### ' IMPLEMENTATION MODULE MMenu ' ###################################################################### ' >Procedure mapanatal If tx = d0 If @fecha If @hora If @loclon

If @loclat dgnom$ = @evento() encabezado(" RADIX") nombre$ = titulo$ bandera% = 1 efemerides(sol%, ultimo%) vcangulos domificacion igualizar(0) llenastrings pantalla EndIf EndIf EndIf EndIf Else llenaradix pantalla EndIf EndProc ' >Procedure llenastrings Mat Cpy radix() = vc() Mat Cpy cusprx() = cuspide() Mat Cpy puntarx() = punta() Mat Cpy rxcd() = cd() Mat Cpy rxnut() = nut() For i% = 1 To zodiaco% rxcasa$(i%) = xcasa$(i%) rxfntcasa$(i%) = fontcasa$(i%) Next i% For i% = lun% To planeta% rxplan$(i%) = xplan$(i%) rxfntplan$(i%) = fontplan$(i%) If i% <= aries% Then For j% = hlon% To hdr% heliorx(i%, j%) = heliop(i%, j%) Next j% EndIf Next i% tx = dj vlsolx = cd(vlsol%) anomsolx = dla(anomsol%) svpx = cd(svp%) ayanx = cd(ayanamsa%) geos(latrx%) = geos(lat%) geos(lonrx%) = geos(lon%) salvar? = True EndProc ' >Procedure llenaradix dj = tx getfecha(dj, jd|, jm|, ja%) If opcion% = rad% encabezado(" RADIX") bandera% = 1 Else bandera% = 0 EndIf astercheck(n%)

geos(lat%) = geos(latrx%) geos(lon%) = geos(lonrx%) efemerides(sol%, ultimo%) vcangulos domificacion igualizar(0) llenastrings auxfecha For i% = 1 To zodiaco% rxcasa$(i%) = xcasa$(i%) rxfntcasa$(i%) = fontcasa$(i%) Next i% For i% = lun% To ultimo% xplan$(i%) = rxplan$(i%) fontplan$(i%) = rxfntplan$(i%) Next i% dgnom$ = "radix" EndProc ' >Procedure compare(pl%, f%, indice%, piso As Double) Local Double a, d, ax, by, dist, sinodicos?, next%, nada?, asp%, pl1% If pl% > 0 ftab(4, Left$(plaux$(pl%), 4) + " =") fsigno(0, vc(pl%, longitud%), 0, signo%, q$, q2$) corrfont ftab(11, q2$ + retr$(sinodico%(pl%))) nortesur(vc(pl%, declinacion%), 0, q$) ftab(21, q$ + " :") sinodicos? = False next% = lun% Else pl% = -pl% sinodicos? = True next% = Succ(pl%) EndIf nada? = True If Not (pl% = lun% And Abs(f%) = 2) For pl1% = next% To m_c% brinque(brinca%, pl1%) If Not aborta? If Not sinodicos? dist = @mdl(vc(pl%, longitud%) + cd(ayanamsa%) - radix(pl1%, longitud% ) - ayanx) Else dist = @mdl(vc(pl%, longitud%) - vc(pl1%, longitud%)) EndIf d = Sgn(n8 - dist) If d < d0 dist = ng - dist EndIf Mul d, Sgn(f%) For asp% = con% To indice% ax = orbes%(asp%, 1) / mc Select pl% Case lun% by = n2 Default by = d3 EndSelect If (dist > (ax - by)) And (dist < (ax + by))

If Not sinodicos? a = @acelere((ax - dist) / vc(pl%, velocidad%) * d) Else a = @acelere((ax - dist) / (vc(pl%, velocidad%) - vc(pl1%, velocid ad%)) * d) EndIf If (Abs(f%) = 2 And Abs(a) < n2) Or (Abs(f%) = 1 And Abs(a) < d3) q2$ = aspaux$(asp%) + " " + Left$(plaux$(pl1%), 4) If sinodicos? q2$ = q2$ + " pr" EndIf ftab(34, q2$) EndIf If Abs(f%) = 2 And Abs(a) < n2 impfecha(a * mesl + piso, 0, 0, 0, 50, q$) nada? = False tb.Text = tb.Text + Left$(nuevalinea$, 78) + crlf$ baja(xi%) Else If Abs(f%) = 1 And Abs(a) < d3 d = a If Abs(a) < d1 Mul a, n2 q$ = " months" Else q$ = " years" EndIf ftab(47, Str$(a, 5, 1) + q$) impfecha(d * jt + piso, 0, 0, 0, 62, q$) nada? = False tb.Text = tb.Text + Left$(nuevalinea$, 78) + crlf$ baja(xi%) EndIf Exit If True EndIf Next asp% EndIf Next pl1% EndIf If nada? And Not sinodicos? And Not aborta? tb.Text = tb.Text + Left$(nuevalinea$, 78) + crlf$ baja(xi%) EndIf EndProc ' >Procedure rutina(f%, piso As Double, ByRef arco As Double) ftab(xcentro%, basetitulo$ + dgdate$) tb.Text = tb.Text + Left$(nuevalinea$, 78) + crlf$ + crlf$ baja(yi%) bandera% = 9 efemerides(sol%, ultimo%) vcangulos contador% = 0 For pl% = lun% To m_c% brinque(brinca%, pl%) If Not aborta? compare(pl%, f%, asptop%, piso) compare(-pl%, f%, asptop%, piso) EndIf Exit If aborta? Next pl%

If Not aborta? arco = vc(sol%, longitud%) + cd(ayanamsa%) - radix(sol%, longitud%) - ayanx pantalla EndIf EndProc ' >Procedure progresado Local Double piso, prec, arco1, arco2, fecha$ lunaciones If Not aborta? asptop% = @limitaspect("PROGRESSIONS") If asptop% <> 7 And asptop% > 0 If @fecha encabezado(" PROGRESS") suspendwrite? = True tb.Visible = True tb.ScrollBars = basVertical piso = dj prec = @precesion(tx, dj) basetitulo$ = "SECONDARY DIRECT " dj = tx + (piso - tx) / @acelere(jt) rutina(1, piso, arco1) If Not aborta? suspendwrite? = False encabezado(titulo$) suspendwrite? = True basetitulo$ = "SECONDARY CONVERSE " dj = tx - (piso - tx) / @acelere(jt) rutina(-1, piso, arco2) EndIf If Not aborta? suspendwrite? = False encabezado(titulo$) suspendwrite? = True If basesideral? ftab(12, "SOLAR ARC: direct converse") Else ftab(12, "SOLAR ARC: direct converse precession") EndIf tb.Text = tb.Text + Left$(nuevalinea$, 78) + crlf$ + crlf$ baja(yi%) For pl% = lun% To qb1% brinque(brinca%, pl%) ftab(12, Left$(plaux$(pl%), 3) + " =") fsigno(0, radix(pl%, longitud%) + arco1, 23, signo%, q$, q2$) fsigno(0, radix(pl%, longitud%) + arco2, 39, signo%, q$, q2$) If Not basesideral? fsigno(0, radix(pl%, longitud%) + prec, 56, signo%, q$, q2$) EndIf tb.Text = tb.Text + Left$(nuevalinea$, 78) + crlf$ baja(xi%) Next pl% pantalla EndIf If Not aborta? suspendwrite? = False encabezado(titulo$) suspendwrite? = True basetitulo$ = "TERTIARY DIRECT " dj = tx + (piso - tx) / @acelere(mesl)

rutina(2, piso, arco1) If Not aborta? suspendwrite? = False encabezado(titulo$) suspendwrite? = True basetitulo$ = "TERTIARY CONVERSE " dj = tx - (piso - tx) / @acelere(mesl) rutina(-2, piso, arco1) EndIf Cls EndIf EndIf llenaradix EndIf EndIf EndProc ' >Procedure quotidian EndProc ' >Procedure conversos Local co% llenaradix If basebija? Or basesideral? Then q$ = "PRECESSION|CORRECTED||" Else q$ = "UNP RECESSED||" Alert 2 | 16, q$ + "TRANSITS| or|SYNASTRY", 4, " Direct | Converse 1 | Co nverse 2 | cancel ", co% If co% > 0 And co% < 4 If @fecha If @hora If @loclon If @loclat If co% = 2 Then dj = tx / z5 - dj If co% = 3 Then dj = dj / z5 - tx encabezado(" TRANSITS") dgnom$ = Trim$(titulo$) bandera% = 4 efemerides(sol%, ultimo%) vcangulos domificacion EndIf EndIf EndIf EndIf pantalla EndIf EndProc ' >Procedure relacion Print "Davison relationship chart. Enter data for the second chart:" If @fecha If @hora If @loclon If @loclat encabezado(" DAVISON") geos(lon%) = (geos(lonrx%) + geos(lon%)) * z5 geos(lat%) = (geos(latrx%) + geos(lat%)) * z5 dgnom$ = Trim$(titulo$) dj = (dj + tx) * z5 auxfecha

bandera% = 4 efemerides(sol%, ultimo%) pantalla EndIf EndIf EndIf EndIf EndProc ' >Procedure arcospr asptop% = @limitaspect("SOLAR|ARCS") If asptop% <> 7 And asptop% > 0 llenaradix historia(sol%, sol%, asptop%, "HISTORY OF THE SUN") historia(lun%, lun%, asptop%, "HISTORY OF THE MOON") historia(mer%, plu%, asptop%, "PLANETS") EndIf EndProc >Procedure historia(pl1%, pl2%, indice%, h$) Local Double ar, dist, dh, i%, m%, asp%, plx% vcangulos If Not aborta? encabezado(" SolARCS") m% = 0 For plx% = pl1% To pl2% Exit If plx% > qb1% And plx% < nodo% brinque(brinca%, plx%) For pl% = Succ(plx%) To m_c% Exit If pl% > ultimo% And pl% < nodo% brinque(brinca%, pl%) dist = @mdl(vc2(pl%) - vc2(plx%)) If dist > n8 ar = ng - dist Else ar = dist EndIf For asp% = con% To indice% dh = ar - orbes%(asp%, 1) / mc 'If Abs(dh) < mc Inc m% spi%(m%) = m% If (dist >= n8 And dh >= d0) Or (dist < n8 And dh < d0) spx%(Add(m%, 6000)) = CInt(Abs(@arcosolar(-Abs(dh))) * mz) spx%(m%) = CInt(@arcosolar(Abs(dh)) * mz) fila$(Add(m%, 6000)) = "c" + Left$(plaux$(plx%), 4) + " " + aspaux$( asp%) + " " + Left$(plaux$(pl%), 4) + " " fila$(m%) = " " + Left$(plaux$(pl%), 4) + " " + aspaux$(asp%) + " " + Left$(plaux$(plx%), 4) + " " Else spx%(m%) = CInt(@arcosolar(Abs(dh)) * mz) spx%(Add(m%, 6000)) = CInt(Abs(@arcosolar(-Abs(dh))) * mz) fila$(Add(m%, 6000)) = "c" + Left$(plaux$(pl%), 4) + " " + aspaux$(a sp%) + " " + Left$(plaux$(plx%), 4) + " " fila$(m%) = " " + Left$(plaux$(plx%), 4) + " " + aspaux$(asp%) + " " + Left$(plaux$(pl%), 4) + " " EndIf 'EndIf Next asp% Next pl% Next plx%

QSort spx%(), m%, spi%() suspendwrite? = True tb.Visible = True tb.Text = nul$ + crlf$ tb.ScrollBars = basVertical pb.Refresh pb.Min = d1 pb.Max = m% pb.Top = fh% pb.Visible = True baja(xi%) For i% = 1 To m% pb.Value = i% dh = spx%(i%) / mz ar = spx%(Add(spi%(i%), 6000)) / mz Inc contador% q$ = fila$(spi%(i%)) + Str$(dh, 6, 2) If InStr(q$, aspaux$(con%)) And pl2% = sol% Then @txt(brcyan%) ftab(2, q$) getfecha(dh * jt + tx, jd|, jm|, ja%) ftab(24, Left$(mes$(jm|), 3) + spc$ + Str$(jd|, 2) + Str$(ja%)) ftab(42, fila$(Add(spi%(i%), 6000)) + Str$(ar, 6, 2)) getfecha(ar * jt + tx, jd|, jm|, ja%) ftab(64, Left$(mes$(jm|), 3) + spc$ + Str$(jd|, 2) + Str$(ja%)) @txt(white%) tb.Text = tb.Text + Left$(nuevalinea$, 78) + crlf$ baja(xi%) Next i% pantalla suspendwrite? = False EndIf EndProc ' >Procedure llenahelio Local pl%, vec%, lon#, lat#, rvc# Dim r(xyz%) As Double auxfecha efemerides(sol%, sol%) For pl% = mer% To ultimo% lon# = vc(pl%, longitud%) lat# = vc(pl%, latitud%) rvc# = vc(pl%, rvector%) polar2rect(lon#, lat#, rvc#, r()) For vec% = xi% To zi% Sub r(vec%), helior(sol%, vec%) Next vec% rect2polar(r(), lon#, lat#, rvc#) heliop(pl%, hlon%) = lon# heliop(pl%, hlat%) = lat# heliop(pl%, hdis%) = rvc# Next pl% EndProc ' >Function nuevarvs(j As Double, r As Double, sideral?, ingreso%) As Double Naked dj = j bandera% = 8 efemerides(sol%, sol%) If sideral? If ingreso% r = @mdl(ng - cd(svp%) + r)

Else r = @mdl(svpx - cd(svp%) + r) EndIf EndIf j = r - vc(sol%, longitud%) j = (j - ng * (Abs(j) > n8)) / vc(sol%, velocidad%) Return (dj + j) EndFunc >Procedure revolsolar Local Double radical, epoca, ts2, pp, qq, ff, dh, sa, ar, raas, djx Local modo%, ingreso%, sinetico%, i%, jsa%, metodo% Local Const rsideral% = 2, rtropical% = 1, rdirecta% = 1, rconversa% = -1 llenaradix rvano(modo%, sinetico%, ingreso%) buffer? = basebija? If sinetico% = rsideral% Then basebija? = True Else basebija? = False jsa% = ja% If Not aborta? If @loclon If @loclat If ingreso% nuevo radical = n9 * (Pred(ingreso%)) modo% = rdirecta% getdj(1, 1, jsa%) Else radical = radix(sol%, longitud%) If modo% = rconversa% dj = @nuevarvs(tx - j5 * (Sub(jsa%, Trunc(@f2000(tx)))), radical, si netico% = rsideral, ingreso%) Else dj = @nuevarvs((Sub(jsa%, Trunc(@f2000(tx)))) * j5 + tx, radical, si netico% = rsideral, ingreso%) EndIf EndIf Do pp = @nuevarvs(dj, radical, sinetico% = rsideral%, ingreso%) ff = Abs(pp - dj) dj = pp Loop Until ff < p8 bandera% = 2 encabezado(" SolRETURN") dgnom$ = Trim$(titulo$) efemerides(sol%, ultimo%) pantalla Mat Cpy rx2() = vc() If Not ingress? q2$ = "PSSR|SOLAR QUOTIDIAN" Alert 0 | 16, nul$, 3, q2$ + "|CANCEL", metodo% If metodo% = 1 Or metodo% = 2 djx = dj epoca = dj - CFloat(modo%) * tu / n4 ' starting date ts2 = ts ' starting RAMC raas = vc(sol%, ascensionrecta%) ' starting RAAS ' ********************************************** ' calculamos ARMC de la siguiente R.S. Sideral ' ********************************************** Add dj, j5 * modo% bandera% = 8 efemerides(sol%, sol%)

pp = @mdl(-(svpx - cd(svp%)) * (sinetico% = rsideral%) + radical) vc(sol%, longitud%) dj = pp / vc(sol%, velocidad%) + dj tiemposideral(dj) ' ************************** ' "segundo de aniversario" ' ************************** If metodo% = 2 ff = d1 'SOLAR QUOTIDIAN Else If modo% = rconversa% ff = ng + ts2 - ts Else ff = ng + ts - ts2 EndIf If ff < ng Then Add ff, ng Div ff, ng EndIf ' ************************************************** ' comenzamos a partir de las 0h del dia de la R.S. ' ************************************************** radical = ts2 baja(xi%) pausa? = False suspendwrite? = True cmdStop.Visible = True tb.Visible = True tb.Text = nul$ tb.ScrollBars = basVertical pb.Refresh pb.Min = 0 pb.Max = 366 pb.Visible = True For i% = 0 To 365 Exit If pausa? pb.Value = i% ingreso% = 46 dj = epoca + CFloat(Mul(modo% * i%)) baselow? = (dj > lowmin And dj < lowmax) efemerides(sol%, nombrados%) If modo% = rconversa% impfecha(tx * d2 - dj, 0, 0, 0, 0, q$) q$ = Left$(q$, 7) + Right$(q$, 2) + " " + Left$(dia$(@semana(tx * d2 - dj + z5)), 1) Else impfecha(dj, 0, 0, 0, 0, q$) q$ = Left$(q$, 7) + Right$(q$, 2) + " " + Left$(dia$(@semana(dj + z5)), 1) EndIf ftab(2, q$) If modo% = rconversa% qq = raas - vc(sol%, ascensionrecta%) Else qq = vc(sol%, ascensionrecta%) - raas EndIf If i% Then qq = mdl(qq) ' ***************** ' Luna progresada ' ***************** dj = djx + qq / acc / ng * ff

efemerides(0, 0) expansion(w2, longitud%, r(), v()) ' pp = @mdl(radical + CFloat(modo%) * ff * qq) 'fminutos(k4%, pp / n5, 1, 13, q$) fsigno(0, r(1), 0, signo%, q$, q2$) corrfont ftab(15, q2$) fsigno(0, @reduccion(sol%, pp, 1), 0, signo%, q$, q2$) corrfont ftab(23, q2$) fsigno(0, @ascndt(pp, tanlat), 0, signo%, q$, q2$) corrfont ftab(30, q2$) 'If basebija? Or basesideral? 'sa = Deg(Atn(Sin(Rad(pp)) * (cd(esin%) / cd(ecos%)))) 'prigurosa(tx, dj, pp, sa) 'EndIf freal(pp, 3, 2, 37, q$) For pl% = lun% To ultimo% Exit If pl% = Succ(nombrados%) Or pausa? ' ********************************* ' planetas de la revolucion solar ' ********************************* ar = rx2(pl%, ascensionrecta%) semiarco(ar, rx2(pl%, declinacion%), dh, qq, sa, dh, prueba?) rvparanes(ar, pp, ff, " mS", modo%, ingreso%) rvparanes(@mdl(ar + n8), pp, ff, " iS", modo%, ingreso%) rvparanes(@mdl(ar - sa), pp, ff, " aS", modo%, ingreso%) rvparanes(@mdl(ar + sa), pp, ff, " dS", modo%, ingreso%) ' ******************** ' planetas radicales ' ******************** If pl% <> sol% ar = radix(pl%, ascensionrecta%) semiarco(ar, radix(pl%, declinacion%), dh, qq, sa, dh, prueba? ) rvparanes(ar, pp, ff, " mR", modo%, ingreso%) rvparanes(@mdl(ar + n8), pp, ff, " iR", modo%, ingreso%) rvparanes(@mdl(ar - sa), pp, ff, " aR", modo%, ingreso%) rvparanes(@mdl(ar + sa), pp, ff, " dR", modo%, ingreso%) EndIf ' ********************** ' planetas en transito ' ********************** If pl% > lun% ar = vc(pl%, ascensionrecta%) sa = vc(pl%, declinacion%) 'If basebija? Or basesideral? Then prigurosa(tx, dj, ar, sa) semiarco(ar, sa, dh, qq, sa, dh, prueba?) rvparanes(ar, pp, ff, " mT", modo%, ingreso%) rvparanes(@mdl(ar + n8), pp, ff, " iT", modo%, ingreso%) rvparanes(@mdl(ar - sa), pp, ff, " aT", modo%, ingreso%) rvparanes(@mdl(ar + sa), pp, ff, " dT", modo%, ingreso%) EndIf Next pl% tb.Text = tb.Text + Left$(nuevalinea$, 78) + crlf$ baja(xi%) Next i% baselow? = False

cmdStop.Visible = False pb.Visible = False Color black%, white% Print AT(3, 1); "Progr. date Moon M.C. Asc RAMC hits: a =Asc, d=desc, i=IC, m=MC" Color white%, atras% pantalla llenaradix EndIf Else llenastrings EndIf EndIf EndIf EndIf basebija? = buffer? EndProc ' >Procedure rvparanes(ar As Double, p As Double, f As Double, s$, modo%, ByRef in greso%) If modo% > 0 prueba? = (ar < (p + f) And ar > p) Else '==>conversa prueba? = (ar > (p - f) And ar < p) EndIf If prueba? If ingreso% > 67 tb.Text = tb.Text + Left$(nuevalinea$, 78) + crlf$ baja(xi%) Inc contador% If opcion% = rvs% Then ingreso% = 46 Else ingreso% = 49 EndIf ftab(ingreso%, Left$(plaux$(pl%), 3) + "=" + Trim$(Str$(ar, 5, 1)) + s$) Add ingreso%, 14 EndIf EndProc ' >Procedure primarias Local Double dh, sa, sad, h, ar, dc Local debajo?, asptop%, m%, i%, plx%, mundo?, clave%, top% ' primero calcula y guarda el speculum ' una llamada determina si se hace con o sin latitud Alert 0, " PLANETS WITH OR WITHOUT LATITUDE?", 2, " in zodiaco | in mundo | c ancel ", n% If n% = 2 Or n% = 1 If n% = 2 Then mundo? = True Else mundo? = False q$ = "||KEY|TO|CONVERT|ARC|INTO|TIME?" Alert 0 | 16, q$, 1, "1 degree = 1 year|NAIBOD ARC|BIRTH RATE IN R.A.|SOLAR ARC IN R.A.|cancel", clave% If clave% > 0 And clave% <> 5 encabezado(" PRIMARIES") If ultimo% > plu% Then top% = nombrados% Else top% = plu% For pl% = lun% To top% If mundo? ar = vc(pl%, ascensionrecta%) dc = vc(pl%, declinacion%) Else ar = vc(pl%, longitud%) dc = d0 EndIf

semiarco(ar, dc, dh, sa, sad, h, debajo?) sp(pl%, 6) = h ' hour angle 0-360 (ts-ar) If h > n8 Then h = ng - h ' reduce to 0 -180 If h > sad Then h = n8 - h ' if below us e I.C. sp(pl%, 1) = h ' meridian di stance 0-180 sp(pl%, 2) = Abs(sa - h) ' arc to the horizon sp(pl%, 3) = h * n9 / sa ' DMO sp(pl%, 4) = sad ' diurnal sem iarc If sa = n8 Then sp(pl%, 2) = ng ' circumpolar h = sp(pl%, 6) If (Not debajo?) And h > n8 Then dh = sp(pl%, 3) + n8 + n9 ' 270-360 If debajo? And h > n8 Then dh = n9 - sp(pl%, 3) ' 0- 90 If (Not debajo?) And h < n8 Then dh = n8 + n9 - sp(pl%, 3) ' 180-270 If debajo? And h < n8 Then dh = sp(pl%, 3) + n9 ' 90-180 sp(pl%, 5) = @mdl(dh) ' MundoPla Next pl% ' ahora calcule y guarde las direcciones ' primero guarda las conjunciones con las cuspides m% = 0 For pl% = lun% To top% sa = sp(pl%, 4) If sa <> d0 And sa <> n8 dh = -sa q$ = " CON " For i% = k2 DownTo 1 If i% = 6 Then sa = (n8 - sa) q2$ = spc$ + spc$ + Str$(i%, 2) dh = dh + sa / d3 If True 'i% = 1 Or i% = 4 Or i% = 7 Or i% = 10 Inc m% h = @angdist(@mdl(dh), sp(pl%, 6)) spx%(m%) = CInt(h * mz) spx%(Add(m%, 6000)) = spx%(m%) If @mdl(dh - sp(pl%, 6)) > n8 fila$(m%) = spc$ + Left$(plaux$(pl%), 4) + q$ + q2$ + spc$ fila$(Add(m%, 6000)) = "c" + q2$ + q$ + Left$(plaux$(pl%), 4) + spc$ Else fila$(m%) = spc$ + q2$ + q$ + Left$(plaux$(pl%), 4) + spc$ fila$(Add(m%, 6000)) = "c" + Left$(plaux$(pl%), 4) + q$ + q2$ + spc$ EndIf spi%(m%) = m% EndIf Next i% EndIf Next pl% ' luego las paralelas raptas (pendiente) ' despues los aspectos mutuos entre planetas asptop% = con% '@limitaspect("PRIMARIES") For plx% = lun% To top% sa = sp(plx%, 4) If sa <> d0 And sa <> n8 For pl% = Succ(plx%) To top%

For i% = con% To asptop% Inc m% h = orbes%(i%, 1) / mc spi%(m%) = m% If (@mdl(sp(plx%, 6) - sp(pl%, 6)) > n8) spx%(m%) = CInt(@arc2time(pl%, plx%, h) * mz) spx%(Add(m%, 6000)) = CInt(@arc2time(plx%, pl%, -h) * mz) fila$(Add(m%, 6000)) = "c" + Left$(plaux$(plx%), 4) + " " + aspa ux$(i%) + " " + Left$(plaux$(pl%), 4) + " " fila$(m%) = " " + Left$(plaux$(pl%), 4) + " " + aspaux$(i%) + " " + Left$(plaux$(plx%), 4) + " " Else spx%(m%) = CInt(@arc2time(plx%, pl%, h) * mz) spx%(Add(m%, 6000)) = CInt(@arc2time(pl%, plx%, -h) * mz) fila$(Add(m%, 6000)) = "c" + Left$(plaux$(pl%), 4) + " " + aspau x$(i%) + " " + Left$(plaux$(plx%), 4) + " " fila$(m%) = " " + Left$(plaux$(plx%), 4) + " " + aspaux$(i%) + " " + Left$(plaux$(pl%), 4) + " " EndIf Next i% Next pl% EndIf Next plx% ' por ultimo se ordena y se muestra en pantalla QSort spx%(), m%, spi%() suspendwrite? = True tb.Visible = True tb.Text = nul$ + crlf$ tb.ScrollBars = basVertical pb.Refresh pb.Min = 1 pb.Max = m% pb.Top = fh% pb.Visible = True baja(xi%) For i% = 1 To m% pb.Value = i% dh = spx%(i%) / mz If dh < mc ar = spx%(Add(spi%(i%), 6000)) / mz Inc contador% q$ = fila$(spi%(i%)) + Str$(dh, 6, 2) ftab(2, q$) If clave% = 2 dh = dh / naibod ar = ar / naibod Else If clave% = 3 dh = dh / vc(sol%, veloar%) ar = ar / vc(sol%, veloar%) Else If clave% = 4 dh = @arcosolarAR(dh) ar = Abs(@arcosolarAR(-ar)) EndIf getfecha(dh * jt + tx, jd|, jm|, ja%) ftab(25, Left$(mes$(jm|), 3) + spc$ + Str$(jd|, 2) + Str$(ja%)) ftab(41, fila$(Add(spi%(i%), 6000)) + Str$(ar, 6, 2)) getfecha(ar * jt + tx, jd|, jm|, ja%) ftab(64, Left$(mes$(jm|), 3) + spc$ + Str$(jd|, 2) + Str$(ja%)) tb.Text = tb.Text + Left$(nuevalinea$, 79) + crlf$ baja(xi%)

EndIf Next i% pantalla EndIf EndIf EndProc >Function arc2time(s%, p%, dis As Double) As Double Local Double dmS, dmP, dhS, dhP, dm0, dm, arco, sad, mun, opuestos? sad = sp(p%, 4) ' semiarco diurno del promisor mun = sp(s%, 5) ' posicion IN MUNDO del significador dmS = sp(s%, 6) ' distancia meridiana del significador 0-360 dmP = @mdl(sp(p%, 6) + dis) ' distancia meridiana del promisor 0-360 dhS = sp(s%, 2) ' arco al horizonte del significador opuestos? = (dmS <= n8 And dmP > n8) Or (dmS > n8 And dmP <= n8) If dmP > n8 Then dm0 = ng - dmP Else dm0 = dmP If dm0 > sad And mun >= n8 ' P debajo, S encima dhP = Abs(- sad + dm0) dm = dhP * (n8 - sp(s%, 4)) / (n8 - sad) If opuestos? Then dm = dm + sp(s%, 4) + sp(s%, 1) Else dm = dm + dhS Else If dm0 > sad And mun < n8 ' P debajo, S debajo dm0 = n8 - dm0 dm = dm0 * (n8 - sp(s%, 4)) / (n8 - sad ) If opuestos? Then dm = dm + sp(s%, 1) Else dm = Abs(sp(s%, 1) - dm) Else If dm0 <= sad And mun >= n8 ' P encima, S encima dm = dm0 * sp(s%, 4) / sad If opuestos? Then dm = dm + sp(s%, 1) Else dm = Abs(sp(s%, 1) - dm) Else If dm0 <= sad And mun < n8 ' P encima, S debajo dhP = Abs(sad - dm0) dm = dhP * sp(s%, 4) / sad If opuestos? Then dm = dm + (n8 - sp(s%, 4)) + sp(s%, 1) Else dm = dm + dhS EndIf Return dm EndFunc ' >Procedure speculum Local g3#, dh#, sa#, sad#, h#, debajo?, ar#, dc# tb.Visible = True tb.Text = nul$ tb.ScrollBars = basVertical deg$ = deg3$ ' encabezado(" SPECULUM") suspendwrite? = True astercheck(n%) ftab(15, "Meridian") ftab(28, " OMD") ftab(40, "Horizon") ftab(58, "SemiArcs") tb.Text = tb.Text + Left$(nuevalinea$, 78) + crlf$ + crlf$ baja(yi%) For pl% = lun% To m_c% brinque(ultimo%, pl%) ftab(4, Left$(plaux$(pl%), 6) + " =") ar# = vc(pl%, ascensionrecta%) dc# = vc(pl%, declinacion%) If basebija? Or basesideral? prigurosa(tx, dj, ar#, dc#) EndIf semiarco(ar#, dc#, dh#, sa#, sad#, h#, debajo?) If h# > n8

h# = ng - h# sp(pl%, 4) = -d1 ' planet ascends Else sp(pl%, 4) = d1 ' planet descends EndIf If h# > sad# Then h# = n8 - h# ' planet below horizon, H from IC sp(pl%, 1) = h# sp(pl%, 2) = dh# sp(pl%, 3) = h# * n9 / sa# If sa# = n8 sp(pl%, 4) = d0 sp(pl%, 5) = d0 Else Mul sp(pl%, 4), Deg(Asin(h# / sa# * tanlat * Tan(Rad(dc#)))) sp(pl%, 5) = Deg(Atn(h# / sa# * tanlat)) EndIf freal(h#, 3, 3, 15, q$) If sa# = n8 sp(pl%, 2) = ng ftab(28, "--- circunpolar ---") Else freal(sp(pl%, 3), 3, 3, 27, q$) freal(sp(pl%, 2), 3, 3, 40, q$) EndIf freal(sa#, 3, 3, 52, q$) freal(n8 - sa#, 3, 3, 0, q$) ftab(61, "(" + q$ + ")") If debajo? ftab(72, "N") Else ftab(72, "D") EndIf tb.Text = tb.Text + Left$(nuevalinea$, 78) + crlf$ baja(xi%) Next pl% For pl% = decima% To novena% ftab(6, Left$(casa$(pl%), 5) + " =") semiarco(cuspide(pl%), d0, dh#, sa#, sad#, h#, debajo?) If h# > n8 Then h# = ng - h# If h# > sad# Then h# = n8 - h# ' below horizon, H from IC freal(h#, 3, 3, 15, q$) If sa# = n8 ftab(28, "--- circunpolar ---") Else freal(h# * n9 / sa#, 3, 3, 27, q$) freal(dh#, 3, 3, 40, q$) EndIf freal(sa#, 3, 3, 52, q$) freal(n8 - sa#, 3, 3, 0, q$) ftab(61, "(" + q$ + ")") If debajo? ftab(72, "N") Else ftab(72, "D") EndIf tb.Text = tb.Text + Left$(nuevalinea$, 78) + crlf$ baja(xi%) Next pl% pantalla '

If Not aborta? suspendwrite? = False tb.Text = nul$ encabezado(titulo$) suspendwrite? = True ftab(20, "RightAsc") ftab(34, "AscDiff") ftab(49, "OA/OD") ftab(64, " Pole") tb.Text = tb.Text + Left$(nuevalinea$, 78) + crlf$ + crlf$ baja(yi%) For pl% = lun% To m_c% brinque(ultimo%, pl%) ftab(4, plaux$(pl%) + " =") ar# = vc(pl%, ascensionrecta%) dc# = vc(pl%, declinacion%) If basebija? Or basesideral? prigurosa(tx, dj, ar#, dc#) EndIf fsegundos(kg%, 1, ar#, 19, q$) If sp(pl%, 4) <> d0 fsegundos(kg%, 1, sp(pl%, 4), 32, q$) ar# = @mdl(sp(pl%, 4) + ar#) fsegundos(kg%, 1, ar#, 47, q$) EndIf If sp(pl%, 5) <> d0 fsegundos(kg%, 1, sp(pl%, 5), 62, q$) EndIf tb.Text = tb.Text + Left$(nuevalinea$, 78) + crlf$ baja(xi%) Next pl% pantalla EndIf ' If Not aborta? suspendwrite? = False tb.Text = nul$ encabezado(titulo$) suspendwrite? = True ftab(13, "Azimuth") ftab(25, "Altitude") ftab(40, "Mundo" + Left$(Trim$(hdom$(sistema%)), 4)) ftab(53, "MundoLong") ftab(67, "Zodiac") tb.Text = tb.Text + Left$(nuevalinea$, 78) + crlf$ + crlf$ baja(yi%) For pl% = lun% To m_c% brinque(ultimo%, pl%) ftab(2, Left$(plaux$(pl%), 5) + " =") ar# = vc(pl%, ascensionrecta%) dc# = vc(pl%, declinacion%) If basebija? Or basesideral? prigurosa(tx, dj, ar#, dc#) EndIf acimutaltura(ar#, dc#, sa#, h#) fsegundos(kg%, 1, sa#, 11, q$) fsegundos(kg%, 1, h#, 24, q$) obliquelon(pl%, dh#, h#) 'freal(dh# / n3 + d1, 3, 4, 40, q$) fsigno(0, dh# - cd(ayanamsa%), 40, signo%, q$, q2$)

fsigno(0, h#, 53, signo%, q$, q2$) fsigno(0, vc(pl%, longitud%), 66, signo%, q$, q2$) tb.Text = tb.Text + Left$(nuevalinea$, 77) + crlf$ baja(xi%) Next pl% For pl% = decima% To novena% ftab(3, Left$(casa$(pl%), 5) + " =") ar# = @reduccion(sol%, cuspide(pl%), -1) dc# = @edeclinacion(cuspide(pl%), etrue%) acimutaltura(ar#, dc#, sa#, h#) fsegundos(kg%, 1, sa#, 11, q$) fsegundos(kg%, 1, h#, 24, q$) tb.Text = tb.Text + Left$(nuevalinea$, 78) + crlf$ baja(xi%) Next pl% pantalla EndIf EndProc ' >Procedure aspectario Local Double ax, bx, ay, by, dist, pl1%, pl2%, asp%, mitad%, ar$, raya$, hit? Local ListItem LVIt suspendwrite? = True SV(1).Clear SV(1).Visible = True deg$ = deg3$ encabezado(" ASPECTAR") ar$ = "F true dist Aspect" ftab(11, ar$) ftab(50, ar$) baja(yi%) contador% = 0 pb.Refresh pb.Min = 0 pb.Top = fh% pb.Max = Combin(Add(brinca%, 3), 2) pb.Visible = True For pl1% = lun% To m_c% brinque(brinca%, pl1%) For pl2% = Succ(pl1%) To m_c% brinque(brinca%, pl2%) If pl2% <> pl1% Inc contador% pb.Value = contador% mitad% = Mul(39, -Even(contador%)) ftab(Add(1, mitad%), bar$ + Left$(plaux$(pl1%), 3) + "/" + Left$(plaux$( pl2%), 3)) raya$ = plaux$(pl1%) + ";" + plaux$(pl2%) ' ########################### ' ###### fase ####### ' ########################### dist = @mdl(vc(pl1%, longitud%) - vc(pl2%, longitud%)) If pl2% < aries% ax = osc(pl1%, ax%) bx = osc(pl2%, ax%) If bx < ax dist = ng - dist EndIf EndIf q$ = Str$(Succ(Trunc(dist / c5)), 1)

ftab(Add(11, mitad%), q$) raya$ = raya$ + ";" + q$ ' ########################### ' ##### distancia ##### ' ########################### If dist > n8 Then dist = ng - dist freal(@truedist(pl1%, pl2%), 3, 2, Add(13, mitad%), q$) raya$ = raya$ + ";" + q$ freal(dist, 3, 1, Add(20, mitad%), q$) raya$ = raya$ + ";" + q$ ' ########################## ' ###### aspecto ####### ' ########################## hit? = False For asp% = con% To nov% ax = orbes%(asp%, 1) / mc by = orbes%(asp%, 2) / mc If dist > (ax - by) And dist < (ax + by) raya$ = raya$ + ";" + aspaux$(asp%) fminutos(kg%, Abs(dist - ax), 0, 0, q$) raya$ = raya$ + ";" + Trim$(q$) q$ = spc$ + Trim$(q$) ftab(Add(27, mitad%), aspaux$(asp%) + q$) hit? = True Exit If hit? EndIf Next asp% If Not hit? Then raya$ = raya$ + ";" + nul$ + ";" + nul$ ' ########################## ' ###### paralelo ###### ' ########################## ax = Abs(Abs(vc(pl1%, declinacion%)) - Abs(vc(pl2%, declinacion%))) If ax < d1 q$ = Str$(ax * n6, 2, 0) + Chr$(39) raya$ = raya$ + ";" + q$ ftab(Add(36, mitad%), "*" + q$) Else raya$ = raya$ + ";" + nul$ EndIf ' If mitad% Then baja(xi%) Set LVIt = SV(1).Add LVIt.AllText = raya$ EndIf Next pl2% Exit If aborta? Next pl1% pb.Visible = False pantalla SV(1).Visible = False EndProc ' ' ###################################################################### ' IMPLEMENTATION MODULE MCasas ' ###################################################################### ' >Function modulaparanes(f As Double) As Double Naked If f NEAR ng Return n4 Else

f = (f - ts) / n5 If Abs(f) > n2 If f < d0 Add f, n4 Else Sub f, n4 EndIf EndIf Return f EndIf EndFunc >Procedure paranes Local dh#, sa#, sad#, h#, ar#, debajo?, i%, j%, top%, ix%, mx%, pl2%, s% encabezado(" PARANS") baja(xi%) top% = ultimo% For pl% = lun% To top% If Not (Abs(dj - tx) NEAR d0) For pl2% = lun% To ultimo% top% = Add(pl2%, ultimo%) ar# = radix(pl2%, ascensionrecta%) sa# = radix(pl2%, declinacion%) If basebija? Or basesideral? prigurosa(dj, tx, ar#, sa#) EndIf fagan(top%, 1) = ar# fagan(top%, 2) = sa# Next pl2% EndIf fagan(pl%, 1) = vc(pl%, ascensionrecta%) fagan(pl%, 2) = vc(pl%, declinacion%) Next pl% For pl% = lun% To top% ar# = fagan(pl%, 1) semiarco(ar#, fagan(pl%, 2), dh#, sa#, sad#, h#, debajo?) i% = Sub(Mul(pl%, 4), 3) spx%(i%) = CInt(ar# * mz) spi%(i%) = i% i% = Sub(Mul(pl%, 4), 2) spx%(i%) = CInt(@mdl(ar# + n8) * mz) spi%(i%) = i% i% = Pred(Mul(pl%, 4)) spi%(i%) = i% If sa# = n8 spx%(i%) = CInt(ng * mz) Else spx%(i%) = CInt(@mdl(ar# - sad#) * mz) EndIf i% = Mul(pl%, 4) spi%(i%) = i% If sa# = n8 spx%(i%) = CInt(ng * mz) Else spx%(i%) = CInt(@mdl(ar# + sad#) * mz) EndIf Next pl% QSort spx%(), Mul(top%, 4), spi%() top% = Div(Mul(top%, 4), 4) mx% = Mul(top%, 4) i% = 1

contador% = 0 suspendwrite? = True rtb.ScrollBars = basVertical rtb.Refresh rtb.SelStart = 0 rtb.SelText = #10#10 Repeat If i% > mx% Sub i%, Pred(mx%) rtb.SelText = #10 baja(xi%) EndIf Inc contador% sad# = @modulaparanes(spx%(i%) / mz) If i% = 1 dh# = @modulaparanes(spx%(mx%) / mz) ar# = @modulaparanes(spx%(Succ(i%)) / mz) Else If i% = mx% dh# = @modulaparanes(spx%(Pred(i%)) / mz) ar# = @modulaparanes(spx%(1) / mz) Else dh# = @modulaparanes(spx%(Pred(i%)) / mz) ar# = @modulaparanes(spx%(Succ(i%)) / mz) EndIf fminutos(k4%, sad#, 1, 0, q2$) j% = Mod(spi%(i%), 4) q$ = Mid$(" d m i a", Succ(Mul(j%, 2)), 2) pl% = Sub(spi%(i%) \ 4, j% > 0) If pl% > ultimo% Sub pl%, ultimo% q$ = q$ + "r" Else q$ = q$ + spc$ EndIf fila$(i%) = Left$(plaux$(pl%), 3) + q$ ix% = Add(Mul(18, i% \ top%), Mul(18, Mod(i%, top%) = 0)) q$ = q2$ + " " + fila$(i%) h# = 0.02 rtb.SelColor = white% If ((sad# - dh#) < h# And Abs(sad# - dh#) < h#) Or ((ar# - sad#) < h# And Ab s(ar# - sad#) < h#) rtb.SelColor = brcyan% EndIf rtb.SelText = spc$ + q$ + spc$ ftab(Add(3, ix%), q$) Add i%, top% Until i% = Add(mx%, top%) rtb.SelText = #10 rtb.Visible = True pantalla EndProc ' >Procedure llenapuntas Local i% punta(1) = d0 punta(13) = ng For i% = 2 To k2% punta(i%) = @mdl(cuspide(@disminuye(Add(i%, 3), k2%)) - cuspide(primera%)) Next i% EndProc

' >Procedure igualizar(l%) Local orig%, s$, s2$, c$, cusp_m% For cusp% = decima% To novena% orig% = @disminuye(Add(cusp%, 9), k2%) c$ = nul$ fsigno(l%, cuspide(cusp%) + cd(ayanamsa%) * (basedom% = zod%), 0, signo%, s$ , s2$) farcseconds(cuspide(cusp%) + cd(ayanamsa%) * (basedom% = zod%), s$) If basedom% = pla% And polar? If oa%(cusp%) = 0 Or oa%(cusp%) > 1 c$ = "*" EndIf EndIf xcasa$(orig%) = s$ + c$ fontcasa$(orig%) = s2$ + c$ cusp_m% = Add(cusp%, middle%) fsigno(l%, cuspide(cusp_m%) + cd(ayanamsa%) * (basedom% = zod%), 0, signo%, s$, s2$) farcseconds(cuspide(cusp_m%) + cd(ayanamsa%) * (basedom% = zod%), s$) If basedom% = pla% And polar? If oa%(cusp_m%) = 0 Or oa%(cusp_m%) > 1 c$ = "*" EndIf EndIf xcasa$(Add(orig%, middle%)) = s$ + c$ fontcasa$(Add(orig%, middle%)) = s2$ + c$ Next cusp% EndProc ' >Procedure salecasas Local s$, s2$, u$, cusp%, orig% igualizar(1) encabezado(" HOUSES") fsegundos(k4%, -1, ts / n5, 0, q$) fsegundos(kg%, 1, geos(lon%), 0, s$) If geos(lon%) >= d0 Then s$ = "+" + Trim$(s$) fsegundos(kg%, 1, geos(lat%), 0, s2$) If geos(lat%) >= d0 Then s2$ = "+" + Trim$(s2$) Color black%, cyan% ftab(13, "ARMC=" + Trim$(q$) + " Lon=" + Trim$(s$) + " Lat=" + Trim$(s2$)) Color white%, atras% baja(yi%) ftab(32, Upper$(hdom$(sistema%))) baja(yi%) For cusp% = 1 To k2% orig% = @disminuye(Add(cusp%, 3), k2%) ftab(13, casa$(orig%) + " =" + xcasa$(cusp%)) ftab(39, casa$(Add(orig%, middle%)) + " =" + xcasa$(Add(cusp%, middle%))) baja(xi%) Next cusp% baja(yi%) For cusp% = ascendente% To fortuna% farcseconds(cuspide(cusp%) + cd(ayanamsa%) * (basedom% = zod%), s$) ftab(24, casa$(cusp%) + " = " + s$) baja(xi%) Next cusp% farcseconds(@mdl(d2 * cuspide(ascendente%) - cuspide(fortuna%)), s$) ftab(24, "Fortuna N." + " = " + s$) baja(xi%)

farcseconds(@ascndt(ts, d0), s$) ftab(24, "East Point" + " = " + s$) baja(xi%) pantalla EndProc ' >Procedure vcangulos Local Double gl, bl, rv, vel tanlat = geos(usin%) / geos(ucos%) + p13 polar? = Abs(tanlat) >= (cd(ecos%) / cd(esin%)) ambiguo? = False If polar? If basedom% = goh% ambiguo? = True Else ambiguo? = @ambipolo(tanlat, Rad(ts)) EndIf Else ambiguo? = False EndIf cuspide(mediocielo%) = @reduccion(sol%, ts, 1) cuspide(ascendente%) = @ascndt(ts, tanlat) cuspide(vertex%) = @ascndt(ts - n8, d1 / tanlat) cuspide(fortuna%) = @mdl(cuspide(ascendente%) + vc(lun%, longitud%) - vc(sol%, longitud%)) vc(aries%, longitud%) = d0 vc(asc%, longitud%) = cuspide(ascendente%) vc(m_c%, longitud%) = cuspide(mediocielo%) vc(asc%, velocidad%) = @velascend(ascendente%) vc(m_c%, velocidad%) = naibod For pl% = aries% To m_c% fsigno(0, vc(pl%, longitud%), 0, signo%, q$, q2$) xplan$(pl%) = q$ + " " + retr$(sinodico%(pl%)) fontplan$(pl%) = q2$ + retr$(sinodico%(pl%)) indicepl%(pl%, 1) = signo% If Not (pl% = nodo% Or pl% = BML%) vc(pl%, latitud%) = d0 vc(pl%, declinacion%) = @edeclinacion(vc(pl%, longitud%), etrue%) vc(pl%, ascensionrecta%) = @reduccion(sol%, vc(pl%, longitud%), -1) EndIf Next pl% For pl% = lun% To m_c% vc2(pl%) = vc(pl%, longitud%) Next pl% EndProc ' >Procedure cuspides Local n% Do menufree(basedom%) vcangulos domificacion salecasas If aborta? Or k$ = rt$ aborta? = False Exit Do EndIf If k$ = "P" sistema% = @disminuye(Pred(sistema%), Sub(xmenu%(geo%), xmenu%(dom%))) Else

sistema% = @disminuye(Succ(sistema%), Sub(xmenu%(geo%), xmenu%(dom%))) EndIf basedom% = Add(sistema%, Pred(pla%)) Loop menucheck(basedom%) EndProc ' >Procedure domificacion Local t As Double Let t = ts If basedom% = geo% ts = @mdl(-geos(lon%)) vcangulos sistema% = 1 Else sistema% = Sub(basedom%, Pred(pla%)) EndIf cuspide(decima%) = cuspide(mediocielo%) cuspide(primera%) = cuspide(ascendente%) If ambiguo? If opcion% = tbc% @txt(cyan%) Else Select basedom% Case goh%, pla%, geo% q$ = "|The " + hdom$(sistema%) + " system cannot be used" q$ = q$ + "|or requires additional definition." q$ = q$ + "|Riyal will use Alchabitius instead.| |" Alert 0 | 16, "POLAR AMBIGUITY!" + q$, 1, "Enter ", n% sistema% = Sub(alc%, Pred(pla%)) Default q$ = "|The Midheaven is below the horizon and the" q$ = q$ + "|houses should be inverted 180 degrees.| |" Alert 0 | 16, "POLAR AMBIGUITY!" + q$, 1, "Enter ", n% EndSelect EndIf EndIf For cusp% = m10% To m3% cuspide(cusp%) = d0 Next cusp% cusp% = undecima% On sistema% Call placido, campano, regiomontano, alcabicio, svarogich, abenrag el, koch, topocentrico, porfirio, morin, axial, horizontal, modusequalis, zodiac onatural For cusp% = undecima% To m3% If cusp% = primera% And cuspide(decima%) NEAR n7 cuspide(primera%) = d0 Else If cusp% >= m10% Or cusp% <= tercera% If @mdl(cuspide(cusp%) - cuspide(decima%)) > n8 cuspide(cusp%) = @mdl(cuspide(cusp%) + n8) EndIf EndIf Next cusp% If basedom% = apc% For cusp% = quinta% To novena% If cusp% = setima% And cuspide(decima%) NEAR n7 cuspide(setima%) = n8 Else If @mdl(cuspide(cusp%) - cuspide(cuarta%)) > n8 cuspide(cusp%) = @mdl(cuspide(cusp%) + n8)

EndIf EndIf Next cusp% Else For cusp% = decima% To tercera% cuspide(Add(cusp%, tercera%)) = @mdl(cuspide(cusp%) + n8) cuspide(Add(cusp%, Add(tercera%, middle%))) = @mdl(cuspide(Add(cusp%, midd le%)) + n8) Next cusp% EndIf Let ts = t llenapuntas If basedom% = geo% sistema% = Sub(basedom%, Pred(pla%)) vcangulos EndIf EndProc ' >Procedure placido Local Double m, da, p, j% etanz = cd(esin%) / cd(ecos%) * tanlat If Not polar? ao(ts + n3, d1) ao(ts + n6, d2) Inc cusp% ao(ts + n8 - n6, d2) ao(ts + n8 - n3, d1) cusp% = m10% ao(ts + n5, z5) ' middle of house 10 ao(ts + n3 + n5, d1 + z5) ' middle of house 11 ao(ts + n6 + n5, d2 + z5) ' middle of house 12 ao(ts + n9 + n5, d2 + z5) ' middle of house 1 ao(ts + n8 - c5, d1 + z5) ' middle of house 2 ao(ts + n8 - n5, z5) ' middle of house 3 Else Global Dim aop(4, Succ(kg%), 2) m = (Deg(Asin(d1 / etanz)) - p13 * Sgn(etanz)) / ng p = d0 For j% = 1 To 361 da = Deg(Asin(etanz * Sin(Rad(p)) - p13)) aop(1, j%, 1) = p aop(1, j%, 2) = da aop(2, j%, 1) = n8 - p aop(2, j%, 2) = da aop(3, j%, 1) = p - n8 aop(3, j%, 2) = -da aop(4, j%, 1) = -p aop(4, j%, 2) = -da Add p, m Next j% polarao(d1, d1) polarao(d2, d2) Inc cusp% polarao(d4, d2) polarao(d5, d1) cusp% = m10% polarao(z5, z5) ' middle of house 10 polarao(d1 + z5, d1 + z5) ' middle of house 11 polarao(d2 + z5, d2 + z5) ' middle of house 12 polarao(d3 + z5, d2 + z5) ' middle of house 1

polarao(d4 + z5, d1 + z5) ' middle of house 2 polarao(d5 + z5, z5) ' middle of house 3 Erase aop() EndIf EndProc >Procedure ao(ar As Double, i As Double) Local Double oa, m, da If cusp% >= m10% oa = ts + n3 * Sub(cusp%, m10%) + n5 Else oa = ts + n3 * Sub(cusp%, decima%) EndIf Repeat m = ar da = Deg(Asin(etanz * Sin(Rad(m)))) ar = oa + da / d3 * i Until Abs(m - ar) < darcsec cuspide(cusp%) = @mdl(@reduccion(sol%, ar, 1)) Inc cusp% EndProc >Procedure polarao(k, f) Local Double ao1, ao2, ar1, ar2, ar, oa, p, j%, i% If ambiguo? oa = @mdl(ts + n8 - n3 * k) Else oa = @mdl(ts + n3 * k) EndIf prueba? = False oa%(cusp%) = 0 For j% = 1 To 4 For i% = 1 To Succ(kg%) ar1 = aop(j%, i%, 1) ao1 = ar1 - aop(j%, i%, 2) / d3 * f If i% > 1 p = oa + ng * (oa > n8) If (p < ao1 And p > ao2) Or (p > ao1 And p < ao2) Inc oa%(cusp%) ar = (p - ao2) * (ar1 - ar2) / (ao1 - ao2) + ar2 prueba? = True EndIf EndIf ao2 = ao1 ar2 = ar1 Next i% Next j% If Not prueba? If ambiguo? ar = ts / z5 + n8 - oa Else ar = oa + n3 * k EndIf EndIf cuspide(cusp%) = @mdl(@reduccion(sol%, ar, 1)) Inc cusp% EndProc ' >Function ambipolo(tp As Double, th As Double) As Boolean Local f As Double f = -cd(ecos%) / (Sin(th) * cd(esin%) + p13) If f < d0

Return (tp <= f) Else Return (tp >= f) EndIf EndFunc ' >Function asoblicua(m As Double, p As Double, th As Double) As Double Naked If ambiguo? m = @rmdl(Rad(m) + PI - th) - p12 Else m = @rmdl(Rad(m) + th) - p12 EndIf th = Deg(Atn(d1 / (cd(ecos%) / Tan(m) - cd(esin%) * p * Sin(th) / Sin(m)))) Return @mdl(th - n8 * (th < d0) - n8 * (m > PI)) EndFunc ' >Procedure campano Dec cusp% For i% = 0 To k5% Step k3% If i% <> k9% And i% <> 0 cuspide(cusp%) = @asoblicua(ts, tanlat, Atn(geos(ucos%) * Tan(Rad(i%)))) EndIf cuspide(Add(cusp%, middle%)) = @asoblicua(ts, tanlat, Atn(geos(ucos%) * Tan( Rad(CFloat(i%) + n5)))) Inc cusp% Next i% EndProc ' >Procedure regiomontano Dec cusp% For i% = 0 To k5% Step k3% If i% <> k9% And i% <> 0 cuspide(cusp%) = @asoblicua(ts, tanlat, Rad(i%)) EndIf cuspide(Add(cusp%, middle%)) = @asoblicua(ts, tanlat, Rad(CFloat(i%) + n5)) Inc cusp% Next i% EndProc ' >Procedure horizontal Local ambilat? Dec cusp% ambilat? = ambiguo? ambiguo? = @ambipolo(d1 / tanlat, Rad(ts + n8)) Xor tanlat < d0 For i% = 0 To k5% Step k3% If i% = k9% cuspide(primera%) = @mdl(cuspide(vertex%) + n8) Else If i% cuspide(cusp%) = @asoblicua(ts + n8, d1 / tanlat, Atn(geos(usin%) * Tan(Ra d(i%)))) EndIf cuspide(Add(cusp%, middle)) = @asoblicua(ts + n8, d1 / tanlat, Atn(geos(usin %) * Tan(Rad(CFloat(i%) + n5)))) Inc cusp% Next i% ambiguo? = ambilat? EndProc ' >Procedure alcabicio Local dh#, sa#, sad#, m#, debajo?

semiarco(cuspide(ascendente%), d0, dh#, sa#, sad#, m#, debajo?) sa# = sad# / d3 m# = ts - sa# - n8 * ambiguo? For cusp% = decima% To tercera% Add m#, sa# If cusp% = primera% sa# = n6 - sa# EndIf cuspide(Add(cusp%, middle%)) = @mdl(@reduccion(sol%, m# + sa# * z5, 1)) If cusp% <> primera% And cusp% <> decima% cuspide(cusp%) = @mdl(@reduccion(sol%, m#, 1)) EndIf Next cusp% EndProc ' >Function node_dist_ecl(terra, th) Local node_dist_terra, ecl, tanth tanth = (d1 - Abs(terra) / n9) * Tan(Rad(th)) node_dist_terra = Rad(@mdl(terra - n9 + ts)) If node_dist_terra > PI Then node_dist_terra -= d2pi ecl = artan2(Sin(node_dist_terra), Cos(node_dist_terra) * cd(ecos%) + cd(esin% ) * tanth) Return @mdl(Deg(ecl) + n8) EndFunc >Procedure svarogich Local tau, dynamicAngle, freeAcc, delta_lat, j% freeAcc = 9.780319 * (d1 + 0.0053024 * Square(geos(usin%)) - 0.0000058 * Squar e(Sin(d2 * Rad(geos(lat%))))) delta_lat = Sin(d2 * Rad(geos(lat%))) * ((-Square(7.292115E-5) * 6378136.3) / (d2 * freeAcc)) dynamicAngle = geos(lat%) + Deg(delta_lat) For j% = 1 To 5 tau = @mdl(n7 + n3 * j%) If tau > n8 Then tau -= ng cuspide(Succ(j%)) = @node_dist_ecl(tau, dynamicAngle) Next j% For j% = 0 To 5 tau = @mdl(n7 + n3 * j% + n5) If tau > n8 Then tau -= ng cuspide(Add(Succ(j%), middle%)) = @node_dist_ecl(tau, dynamicAngle) Next j% EndProc ' >Procedure abenragel Local Double kv, dasc, az, taneps, a, b, c, e az = Rad(ts - n8 * ambiguo?) taneps = cd(esin%) / cd(ecos%) kv = Deg(Atn(tanlat * taneps * Cos(az) / (d1 + tanlat * taneps * Sin(az)))) dasc = Atn(Sin(Rad(kv)) / tanlat) b = Tan(dasc) * tanlat * Sin(az) For cusp% = decima% To novena% n% = @disminuye(Add(cusp%, 9), k2%) If n% < 8 a = Rad(kv + ts + n9 + Pred(n%) * (n9 - kv) / d3) e = Rad(kv + ts + n9 + Pred(n%) * (n9 - kv) / d3 + (n9 - kv) / d6) Else a = Rad(kv + ts + n9 + Sub(n%, zodiaco%) * (n9 + kv) / d3) e = Rad(kv + ts + n9 + Sub(n%, zodiaco%) * (n9 + kv) / d3 + (n9 + kv) / d6 ) EndIf

c = cd(ecos%) * (Tan(dasc) * tanlat * Cos(az) + Cos(a)) + cd(esin%) * tanlat * Sin(az - a) cuspide(cusp%) = Deg(@artan2(b + Sin(a), c)) c = cd(ecos%) * (Tan(dasc) * tanlat * Cos(az) + Cos(e)) + cd(esin%) * tanlat * Sin(az - e) cuspide(Add(cusp%, middle%)) = Deg(@artan2(b + Sin(e), c)) Next cusp% EndProc ' >Procedure koch Local dh#, sa#, sad#, m#, debajo?, sac semiarco(cuspide(mediocielo%), d0, dh#, sa#, sad#, m#, debajo?) sad# = sa# / d3 sac = z5 * sad# For cusp% = decima% To tercera% If cusp% <> primera% And cusp% <> decima% cuspide(cusp%) = @ascndt(ts - sa# + sad# * Pred(cusp%), tanlat) EndIf cuspide(Add(cusp%, middle%)) = @ascndt(ts - sa# + sad# * Pred(cusp%) + sac, tanlat) Next cusp% EndProc ' >Procedure topocentrico Local b, a, c As Double If polar? b = d1 / ((Square(cd(esin%) / cd(ecos%))) * tanlat) / d3 Else b = tanlat / d3 EndIf a = z5 * b For cusp% = undecima% To tercera% If cusp% <> primera% cuspide(cusp%) = @ascndt(ts - n9 + Pred(cusp%) * n3, b - b * Odd(cusp%)) Else If polar? cuspide(cusp%) = @ascndt(ts, b * d3) EndIf Select cusp% Case duodecima%, primera% c = a Case undecima%, segunda% c = a * d3 Case decima%, tercera% c = a * d5 EndSelect cuspide(Add(cusp%, middle%)) = @ascndt(ts - n9 + n5 + Pred(cusp%) * n3, c) Next cusp% EndProc ' >Procedure porfirio Local Double b, glon glon = cuspide(mediocielo%) b = @angdist(cuspide(ascendente%), glon) / d3 cuspide(m10%) = @mdl(glon + b * z5) For cusp% = undecima% To tercera% Add glon, b If cusp% = primera% b = n6 - b Else cuspide(cusp%) = @mdl(glon)

EndIf cuspide(Add(cusp%, middle%)) = @mdl(glon + b * z5) Next cusp% EndProc ' >Procedure morin For cusp% = decima% To tercera% cuspide(cusp%) = @mdl(@reduccion(sol%, ts + Mul(Pred(cusp%), k3%), -1)) cuspide(Add(cusp%, middle%)) = @mdl(@reduccion(sol%, ts + n5 + Mul(Pred(cusp %), k3%), -1)) Next cusp% EndProc ' >Procedure axial For cusp% = undecima% To tercera% cuspide(cusp%) = @mdl(@reduccion(sol%, ts + Mul(Pred(cusp%), k3%), 1)) cuspide(Add(cusp%, middle%)) = @mdl(@reduccion(sol%, ts + n5 + Mul(Pred(cusp %), k3%), 1)) Next cusp% cuspide(m10%) = @mdl(@reduccion(sol%, ts + n5, 1)) EndProc ' >Procedure modusequalis For cusp% = decima% To tercera% cuspide(cusp%) = @mdl(cuspide(ascendente%) - n9 + n3 * Pred(cusp%)) cuspide(Add(cusp%, middle%)) = @mdl(cuspide(cusp%) + n5) Next cusp% EndProc ' >Procedure zodiaconatural For cusp% = decima% To tercera% cuspide(cusp%) = @mdl(n7 + Mul(k3%, Pred(cusp%))) cuspide(Add(cusp%, middle%)) = @mdl(n7 + n5 + Mul(k3%, Pred(cusp%))) Next cusp% EndProc ' >Function ascndt(h As Double, z As Double) As Double Local lm As Double h = @mdl(h) lm = Deg(Atn(-Cos(Rad(h)) / (Sin(Rad(h)) * cd(ecos%) + cd(esin%) * z))) Return @mdl(lm - n8 * (lm < d0) - n8 * (h >= n9 And h < n7) - n8 * @ambipolo(z , Rad(h))) EndFunc >Function velascend(c%) As Double Naked If c% = ascendente% Return @angdist(@ascndt(ts + naibod, tanlat), cuspide(ascendente%)) Else Return @angdist(@ascndt(ts + n8 + naibod, d1 / tanlat), cuspide(vertex%)) EndIf EndFunc ' >Procedure semiarco(gl As Double, dc As Double, ByRef dh#, ByRef sa#, ByRef sad# , ByRef h#, ByRef debajo?) Local Double da, dsin, dcos, x If dc = d0 '==>ZODIACAL dc = @edeclinacion(gl, etrue%) gl = @reduccion(sol%, gl, -1) EndIf dsin = Sin(Rad(dc)) dcos = Cos(Rad(dc))

h# = @mdl(ts - gl) dh# = dsin * geos(usin%) + dcos * geos(ucos%) * Cos(Rad(h#)) + p12 debajo? = (dh# < d0) x = geos(usin%) / geos(ucos%) * dsin / dcos If Abs(x) < d1 da = Deg(Asin(x)) sa# = n9 + da * Sgn(dh#) Else sa# = n8 If debajo? Then da = -n9 Else da = n9 EndIf sad# = n9 + da dh# = @mdl(h# + sad#) + sad# / z5 * debajo? EndProc ' >Function sector(glon As Double) As Int Local Double d, g, i% = 0 d = @mdl(glon - cuspide(primera%)) If d = ng Then d = d0 Repeat Inc i% g = d - punta(Succ(i%)) Until g < d0 Return i% EndFunc >Function rxsector(glon As Double) As Int Local Double d, g, i% = 0 d = @mdl(glon - cusprx(primera%)) Repeat Inc i% g = d - puntarx(Succ(i%)) Until g < d0 Return i% EndFunc ' >Procedure tabladecasas Local paso As Double, i%, cusp%, limit%, s$, t$, p$ If @fecha If @loclat efemerides(0, 0) Alert 0 | 128, "choose STEP in minutes of sidereal time...|'ESC' = CANCEL" , 4, "1|2|3|4|5|6|7|8", n% If n% > 0 paso = CFloat(n%) / d4 Dim signo0%(novena%) nortesur(geos(lat%), 0, s$) encabezado(" " + Upper$(Left$(Trim$(hdom$(sistema%)), 8))) suspendwrite? = True tb.Visible = True tb.ScrollBars = basVertical pb.Refresh pb.Min = d0 pb.Max = ng pb.Top = fh% pb.Visible = True p$ = " " + bar$ + " " t$ = " T.S. X XI XII I II III" limit% = tercera% 'If basedom% = apc%

'limit% = novena% 'tb.Width = Mul(av%, 2) 'tb.ScrollBars = basBoth 't$ = t$ + " IV IX"

VI

VII

VIII

'EndIf tb.Text = tb.Text + t$ + crlf$ + crlf$ ftab(0, t$) baja(yi%) For ts = d0 To 361 Step paso pb.Value = ts @txt(white%) vcangulos domificacion q2$ = nul$ For cusp% = decima% To limit% fsigno(1, cuspide(cusp%), 0, signo%, s$, q$) If signo% = signo0%(cusp%) And contador% Mid$(q$, 3, 2) = " " EndIf If basedom% = pla% And polar? If oa%(cusp%) = 0 Or oa%(cusp%) > 1 If Not ambiguo? q2$ = q2$ + " " + bar$ + "*" + q$ Else q2$ = q2$ + " " + bar$ + "* " EndIf Else q2$ = q2$ + p$ + q$ EndIf Else q2$ = q2$ + p$ + q$ EndIf signo0%(cusp%) = signo% Next cusp% fsegundos(k4%, 0, ts / n5, 0, q$) ftab(1, bar$ + q$ + bar$ + Mid$(q2$, 3, Len(q2$)) + p$) tb.Text = tb.Text + Left$(nuevalinea$, 78) + crlf$ baja(xi%) Next ts ts = tx vcangulos domificacion Erase signo0%() pb.Visible = False pantalla 'tb.Width = av% 'tb.ScrollBars = basVertical EndIf EndIf EndIf EndProc ' >Procedure horaplanetaria horas: Data Saturn,7,Jupiter,3,Mars,6,Sun,2,Venus,5,Mercury,1,Moon,4 Local dh#, sa#, sad#, h#, hcum%, pl%, basenoche? Dim guiapl%(caldeo%), horapl$(caldeo%) Restore horas For pl% = 1 To caldeo%

Read horapl$(pl%), guiapl%(pl%) Next pl% semiarco(vc(sol%, longitud%), d0, dh#, sa#, sad#, h#, basenoche?) hcum% = Succ(Trunc(dh# * d6 / sa#)) Sub hcum%, Mul(k2%, basenoche?) Add hcum%, guiapl%(@semana( dj + z5 - geos(lon%) / n5 / n4 )) vcfecha$(rcaldea%) = horapl$(@disminuye(Pred(hcum%), caldeo%)) For pl% = lun% To sat% If plaux$(pl%) = vcfecha$(rcaldea%) Then basecaldea% = pl% Next pl% Erase guiapl%(), horapl$() EndProc ' >Function mundopos(ar#, dc#) Local omd As Double, hpos, hh, dmc As Double, amc As Double, dh#, sa#, sad#, h #, debajo? Local tanlat = geos(usin%) / geos(ucos%) Local taneps = cd(esin%) / cd(ecos%) semiarco(ar#, dc#, dh#, sa#, sad#, h#, debajo?) Select basedom% Case pla% If h# > n8 Then dh# = ng - h# Else dh# = h# ' planet ascends If dh# > sad# Then dh# = n8 - dh# ' planet below horizon, H from I C omd = dh# * n9 / sa# ' OBLIQUE MERIDIAN DISTANCE If (Not debajo?) And h# > n8 Then dh# = omd + n7 If debajo? And h# > n8 Then dh# = n9 - omd If (Not debajo?) And h# < n8 Then dh# = n7 - omd If debajo? And h# < n8 Then dh# = omd + n9 hpos = dh# Case cam% dh# = (Tan(Rad(dc#)) * tanlat * (d1 / Sin(Rad(h#))) + (d1 / Tan(Rad(h#)))) * geos(ucos%) hpos = @mdl(ng - (-Deg(Atn(dh#)) + n9 - n8 * (h# > n8)) - n9) Case reg% dh# = -(tanlat * Tan(Rad(dc#)) + Cos(Rad(h#))) / Sin(Rad(h#)) hpos = @mdl(Deg(-Atn(dh#)) - n8 * (h# < n8)) Case hor% acimutaltura(ar#, dc#, sa#, h#) hpos = @mdl(n9 + sa#) Case alc% ' SAVE THE HOUR ANGLE hh = h# ' NORMALIZE THE MERIDIAN DISTANCE If hh > n8 Then omd = ng - hh Else omd = hh If omd > sad# Then omd = n8 - omd semiarco(cuspide(ascendente%), d0, dh#, sa#, sad#, h#, prueba?) ' L'ABSURDIT: If (debajo? And hh > n8) Or ((Not debajo?) And hh < n8) Then sad# = n8 - sad # Mul omd, n9 / sad# ' CHECK QUADRANTS If (Not debajo?) And hh > n8 Then dh# = omd + n7 If debajo? And hh > n8 Then dh# = n9 - omd If (Not debajo?) And hh < n8 Then dh# = n7 - omd If debajo? And hh < n8 Then dh# = omd + n9 hpos = dh# Case goh% ' SWISS EPHEMERIS KOCH ALGORITHM dmc = Deg(Atn(taneps * Sin(Rad(ts))))

h# = n9 - Abs(geos(lat%)) If h# <= dc# Or h# <= dmc aborta? = True hpos = d0 Else dmc = Deg(Asin(taneps * tanlat * Sin(Rad(ts)))) omd = sad# - n9 sad# = n9 + dmc hh = ar - ts If hh >= d0 hpos = @mdl(((hh - omd + dmc) / sad# - d1) * n9) Else hpos = @mdl(((hh + n8 + omd + dmc) / sad# + d1) * n9) EndIf EndIf Case tpc% ' SWISS EPHEMERIS TOPOCENTRIC ALGORITHM hh = @mdl(ar# - ts) If debajo? ar# = @mdl(ar# + n8) dc# = -dc# hh = @mdl(hh + n8) EndIf If hh > n8 Then ar# = @mdl(ts - hh) ' START SEARCH: sa# = geos(lat%) h# = @mdl(ts + n9) dmc = d1 omd = dc# dh# = d2 While Abs(dmc) > p6 If dmc > d0 sa# = Deg(Atn(Tan(Rad(sa#)) - tanlat / dh#)) h# -= n9 / dh# Else sa# = Deg(Atn(Tan(Rad(sa#)) + tanlat / dh#)) h# += n9 / dh# EndIf cotrans(@mdl(ar# - h#), omd, amc, dmc, n9 - sa#) dh# *= d2 EndWhile hpos = @mdl(h# - ts) If hh > n8 Then hpos = @mdl(-hpos) If debajo? Then hpos = @mdl(hpos + n8) hpos = @mdl(hpos - n9) Case zar% hpos = @mdl(n7 - h#) Default hpos = d0 EndSelect Return hpos EndFunc ' >Procedure obliquelon(pl%, ByRef hpos, ByRef hlon) Local fmid, paso = d1, sg, cusp% aborta? = False ' GET THE MUNDANE POSITION: hpos = @mundopos(vc(pl%, ascensionrecta%), vc(pl%, declinacion%)) + p6 ' NOW GET THE OBLIQUE LONGITUDE: If Abs(vc(pl%, latitud%)) < p3 '=3.6"

hlon = vc(pl%, longitud%) Else If Not aborta? Select basedom% Case pla%, cam%, reg%, hor%, goh%, tpc% ' FIRST APPROXIMATION cusp% = @disminuye(Add(Succ(Trunc(hpos / n3)), 3), k2%) hlon = cuspide(cusp%) fmid = hpos - @mundopos(@reduccion(sol%, hlon + paso, -1), @edeclinacion(h lon + paso, etrue%)) Add fmid, ng * (fmid > n8) - ng * (fmid < -n8) ' ITERATE UNTIL ZERO IS PASSED While fmid > d0 And Not aborta? Add hlon, paso fmid = hpos - @mundopos(@reduccion(sol%, hlon, -1), @edeclinacion(hlon, etrue%)) Add fmid, ng * (fmid > n8) - ng * (fmid < -n8) Wend If Not aborta? ' ZERO PASSED, NOW CONVERGE AT DECREASING HALF-STEPS paso = -paso * z5 : sg = Sgn(fmid) For cusp% = 1 To kc% Add hlon, paso fmid = hpos - @mundopos(@reduccion(sol%, hlon, -1), @edeclinacion(hlon , etrue%)) Add fmid, ng * (fmid > n8) - ng * (fmid < -n8) If Sgn(fmid) <> sg Then paso = -paso * z5, sg = -sg Exit If Abs(fmid) < p4 Or aborta? Next cusp% EndIf Case zar%, alc% hlon = @reduccion(sol%, vc(pl%, ascensionrecta%), 1) Case sva%, apc% hlon = d0 Default hlon = d0 EndSelect EndIf If aborta? Then hlon = d0 EndProc ' ' ###################################################################### ' IMPLEMENTATION MODULE MConstel ' ###################################################################### ' >Procedure iauconstel(ar As Double, dc As Double, ByRef q$) Local l% prigurosa(B1875, dj, ar, dc) For l% = 1 To 357 With IAU_constel(l%) If Not (.decl > dc) If Not (.rau <= ar) If Not (.ral > ar) If ar >= .ral && ar < .rau && .decl <= dc q$ = .con l% = 357 EndIf EndIf EndIf EndIf EndWith

Next l% EndProc ' >Procedure starcatalog(cual%, ByRef ar As Double, ByRef dc As Double, ByRef m As Single, ByRef c$) ' *** THE ASTRONOMICAL ALMANAC 1981 p.B36-37 *** Local Double v, p, am, dm, tmx, tmy, tmz, dsin, dcos, gsin, gcos Local cat As catalogo ' cat = usnostars(cual%) ar = cat.ar2000 * n5 dc = cat.dc2000 am = cat.movar * p1 * rsec '==> radianes dm = cat.movdc * p1 * rsec '==> radianes p = cat.paralax * p3 * rsec '==> radianes v = cat.radvel * 21.09495276 '==> UA/siglo m = cat.mag / md c$ = cat.nombre ' ' *** COSENOS DIRECTORES J2000 *** dcosenos(ar, dc, gsin, gcos, dsin, dcos) r(xi%) = dcos * gcos r(yi%) = dcos * gsin r(zi%) = dsin ' ' *** VECTOR DE MOVIMIENTO ESPACIAL *** tmx = w2 * (-am * r(yi%) - dm * dsin * gcos + v * p * r(xi%)) tmy = w2 * (+am * r(xi%) - dm * dsin * gsin + v * p * r(yi%)) tmz = w2 * (+dm * dcos + v * p * r(zi%)) ' ' *** CORRECCION DE PARALAJE *** Add r(xi%), tmx + p * pq(rsol%, xi%) Add r(yi%), tmy + p * pq(rsol%, yi%) Add r(zi%), tmz + p * pq(rsol%, zi%) 'Mat Norm r(), 0 '==> < p0+tm-pi*r > ' ' *** CORRECCION DE ABERRACION *** Sub r(xi%), ab * pq(vsol%, xi%) Sub r(yi%), ab * pq(vsol%, yi%) Sub r(zi%), ab * pq(vsol%, zi%) 'Mat Norm r(), 0 '==> < p1+ab*( r'-s ) > ' ' *** PRECESION Y NUTACION *** transformacion(j2000fecha%, ecuador%, r()) tres(r(), nut()) ' rect2polar(r(), ar, dc, v) ' ' *** ABERRACION DIURNA *** ' v=0.3195*geos(rvg%)*geos(ucos%)/ns ' ADD ar,v*COS(RAD(ts))/COS(RAD(dc)) ' ADD dc,v*SIN(RAD(ts))/SIN(RAD(dc)) ' EndProc ' >Procedure catalog2apparent(obliquity%, ByRef ar#, ByRef dc#) Local v#, dsin#, dcos#, gsin#, gcos# Local Dim r(xyz%) As Double dcosenos(ar#, dc#, gsin#, gcos#, dsin#, dcos#) r(xi%) = dcos# * gcos#

r(yi%) = dcos# * gsin# r(zi%) = dsin# ecuatoriales(-obliquity%, r()) rect2polar(r(), ar#, dc#, v#) EndProc ' >Function acglongitud(l As Double) As Double Naked If acg? l = @mdl(geos(lon%) + ts - l) Else l = ng - l EndIf If l > n8 Then Sub l, ng If l < d0 l = Abs(l) + n8 Else l = n8 - l EndIf Return l EndFunc ' >Procedure acgmeridiano(l As Double, marca$) Local mx%, my% mx% = CInt(@acglongitud(l) * ra) my% = CFloat(_Y) * 0.9 Text Sub(mx%, 16), my%, Left$(plaux$(pl%), 2) + marca$ Line mx%, 0, mx%, Sub(my%, 8) EndProc ' >Procedure acghorizonte(maxlat As Double, b As Double, n As Double, tdec As Doub le, ByRef x1%, ByRef y1%) Local mx%, my%, mk% prueba? = True If acg? b = Deg(Atn(Sin(Rad(b - n9)) / tdec)) Else n = Tan(Rad(b)) * tdec If Abs(n) < d1 n = @mdl(ar# - (n9 + Deg(Asin(n)))) Else prueba? = False EndIf EndIf mx% = CInt(@acglongitud(n) * ra) my% = hv% - rb * (b + maxlat) Inc contador% If prueba? And (b <= maxlat And b >= (-n6)) If acg? If mx% > x1% And x1% Line x1%, y1%, mx%, my% EndIf If contador% Mod k3% = 0 Text mx%, my%, plfont$(pl%) EndIf Else mk% = CInt(@acglongitud(@mdl(ar# + @angdist(ar#, n))) * ra) Plot mx%, my% Plot mk%, my% If contador% Mod k6% = 0 Text mx%, my%, plfont$(pl%)

Text mk%, my%, plfont$(pl%) EndIf EndIf x1% = mx% y1% = my% Else x1% = 0 EndIf EndProc ' >Procedure cartography Local Double maxlat, minlat, maxlon, minlon, h, dc#, x1%, y1%, pl1%, pl2%, map acolor%, scr$ Local Double newmaxlat, newmaxlon, newminlat, newminlon, deflon, deflat Global ar#, acg? dlgplanetas("10 planets maximum (not recommended)", pl1%, pl2%, ultimo%, kd%) If pl1% > finpl% Or pl1% = 0 Or pl2% > finpl% Print range$ aborta? = True Else aborta? = False EndIf If pl2% = 0 Then pl2% = pl1% If pl1% > pl2% Then Swap pl1%, pl2% If Not aborta? q$ = "GEODETIC EQUIVALENTS|" + Space$(20) + "or| ASTRO-CARTOGRAPHY?|" Alert 2, q$, 2, "geodetic|acg| cancel ", n% If n% < 3 And n% > 0 acg? = (n% = 2) Open ExecPath + "world.map" for Input As # 8 maxlat = n9 minlat = -maxlat maxlon = n8 minlon = -maxlon fullscreen Cls ra = av% / (maxlon - minlon) rb = hv% / (maxlat - minlat) dibujemapa(maxlat, minlat, maxlon, minlon, ra, rb) For pl% = pl1% To pl2% If @is_in_seq(pl%) If acg? Color crema%, atras% ar# = vc(pl%, ascensionrecta%) dc# = vc(pl%, declinacion%) Else Color crema%, atras% ar# = @reduccion(sol%, vc(pl%, longitud%), -1) dc# = @edeclinacion(vc(pl%, longitud%), etrue%) EndIf If basebija? Or basesideral? prigurosa(tx, dj, ar#, dc#) EndIf dc# = Tan(Rad(dc#)) acgmeridiano(ar#, "-M") acgmeridiano(ar# + n8, "-I") x1% = 0 y1% = 0 If acg? For h = 1 To ng

acghorizonte(maxlat, @mdl(ar# - h), h, dc#, x1%, y1%) Next h Else For h = -n6 To 80 Step z5 acghorizonte(maxlat, h, ar#, dc#, x1%, y1%) Next h EndIf EndIf Next pl% cambiafont(14) Color brwhite%, grey% Text Sub(xcentro%, 75), 0, "IC-rise-MC-set-IC" Text 0, Sub(hv%, k2%), " right-click to exit " Text Sub(av%, 170), Sub(hv%, k2%), " right-click to exit " Color brcyan%, atras% mx0 = MouseX my0 = MouseY Get 0, 0, av%, hv%, scr$ Do Exit If MouseK = 2 deflon = maxlon deflat = minlat ra = av% / (maxlon - minlon) rb = hv% / (maxlat - minlat) If False 'MouseK = 1 Do '*** DEFINE RECTANGULO PARA COPIAR *** Put 0, 0, scr$ ' refresh window GraphMode R2_XORPEN mx1 = MouseX my1 = MouseY Box mx0, my0, mx1, my1 If MouseK = 0 newmaxlat = minlat - (my1 - hv%) / rb newminlat = minlat - (my0 - hv%) / rb If newmaxlat < newminlat Then Swap newmaxlat, newminlat newmaxlon = mx0 / ra + maxlon If newmaxlon >= n8 Then Sub newmaxlon, ng newminlon = mx1 / ra + maxlon If newminlon >= n8 Then Sub newminlon, ng If newmaxlon < newminlon Then Swap newmaxlon, newminlon ar# = (newmaxlon - newminlon) dc# = (newmaxlat - newminlat) deflon = newmaxlon deflat = newminlat ra = av% / ar# rb = hv% / dc# If Abs(ar#) > d5 And Abs(dc#) > d5 Cls dibujemapa(newmaxlat, newminlat, newmaxlon, newminlon, ra, rb) EndIf Exit If True EndIf Loop EndIf If MouseX <> mx0 Or MouseY <> my0 mx0 = MouseX, my0 = MouseY If (mx0 >= xv% And mx0 <= av%) And (my0 >= yv% And my0 <= hv%) ar# = mx0 / ra + deflon If ar# >= n8 Then Sub ar#, ng

dc# = deflat - (my0 - hv%) / rb nortesur(dc, 0, q$) esteoeste(-ar, 0, q2$) GraphMode 1 Color brwhite%, mapacolor% q$ = q$ + " - " + q2$ Text Sub(xcentro%, 80), Sub(hv%, fh%), q$ EndIf EndIf Loop Close # 8 Text Sub(xcentro%, 80), Sub(hv%, fh%), Str$(" ", 15) Text 0, Sub(hv%, k2%), Str$(" ", kc%) grpantalla EndIf EndIf Clr ar#, acg? EndProc >Procedure dibujemapa(maxlat#, minlat#, maxlon#, minlon#, ra#, rb#) Local lat&, lon&, a As Double, b As Double, i%, j%, x1%, y1%, x%, y%, dibuja? GraphMode R2_COPYPEN Color brcyan%, atras% Seek # 8, 0 For i% = 1 To 104612 lat& = Cvi(Input$(2, # 8)) lon& = Cvi(Input$(2, # 8)) a = CFloat(lat&) / mc b = CFloat(lon&) / mc dibuja? = (a <= maxlat# And a >= minlat#) If dibuja? Sub a, minlat# Sub b, maxlon# If b < d0 Then Add b, ng x% = CInt(b * ra#) y% = CInt(CFloat(hv%) - a * rb#) Plot x%, y% EndIf Next i% EndProc ' >Procedure acimutaltura(glon As Double, dc As Double, ByRef az#, ByRef h#) Local a#, b#, c#, d# dcosenos(ts - glon, dc, a#, b#, c#, d#) az# = Deg(@artan2(d# * a#, (-c# * geos(ucos%) + d# * geos(usin%) * b#))) h# = Deg(Asin(c# * geos(usin%) + d# * geos(ucos%) * b#)) ' IF NOT geometricas? THEN refraccion(h) EndProc ' >Procedure refraccion(ByRef alt As Double) Local Double d, q, p If alt < n9 And alt > (-d2) p = cnt(mbpresion%) - 0.156 * cnt(mbvapor%) q = 283 / (273 + cnt(ctemperatura%)) * (p / 1010) ' *** SEGUN SAEMUNDSSON, EN MEEUS AA 15.4 *** ' *** EXACTA ~8" PARA TODAS LAS ALTITUDES *** d = 1.02 / Tan(Rad(alt + 10.3 / (alt + 5.11))) Add alt, (d * q + 0.0019279) / n6 EndIf EndProc

' >Procedure ecltoeqt(gl#, bl#, ByRef glon#, ByRef decl#) Naked polar2rect(gl#, bl#, d1, r()) ecuatoriales(etrue%, r()) rect2polar(r(), glon#, decl#, bl#) EndProc ' >Procedure hacemarco GraphMode R2_COPYPEN Color green%, atras% DefLine 0, 4 Line xv%, yv%, av%, yv% Line xv%, yv%, xv%, hv% Line xv%, hv%, av%, hv% Line av%, hv%, av%, yv% EndProc ' >Procedure escala(ex As Double, ey As Double) Naked ra = CFloat(Sub(av%, fa%)) / ex rb = CFloat(Sub(hv%, fa%)) / ey EndProc ' >Procedure constelaciones Local c%, d%, ix%, iy%, cual%, cuadrante%, top%, cat$ Local Double a, b, c, campo, mag! Global fcentro% Alert 2, " |Horizontal field?", 2, " 180 | 90 | 60 ", cual% campo = n8 / cual% fullscreen escala(campo, campo) top% = Pred(CInt(ng / campo)) fcentro% = Sub(ycentro%, CInt(n2 * rb)) For cuadrante% = 0 To top% GraphMode R2_COPYPEN If cuadrante% = Succ(top%) \ 2 fcentro% = Sub(hv%, fcentro%) EndIf For cual% = 1 To cuantas% starcatalog(cual%, a, b, mag, cat$) Sub a, cuadrante% * campo If a < campo And a > d0 scr(a, b, ix%, iy%) plotestrella(ix%, iy%, cual%, mag) starname(cat$, mag, ix%, iy%, d2) EndIf Exit If InKey$ = esc$ Next cual% For pl% = lun% To nombrados% If planets_in_wheel?(pl%) Exit If pl% > qb1% a = vc(pl%, ascensionrecta%) - cuadrante% * campo If a < campo And a > d0 scr(a, vc(pl%, declinacion%), ix%, iy%) plotestrella(ix%, iy%, -pl%, md) EndIf EndIf Next pl% Color yellow%, atras% For j% = 0 To CInt(campo) scr(j%, d0, ix%, iy%)

Plot ix%, iy% For c = -d2 To d2 Step z5 If c = d0 Or Mod(j%, k3%) = 0 ecltoeqt(Add(j%, Mul(campo, cuadrante%)), c, a, b) scr(a - Mul(campo, cuadrante%), b, ix%, iy%) Plot ix%, iy% If c = d0 And Mod(j%, k3%) = 0 signo% = @disminuye(Succ(Add(j%, Mul(campo, cuadrante%)) Div k3%), k 2%) Text ix%, iy%, sgfont$(signo%) EndIf EndIf Next c Next j% DefLine 0, 1 Color green% cual% = 0 hacemarco If cuadrante% < top% toquemouse Exit If aborta? EndIf Next cuadrante% grpantalla Clear fcentro% EndProc ' >Procedure plotestrella(ix%, iy%, cual%, mag As Single) Naked If cual% < 0 Color pink%, atras% Text ix%, iy%, plaux$(-cual%) Else Color brcyan%, atras% Plot ix%, iy% If mag < 2.5 Color brwhite%, atras% Plot(Pred(ix%), iy%) Plot(ix%, Pred(iy%)) Plot(Succ(ix%), iy%) Plot(ix%, Succ(iy%)) If mag < z5 Plot(Pred(ix%), Pred(iy%)) Plot(Succ(ix%), Pred(iy%)) Plot(Succ(ix%), Succ(iy%)) Plot(ix%, Sub(iy%, 2)) Plot(Succ(ix%), Sub(iy%, 2)) Plot(Add(ix%, 2), Pred(iy%)) Plot(Add(ix%, 2), iy%) EndIf EndIf EndIf EndProc ' >Procedure scr(lon As Double, lat As Double, ByRef xp%, ByRef yp%) Naked ' *** PROYECCION GNOMONICA ESTA PENDIENTE *** xp% = Sub(av%, Add((Sub(CInt(lon * ra), xcentro%)), xcentro%)) yp% = Add(Sub(hv%, CInt(lat * rb)), Mul(fcentro%, opcion% = ctl%)) EndProc ' >Procedure starname(s$, mag As Single, ix%, iy%, lim As Single)

If Len(s$) > 6 And mag <= lim GraphMode R2_XORPEN Color brblue%, atras% Text Add(ix%, 2), iy%, Mid$(s$, 7, Len(s$)) EndIf EndProc ' >Procedure plothorizon(hem%, cual%, ar, dc, mag As Single) Local az As Double, h As Double, q As Double, ix%, iy%, cat$ If cual% > 0 Then cat$ = usnostars(cual%).nombre acimutaltura(ar, dc, az, h) If h > d0 q = n9 * hem% If hem% = 3 And az < n9 Add az, ng EndIf If az > q And az < (q + n8) scr(az - q, h, ix%, iy%) plotestrella(ix%, iy%, cual%, mag) starname(cat$, mag, ix%, iy%, d2) EndIf EndIf EndProc >Procedure plotcenit(cual%, ar As Double, dc As Double, mag As Single) Local az As Double, h As Double, cx%, cy%, cat$ If cual% > 0 Then cat$ = usnostars(cual%).nombre acimutaltura(ar, dc, az, h) If h > 64 h = n9 - h cx% = Sub(xcentro%, CInt(ra * h * CosQ(az))) cy% = Add(ycentro%, CInt(rb * h * SinQ(az))) plotestrella(cx%, cy%, cual%, mag) starname(cat$, mag, cx%, cy%, d5) EndIf EndProc >Procedure grhorizonte Local a As Double, b As Double, cual%, hem%, mag As Single, cat$ fullscreen escala(n8, n9) For hem% = 0 To 3 q$ = Mid$("S___WEST___N E___SOUTH___WN___EAST___S W___NORTH___E", Succ(Mul(h em%, 13)), 13) Color brwhite%, atras% Text Sub(xcentro%, Mul(8, Len(q$) \ 2)), fa%, q$ Text xcentro%, Mul(fa%, 2), "|" For cual% = 1 To cuantas% starcatalog(cual%, a, b, mag, cat$) plothorizon(hem%, cual%, a, b, mag) Exit If InKey$ = esc$ Next cual% For pl% = lun% To nombrados% If planets_in_wheel?(pl%) Exit If pl% > qb1% plothorizon(hem%, -pl%, vc(pl%, ascensionrecta%), vc(pl%, declinacion%), md) EndIf Next pl% hacemarco toquemouse Exit If aborta?

Next hem% ' *** CENIT *** If Not aborta? Color blue%, atras% DefFill 41 PBox xv%, yv%, av%, hv% escala(n6, n6) Ellipse xcentro%, ycentro%, Sub(xcentro%, 2), Sub(ycentro%, 2) Color brwhite%, atras% Text Sub(xcentro%, fa% \ 2), Add(ycentro%, fa% Div 2), "Z" For cual% = 1 To cuantas% starcatalog(cual%, a, b, mag, cat$) plotcenit(cual%, a, b, mag) Exit If InKey$ = esc$ Next cual% For pl% = lun% To nombrados% Exit If pl% > ultimo% plotcenit(-pl%, vc(pl%, ascensionrecta%), vc(pl%, declinacion%), mag) Next pl% hacemarco EndIf grpantalla EndProc ' >Procedure plotesfera(cual%, ar As Double, dc As Double, ByRef xp%, ByRef yp%) Local az As Double, h As Double If cual% <> cuantas% acimutaltura(ar, dc, az, h) Else h = dc az = ar EndIf If Not (az > n8 And az < ng) Sub az, n8 Else az = n8 - az EndIf '*** ACIMUTAL EQUIDISTANTE --> se distorsiona hacia arriba *** ar = h / Sin(Rad(h + p12)) xp% = Add(xcentro%, CInt(SinQ(az - n9) * CosQ(h) * ra * ar)) yp% = Sub(ycentro%, CInt(SinQ(h) * rb * ar)) plotestrella(xp%, yp%, cual%, md) 'If dc = d0 'Color brblue%, atras% 'Plot Add(xcentro%, Sub(ycentro%, yp%)), Sub(ycentro%, Sub(xcentro%, xp%)) 'EndIf EndProc >Procedure esfera Local a As Double, b As Double, mag As Single, j%, c%, xp%, yp%, plextra% dlgplanetas("10 planets maximum", plextra%, n%, ultimo%, kd%) If Not aborta? fullscreen GraphMode R2_COPYPEN escala(n8, n8) hacemarco Color blue%, atras% DefLine 0, 1 GraphMode R2_XORPEN Line xv%, ycentro%, av%, ycentro% Line xcentro%, yv%, xcentro%, hv%

GraphMode R2_COPYPEN For j% = 0 To kg% ecltoeqt(j%, d0, a, b) plotesfera(1, a, b, xp%, yp%) If (j% Mod k3%) = 0 DefLine 2, 1 Line xcentro%, ycentro%, xp%, yp% signo% = @disminuye(Succ(j% Div k3%), k2%) Color yellow%, atras% Text Sub(xp%, fa% Div 2), yp%, sgfont$(signo%) EndIf Color brwhite%, atras% If j% = Trunc(cuspide(ascendente%)) Text Sub(xp%, fa%), yp%, "Asc" 'Else If j% = Trunc(@mdl(cuspide(ascendente%) + n8)) 'Text Sub(xp%, Add(fa%, fa% Div 2)), yp%, "Desc" Else If j% = Trunc(cuspide(mediocielo%)) Text Sub(xp%, fa% Div 2), yp%, "MC" 'Else If j% = Trunc(@mdl(cuspide(mediocielo%) + n8)) 'Text Sub(xp%, fa% Div 2), yp%, "I.C." EndIf Next j% For pl% = lun% To finpl% If pl% <= sol% Or pl% = plextra% plotesfera(-pl%, vc(pl%, ascensionrecta%), vc(pl%, declinacion%), xp%, y p%) EndIf Next pl% grpantalla EndIf EndProc ' >Procedure cuando Local t$, lapso As Double, ff As Double, ss%, mx%, my%, dist As Double lapso = dj1 - dj0 ff = ng / sh / fac If polar% <= 2 Then ss% = s% Div 2 Else ss% = s% cambiafont(9) Color brwhite% DefMouse 2 mx% = MouseX my% = MouseY Do Exit If MouseK If MouseY <> my% Or MouseX <> mx% mx% = MouseX, my% = MouseY If my% >= ss% And my% <= (Sub(hv%, ss%)) If mx% >= xv% And mx% <= av% dj = lapso * CFloat(mx%) / CFloat(av%) + dj0 getfecha(dj, jd|, jm|, ja%) t$ = Str$(jd|, 2) + "/" + Str$(jm|, 2) + "/" + Str$(ja%, 4) + spc$ If polar% <= 2 fsigno(0, CFloat(Sub(my%, ss%)) * ff - cd(ayanamsa%), 0, signo%, q$, q2$) Else If polar% = 3 fminutos(kg%, CFloat(Sub(Sub(hv%, my%), ss%)) * fac / sh, 0, 0, q$) Else If polar% = 4 Or polar% = 5 Or polar% = 6 dist = CFloat(Sub(Sub(hv%, my%), ss%)) * fac / sh If dist < p2 freal(dist * au, 6, 0, 0, q$)

q$ = q$ + "Km" Else freal(dist, 4, 4, 0, q$) q$ = q$ + "AU" EndIf EndIf Text Sub(xcentro%, 110), Sub(hv%, 18), spc$ + q$ + " - " + t$ EndIf EndIf EndIf Loop DefMouse 0 EndProc ' >Procedure grprogresado Local bpl%, apl%, x2% = 0, y2%, xc%, yc%, paso As Single Global polar%, cpl%, x1% = 0, y1%, s% = 32, fac As Double, sh As Double, dj0 A s Double, dj1 As Double, pausa? = False q$ = "LONGITUDE|4th HARMONIC LONGITUDE|DECLINATION|GEO DISTANCE" q$ = q$ + "|HELIO DISTANCE|SEMI-MAJOR AXIS" Alert 2 | 16, nul$, 1, q$ + "|cancel", polar% If Not aborta? And (polar% > 0 And polar% < 7) dlgplanetas("only 1 or 2 planets", bpl%, cpl%, allplanets%, 2) If bpl% = cpl% Then cpl% = 0 If bpl% And Not aborta? dlgephemstep(dj0, dj1, paso) If Not aborta? ' CHECK RANGES FIRST: dj = dj0 pausa? = Not @withinrange(bpl%) If cpl% Then pausa? = pausa? Or Not @withinrange(cpl%) dj = dj1 pausa? = pausa? Or Not @withinrange(bpl%) If cpl% Then pausa? = pausa? Or Not @withinrange(cpl%) If Not pausa? abralostodos(True) fullscreen sh = CFloat(Sub(hv%, s%)) GraphMode R2_COPYPEN Color grey%, atras% DefLine 0, 6 Select polar% Case 1 q2$ = "LONGITUDE OF " fac = d1 n% = Sub(hv%, s% Div 2) Case 2 q2$ = "4TH HARMONIC " fac = d4 n% = Sub(hv%, s% Div 2) Case 3 q2$ = "DECLINATION OF " fac = n3 n% = Sub(hv%, s%) Case 4 q2$ = "GEODISTANCE OF " fac = n6 n% = Sub(hv%, s%) Case 5 q2$ = "HELIODISTANCE OF "

fac = n6 n% = Sub(hv%, s%) Case 6 q2$ = "SEMIMAJOR AXIS OF " fac = n6 n% = Sub(hv%, s%) EndSelect Line 0, n%, av%, n% Line 0, Sub(hv%, n%), av%, Sub(hv%, n%) Color brcyan%, atras% If cpl% And Not polar% = 6 Text Sub(xcentro%, 186), 1, q2$ + Upper$(plaux$(bpl%)) Color yellow% Text Add(xcentro%, 10), 1, q2$ + Upper$(plaux$(cpl%)) Else If cpl% And polar% = 6 Swap cpl%, bpl% Text Sub(xcentro%, 200), 1, q2$ + Upper$(plaux$(bpl%)) Color yellow% Text Add(xcentro%, 10), 1, "DISTANCE FROM " + Upper$(plaux$(cpl%)) Else Text Sub(xcentro%, 95), 1, q2$ + Upper$(plaux$(bpl%)) EndIf DefLine 0, 2 Color brcyan%, atras% HideM contador% = 0 For dj = dj0 To dj1 Step paso baselow? = (dj > lowmin And dj < lowmax) 'And Not polar% = 7 Inc contador prplot(bpl%) If cpl% And Not polar% = 6 Color yellow% xc% = x1% yc% = y1% x1% = x2% y1% = y2% prplot(cpl%) x2% = x1% y2% = y1% x1% = xc% y1% = yc% Color brcyan% EndIf If InKey$ = spc$ Then pausa? = True Exit If pausa? Next dj ShowM DefLine 0, 1 If Not aborta? And tx <> d0 For apl% = lun% To plu% If polar% <= 2 n% = Add(CInt(@mdl(fac * (radix(apl%, longitud%) + ayanx)) * sh / ng), s% Div 2) Else If polar% = 3 n% = Sub(hv%, Add(CInt(Abs(radix(apl%, declinacion%)) * sh / fac ), s% )) Else If polar% = 4 n% = Sub(hv%, Add(CInt(radix(apl%, rvector%) * sh / fac), s% )) Else If polar% = 5 n% = Sub(hv%, Add(CInt(heliorx(apl%, hdis%) * sh / fac), s% ))

Else If polar% = 6 n% = Sub(hv%, Add(CInt(osc(apl%, ax%) * sh / fac), s% )) EndIf If n% >= s% Div 2 And n% <= (Sub(hv%, s% Div 2)) Color caf% Line xv%, n%, av%, n% Color crema% Text Sub(av%, Mul(apl%, k2%)), Sub(n%, 5), plfont$(apl%) EndIf Next apl% EndIf cuando grpantalla abralostodos(False) If tx <> d0 llenaradix Else nuevo EndIf baselow? = False Else Print range$ toquemouse EndIf EndIf EndIf EndIf Clr pausa?, polar%, x1%, y1%, s%, fac, sh, dj0, dj1 EndProc ' >Procedure prplot(pl%) Local x%, y%, yA%, yP%, centricy% tabephem(pl%) If contador% = 1 If polar% = 3 Select pl% Case BML%, lun% fac = d6 Case nodo%, asc%, m_c% fac = d0 Default fac = Deg(osc(pl%, cl%)) * d6 / d5 EndSelect Add fac, cd(oblicuidad%) ElseIf polar% = 4 Or polar% = 5 Select pl% Case BML%, nodo%, lun% fac = axlu / au * d6 / d5 Default fac = (d1 + osc(pl%, ax%) * (d1 + osc(pl%, ec%))) * d6 / d5 EndSelect ElseIf polar% = 6 fac = osc(pl%, ax%) * (d1 + osc(pl%, ec%)) * d6 / d5 EndIf EndIf x% = CInt((dj - dj0) * av% / (dj1 - dj0)) If polar% <= 2 y% = Add(CInt(@mdl(fac * (vc(pl%, longitud%) + cd(ayanamsa%))) * sh / ng), s % Div 2) Else If polar% = 3

If tx <> d0 Add vc(pl%, declinacion%), 0.005566 * (dj - tx) / j5 * CosQ(vc(pl%, declin acion%)) EndIf y% = Sub(hv%, Add(CInt(Abs(vc(pl%, declinacion%)) * sh / fac), s%)) Else If polar% = 4 y% = Sub(hv%, Add(CInt(vc(pl%, rvector%) * sh / fac), s%)) Else If polar% = 5 y% = Sub(hv%, Add(CInt(heliop(pl%, hdis%) * sh / fac), s%)) yA% = Sub(hv%, Add(CInt(osc(pl%, ax%) * (d1 + osc(pl%, ec%)) * sh / fac), s% )) yP% = Sub(hv%, Add(CInt(osc(pl%, ax%) * (d1 - osc(pl%, ec%)) * sh / fac), s% )) If pl% <> cpl% DefLine 6, 1 Line x%, yA%, x%, yP%, grey% DefLine PS_SOLID, 3 EndIf Else If polar% = 6 If cpl% If cpl% <> sol% tabephem(cpl%) If contador% = 1 Add fac, osc(cpl%, ax%) * (d1 + osc(cpl%, ec%)) EndIf r(xi%) = helior(pl%, xi%) - helior(cpl%, xi%) r(yi%) = helior(pl%, yi%) - helior(cpl%, yi%) r(zi%) = helior(pl%, zi%) - helior(cpl%, zi%) centricy% = Sub(hv%, Add(CInt(@vmg(r()) * sh / fac), s%)) Else centricy% = Sub(hv%, Add(CInt(heliop(pl%, hdis%) * sh / fac), s%)) EndIf Color yellow% Plot x%, centricy% Color brcyan% EndIf y% = Sub(hv%, Add(CInt(osc(pl%, ax%) * sh / fac), s%)) EndIf If contador% > 1 If Abs(Sub(y1%, y%)) < ycentro% And Abs(Sub(x1%, x%)) > 0 Line x%, y%, x1%, y1% EndIf EndIf x1% = x% y1% = y% EndProc ' ' ###################################################################### ' IMPLEMENTATION MODULE MDialogos ' ###################################################################### ' >Function limitaspect(r$) As Integer Naked q$ = "|CHOOSE|LIMITING|ASPECT|FOR|" + r$ + "||SELECTION|INCLUDES|ALL|OTHERS|ON TOP" Alert 0 | 16, q$, 3, "conjunction|opposition|square|trine|sextile|quincunx|CAN CEL", n% Return n% EndFunc ' >Function num(indice%, l%) As Integer

indice% = Val(Mid$(q$, indice%, 1)) If indice% < 0 Or indice% > 9 Return 0 Else Return Mul(indice%, l%) EndIf EndFunc ' >Function remove_rt(r As String) As String Local ret As Long Repeat ret = InStr(r, rt$) If ret r = Left(r, Pred(ret)) + Right(r, Sub(Len(r), Succ(ret))) EndIf Until ret = 0 Return r EndFunc ' >Procedure abradialogo(h%, l%, t%, w%, sk$) OpenW Hidden Owner Me, 2 With Win_2 .ControlBox = False .BackColor = grey% .Appearance = basThreeD .Caption = sk$ .Height = h% .Left = l% .Top = t% .Width = w% .AutoRedraw = True .AutoClose = False .Sizeable = False .SetFont "terminal", 14, , , , , OEM_CHARSET .Center Win_1.hWnd .Show EndWith simulatecla(VK_INSERT) EndProc >Procedure cierradialogo CloseW 2 Win_1.ToTop EndProc ' >Procedure simulatecla(key%) ~keybd_event(key%, 0, 0, 0) ~keybd_event(key%, 0, KEYEVENTF_KEYUP, 0) EndProc ' >Sub cmdQuit_Click aborta? = True prueba? = False >Sub cmdOK_Click prueba? = True aborta? = False End Sub ' >Procedure calendario abradialogo(3470, 60, 340, 3500, nul$) prueba? = False

aborta? = False Ocx MonthView calendar = , 2, 2 Ocx Command cmdOK = "exit", 0, 204, 230, 24 .FontSize = 9 .Default = True .Cancel = True Do Sleep Exit If aborta? Or prueba? Until Me Is Nothing 'getdj(calendar.Day, calendar.Month, calendar.Year) cierradialogo EndProc ' >Sub ahora_Click dglat$ = zlat$ dglon$ = zlon$ dgnom$ = "--" + Date$ + "--" dgtime$ = "1" dgdate$ = Date$ textf.Text = dgdate$ textf.SelAlignment = 2 prueba? = False aborta? = False BCE = False oldstyle = False EndSub >Sub database_Click carguedatos textf.SelAlignment = 2 textf.Text = dgdate$ aborta? = False EndSub >Function fecha() As Boolean Local df As Date prueba? = False aborta? = False abradialogo(3300, 60, 345, 3600, nul$) If dgdate$ = nul$ Then dgdate$ = Date$ Ocx Label database = "DATABASE", 33, 12, 70, 15 .FontSize = 7 .Alignment = 2 .BackColor = yellow% .BorderStyle = 2 Ocx Label ahora = "HERE NOW", 128, 12, 70, 15 .FontSize = 7 .Alignment = 2 .BackColor = yellow% .BorderStyle = 2 Ocx Command cmdOK = "OK", 16, 170, 80, 35 .FontSize = 9 .Default = True Ocx Command cmdQuit = "Cancel", 123, 170, 80, 35 .FontSize = 9 .Cancel = True Ocx Label guia1 = "dd mm yyyy", 16, 42, 202, 20 .Alignment = 2 .FontSize = 9 .FontBold = 0 Ocx Option oldstyle = "old style (Julian)", 31, 110, 167, 13

.SetFont "terminal", 7, , , , , OEM_CHARSET Ocx Option newstyle = "new style (Gregorian)", 31, 97, 167, 13 .SetFont "terminal", 7, , , , , OEM_CHARSET .DoClick Ocx CheckBox BCE = "BCE - Before Christ (BC)", 31, 133, 167, 13 .SetFont "terminal", 7, , , , , OEM_CHARSET Ocx RichEdit textf = dgdate$, 16, 63, 202, 20 .SelLength = 10 .SelAlignment = 2 .MaxLength = 11 .SetFocus skipdate? = False simulatecla(VK_HOME) Do Sleep If prueba? If textf.Text = nul$ aborta? = True Else q$ = @remove_rt(textf.Text) dgdate$ = q$ jd| = Add(@num(1, kd%), @num(2, 1)) jm| = Add(@num(4, kd%), @num(5, 1)) ja% = Add(Add(@num(7, kl%), @num(8, kc%)), Add(@num(9, kd%), @num(10, 1) )) If BCE prueba? = (jm| > 0 And jm| <= k2%) And jd| < 32 And ja% <= 4713 Else prueba? = (jm| > 0 And jm| <= k2%) And jd| < 32 And ja% <= 8000 EndIf Exit If prueba? ilegal textf.Text = Date$ textf.SelAlignment = 2 textf.SetFocus EndIf EndIf Exit If aborta? Until Me Is Nothing If Not aborta? If Not skipdate? If BCE Then ja% = Sub(1, ja%) If oldstyle Then basegregoriano? = False If ja% < 1582 Then basegregoriano? = False getdj(jd|, jm|, ja%) EndIf cierradialogo Return True Else cierradialogo Return False EndIf EndFunc ' >Function hora() As Boolean Local b As Double If skipdate? Then Return True abradialogo(3300, 60, 345, 3600, nul$) q$ = Time$ tu = tz + @num(1, kd%) + @num(2, 1) + (@num(4, kd%) + @num(5, 1)) / n6 + (@num

(7, kd%) + @num(8, 1)) / ns If tu < d0 Add tu, n4 b = -d1 Else If tu > n4 b = d1 Else b = d0 EndIf fsegundos(k4%, 1, tu, 0, q$) q2$ = q$ If dgtime$ = nul$ Or dgtime$ = "1" Then dgtime$ = q$ prueba? = False aborta? = False Ocx Command cmdOK = "OK", 15, 180, 93, 27 .FontSize = 9 .Default = True Ocx Command cmdQuit = "Cancel", 124, 180, 93, 27 .FontSize = 9 .Cancel = True Ocx RichEdit text1 = dgtime$ + spc$, 15, 32, 202, 20 .SelAlignment = 2 .SelFontName = "terminal" .SelLength = 9 .MaxLength = 10 .SelStart = 0 Ocx Label guia1 = "hh mm ss", 15, 11, 202, 20 .Alignment = 2 .FontSize = 9 Ocx Option gt = "gmt = universal time", 34, 67, 160, 14 .FontSize = 7 .DoClick Ocx Option ht = "expected time zone", 34, 80, 160, 14 .FontSize = 7 Ocx Option dt = "daylight time (+1h)", 34, 93, 160, 14 .FontSize = 7 Ocx Option lt = "local mean time", 34, 107, 160, 14 .FontSize = 7 Ocx Option tt = "apparent solar time", 34, 120, 160, 14 .FontSize = 7 Ocx Option rt = "sunrise (enter 6h)", 34, 133, 160, 14 .FontSize = 7 Ocx Option zt = "sunset (enter 18h)", 34, 147, 160, 14 .FontSize = 7 text1.SetFocus simulatecla(VK_LEFT) Do Sleep If prueba? If text1.Text = nul$ aborta? = True Else q$ = @remove_rt(text1.Text) If q2$ <> q$ b = d0 EndIf tu = @num(1, kd%) + @num(2, 1) + (@num(4, kd%) + @num(5, 1)) / n6 + (@nu m(7, kd%) + @num(8, 1)) / ns prueba? = (tu <= 36 And tu >= d0) Exit If prueba?

ilegal text1.SetFocus EndIf EndIf Exit If aborta? Until Me Is Nothing If Not aborta? dgtime$ = q$ Add dj, tu / n4 + b basecodigo% = greenwich% If ht Then basecodigo% = hnormal% If dt Then basecodigo% = verano% If lt Then basecodigo% = local% If tt Then basecodigo% = solar% If rt Then basecodigo% = orto% If zt Then basecodigo% = ocaso% cierradialogo Return True Else cierradialogo Return False EndIf EndFunc ' >Function loclon() As Boolean Local Double vlon, ulat, h If skipdate? And Not (opcion% = rvs% Or opcion% = rvl%) Then Return True abradialogo(1720, 60, 345, 3600, nul$) prueba? = False aborta? = False Ocx Command cmdOK = "OK", 17, 73, 93, 27 .FontSize = 9 .Default = True Ocx Command cmdQuit = "Cancel", 124, 73, 93, 27 .FontSize = 9 .Cancel = True Ocx RichEdit Text1 = dglon$ + " ", 15, 31, 202, 20 .SelAlignment = 2 .MaxLength = 9 Ocx Label guia1 = "longitude", 15, 15, 202, 15 .Alignment = 2 .FontSize = 9 .FontBold = 0 Text1.SetFocus Do Sleep If prueba? q$ = @remove_rt(Text1.Text) dglon$ = q$ vlon = @num(1, kc%) + @num(2, kd%) + @num(3, 1) + (@num(5, kd%) + @num(6, 1)) / n6 + (@num(7, kd%) + @num(8, 1)) / ns If Lower$(Mid$(q$, 4, 1)) = "e" vlon = -vlon EndIf prueba? = (Abs(vlon) <= n8) Exit If prueba? ilegal Text1.SetFocus EndIf Exit If aborta?

Until Me Is Nothing If Not aborta? Select basecodigo% Case greenwich% h = d0 Case hnormal%, verano% h = Add(Round(vlon / n5) - basecodigo%, 2) Case local% To ocaso% h = vlon / n5 EndSelect Add tu, h Add dj, h / n4 geos(dl%) = h geos(lon%) = vlon tiemposideral(dj) cierradialogo Return True Else cierradialogo Return False EndIf EndFunc >Function loclat() As Boolean Local Double vlon, ulat, h If skipdate? And Not (opcion% = rvs% Or opcion% = rvl%) Then Return True abradialogo(2000, 60, 345, 3600, nul$) prueba? = False aborta? = False Ocx Command cmdOK = "OK", 17, 97, 93, 27 .FontSize = 9 .Default = True Ocx Command cmdQuit = "Cancel", 124, 97, 93, 27 .FontSize = 9 .Cancel = True Ocx RichEdit Text2 = dglat$ + " ", 15, 31, 202, 20 .SelAlignment = 2 .MaxLength = 8 Ocx Label guia2 = "latitude", 15, 15, 202, 15 .Alignment = 2 .FontSize = 9 .FontBold = 0 Ocx CheckBox gc = "geocentric latitude", 44, 64, 133, 13 .FontSize = 7 Text2.SetFocus Do Sleep If prueba? q$ = @remove_rt(Text2.Text) dglat$ = q$ ulat = @num(1, kd%) + @num(2, 1) + (@num(4, kd%) + @num(5, 1)) / n6 + (@nu m(6, kd%) + @num(7, 1)) / ns If Lower$(Mid$(q$, 3, 1)) = "s" ulat = -ulat EndIf prueba? = Abs(ulat) < n9 Exit If prueba? ilegal Text2.SetFocus EndIf Exit If aborta?

Until Me Is Nothing If Not aborta? If gc Then latgeoc? = True Else latgeoc? = False geos(lat%) = ulat geocentrico cierradialogo Return True Else cierradialogo Return False EndIf EndFunc ' >Procedure rvano(ByRef modo%, ByRef sinetico%, ByRef ingreso%) abradialogo(3000, 60, 345, 3600, nul$) prueba? = False aborta? = False Ocx Command cmdOK = "OK", 17, 167, 93, 20 .FontSize = 9 .Default = True Ocx Command cmdQuit = "Cancel", 120, 167, 93, 20 .FontSize = 9 .Cancel = True Ocx RichEdit Text1 = "2007" + spc$, 17, 32, 196, 20 .SelAlignment = 2 .SelFontName = "terminal" .MaxLength = 5 Ocx Label guia1 = "year of the return:", 17, 11, 196, 20 .Alignment = 2 .FontSize = 9 .FontBold = 0 Ocx CheckBox rconv = "converse", 37, 67, 70, 14 .FontSize = 7 Ocx CheckBox rsid = "sidereal", 117, 67, 70, 14 .FontSize = 7 Ocx Label guia2 = "cardinal ingresses:", 33, 96, 157, 13 .Alignment = 2 .FontSize = 7 Ocx Option rari = "Aries", 33, 109, 78, 14 .FontSize = 7 Ocx Option rcan = "Cancer", 33, 123, 78, 14 .FontSize = 7 Ocx Option rlib = "Libra", 112, 109, 78, 14 .FontSize = 7 Ocx Option rcap = "Capricorn", 112, 123, 78, 14 .FontSize = 7 If basebija? Or basesideral? Then rsid = True If tx = d0 Then rcap = True Text1.SetFocus Do Sleep If prueba? q$ = Text1.Text If q$ = nul$ aborta? = True Else ja% = Val(q$) prueba? = (ja% <= 8000 And ja% > -4712) Exit If prueba? ilegal

Text1.SetFocus EndIf EndIf Exit If aborta? Until Me Is Nothing ingreso% = 0 If rari Then ingreso% = 1 If rcan Then ingreso% = 2 If rlib Then ingreso% = 3 If rcap Then ingreso% = 4 If rconv Then modo% = -1 Else modo% = 1 If rsid Then sinetico% = 2 Else sinetico% = 1 cierradialogo EndProc ' >Sub opt4_Click If opt4 q$ = "||CHOOSE|THE|AYANAMSA|||MAKE|SURE|TO RE-|CALCULATE|YOUR|DATA!" q2$ = "Fagan/Bradley|Lahiri|Raman|Babylonian|Sassanian|Galactic Center|Sunda ra Rajan|Krishnamurti" Alert 0 | 16, q$, baseayanamsa%, q2$ + "|user-defined|CANCEL", n% EndIf If n% = kd% Then opt4 = False Else baseayanamsa% = n% EndSub >Procedure globalpanel Local Int xt, yt, wt, ht abradialogo(6500, 60, 345, 6400, nul$) Win_2.SetFont "courier new", 10, True prueba? = False aborta? = False yt = 392, wt = 200, ht = 32 Ocx Command cmdOK = "OK", 8, yt, wt, ht .Default = True Ocx Command cmdQuit = "Cancel", 212, yt, wt, ht .Cancel = True xt = 8, yt = 10, wt = 407, ht = 25 Ocx CheckBox opt1 = "GEOMETRIC: true positions, no light-time.", xt, yt, wt, h t Add yt, ht Ocx CheckBox opt2 = "EPHEMERIS TIME: Dynamical Time, no delta-t.", xt, yt, wt, ht Add yt, ht Ocx CheckBox opt3 = "PRECESSED: precession-corrected positions.", xt, yt, wt, ht Add yt, ht Ocx CheckBox opt4 = "SIDEREAL: positions in the sidereal zodiac.", xt, yt, wt, ht Add yt, ht Ocx CheckBox opt5 = "TOPOCENTRIC: observer's parallax.", xt, yt, wt, ht Add yt, ht Ocx CheckBox opt6 = "CENTAURS: include centaurs and tno's.", xt, yt, wt, ht Add yt, ht Ocx CheckBox opt7 = "NAMED: include named centaurs only.", xt, yt, wt, ht Add yt, ht Ocx CheckBox optA = "NODE: include the ascending lunar node.", xt, yt, wt, ht Add yt, ht Ocx CheckBox optB = "TRUE (osculating) lunar node.", xt, yt, wt, ht Add yt, ht Ocx CheckBox optC = "BM: include the lunar apogee or Black Moon.", xt, yt, wt, ht

Add yt, ht Ocx CheckBox optD = "TBM: true (osculating) lunar apogee.", xt, yt, wt, ht Add yt, ht Ocx CheckBox optE = "UNEQUAL (European-style) zodiacal chart.", xt, yt, wt, ht Add yt, ht Ocx CheckBox optF = "SWISS EPHEMERIS positions if possible.", xt, yt, wt, ht Add yt, ht Ocx Label path = " PATH to Swiss Ephem files ", xt, yt, wt, ht Ocx TextBox optG = se_path$, 223, Add(yt, 3), 190, 20 .BackColor = white% Add yt, ht Ocx Label ayan_a = " USER-defined Ayanamsa ", xt, yt, wt, ht Ocx Label ayan_b = " epoch ", 275, yt, 100, ht Add yt, 4 Ocx TextBox optH = zayan_a$, 190, yt, 85, 21 .BackColor = white% Ocx TextBox optI = zayan_b$, 330, yt, 83, 21 .BackColor = white% opt1 = geometricas? opt2 = Not basetu? opt3 = basebija? opt4 = basesideral? opt5 = basetopo? opt6 = baseasteroides? opt7 = basenamed? optA = basenodo% > 0 optB = (basenodo% = 2) optC = basenoire% > 0 optD = (basenoire% = 2) optE = base_eu? optF = baseswephem? Do '#################################### ' SWISS EPHEMERIS PATH CHECK: If optF If Exist(ExecPath + "swedll32.dll") se_path = optG.Text If DirExists(se_path$) swe_set_ephe_path(se_path$) Else SEpathAlert optF = False EndIf Else SEdllAlert optF = False EndIf EndIf '#################################### opt7.Enabled = opt6 optB.Enabled = optA optD.Enabled = optC Sleep Exit If prueba? Or aborta? Until Me Is Nothing If Not aborta? se_path = optG.Text zayan_a$ = optH.Text zayan_b$ = optI.Text geometricas? = opt1

If opt2 Then basetu? = False basebija? = opt3 '############### SIDEREAL ################## basesideral? = opt4 If basesideral? version$ = "Riyal for Windows (Sidereal - " + zsideral$(baseayanamsa%) + " )" ayanx = svpx Else version$ = "Riyal for Windows" ayanx = d0 EndIf '############## ASTEROIDES ################# baseasteroides? = opt6 basenamed? = opt7 If baseasteroides? ultimo% = finpl% If basenamed? Then ultimo% = nombrados% For pl% = lun% To ultimo% If pl% <= ub3% Then planets_in_wheel?(pl%) = True Next pl% EndIf '############ SWISS EPHEMERIS ############## baseswephem? = optF If baseswephem? version$ = version + " (Swiss Ephemeris planets)" EndIf Win_1.Caption = version$ ArrayFill prohibe%(), False '########################################### basetopo? = opt5 base_eu? = optE If optA basenodo% = 1 If optB Then Inc basenodo% Else basenodo% = 0 EndIf If optC basenoire% = 1 If optD Then Inc basenoire% Else basenoire% = 0 EndIf If tx <> d0 Then llenaradix EndIf cierradialogo EndProc ' >Function evento() As String If skipdate? Return dgnom$ Else abradialogo(1600, 60, 345, 3900, nul$) prueba? = False aborta? = False Ocx Command cmdOK = "OK", 77, 67, 100, 27 .FontSize = 9 .Default = True .Cancel = True

Ocx TextBox quien = , 21, 30, 213, 20 .Alignment = 2 .MaxLength = 30 .SelText = dgnom$ Ocx Label guia1 = "name of person or event:", 21, 17, 213, 13 .Alignment = 2 .FontSize = 9 simulatecla(VK_TAB) simulatecla(VK_HOME) Do Sleep Exit If prueba? Or aborta? Until Me Is Nothing dgnom$ = @remove_rt(quien.Text) cierradialogo Return dgnom$ EndIf EndFunc ' >Sub c_from_Click cmdOK.Enabled = True to_eqt_2000.Enabled = True to_zod_2000.Enabled = True from_eqt_2000.Enabled = True from_zod_2000.Enabled = True If tx == d0 of_date1.Visible = True of_date2.Visible = True Else to_eqt_date.Enabled = True to_zod_date.Enabled = True from_eqt_date.Enabled = True from_zod_date.Enabled = True EndIf c_from.Refresh text3.Text = nul$ text4.Text = nul$ EndSub >Procedure eqt2zod Local ar As Double, dc As Double, v As Double, d As Single, m As Single, s As Single Local from_equator?, to_equator?, from_j2000?, to_j2000?, epsilon%, planoref% Local Integer xt, yt, wt, ht, bt Local Const izq As Integer = 10 Local Const der As Integer = 232 Local Const little As Integer = 7 Local Const centro As Integer = 2 Local Const grande As Integer = 14 Local Const hms$ = "hrs min sec", dms$ = " ' " + sec$ Local Const ra_2000$ = "J2000 right ascension", dc_2000$ = "J2000 declination" Local Const ra_date$ = "apparent right ascension of date", dc_date$ = "apparen t declination of date" Local Const lon_2000$ = "J2000 longitude", lat_2000$ = "J2000 latitude" Local Const lon_date$ = "apparent longitude of date", lat_date$ = "apparent la titude of date" abradialogo(5360, 60, 345, 6940, " equatorial to zodiacal conversion...") Win_2.FontName = "terminal" Win_2.FontSize = 9 Win_2.FontBold = False

Win_2.BackColor = grey% Win_2.BorderStyle = 2 ' ########### DISPLAY LABELS ############ xt = izq, yt = 200, wt = 209, ht = 20 Ocx Label guia3 = lon_2000$, xt, yt, wt, ht .Alignment = centro .BackColor = crema% .FontSize = little xt = der Ocx Label guia4 = lat_2000$, xt, yt, wt, ht .Alignment = centro .BackColor = crema% .FontSize = little ' ######### DISPLAY THE RESULTS ######### xt = izq, yt = 221, ht = 30 Ocx Label text3 = , xt, yt, wt, ht .FontSize = grande .Alignment = centro .BackColor = brwhite% xt = der Ocx Label text4 = , xt, yt, wt, ht .FontSize = grande .Alignment = centro .BackColor = brwhite% ' ----------------------------------------------------------------------Ocx CheckBox catalog = "use the mean ecliptic of J2000", 12, 170, 206, 16 .FontSize = little .BackColor = crema% ' ############### WARNING ############### xt = der, yt = 168, wt = 206, ht = 12 q$ = " conversion 'of date' is possible" Ocx Label of_date1 = q$, xt, yt, wt, ht .FontSize = little .BackColor = brcyan% .Visible = False Add yt, ht q$ = " only after you enter Riyal data." Ocx Label of_date2 = q$, xt, yt, wt, ht .FontSize = little .BackColor = brcyan% .Visible = False ' ############ EXIT COMMANDS ############ xt = izq, yt = 266, wt = 209, ht = 45 Ocx Command cmdOK = "CONVERT", xt, yt, wt, ht .Default = True xt = der Ocx Command cmdQuit = "EXIT", xt, yt, wt, ht .Cancel = True ' ############ DEFAULT VALUES ########### xt = izq, yt = 40, wt = 67, ht = 20, bt = 71 Ocx RichEdit Text_1a = "0", xt, yt, wt, ht .FontSize = grande .SelAlignment = centro .MaxLength = 3 Add xt, bt Ocx RichEdit Text_1b = "0.0", xt, yt, wt, ht .FontSize = grande .SelAlignment = centro .MaxLength = 6 Add xt, bt

Ocx RichEdit Text_1c = "0", xt, yt, wt, ht .FontSize = grande .SelAlignment = centro .MaxLength = 6 xt = der Ocx RichEdit Text_2a = "0", xt, yt, wt, ht .FontSize = grande .SelAlignment = centro .MaxLength = 4 Add xt, bt Ocx RichEdit Text_2b = "0.0", xt, yt, wt, ht .FontSize = grande .SelAlignment = centro .MaxLength = 6 Add xt, bt Ocx RichEdit Text_2c = "0", xt, yt, wt, ht .FontSize = grande .SelAlignment = centro .MaxLength = 6 ' ############ DEFAULT LABELS ########### xt = izq, yt = 11, wt = 209, ht = 15, bt = 13 Ocx Label guia1a = ra_2000$, xt, yt, wt, ht .Alignment = centro .BackColor = crema% Add yt, bt .FontSize = little Ocx Label guia1b = hms$, xt, yt, wt, 13 .Alignment = centro .BackColor = crema% .FontSize = little xt = der, yt = 11 Ocx Label guia2a = dc_2000$, xt, yt, wt, ht .Alignment = centro .BackColor = crema% .FontSize = little Add yt, bt Ocx Label guia2b = dms$, xt, yt, wt, 13 .Alignment = centro .BackColor = crema% .FontSize = little ' ############ CONVERT FROM ############# xt = 12, yt = 72, wt = 213, ht = 13, bt = 16 Ocx Label convert_from = , xt, yt, wt, 90 .BackColor = crema% Ocx Command c_from = "from:", xt, yt, wt, 17 .ToolTipText = "click to select" Add yt, 22 Ocx Option from_eqt_2000 = "mean equator of J2000", xt, yt, wt, ht .FontSize = little .BackColor = crema% Add yt, bt Ocx Option from_eqt_date = "true equator of date", xt, yt, wt, ht .FontSize = little .BackColor = crema% Add yt, bt Ocx Option from_zod_2000 = "mean ecliptic of J2000", xt, yt, wt, ht .FontSize = little .BackColor = crema% Add yt, bt Ocx Option from_zod_date = "true ecliptic of date", xt, yt, wt, ht

.FontSize = little .BackColor = crema% ' ############# CONVERT TO ############## xt = 225, yt = 72 Ocx Label convert_to = , xt, yt, wt, 90 .BackColor = crema% Ocx Label c_to = "to:", xt, yt, wt, 17 .Alignment = centro .BackColor = crema% Add yt, 22 Ocx Option to_eqt_2000 = "mean equator of J2000", xt, yt, wt, ht .FontSize = little .BackColor = crema% Add yt, bt Ocx Option to_eqt_date = "true equator of date", xt, yt, wt, ht .FontSize = little .BackColor = crema% Add yt, bt Ocx Option to_zod_2000 = "mean ecliptic of J2000", xt, yt, wt, ht .FontSize = little .BackColor = crema% Add yt, bt Ocx Option to_zod_date = "true ecliptic of date", xt, yt, wt, ht .FontSize = little .BackColor = crema% ' ####################################### Repeat Text_1a.SetFocus prueba? = False aborta? = False cmdOK.Enabled = False to_eqt_2000.Enabled = False to_zod_2000.Enabled = False to_eqt_date.Enabled = False to_zod_date.Enabled = False from_eqt_2000.Enabled = False from_zod_2000.Enabled = False from_eqt_date.Enabled = False from_zod_date.Enabled = False to_eqt_2000 = False to_zod_2000 = False to_eqt_date = False to_zod_date = False from_eqt_2000 = False from_zod_2000 = False from_eqt_date = False from_zod_date = False Do Sleep ' THERE ARE 4 POSSIBLE "FROM" CHOICES If from_eqt_2000 ' CHOICE 1 If guia1a.Text <> ra_2000$ Then guia1a.Text = ra_2000$ If guia1b.Text <> hms$ Then guia1b.Text = hms$ If guia2a.Text <> dc_2000$ Then guia2a.Text = dc_2000$ If to_eqt_2000.Enabled Then to_eqt_2000.Enabled = False to_zod_2000.Enabled = True If tx <> d0 to_zod_date.Enabled = True to_eqt_date.Enabled = True EndIf

EndIf If from_zod_2000 ' CHOICE 2 If guia1a.Text <> lon_2000$ Then guia1a.Text = lon_2000$ If guia1b.Text <> dms$ Then guia1b.Text = dms$ If guia2a.Text <> lat_2000$ Then guia2a.Text = lat_2000$ If to_zod_2000.Enabled Then to_zod_2000.Enabled = False to_eqt_2000.Enabled = True If tx <> d0 to_zod_date.Enabled = True to_eqt_date.Enabled = True EndIf EndIf If from_eqt_date ' CHOICE 3 If guia1a.Text <> ra_date$ Then guia1a.Text = ra_date$ If guia1b.Text <> hms$ Then guia1b.Text = hms$ If guia2a.Text <> dc_date$ Then guia2a.Text = dc_date$ If to_eqt_date.Enabled Then to_eqt_date.Enabled = False to_zod_date.Enabled = True to_zod_2000.Enabled = True to_eqt_2000.Enabled = True EndIf If from_zod_date ' CHOICE 4 If guia1a.Text <> lon_date$ Then guia1a.Text = lon_date$ If guia1b.Text <> dms$ Then guia1b.Text = dms$ If guia2a.Text <> lat_date$ Then guia2a.Text = lat_date$ If to_zod_date.Enabled Then to_zod_date.Enabled = False to_zod_2000.Enabled = True to_eqt_date.Enabled = True to_eqt_2000.Enabled = True EndIf ' THERE ARE 4 POSSIBLE "TO" CHOICES If to_eqt_2000 ' CHOICE 1 If guia3.Text <> ra_2000$ Then guia3.Text = ra_2000$ If guia4.Text <> dc_2000$ Then guia4.Text = dc_2000$ EndIf If to_zod_2000 ' CHOICE 2 If guia3.Text <> lon_2000$ Then guia3.Text = lon_2000$ If guia4.Text <> lat_2000$ Then guia4.Text = lat_2000$ EndIf If to_eqt_date ' CHOICE 3 If guia3.Text <> ra_date$ Then guia3.Text = ra_date$ If guia4.Text <> dc_date$ Then guia4.Text = dc_date$ EndIf If to_zod_date ' CHOICE 4 If guia3.Text <> lon_date$ Then guia3.Text = lon_date$ If guia4.Text <> lat_date$ Then guia4.Text = lat_date$ EndIf If (to_eqt_2000 Or to_zod_2000 Or to_eqt_date Or to_zod_date) Exit If prueba? Else prueba? = False EndIf Exit If aborta? Until Me Is Nothing If Not aborta? from_j2000? = (from_zod_2000 Or from_eqt_2000) from_equator? = (from_eqt_date Or from_eqt_2000) to_j2000? = (to_zod_2000 Or to_eqt_2000) to_equator? = (to_eqt_date Or to_eqt_2000) ' ORIGINAL COORDINATES

d = Val(Text_1a.Text), m = Val(Text_1b.Text), s = Val(Text_1c.Text) ar = d + m / n6 + s / ns If from_equator? Then Mul ar, n5 d = Val(Text_2a.Text), m = Val(Text_2b.Text), s = Val(Text_2c.Text) dc = (Abs(d) + m / n6 + s / ns) * Sgn(d) polar2rect(ar, dc, d1, g()) If from_equator? Then planoref% = ecuador% Else planoref% = ecliptica% If from_j2000? And Not to_j2000? ' PRECESS TO DATE IF NECESSARY transformacion(j2000fecha%, planoref%, g()) EndIf If to_j2000? And Not from_j2000? ' PRECESS FROM DATE IF NECESSARY transformacion(fechaj2000%, planoref%, g()) EndIf If (catalog Or tx = d0) Then epsilon% = e2000% Else epsilon% = etrue% If from_equator? And Not to_equator? ' CONVERT TO ECLIPTIC ecuatoriales(-epsilon%, g()) EndIf If to_equator? And Not from_equator? ' CONVERT TO EQUATORIAL ecuatoriales(epsilon%, g()) EndIf rect2polar(g(), ar, dc, v) If catalog Or tx = d0 If to_equator? If to_j2000? And Not from_j2000? tresxtres(g(), nut()) Else If from_j2000? And Not to_j2000? tres(g(), nut()) EndIf rect2polar(g(), ar, dc, v) Else ' ecliptic If to_j2000? And Not from_j2000? Sub ar, cd(lnut%) Else If from_j2000? And Not to_j2000? Add ar, cd(lnut%) EndIf EndIf EndIf fseg2(kg%, dc, 0, q2$) text4.Text = Trim$(q2$) If to_equator? fseg2(k4%, ar / n5, 0, q2$) Else fsigno(1, ar, 0, signo%, q$, q2$) d = Frac(ar / n3) * n3 If d == n3 Then d = d0 fseg2(kg%, d, 0, q2$) Mid$(q2$, 1) = nul$ q2$ = q2$ + " " + sgaux$(signo%) EndIf text3.Text = Trim$(q2$) EndIf Until aborta? cierradialogo EndProc ' >Sub cajita_Click(p%)

Local cl% = cajita(p%).BackColor If cl% = brwhite% Or cl% = brcyan% Or cl% = crema% If contador% < plmax% cajita(p%).BackColor = yellow% Inc contador% Else Win_2.Caption = " erase one to select another! (maximum=" + Str$(plmax%) + ")" EndIf Else If p% = aux% cajita(p%).BackColor = crema% Else If p% > planeta% Then cajita(p%).BackColor = brcyan% Else cajita(p%).BackC olor = brwhite% EndIf Win_2.Caption = " - choose " + z$ + "!" If contador% > 0 Dec contador% EndIf EndIf EndSub >Procedure dlgplanetas(y$, ByRef pl1%, ByRef pl2%, top%, cuantos%) Local Const largo% = 18 Global plf% = 0, plg% = 0, plmax%, z$ abradialogo(5980, 60, 345, 8890, " - choose " + y$ + ":") Ocx Command cmdok = "OK", 5, 4, 284, 33 .FontSize = 9 .Default = True Ocx Command cmdQuit = "Cancel", 293, 4, 284, 33 .FontSize = 9 .Cancel = True contador% = 0 For pl% = lun% To allplanets% If condicion?(pl%, top%) ix% = Add(4, Mul(32, Sub(Pred(pl%), Mul(largo%, Pred(pl%) Div largo%)))) iy% = Add(40, Mul(32, Pred(pl%) Div largo%)) q$ = Left$(plaux$(pl%), 4) Ocx Label cajita(pl%) = q$, ix%, iy%, 30, 30 cajita(pl%).FontSize = 6 cajita(pl%).FontBold = True If pl% > planeta% Then cajita(pl%).BackColor = brcyan% Else cajita(pl%).Ba ckColor = brwhite% If pl% = aries% Then cajita(aux%).BackColor = crema% cajita(pl%).Alignment = 2 cajita(pl%).Appearance = 4 If pl% > ultimo% And top% <> allplanets% Select top% Case m_c% If pl% < nodo% Or pl% > m_c% Then cajita(pl%).Enabled = False Default ' ultimo%, finpl% cajita(pl%).Enabled = False EndSelect EndIf If opcion% = obj% cajita(pl%).Enabled = True If planets_in_wheel?(pl%) Inc contador% cajita(pl%).BackColor = yellow% EndIf

cajita(pl%).Text = q$ EndIf '********* SWISS EPHEMERIS ERROR PLANETS ********** If prohibe%(pl%) cajita(pl%).Enabled = False cajita(pl%).BackColor = brwhite% EndIf '************************************************** EndIf Next pl% If opcion% = obj% For j% = gq1% To top% If j% <= ultimo% Select j% Case oo7%, aw7%, ux5%, tx3%, tc3%, vq4%, xx3%, gm7%, bl4%, dh5% Inc dummy% Default cajita(j%).Enabled = False EndSelect EndIf Next j% EndIf If top% >= aux% cajita(aux%).BackColor = crema% cajita(aux%).Text = "Aux" EndIf plmax% = cuantos% z$ = y$ clear_seq prueba? = False aborta? = False Do Sleep ' BUILD THE WHOLE GROUP clear_seq For pl% = lun% To allplanets% If condicion?(pl%, top%) If cajita(pl%).BackColor = yellow% set_in_seq(pl%) EndIf EndIf Next pl% ' FIND PL1 AND PL2: plf% = @first_in_seq() plg% = @last_in_seq() ' CHECK THAT THEY ARE VALID If cuantos% <= 2 And plf% = 0 Then prueba? = False prueba? = prueba? And (plf% <= ultimo% Or plf% = nodo% Or plf% = asc% Or plf % = m_c%) prueba? = prueba? And (plg% <= ultimo% Or plg% = nodo% Or plg% = asc% Or plg % = m_c%) Exit If aborta? Or prueba? Until Me Is Nothing cierradialogo If Not aborta? pl1% = plf% pl2% = plg% If pl1% = aux% Or pl2% = aux% Then plaux$(aux%) = npaux$ Else pl1% = False

pl2% = False EndIf Clear plf%, plg%, plmax%, z$ EndProc >Function condicion?(p%, tp%) Local condition? condition? = p% <= tp% And p% <= ultimo% condition? = (inrange(p%, aries%, m_c%) And opcion% <> car%) Or condition? condition? = (opcion% = fen% Or opcion% = gpr% Or opcion = tst%) Or condition? condition? = (p% > planeta% And p% <= tp%) Or condition? Return condition? EndFunc ' >Sub cmdCowell_Click prueba? = True rk5? = True aborta? = False >Sub cmdNom_Click If dbfile? elemfile? = True leefile? = True elements.Visible = True cmdok.Enabled = False cmdCowell.Enabled = False cmdQuit.Enabled = False cmdNom.Enabled = False elements.SetFocus Else leefile? = False Alert 1, "|NO ELEMENTS FILE!", 1, " n% EndIf '##B# >Sub elements_KeyPress(Ascii&) leefile? = False If Ascii& = 27 elemfile? = False elements.Visible = False cmdok.Enabled = True cmdCowell.Enabled = True cmdQuit.Enabled = True cmdNom.Enabled = True EndIf >Sub elements_DblClick If elements.SelectedCount leefile? = False elemfile? = False elements.Visible = False cmdok.Enabled = True cmdCowell.Enabled = True cmdQuit.Enabled = True cmdNom.Enabled = True EndIf >Sub elements_MouseDown(Button&, Shift&, x!, y!) If Button& = MK_RBUTTON leefile? = False elemfile? = False elements.Visible = False cmdok.Enabled = True

ENTER

",

cmdCowell.Enabled = True cmdQuit.Enabled = True cmdNom.Enabled = True Else leefile? = False EndIf EndSub >Procedure inputosc Local Double j0, gl, bl, ar, dc, dt1, dt2, s$, neo? Local Integer xt, yt, wt, ht, bt Local Const grande As Integer = 14 Local Const little As Integer = 7 Local Const centro As Integer = 2 Global s1$, s2$, s3$, s4$, s5$, s6$, s7$, s8$, lvit As ListItem Global rk5? = False, leefile? = False, elemfile? = False, dbfile? = False s$ = " osculating orbital elements" abradialogo(6200, 60, 345, 5600, s$) Win_2.FontSize = 9 ' ---------------------------------------------------------xt = 17, yt = 333, wt = 107, ht = 37, bt = 113 Ocx Command cmdOK = "calculate", xt, yt, wt, ht Add xt, bt Ocx Command cmdCowell = "integrate", xt, yt, wt, ht .Default = True Add xt, bt Ocx Command cmdQuit = "Exit", xt, yt, wt, ht .Cancel = True ' ---------------------------------------------------------xt = 13, wt = 153, ht = 15, bt = 41 Ocx Command cmdNom = Upper$(npaux$), xt, 12, wt, 19 .FontSize = grande yt = 39 Ocx Label guiaSE = "semi-major axis", xt, yt, wt, ht .Alignment = centro .FontSize = little Add yt, bt Ocx Label guiaLM = "mean anomaly", xt, yt, wt, ht .Alignment = centro .FontSize = little Add yt, bt Ocx Label guiaPH = "argument of perihelion", xt, yt, wt, ht .Alignment = centro .FontSize = little Add yt, bt Ocx Label guiaEX = "eccentricity", xt, yt, wt, ht .Alignment = centro .FontSize = little Add yt, bt Ocx Label guiaIN = "inclination", xt, yt, wt, ht .Alignment = centro .FontSize = little Add yt, bt Ocx Label guiaNA = "ascending node", xt, yt, wt, ht .Alignment = centro .FontSize = little Add yt, bt Ocx Label guiajuliano = "julian day", xt, yt, wt, ht .Alignment = centro .FontSize = little ' ----------------------------------------------------------

yt = 55, ht = 17 Ocx RichEdit dlax = seaux, xt, yt, wt, ht .SelAlignment = 3 .BackColor = brwhite% .FontSize = grande .SetFocus Add yt, bt Ocx RichEdit dlvl = lmaux, xt, yt, wt, ht .SelAlignment = 3 .BackColor = brwhite% .FontSize = grande Add yt, bt Ocx RichEdit dlpn = phaux, xt, yt, wt, ht .SelAlignment = 3 .BackColor = brwhite% .FontSize = grande Add yt, bt Ocx RichEdit dlec = exaux, xt, yt, wt, ht .SelAlignment = 3 .BackColor = brwhite% .FontSize = grande Add yt, bt Ocx RichEdit dlcl = inaux, xt, yt, wt, ht .SelAlignment = 3 .BackColor = brwhite% .FontSize = grande Add yt, bt Ocx RichEdit dlan = naaux, xt, yt, wt, ht .SelAlignment = 3 .BackColor = brwhite% .FontSize = grande Add yt, bt Ocx RichEdit juliano = j0aux, xt, yt, wt, ht .SelAlignment = 3 .BackColor = brwhite% .FontSize = grande ' ---------------------------------------------------------xt = 193, yt = 303, ht = 17, bt = 120 Ocx Label guiastep = "int. step in days", xt, yt, 119, ht .Alignment = centro .FontSize = little Add xt, bt Ocx RichEdit stepsize = "12", xt, yt, 33, ht .BackColor = brwhite% .FontSize = grande .MaxLength = 2 ' ---------------------------------------------------------xt = 205, yt = 9, wt = 133, ht = 15, bt = 36 Ocx Label guiaFecha = "TARGET DATE: D-M-Y", xt, yt, wt, ht .Alignment = centro .FontSize = little .BackColor = grey% .ForeColor = brwhite% .Appearance = basThreeD Add yt, bt Ocx Label guiaHora = "TARGET GMT TIME", xt, yt, wt, ht .Alignment = centro .FontSize = little .BackColor = grey% .ForeColor = brwhite%

.Appearance = basThreeD yt = 25, ht = 18 Ocx RichEdit dlfecha = "01 01 1900", xt, yt, wt, ht .SelAlignment = centro .FontSize = grande .BackColor = brcyan% .MaxLength = 11 Add yt, bt Ocx RichEdit dlhora = "00 00 00", xt, yt, wt, ht .SelAlignment = centro .FontSize = grande .BackColor = brcyan% .MaxLength = centro ' ---------------------------------------------------------xt = 200, yt = 277, wt = 67, ht = 13, bt = 76 Ocx Option aparente = "of date", xt, yt, wt, ht .FontSize = little .DoClick Add xt, bt Ocx Option catalogo = "J2000", xt, yt, wt, ht .FontSize = little ' ---------------------------------------------------------xt = 193, yt = 109, wt = 160, ht = 20, bt = 43 Ocx Label textLON = , xt, yt, wt, ht .FontSize = grande .Alignment = centro .BackColor = brwhite% Add yt, bt Ocx Label textLAT = , xt, yt, wt, ht .FontSize = grande .Alignment = centro .BackColor = brwhite% yt = 207 Ocx Label textAR = , xt, yt, wt, ht .FontSize = grande .Alignment = centro .BackColor = brwhite% Add yt, bt Ocx Label textDEC = , xt, yt, wt, ht .FontSize = grande .Alignment = centro .BackColor = brwhite% yt = 93, ht = 15 Ocx Label guia1 = "longitude", xt, yt, wt, ht .Alignment = centro Add yt, bt Ocx Label guia2 = "latitude", xt, yt, wt, ht .Alignment = centro yt = 191 Ocx Label guia3 = "right ascension", xt, yt, wt, ht .Alignment = centro Add yt, bt Ocx Label guia4 = "declination", xt, yt, wt, ht .Alignment = centro ' ---------------------------------------------------------' AFTER DRAWING THE DIALOG, LOAD THE ELEMENTS DATABASE IN THE BACKGROUND If Exist(ExecPath + "named.dat") Open ExecPath + "named.dat" for Input As # 11 elemfile? = True dbfile? = True

elements.Clear elements.Height = Sub(hv%, 45) While Not EOF(# 11) Input # 11, s1$, s2$, s3$, s4$, s5$, s6$, s7$, s8$ Set lvit = elements.Add lvit.AllText = s1$ + ";" + s8$ + ";" + s3$ + ";" + s7$ + ";" + s4$ + ";" + s6$ + ";" + s5$ + ";" + s2$ Wend elements.Sort 0, True Close # 11 EndIf Repeat prueba? = False aborta? = False leefile? = False Do Sleep If leefile? And elemfile? ' USER CLICKED ON cmdNom. FILE IS NOW ON DISPLAY... Do : Sleep : Until Not leefile? ' USER CHOSE. NOW FEED THE DIALOG WITH THE ELEMENTS If elements.SelectedCount cmdNom.Text = Upper$(Trim$(elements.SelectedItem.SubItems(0))) dlax.Text = Trim$(elements.SelectedItem.SubItems(1)) dlvl.Text = Trim$(elements.SelectedItem.SubItems(2)) dlec.Text = Trim$(elements.SelectedItem.SubItems(3)) dlpn.Text = Trim$(elements.SelectedItem.SubItems(4)) dlcl.Text = Trim$(elements.SelectedItem.SubItems(5)) dlan.Text = Trim$(elements.SelectedItem.SubItems(6)) juliano.Text = Trim$(elements.SelectedItem.SubItems(7)) EndIf leefile? = True EndIf ' NOW WAIT FOR USER CLICKING ON THE DIALOG npaux$ = Trim$(cmdNom.Text) seaux = Val(dlax.Text) lmaux = Val(dlvl.Text) exaux = Val(dlec.Text) phaux = Val(dlpn.Text) inaux = Val(dlcl.Text) naaux = Val(dlan.Text) j0aux = Val(juliano.Text) Exit If aborta? Or prueba? Until Me Is Nothing If Not aborta? q$ = dlfecha.Text jd| = Add(@num(1, kd%), @num(2, 1)) jm| = Add(@num(4, kd%), @num(5, 1)) ja% = Add(Add(@num(7, kl%), @num(8, kc%)), Add(@num(9, kd%), @num(10, 1))) prueba? = (jm| > 0 And jm| <= k2%) And jd| < 32 And (ja% <= 3400 And ja% > = 600) If prueba? Win_2.Caption = s$ ' GET JD AND DELTA-T OF EPOCH j0 = j0aux - jp ' GET TARGET JD AND DELTA-T getdj(jd|, jm|, ja%) q$ = dlhora.Text tu = @num(1, kd%) + @num(2, 1) + (@num(4, kd%) + @num(5, 1)) / n6 + (@nu m(7, kd%) + @num(8, 1)) / ns

Add dj, tu / n4 efemerides(0, 0) vsop82(sol%, sol%) se = seaux lm = Rad(lmaux) ex = exaux ph = Rad(phaux) in = Rad(inaux) na = Rad(naaux) prueba? = se > d0 And (lm >= d0 And lm <= d2pi) And prueba? prueba? = (in >= d0 And in <= PI) And (na >= d0 And na <= d2pi) And prue ba? prueba? = (j0 > lowmin And j0 < lowmax) And prueba? neo? = ((se * (d1 - ex)) <= d1) And rk5? prueba? = prueba? And Not neo? If prueba? dc = Val(stepsize.Text) ph = @rmdl(ph + na) If Not rk5? lm = @rmdl(lm + ph + kg / (se ^ 1.5) * (dj - j0)) Else lm = @rmdl(lm + ph) EndIf osc(aux%, ax%) = se osc(aux%, vl%) = lm osc(aux%, ec%) = ex osc(aux%, pn%) = ph osc(aux%, cl%) = in osc(aux%, an%) = na vectores(aux%, r(), v()) If rk5? Then integrat((j0 + dt1), (dj + dt2), dc * d2) transformacion(j2000fecha%, ecliptica%, r()) transformacion(j2000fecha%, ecliptica%, v()) If rk5? Then osculacion(aux%, r(), v()) pqposicion(aux%) bl = vc(aux%, latitud%) dc = vc(aux%, declinacion%) ar = vc(aux%, ascensionrecta%) gl = vc(aux%, longitud%) If catalogo Then prigurosa(j2000, dj, ar, dc) nortesur(bl, 0, q2$) 'fseg2(kg%, bl, 0, q2$) textLAT.Text = Trim$(q2$) nortesur(dc, 0, q2$) textDEC.Text = Trim$(q2$) fminutos(k4%, ar / n5, 1, 0, q2$) textAR.Text = Trim$(q2$) fsigno(0, gl, 0, signo%, q$, q2$) textLON.Text = Trim$(q$) Else If neo? Win_2.Caption = " inside the Earth's orbit!" Else Win_2.Caption = " error in the orbital elements!" EndIf Close # 3 Else Win_2.Caption = " error in the target date!" EndIf EndIf rk5? = False

Until aborta? cierradialogo If tx <> d0 Then llenaradix Clr rk5?, leefile?, elemfile?, dbfile? Clr s1$, s2$, s3$, s4$, s5$, s6$, s7$, s8$ Set lvit = Nothing EndProc ' >Procedure dlgephemstep(ByRef dj0 As Double, ByRef dj1 As Double, ByRef paso As Single) abradialogo(3000, 60, 345, 3000, nul$) Ocx Command cmdOK = "GO!", 25, 160, 67, 27 .FontSize = 9 .Default = True Ocx Command cmdQuit = "Cancel", 102, 160, 67, 27 .FontSize = 9 .Cancel = True Ocx RichEdit Text1a = "1", 17, 32, 53, 20 .SelAlignment = 2 .BackColor = brwhite% .MaxLength = 2 Ocx RichEdit Text1b = "1", 72, 32, 53, 20 .SelAlignment = 2 .BackColor = brwhite% .MaxLength = 2 Ocx RichEdit Text1c = "2005", 127, 32, 53, 20 .SelAlignment = 3 .BackColor = brwhite% .MaxLength = 5 Ocx RichEdit Text2a = "1", 17, 80, 53, 20 .SelAlignment = 2 .BackColor = brwhite% .MaxLength = 2 Ocx RichEdit Text2b = "1", 72, 80, 53, 20 .SelAlignment = 2 .BackColor = brwhite% .MaxLength = 2 Ocx RichEdit Text2c = "2012", 127, 80, 53, 20 .SelAlignment = 3 .BackColor = brwhite% .MaxLength = 5 Ocx Label guia1 = "start: dd-mm-yyyy", 17, 16, 163, 15 .Alignment = 2 .FontSize = 9 Ocx Label guia2 = "end: dd-mm-yyyy", 17, 64, 163, 15 .Alignment = 2 .FontSize = 9 Ocx Label guia3 = "step in days:", 19, 120, 107, 20 .FontSize = 7 .Alignment = 2 .BackColor = brcyan% Ocx RichEdit step = "1", 128, 120, 51, 20 .SelAlignment = 2 .MaxLength = 6 .BackColor = brwhite% Repeat prueba? = False aborta? = False Do Sleep

Exit If prueba? Or aborta? Until Me Is Nothing If Not aborta? ja% = Val(Text1c.Text) jm| = Val(Text1b.Text) jd| = Val(Text1a.Text) If (jm| > 0 And jm| <= k2%) And jd| < 32 And (ja% <= 8000 And ja% >= (-471 3)) getdj(jd|, jm|, ja%) dj0 = dj ja% = Val(Text2c.Text) jm| = Val(Text2b.Text) jd| = Val(Text2a.Text) If (jm| > 0 And jm| <= k2%) And jd| < 32 And (ja% <= 8000 And ja% >= (-4 713)) getdj(jd|, jm|, ja%) dj1 = dj prueba? = True Else prueba? = False ilegal EndIf Else prueba? = False ilegal EndIf paso = Val(step.Text) If paso < d0 And dj1 > dj0 Then prueba? = False If paso > d0 And dj1 < dj0 Then prueba? = False EndIf pb.Min = dj0 pb.Max = dj1 Until aborta? Or prueba? cierradialogo EndProc ' >Procedure ilegal Alert 1, " your input is wrong!| please try again...", 1, Space$(22) + "retry " + Space$(22), n% EndProc ' ' ###################################################################### ' IMPLEMENTATION MODULE MSearch ' ###################################################################### ' >Procedure transitsearch Local Double binary, dj1, dj2, mrx, gl, djminimo Local paso As Single, cc%, idx%, pl1%, pl2% = 0, pl1b%, pl2b%, h$ = nul$ Global q3$, q4$, find0% = 0, angular? = False, heliocentric? = False, pausa? = False, tr2tr? = False Global Double djlimite, gcorr q2$ = " conjunction / opposition | 4th harmonic |5th harmonic|7th harmonic|1 2th harmonic" q2$ = q2$ + "|declination|right ascension|high precision longitude|heliocentri c longitude|user-defined longitude" Alert 0 | 16, nul$, 1, q2$ + "|CANCEL", find0% ' input user-dfined position If find0% = 10 q$ = "Enter user-defined position here, then choose the transiting planet. " q$ = q$ + "Please use decimal and whole-circle notation."

q2$ = InputBox(q$, " USER LONGITUDE", "194.033") mrx = Val(q2$) If q2$ = nul$ Or mrx = d0 Then find0% = 0 EndIf If find0% <= kd% And find0% > 0 Cls dlgplanetas("only 1 or 2 planets", pl1%, pl2%, planeta%, 2) If find0% = 9 h$ = "helio " heliocentric? = True If (pl1% >= aries% And pl1% <= planeta%) Or (pl2% >= aries% And pl2% <= pl aneta%) pausa? = True EndIf If pl2% = lun% Then pl2% = 0 If pl1% = lun% Then pl1% = 0 EndIf If pl1% = aries% Or pl2% = aries% pausa? = True Else If pl1% If find0 <> kd% If pl2% = 0 Then pl2% = pl1% If pl2% <> pl1% q2$ = " transits of " + h$ + plaux$(pl2%) + " over radix " + h$ + plau x$(pl1%) q3$ = " transits of " + h$ + plaux$(pl1%) + " over radix " + h$ + plau x$(pl2%) q4$ = " transits of " + h$ + plaux$(pl1%) + " over transiting" + h$ + plaux$(pl2%) Alert 2 | 16, nul$, 1, q2$ + "|" + q3$ + "|" + q4$ + "|CANCEL", n% If n% = 1 Then Swap pl1%, pl2% If n% = 3 Then tr2tr? = True Else tr2tr? = False If n% = 0 Or n% > 3 Then aborta? = True Else q3$ = " transits of " + h$ + plaux$(pl1%) + " over radix " + h$ + plau x$(pl2%) Alert 2 | 16, nul$, 1, q3$ + "|CANCEL", n% If n% = 0 Or n% = 2 Then aborta? = True EndIf If pl2% > planeta% And Not tr2tr? Print "extra planets not allowed as radix yet... sorry!" pausa? = True EndIf Else pl2% = 0 EndIf If Not pausa? And Not aborta? Select find0% Case 1 To 5, 8 To 10 ' longitude idx% = longitud% angular? = True armonica = d1 If find0% = 2 Then armonica = d2 If find0% = 3 Then armonica = d5 If find0% = 4 Then armonica = 7 If find0% = 5 Then armonica = d6 Case 6 ' declination idx% = declinacion% Case 7 ' right ascension idx% = ascensionrecta%

angular? = True EndSelect dlgephemstep(dj1, dj2, paso) If dj1 < tx Then dj1 = tx dj = dj1 If pl1% > plu% And Not @withinrange(pl1%) Then pausa? = True If pl2% > plu% And Not @withinrange(pl2%) Then pausa? = True If paso > d0 And Not pausa? If paso = d1 Select pl1% Case BML% paso = d2 / d6 Case asc%, m_c% paso = p2 ' 14.4 minutes Case lun% paso = d3 / d5 Case sol% To mar%, nodo%, ceres% To Pred(damocles%) paso = d3 Case jup%, sat%, damocles% To allplanets% paso = md Default paso = 20 EndSelect If heliocentric? Then paso = paso / z5 EndIf abralostodos(True) nombre$ = h$ + plaux$(pl1%) pl1b% = pl1% pl2b% = pl2% suspendwrite? = True cmdStop.Visible = True If baseimpresora? Then tb.Text = "WRITING TO " + saletexto$ tb.Visible = True tb.ScrollBars = basNoScroll tb.Text = nul$ + crlf$ If tr2tr? mrx = d0 Else If find0% <> kd% mrx = Abs(radix(pl2%, idx%)) If idx% = longitud% If heliocentric? Then mrx = heliorx(pl2%) mrx = @mdl((mrx + ayanx) * armonica) EndIf EndIf bandera% = 8 contador% = 0 For cc% = 1 To 3 ' start of range control: If cc% = 1 ' limits for type I converse transits djlimite = d2 * tx - dj1 djminimo = d2 * tx - dj2 Else If cc% = 3 ' limits for type II converse transits djlimite = d2 * dj2 - tx djminimo = d2 * dj1 - tx Else ' limits for direct transits djlimite = dj2 djminimo = dj1

EndIf Print If pl1% > cz8% If djminimo < D1702 Then djminimo = D1702 If djlimite > D2018 Then djlimite = D2018 EndIf If (pl1% > plu% And pl1% <= cz8%) If baselong? If djminimo < Dlong Then djminimo = Dlong If djlimite > D2103 Then djlimite = D2103 Else If djminimo < D1702 Then djminimo = D1702 If djlimite > D2018 Then djlimite = D2018 EndIf EndIf ' end of range control pb.Refresh pb.Min = djminimo pb.Max = djlimite pb.Visible = True binary = djminimo pausa? = False Repeat baselow? = (binary < lowmax And binary > lowmin) And Not (find0% = 8) binary = @solve0(binary, pl1%, pl2%, idx%, paso, mrx) If cc% = 1 And (binary > djlimite And binary < dj1) binary = djlimite ' out of range converse Else If cc% = 2 And (binary < dj1 Or binary > dj2) binary = djlimite ' out of range direct Else If cc% = 3 And (binary < djminimo Or binary > djlimite) binary = djlimite ' out of range type II Else If Not pausa? And Not aborta? If cc% = 3 ' type II converse getfecha((dj + tx) / d2, jd|, jm|, ja%) Else If cc% = 2 ' direct getfecha(dj, jd|, jm|, ja%) Else ' type I converse getfecha(d2 * tx - dj, jd|, jm|, ja%) EndIf Select find0% Case 1 To 5, 8 To 9 ' longitud If tr2tr? fsigno(0, vc(pl1%, longitud%), 0, signo%, q$, q2$) corrfont q3$ = q2$ fsigno(0, vc(pl2%, longitud%), 0, signo%, q$, q2$) corrfont q$ = q3$ + " " + q2$ Else If heliocentric? gcorr = heliop(pl1%, hlon%) Else gcorr = vc(pl1%, longitud%) EndIf fsigno(0, gcorr, 0, signo%, q$, q2$) corrfont If heliocentric? gl = @mdl(heliorx(pl2%) + ayanx)

Else gl = @mdl(radix(pl2%, idx%) + ayanx) EndIf fminutos(kg%, @angdist(gcorr + cd(ayanamsa%), gl), 0, 0, q 2$) q$ = q$ + " " + q2$ EndIf Case kd% ' user-defined longitud gcorr = vc(pl1%, longitud%) fsigno(0, vc(pl1%, longitud%), 0, signo%, q$, q2$) corrfont gl = @mdl(mrx + ayanx) fminutos(kg%, @angdist(gcorr + cd(ayanamsa%), gl), 0, 0, q2$ ) q$ = q$ + " " + q2$ + " " Case 7 ' ascension recta fminutos(kg%, gcorr, 1, 0, q$) Case 6 nortesur(gcorr, 0, q$) EndSelect If tr2tr? q2$ = nombre$ + "/" + plaux$(pl2%) + spc$ + q$ + " " Else If find0% = kd% q2$ = nombre$ + " " + q$ Else q2$ = nombre$ + " " + q$ + spc$ + plaux$(pl2%) EndIf If cc% = 1 q2$ = q2$ + "c1" Else If cc% = 3 q2$ = q2 + "c2" Else q2$ = q2 + "d." EndIf q2$ = q2$ + " " + Str$(jd|, 2) + "/" + Str$(jm|, 2) + "/" + S tr$(ja%, 4) fminutos(k4%, tu, Add(1, baselow?), 0, q$) ftab(0, q2$ + q$) baja(xi%) If Not baseimpresora? If contador% = Add(27, Mul(2, low?)) Then tb.ScrollBars = ba sVertical tb.Text = tb.Text + Space(6) + q2$ + spc$ + q$ + crlf$ Inc contador% If InKey$ = spc$ Then pausa? = True EndIf EndIf pl1% = pl1b% pl2% = pl2b% EndIf Until (binary >= djlimite) Or aborta? Or pausa? Or (binary < djminim o) ftab(0, String$(64, "_")) baja(yi%) tb.Text = tb.Text + Space(6) + String$(64, "_") + crlf$ + crlf$ Inc contador% Next cc% cmdStop.Visible = False pantalla abralostodos(False)

aborta? = True If tx <> d0 llenaradix Else nuevo EndIf EndIf EndIf Else pausa? = True EndIf If pausa? And Not aborta? Print range$ pantalla EndIf baselow? = False EndIf Clr q3$, q4$, find0%, angular?, heliocentric?, pausa?, tr2tr?, djlimite, gcorr EndProc ' >Sub srch16_Click srch16 = True If srch16 user16.Visible user16.SetFocus EndIf EndSub >Sub srch11_Click srch11 = True If srch11 q$ = "|CHOOSE|THE|ASPECT|HARMONIC|TO SEARCH" Alert 0 | 16, q$, 2, "2|4|5|7|12|24" + "|CANCEL", n% EndIf If n% = 7 srch11 = False Else If n% = 1 Then srcharmon = d1 If n% = 2 Then srcharmon = d2 If n% = 3 Then srcharmon = d5 If n% = 4 Then srcharmon = caldeo% If n% = 5 Then srcharmon = d6 If n% = 6 Then srcharmon = n2 EndIf EndSub >Procedure search Local Double binary, dj1, m, d Local paso As Single, idx%, pl1%, pl2% = 0, pl1b%, pl2b%, xt%, xbt%, yt%, wt%, ht%, h$ = nul$ Global q3$, find0% = 0, angular? = False, heliocentric? = False, pausa? = Fals e, djlimite, srcharmon abradialogo(4600, 60, 345, 9340, nul$) Win_2.FontSize = 9 Win_2.BackColor = grey% Win_2.BorderStyle = 2 prueba? = False aborta? = False xt% = 10, xbt% = 308, yt% = 250, wt% = 293, ht% = 36 Ocx Command cmdOK = "OK", xt%, yt%, wt%, ht% .Appearance = basThreeD .Default = True

Ocx Command cmdQuit = "Cancel", xbt%, yt%, wt%, ht% .Cancel = True .Appearance = basThreeD yt% = 10, ht% = 23 Ocx Option srch1 = "PERIHELIA / APHELIA", xt%, yt%, wt%, ht% Ocx Option srch5 = "GEOCENTRIC LATITUDE = 0", xbt%, yt%, wt%, ht% Add yt%, ht% Ocx Option srch2 = "HELIOCENTRIC DISTANCE CROSSING", xt%, yt%, wt%, ht% Ocx Option srch6 = "MAXIMUM NORTH/SOUTH LATITUDE", xbt%, yt%, wt%, ht% Add yt%, ht% Ocx Option srch3 = "HELIOCENTRIC LATITUDE = 0", xt%, yt%, wt%, ht% Ocx Option srch7 = "DECLINATION = 0", xbt%, yt%, wt%, ht% Add yt%, ht% Ocx Option srch4 = "HELIO LONGITUDE: 4th HARMONIC", xt%, yt%, wt%, ht% Ocx Option srch8 = "MAXIMUM NORTH/SOUTH DECLINATION", xbt%, yt%, wt%, ht% Add yt%, ht% Ocx Option srch9 = "APOGEE / PERIGEE", xt%, yt%, wt%, ht% Ocx Option srch10 = "STATIONARY IN LONGITUDE", xbt%, yt%, wt%, ht% Add yt%, ht% Ocx Option srch15 = "GALACTIC CENTER AXIS", xt%, yt%, wt%, ht% Ocx Option srch11 = "ASPECTS IN GEOCENTRIC LONGITUDE", xbt%, yt%, wt%, ht% Add yt%, ht% Ocx Option srch17 = "PLANETOCENTRIC DISTANCE", xt%, yt%, wt%, ht% Ocx Option srch12 = "SIGN INGRESS", xbt%, yt%, wt%, ht% Add yt%, ht% Ocx Option srch18 = "MAX/MIN TRUE ANGULAR SEPARATION", xt%, yt%, wt%, ht% Ocx Option srch13 = "OUT OF BOUNDS", xbt%, yt%, wt%, ht% Add yt%, ht% Ocx Option srch19 = "STATIONARY SOLAR BARYCENTER", xt%, yt%, wt%, ht% Ocx Option srch14 = "PARALLEL / CONTRA-PARALLEL", xbt%, yt%, wt%, ht% Add yt%, ht% Ocx Option srch16 = "USER DEFINED POSITION", xt%, yt%, wt%, ht% Ocx RichEdit user16 = srchUser$, 200, Add(yt%, 4), 100, 13 .SelLength = 10 .MaxLength = 10 .SelStart = 0 .Visible = False Ocx Label filler0 = nul$, xbt%, yt%, wt%, ht% Do Sleep user16.Visible = srch16 Exit If prueba? Or aborta? Until Me Is Nothing If srch16 srchUser$ = user16.Text srcharmon = Val(user16.Text) If srcharmon <= d0 Or srcharmon >= ng Then aborta? = True EndIf If Not aborta? If srch1 Then find0% = srPeriAfe If srch2 Then find0% = srHeliDis If srch3 Then find0% = srHeliLat If srch4 Then find0% = srHeliLon If srch5 Then find0% = srCeroLat If srch6 Then find0% = srMaxiLat If srch7 Then find0% = srCeroDec If srch8 Then find0% = srMaxiDec If srch9 Then find0% = srApoPeri If srch10 Then find0% = srStation If srch11 Then find0% = srAspects

If srch12 Then find0% = srIngress If srch13 Then find0% = srOutBoun If srch14 Then find0% = srParalel If srch15 Then find0% = srGCalign If srch16 Then find0% = srUserPos If srch17 Then find0% = srPlcentr If srch18 Then find0% = srTrueAng If srch19 Then find0% = srBariSun cierradialogo EndIf cierradialogo If find0% <= srLastOne And find0% > 0 Cls If find0% <> srBariSun dlgplanetas("only 1 or 2 planets", pl1%, pl2%, allplanets%, 2) Else pl1% = sol% EndIf If pl1% = pl2% Then pl2% = 0 If pl1% = aries% Or pl2% = aries% pausa? = True Else If pl1% Select find0% Case srPeriAfe idx% = hdr% pl2% = 0 heliocentric? = True If pl1% <= sol% Then pausa? = True Case srHeliDis idx% = hdis% heliocentric? = True If pl1% <= sol% Then pausa? = True If pl2% <= sol% Then pausa? = True Case srHeliLat idx% = hlat% pl2% = 0 heliocentric? = True If pl1% <= sol% Then pausa? = True Case srHeliLon idx% = hlon% angular? = True heliocentric? = True If pl2% = 0 Then pausa? = True If pl2% = lun% Or pl1% = lun% Then pausa? = True Case srCeroLat pl2% = 0 idx% = latitud% Case srMaxiLat pl2% = 0 idx% = velobl% Case srCeroDec idx% = declinacion% pl2% = 0 Case srMaxiDec idx% = veldec% pl2% = 0 Case srApoPeri idx% = velorv% pl2% = 0 If pl1% = BML% Then pausa? = True

Case srStation, srBariSun idx% = velocidad% pl2% = 0 Case srAspects, srTrueAng idx% = longitud% angular? = True If pl2% = 0 Then pausa? = True Case srIngress, srUserPos idx% = longitud% angular? = True pl2% = 0 Case srOutBoun idx% = declinacion% pl2% = 0 Case srParalel idx% = declinacion% If pl2% = 0 Then pausa? = True Case srGCalign idx% = hlon% angular? = True pl2% = 0 If pl1% = lun% Then pausa? = True Case srPlcentr idx% = hdr% heliocentric? = True If pl2% = lun% Or pl1% = lun% Then pausa? = True EndSelect If heliocentric? h$ = "helio " If (pl1% >= aries% And pl1% <= planeta%) Or (pl2% >= aries% And pl2% <= planeta%) pausa? = True EndIf EndIf If Not pausa? dlgephemstep(binary, dj1, paso) dj = binary If pl1% > plu% And Not @withinrange(pl1%) Then pausa? = True If pl2% > plu% And Not @withinrange(pl2%) Then pausa? = True If paso > d0 And Not pausa? If paso = d1 If pl2% Then n% = Min(pl1%, pl2%) Else n% = pl1% Select n% Case BML% paso = z5 Case asc%, m_c% paso = p2 ' 14.4 minutes Case lun% paso = d3 / d4 Case sol% To mar%, nodo%, ceres% To Pred(damocles%) paso = d5 Case jup%, sat%, damocles% To allplanets% paso = 20 Default paso = 40 EndSelect EndIf tb.Visible = True tb.ScrollBars = basNoScroll tb.Text = nul$ + crlf$

pb.Refresh pb.Min = binary pb.Max = dj1 pb.Visible = True abralostodos(True) nombre$ = h$ + Trim$(Left$(plaux$(pl1%), 6)) If pl2% Then nombre$ = nombre$ + "/" + Trim$(Left$(plaux$(pl2%), 6)) pl1b% = pl1% pl2b% = pl2% suspendwrite? = True cmdStop.Visible = True djlimite = dj1 contador% = 0 If baseimpresora? Then tb.Text = "WRITING TO " + saletexto$ Repeat binary = @solve0(binary, pl1%, pl2%, idx%, paso, d0) If Not pausa? And Not aborta? getfecha(dj, jd|, jm|, ja%) Select find0% Case srPeriAfe, srHeliDis q$ = Str$(heliop(pl1%, hdis%), 8, 4) Case srHeliLat nortesur(heliop(pl1%, hlat%), 0, q$) Case srHeliLon fsigno(0, heliop(pl1%, hlon%), 0, signo%, q$, q2$) corrfont q3$ = q2$ fsigno(0, heliop(pl2%, hlon%), 0, signo%, q$, q2$) corrfont q$ = q3$ + spc$ + q2$ Case srCeroLat, srMaxiLat nortesur(vc(pl1%, latitud%), 0, q$) Case srCeroDec, srMaxiDec nortesur(vc(pl1%, declinacion%), 0, q$) Case srApoPeri If pl1% = lun% fsigno(0, vc(pl1%, longitud%), 0, signo%, q$, q2$) q$ = q$ + " (" + Str$(vc(pl1%, rvector%) * au, 6, 0) + "Km)" Else q$ = Str$(vc(pl1%, rvector%), 8, 4) EndIf Case srStation, srIngress, srGCalign, srUserPos fsigno(0, vc(pl1%, longitud%), 0, signo%, q$, q2$) Case srBariSun fsigno(0, helior(aux%, hlon%), 0, signo%, q$, q2$) q$ = "BARYCENTER " + q$ Case srAspects fsigno(0, vc(pl1%, longitud%), 0, signo%, q$, q2$) corrfont q3$ = q2$ fsigno(0, vc(pl2%, longitud%), 0, signo%, q$, q2$) corrfont q$ = q3$ + spc$ + q2$ + spc$ fminutos(kg%, @truedist(pl1%, pl2%), 0, 0, q2$) q$ = q$ + spc$ + q2$ Case srOutBoun nortesur(vc(pl1%, declinacion%), 0, q$) If vc(pl1%, veldec%) < d0 Then q$ = q$ + spc$ + "-->S" If vc(pl1%, veldec%) > d0 Then q$ = q$ + spc$ + "-->N" Case srParalel

nortesur(vc(pl1%, declinacion%), 0, q$) nortesur(vc(pl2%, declinacion%), 0, q2$) q$ = q$ + spc$ + q2$ Case srPlcentr q$ = q3$ Case srTrueAng fsigno(0, vc(pl1%, longitud%), 0, signo%, q$, q2$) corrfont q3$ = q2$ fsigno(0, vc(pl2%, longitud%), 0, signo%, q$, q2$) corrfont q$ = q3$ + spc$ + q2$ + spc$ m = @truedist(pl1%, pl2%) fsegundos(kg%, 1, m, 0, q2$) q$ = q$ + spc$ + spc$ + q2$ If m > n9 Then m = n8 - m If (vc(pl1%, semidiametro%) + vc(pl2%, semidiametro%)) > m q$ = q$ + " ECLIPSE " Else fminutos(kg%, @angdist(vc(pl2%, longitud%), vc(pl1%, longitud% )), 0, 0, q2$) q$ = q$ + " (" + q2$ + ")" EndIf EndSelect If Not binary >= djlimite If find0% = srTrueAng q2$ = nombre$ + " " + q$ + " " q2$ = q2$ + Str$(jd|, 2) + "/" + Str$(jm|, 2) + "/" + Str$(ja% , 4) fminutos(k4%, tu, 0, 0, q$) Else q2$ = nombre$ + " " + q$ + " " + Str$(binary + jp, 12, 4) q2$ = q2$ + " " + Str$(jd|, 2) + "/" + Str$(jm|, 2) + "/" + S tr$(ja%, 4) fsegundos(k4%, 1, tu, 0, q$) EndIf ftab(3, q2$ + spc$ + q$) baja(xi%) If Not baseimpresora? If contador% = Add(27, Mul(2, low?)) Then tb.ScrollBars = basV ertical tb.Text = tb.Text + " " + q2$ + spc$ + q$ + crlf$ Inc contador% EndIf EndIf If InKey$ = spc$ Then pausa? = True EndIf pl1% = pl1b% pl2% = pl2b% Until binary >= djlimite Or aborta? Or pausa? cmdStop.Visible = False pantalla pausa? = False abralostodos(False) If tx <> d0 llenaradix Else nuevo EndIf EndIf

EndIf Else pausa? = True EndIf If pausa? And Not aborta? Print range$ pantalla EndIf EndIf Clr q3$, find0%, angular?, heliocentric?, pausa?, djlimite, srcharmon EndProc ' >Function ciclo(j As Double, pl1%, pl2%, indice%, dif As Double) As Double Local Double i%, m, d, k, l, guarde% = all% dj = j If pl1% > plu% And Not @withinrange(pl1%) Then pausa? = True If pl2% > plu% And Not @withinrange(pl2%) Then pausa? = True If Not pausa? pb.Value = dj If find0% = srBariSun barycenter m = heliov(aux%, hlon%) Else tabephem(pl1%) If pl2% = 0 Or (opcion% = tcv% And Not tr2tr?) If heliocentric? Then m = heliop(pl1%, indice%) Else m = vc(pl1%, indice %) If opcion% = tcv% If indice% = longitud% m = @mdl((m + cd(ayanamsa%)) * armonica) Else If basebija? Or basesideral? m = vc(pl1%, ascensionrecta%) d = vc(pl1%, declinacion%) prigurosa(tx, dj, m, d) EndIf If indice% = declinacion% Then gcorr = d Else gcorr = m If indice% = declinacion% Then m = Abs(d) Else If find0% = srIngress If basesideral? Then m = @mdl(m + cd(ayanamsa%)) m = Frac(m * z5 / n3) * n3 If m > n5 Then Sub m, n3 Else If find0% = srOutBoun m = Abs(m) - cd(oblicuidad%) Else If find0% = srGCalign galaxC(l, d) m -= l Else If find0% = srUserPos If basesideral? Then m = @mdl(m + cd(ayanamsa%)) m -= srcharmon Else If find0% = srStation m = vc(pl1%, longitud%) dj = j + p3 / n4 ' 1/1000 of an hour = 3m36s tabephem(pl1%) m = (vc(pl1%, longitud%) - m) / p3 * n4 dj = j EndIf EndIf Else Swap guarde%, opcion%

tabephem(pl2%) Swap opcion%, guarde% If opcion% = tcv% And tr2tr? m = @mdl(@mdl(vc(pl2%, longitud%) + cd(ayanamsa%)) * armonica) m = @mdl(m - @mdl(@mdl(vc(pl1%, longitud%) + cd(ayanamsa%)) * armonica )) Else If heliocentric? If find0% = srHeliLon m = @mdl(heliop(pl2%, indice%) * d2) - @mdl(heliop(pl1%, indice%) * d2) Else If find0% = srPlcentr Mat Clr r() Mat Clr v() For i% = 1 To 3 r(i%) = helior(pl2%, i%) - helior(pl1%, i%) v(i%) = heliov(pl2%, i%) - heliov(pl1%, i%) Next i% velxyz(r(), v(), k, l, m) q3$ = Str$(@vmg(r()), 8, 4) Else m = heliop(pl2%, indice%) - heliop(pl1%, indice%) EndIf Else If find0% = srParalel m = Abs(vc(pl2%, indice%)) - Abs(vc(pl1%, indice%)) Else If find0% = srAspects m = @mdl(vc(pl2%, indice%) * srcharmon) - @mdl(vc(pl1%, indice%) * s rcharmon) Else If find0% = srTrueAng m = @truedist(pl1%, pl2%) dj = j + p3 / n4 ' 1/1000 of an hour = 3m36s tabephem(pl1%) tabephem(pl2%) m = (@truedist(pl1%, pl2%) - m) / p3 * n4 dj = j Else m = vc(pl2%, indice%) - vc(pl1%, indice%) EndIf EndIf 'DISTANCE RING: 'm = osc(pl2&,ax&)*(d1+osc(pl2&,ec&)) - heliop(pl1&,indice&) 'm = osc(pl2&,ax&)*(d1-osc(pl2&,ec&)) - heliop(pl1&,indice&) EndIf Sub m, dif If angular? If m < d0 And Abs(m) > n8 Then m = m + ng If m > n8 Then m = m - ng EndIf EndIf Return m Else Return d0 EndIf EndFunc ' >Function solve0(j As Double, pl1%, pl2%, indice%, paso As Double, dif As Double ) As Double Local Double fr, fmid, rtb, dx, xmid, iter% Add j, paso If (j + paso) <= djlimite

fmid = @ciclo(j + paso, pl1%, pl2%, indice%, dif) fr = @ciclo(j, pl1%, pl2%, indice%, dif) While (fr * fmid) >= d0 Add j, paso If j > djlimite Then pausa? = True Exit If pausa? Or aborta? fr = fmid fmid = @ciclo(j + paso, pl1%, pl2%, indice%, dif) Wend If fr < d0 rtb = j dx = paso Else rtb = j + paso dx = -paso EndIf For iter% = 1 To kc% Exit If pausa? Or aborta? Mul dx, z5 xmid = rtb + dx fmid = @ciclo(xmid, pl1%, pl2%, indice%, dif) If fmid <= d0 Then rtb = xmid Exit If Abs(dx) < p8 Or (fmid == d0) Next iter% Return rtb Else Return j EndIf EndFunc ' ' ###################################################################### ' IMPLEMENTATION MODULE MEphemerides ' ###################################################################### ' >Procedure geocentrico Local Double slat, clat, d, gs, gc Local Dim g(xyz%) As Double slat = Sin(Rad(geos(lat%))) clat = Cos(Rad(geos(lat%))) d = d1 - d1 / 298.2572221 gc = d1 / Sqr(clat * clat + d * d * slat * slat) gs = d * d * gc g(xi%) = (gc + cnt(mtaltitud%) / eqr) * clat * Cos(Rad(geos(lon%))) g(yi%) = (gc + cnt(mtaltitud%) / eqr) * clat * Sin(Rad(geos(lon%))) g(zi%) = (gs + cnt(mtaltitud%) / eqr) * slat d = Atn(g(zi%) / Sqr(g(xi%) * g(xi%) + g(yi%) * g(yi%))) If latgeoc? slat = Sin(d) clat = Cos(d) EndIf If geos(lat%) = d0 Then slat = p13 geos(usin%) = slat geos(ucos%) = clat geos(geoc%) = Deg(d) geos(rvg%) = @vmg(g()) polar2rect(ts, geos(geoc%), geos(rvg%) * eqr / au, geos()) EndProc ' >Function reduccion(pl%, glon As Double, n%) As Double Local Double m, g, s, s1, s2, s3, s4, s5

If pl% = sol% m = (d1 - cd(ecos%)) / (d1 + cd(ecos%)) Else m = Square(Tan(osc(pl%, cl%) * z5)) EndIf s = d1 + d2 * (n% > 0) g = @mdl(glon * d2) seriesen(g, s1, s2, s3, s4, s5) g = Deg(-m * s1 + m * m / d2 * s2 * s - m * m * m / d3 * s3 + m * m * m * m / d4 * s4 * s - m * m * m * m * m / d5 * s5 * s) * s If pl% = sol% Add g, glon EndIf Return g EndFunc ' >Function arcosolar(arco As Double) As Double Local Double m0, m1, v m0 = anomsolx ' M del Sol radical v = @mdl(radix(sol%, longitud%) - vlsolx + m0) + arco ' v del Sol progresado m1 = v - @eqcentro(sol%, v, -1) ' M del Sol progresado v = @acelere((m1 - m0) / vs) ' Tiempo Return v EndFunc >Function arcosolarAR(arco As Double) As Double Local Double rsolp, lsolp, arco2 rsolp = @mdl(radix(sol%, ascensionrecta%) + arco) ' A.R. Sol progresado lsolp = reduccion(sol%, rsolp, 1) ' Longitud Sol progresado arco2 = @angdist(lsolp, radix(sol%, longitud%)) ' arco en longitud Return arcosolar(arco2) EndFunc ' >Function acelere(arco As Double) As Double Naked If basebija? Or basesideral? Mul arco, acc EndIf Return arco EndFunc ' >Function eqcentro(pl%, v As Double, marca%) As Double Local Double a1, a2, a3, a4, a5, e, e2, e3, e4, e5, sv, cv, s2v, s3v, s4v, s5v If pl% = sol% e = cd(ecsol%) Else e = osc(pl%, ec%) EndIf seriesen(v, sv, s2v, s3v, s4v, s5v) cv = s2v / sv / d2 e2 = e * e If marca% > 0 e3 = e2 * e e4 = e3 * e e5 = e4 * e a1 = (e * d2 - e3 / d4 + e5 * 0.0520833) * sv a2 = (e2 / d4 * d5 - e4 * 0.458333) * s2v a3 = (e3 / n2 * 13 - e5 * 0.671875) * s3v a4 = e4 * 1.072916667 * s4v a5 = e5 * 1.142708333 * s5v Return Deg(a1 + a2 + a3 + a4 + a5) Else

a1 = Sqr(d1 - e2) a2 = (d1 + a1) / e a3 = e * a1 * sv / (d1 + e * cv) a4 = d2 * Atn(sv / (a2 + cv)) + a3 Return Deg(a4) EndIf EndFunc ' >Function crossangle(pl%) As Double Local d As Double If osc(Abs(pl%), ax%) = d0 Then Return d0 lm = osc(pl%, vl%) ph = osc(pl%, pn%) ex = osc(pl%, ec%) d = @kepler d = Atn(ex * Sin(d) / Sqr(d1 - ex * ex)) Return Deg(d) EndFunc ' >Procedure nutacion Local Double arg, lcf = d0, ecf = d0, f, g, sarg, carg, serie% If Not basesideral? For serie% = 1 To 77 arg = cfnut%(serie%, 1) * dla(anomalia%) Add arg, cfnut%(serie%, 2) * dla(anomsol%) Add arg, cfnut%(serie%, 3) * dla(arglat%) Add arg, cfnut%(serie%, 4) * dla(elong%) Add arg, cfnut%(serie%, 5) * cd(vlnodo%) f = cfnut%(serie%, 6) + cfnut%(serie%, 7) * w2 g = cfnut%(serie%, 9) + cfnut%(serie%, 10) * w2 sarg = Sin(Rad(arg)) carg = Cos(Rad(arg)) Add lcf, f * sarg + cfnut%(serie%, 8) * carg Add ecf, g * carg + cfnut%(serie%, 11) * sarg Next serie% cd(lnut%) = lcf * p7 / ns cd(enut%) = ecf * p7 / ns Else cd(lnut%) = d0 cd(enut%) = d0 EndIf EndProc ' >Procedure tiemposideral(u As Double) Local Double mt, m0, m1, m2, m3, m4 If bandera% = 9 ' *** progresado *** mt = Frac(tx) + z5 Else mt = Frac(u) + z5 EndIf tu = Frac(mt) * n4 mt = (u - tu / n4 - j2000) / jq / md ' *** P03b - Capitaine, Wallace & Chapront, 2005 *** m0 = 24110.5493771 m1 = 86401847.9447825 m2 = 9.2772110 m3 = -0.00002926 m4 = -0.0199708 Add m0, @pol(m1, m2, m3, m4, -0.0002454, d0, d0, mt)

cd(tse%) = Frac(m0 / ns / n4) * ng + ' *** ACELERACION DEL TIEMPO SIDERAL acc = (m1 + mt * (d2 * m2 + mt * (d3 ts = @mdl(tu * acc * n5 + cd(tse%) If Abs(basecodigo%) >= solar% Add ts, cd(dt%) * vs EndIf EndProc

cd(lnut%) * eq(emedio%, ecos%) *** * m3 + d4 * m4))) / (864000 * jq) + d1 geos(lon%))

>Procedure tiempos Local x As Double, y As Double, j% ano = @f2000(dj) w2 = (dj - j2000) / jq ' If basetu? If ano < (-500) x = (Trunc(ano) - 1820) / mc y = -20 + 32 * x * x Else If ano < 500 x = ano / mc y = 10583.6 + x * (-1014.41 + x * (33.78311 + x * (-5.952053 + x * (-0.179 8452 + x * (0.022174192 + x * 0.0090316521))))) Else If ano < 1600 x = (ano - ml) / mc y = 1574.2 + x * (- 556.01 + x * (71.23472 + x * (0.319781 + x * (-0.85034 63 + x * (-0.005050998 + x * 0.0083572073))))) Else If ano < 1622 x = ano - 1600 y = 120 + x * (-0.9808 + x * (-0.01532 + x / 7129)) Else If ano < 2011 everett(Sub(Trunc(ano), 1619), Frac(ano), deltat%(), y, x) Mul y, p2 Else y = d0 EndIf cd(dt%) = y / ns / n4 Else cd(dt%) = d0 EndIf ' w5 = (dj - b1950 + cd(dt%)) / jq w2 = (dj - j2000 + cd(dt%)) / jq For j% = t0% To t5% pt(j%) = (w2 / md) ^ Sub(j%, 2) Next j% ' ' *** PRECESION Y NUTACION *** psecular(sol%) delaunay(w2) nutacion prmatriz(j2000fecha%, ecliptica%) ' ' *** ECUACION DE TIEMPO *** y = @eqcentro(sol%, dla(anomsol%), 1) solis = @mdl(cd(vlsol%) + y - ab + cd(lnut%)) cd(eqt%) = (solis - y - @reduccion(sol%, solis, -1)) / n5 ' ' *** EXCESO DE ROTACION MEDIA 1 DIA *** naibod = 0.98561228188 + w2 * (-4.6549E-09 + w2 * 3.308E-12) '

' *** DURACION DEL ANO *** jt = 365.2421896698 + w2 * (-6.15359E-06 + w2 * (-7.29E-10 + w2 * 2.64E-10)) js = 365.25636303 + w2 * (1.138629E-07 + w2 * (-7.6091E-11 + w2 * (-1.69E-12)) ) ' ' *** MOVIMIENTO MEDIO TROPICAL DEL SOL *** vs = 0.985647358 + w2 * (1.66E-08 + w2 * (1.644E-12 + w2 * (-7.16E-13))) ' ' *** DURACION DEL MES LUNAR J2000 *** mesl = 27.32158224 + w2 * (1.50645E-07 + w2 * (-3.1609E-09 + w2 * 3.48E-12)) ' Select baseayanamsa% Case 2 ' LAHIRI cd(svp%) = @mdl(337.53953 - (@precesion(j1900, dj) + cd(lnut%))) Case 3 ' RAMAN cd(svp%) = @mdl(338.98556 - (@precesion(j1900, dj) + cd(lnut%))) Case 4 ' MERCIER/BABYLONIAN cd(svp%) = @mdl(5.079167 - (@precesion(1673941 - jp, dj) + cd(lnut%))) Case 5 ' SASSANIAN cd(svp%) = @mdl(d0 - (@precesion(1927135.8747793 - jp, dj) + cd(lnut%))) Case 6 ' GALACTIC CENTER 0 Sag cd(svp%) = @mdl(d0 - (@precesion(1746443.513 - jp, dj) + cd(lnut%))) Case 7 ' SUNDARA RAJAN cd(svp%) = @mdl(338.493055555556 - (@precesion(j1900, dj) + cd(lnut%))) Case 8 ' KRISHNAMURTI cd(svp%) = @mdl(337.636111 - (@precesion(j1900, dj) + cd(lnut%))) Case 9 ' user-defined cd(svp%) = @mdl(ng - Val(zayan_a$) - (@precesion(Val(zayan_b$) - jp, dj) + c d(lnut%))) Default ' *** PUNTO VERNAL SINETICO (Fagan/Bradley) *** cd(svp%) = @mdl(335.957955555 - (@precesion(b1950, dj) + cd(lnut%))) EndSelect Select bandera% Case 2, 4, 8, 9 If basebija? And Not ingress? cd(ayanamsa%) = -@precesion(tx, dj) - cd(lnut%) + rxcd(lnut%) Else cd(ayanamsa%) = d0 EndIf Default cd(ayanamsa%) = d0 EndSelect If basesideral? Then cd(ayanamsa%) = cd(svp%) ' EndProc >Procedure efemerides(first%, last%) Local dh#, sa#, sad#, h# tiempos tiemposideral(dj) geocentrico If basecodigo% >= solar% If basecodigo% >= orto% semiarco(solis, d0, dh#, sa#, sad#, h#, prueba?) h# = @mdl(ts - h# + sad# * (basecodigo% = orto%) - sad# * (basecodigo% = o caso%)) dh# = (h# - ts) / n5 / n4 semiarco(solis + dh# * vs, d0, dh#, sa#, sad#, h#, prueba?) h# = @mdl(ts - h# + sad# * (basecodigo% = orto%) - sad# * (basecodigo% = o caso%))

dh# = (h# - ts) / n5 Add tu, dh# Add dj, dh# / n4 Sub geos(dl%), dh# ts = h# polar2rect(ts, geos(geoc%), geos(rvg%) * eqr / au, geos()) Else Sub tu, cd(eqt%) Sub dj, cd(eqt%) / n4 Add geos(dl%), cd(eqt%) tiemposideral(dj) EndIf tiempos auxfecha basecodigo% = -basecodigo% EndIf If Add(first%, last%) Open ExecPath + "centaurs.fle" for Input As # 2 If baselong? Then Open ExecPath + "long.fle" for Input As # 5 Mat Set vc() = d0 Mat Set osc() = d0 vsop82(sol%, sol%) astercheck(last%) orden% = 0 If Not bandera% = 8 elp2000(w2) EndIf vsop82(Sub(first%, first% = sol%), last%) Close # 2 If baselong? Then Close # 5 EndIf EndProc ' ' ###################################################################### ' IMPLEMENTATION MODULE MELP ' ###################################################################### ' >Procedure series(fase%, ByRef t As Double, ByRef u As Double) Local Double s, c, e, i% u = t e = d1 + w2 * (-0.002516 - w2 * 7.4E-06) If fase% < 4 elm = Rad(dla(anomalia%) + 13.065 * t) els = Rad(dla(anomsol%) + 0.9856 * t) ef = Rad(dla(arglat%) + 13.229 * t) flunar(6, 1) = Sin(elm) flunar(6, 2) = Sin(els) * e flunar(6, 3) = Sin(d2 * elm) flunar(6, 4) = Sin(d2 * ef) flunar(6, 5) = Sin(elm - els) * e flunar(6, 6) = Sin(elm + els) * e flunar(6, 7) = Sin(d2 * els) * e * e flunar(6, 8) = Sin(elm - d2 * ef) flunar(6, 9) = Sin(elm + d2 * ef) flunar(6, 10) = Sin(d2 * elm + els) * e flunar(6, 11) = Sin(d3 * elm) flunar(6, 12) = Sin(els + d2 * ef) * e flunar(6, 13) = Sin(els - d2 * ef) * e flunar(6, 14) = Sin(d2 * elm - els) * e flunar(6, 15) = Sin(Rad(cd(vlnodo%) - 0.053 * t))

flunar(6, 16) = Sin(elm + d2 * els) EndIf Select fase% Case 0 For i% = 1 To 16 Add u, flunar(1, i%) * flunar(6, i%) Next i% Case 2 For i% = 1 To 16 Add u, flunar(2, i%) * flunar(6, i%) Next i% Case 1, 3 For i% = 1 To 16 Add u, flunar(3, i%) * flunar(6, i%) Next i% s = 0.00306 - 0.00038 * Cos(els) * e + 0.00026 * Cos(elm) Sub u, s * (fase% = 1) Add u, s * (fase% = 3) Case 4 'eclipse ' *** No ocupamos el momento del eclipse ' *** solamente el tipo y la magnitud: Add ef, Rad(-0.02665) * flunar(6, 15) s = +5.2207 Add s, -0.3299 * Cos(elm) Add s, -0.006 * Cos(elm + els) * e Add s, -0.0048 * Cos(els) * e Add s, +0.0041 * Cos(elm - els) * e Add s, +0.002 * Cos(d2 * els) * e c = +0.207 * flunar(6, 2) Add c, -0.0392 * flunar(6, 1) Add c, +0.0118 * Sin(d2 * ef) Add c, +0.0116 * flunar(6, 3) Add c, -0.0073 * flunar(6, 6) Add c, +0.0067 * flunar(6, 5) Add c, +0.0024 * (flunar(6, 7) / e) t = (s * Sin(ef) + c * Cos(ef)) * (d1 - 0.0048 * Abs(Cos(ef))) u = 0.0059 - 0.0182 * Cos(elm) + 0.0046 * Cos(els) * e - 0.0005 * Cos(els + elm) + 0.0004 * Cos(d2 * elm) EndSelect EndProc >Procedure eclipses(fase%) Local Double u, u5, m, m9, g series(4, g, u) Select fase% Case 0 ' ########################## ' #### eclipse de sol #### ' ########################## u5 = 1.5433 + u If Abs(g) <= u5 m9 = 0.9972 If u > 0.0047 q$ = " Anular" Else If u < d0 q$ = " Total" Else 'IF u#<(0.00464*SQR(d1-g#*g#)) 'q$=" Anular-total" 'ELSE q$ = " Anular"

'ENDIF EndIf If g > m9 ' ############################ ' #### eclipse no central #### ' ############################ m = (u5 - Abs(g)) / (0.5461 + d2 * u) If g < (m9 + u) q$ = q$ + " n.c." Else q$ = " Partial" EndIf q$ = q$ + " " + Str$(m, 4, 2) EndIf ftab(60, q$) EndIf Case 2 ' ########################### ' #### eclipse de luna #### ' ########################### m = (1.571 + u - Abs(g)) / 0.545 If m >= d0 m9 = (1.0157 - u - Abs(g)) / 0.545 If m9 >= d0 m = m9 If m9 >= d1 q$ = " Total" u5 = 0.4707 Else q$ = " Partial" u5 = 1.0157 EndIf m9 = n6 / (0.5458 + 0.04 * Cos(lm)) * Sqr(Square(u5 - u) - g * g) q$ = q$ + " " + Str$(m, 4, 2) + " " + Str$(m9, 2, 0) + "m" Else q$ = " Penumbral " + Str$(m, 5, 3) EndIf ftab(60, q$) EndIf EndSelect EndProc >Procedure variables(q$, fase%, a As Double) Local Double edad, gl, t ftab(13, q$) t = a series(fase%, t, edad) gl = cd(vlsol%) + edad * vs + @eqcentro(sol%, dla(anomsol%) + edad * naibod, 1 ) fsigno(0, @mdl(gl - ab + n9 * fase%), 0, signo%, q$, q2$) ftab(29, q$) edad = @acelere(Abs(edad)) freal(edad, 3, 1, 39, q2$) ftab(45, " years") freal(@f2000(dj) + edad, 5, 1, 52, q2$) If Even(fase%) And Abs(Sin(ef)) <= 0.36 eclipses(fase%) EndIf baja(xi%) EndProc >Procedure lunaciones

Local Double a, mm, dd, uncuarto, i% Global Double ef, elm, els llenaradix mm = 29.5305888531 + w2 * (2.1621E-07 + w2 * (-3.64E-10)) dd = 12.190749 + w2 * (-8.9E-08 + w2 * (1.5E-10)) uncuarto = mm / d4 encabezado(" LUNATIONS") ftab(27, "PROGRESSED LUNATIONS") baja(yi%) For i% = -3 To 6 If i% > 0 And i% < 5 baja(xi%) EndIf a = i% * mm - dla(elong%) / dd q$ = "New Moon " + Str$(i%, 2) variables(q$, 0, a) If i% > 0 And i% < 4 q$ = "First Quarter" variables(q$, 1, a + uncuarto) q$ = "Full Moon" variables(q$, 2, a + uncuarto * d2) q$ = "Last Quarter" variables(q$, 3, a + uncuarto * d3) EndIf Next i% pantalla Clr ef, elm, els EndProc ' >Function vnodo(i%, k%) As Double Local Double c, f, w = w2, v = d0 Local j% For j% = i% To k% f = vf(j%, bf%) + w * (vf(j%, cf%) + w * (vf(j%, df%) + w * (vf(j%, ef%) + w * vf(j%, ff%)))) c = vf(j%, cf%) + w * (d2 * vf(j%, df%) + w * d3 * (vf(j%, ef%) + w * d4 * v f(j%, ff%))) Add v, vf(j%, af%) * Cos(f) * c Next j% If i% = 23 Add v, Rad(905.60712) * Cos(Rad(103.2 + w2 * 377336.3)) * w2 ' 1'29" T Else Add v, Rad(-50.09319) * Cos(Rad(125.0 + w2 * -1934.1)) ' 4.9" Add v, Rad( 8.32265) * Cos(Rad(220.2 + w2 * -1935.5)) ' 0.8" Add v, Rad( 13.79658) * Cos(Rad(357.5 + w2 * 35999.1)) * w2 ' 1.4" T EndIf Return Deg(v / jq) EndFunc ' >Procedure expand(w As Double, indice%) Local s%, t%, q%, vec%, j%, ff As Double Mat Clr g() For vec% = longitud% To indice% ' MAIN PROBLEM Mat Clr sumasen() If vec% = longitud% Then s% = 0 If vec% = latitud% Then s% = 218 If vec% = rvector% Then s% = 406 For j% = 1 To pptl%(lun%, vec%, rp%) Inc s%

ff = d0 For q% = elong% To anomsol% Add ff, main(s%, q%) * mppdla(q%) Next q% ff = Rad(@mdl(ff)) If vec% = rvector% Add sumasen(rp%), main(s%, 5) * Cos(ff) Else Add sumasen(rp%), main(s%, 5) * Sin(ff) EndIf Next j% ' PERTURBATIONS If vec% = longitud% Then s% = 0 If vec% = latitud% Then s% = 516 If vec% = rvector% Then s% = 668 For t% = t0% To t3% For j% = 1 To pptl%(lun%, vec%, t%) Inc s% ff = d0 For q% = 1 To 13 Add ff, pert(s%, q%) * mppdla(q%) Next q% ff = Rad(@mdl(ff)) Add sumasen(t%), pert(s%, 14) * Sin(ff) + pert(s%, 15) * Cos(ff) Next j% Next t% Mul sumasen(t1%), w Mul sumasen(t2%), w * w Mul sumasen(t3%), w * w * w For j% = t0% To t3% Add sumasen(rp%), sumasen(j%) Next j% Select vec% Case longitud% g(longitud%) = (cd(vlluna%) + sumasen(rp%) / ns) Case latitud% g(latitud%) = sumasen(rp%) / ns Case rvector% g(rvector%) = (385000.56 + sumasen(rp%)) / au EndSelect Next vec% EndProc >Procedure expansion(w, indice%, ByRef lg(), ByRef lv()) Local t t = w + p4 / jq ' 8.6 secs later delaunay(t) expand(t, indice%) Mat Cpy lv() = g() delaunay(w) expand(w, indice%) Mat Cpy lg() = g() Mat Sub lv(), lg() Mat Mul lv(), d1 / p4 EndProc ' >Procedure orbitalunar Local Double gl, dl, bl, rv, gt, bt, rt, g0, b0, r0, vp, exm, axm, clm exm = 0.055545526 - 0.000000016 * w2 axm = (383397.7725 + 0.0040 * w2) / au clm = 5.15668983 - 0.00008 * w2

'axm = axlu / au 'exm = 0.0548799046 'clm = 5.1298350626 ' ' MEAN LUNAR NODE g0 = cd(vlnodo%) b0 = Rad(@mdl(cd(vlnodo%) - cd(vlluna%) + dla(anomalia%))) r0 = axm * (d1 - exm * exm) / (d1 + exm * Cos(bl)) vp = (-190.63 + w2 * (0.000409094 + w2 * 0.000000557)) / ns If basenodo% = 1 Or basenodo% = 0 vc(nodo%, longitud%) = g0 + cd(lnut%) vc(nodo%, rvector%) = r0 vc(nodo%, velocidad%) = vp EndIf dragon(dra_mean_bari%) = g0 + cd(lnut%) 'bari2geo(g0, d0, r0, gl, bl, rv) 'dragon(dra_mean_geo_asc%) = gl + cd(lnut%) 'geo2topo(gl + cd(lnut%), bl, rv, gt, bt, rt) 'dragon(dra_mean_topo_asc%) = gt 'r0 = axm * (d1 - exm * exm) / (d1 + exm * Cos(b0 + PI)) 'bari2geo(@mdl(g0 + n8), d0, r0, gl, bl, rv) 'dragon(dra_mean_geo_desc%) = gl + cd(lnut%) 'geo2topo(gl + cd(lnut%), bl, rv, gt, bt, rt) 'dragon(dra_mean_topo_desc%) = gt ' ' TRUE LUNAR NODE If baseswephem? swissephempos(nodo%, dj, SE_SPEED) gl = r(longitud%) rv = r(rvector%) dl = v(longitud%) Else gl = Deg(na) + cd(lnut%) rv = se * (d1 - ex * ex) / (d1 + ex * Cos(na - ph)) dl = vp + @vnodo(1, 22) EndIf If basenodo% = 2 vc(nodo%, longitud%) = gl vc(nodo%, rvector%) = rv vc(nodo%, velocidad%) = dl EndIf dragon(dra_osc_geo%) = gl geo2topo(gl, d0, rv, gt, bt, rt) dragon(dra_osc_topo_asc%) = gt rv = se * (d1 - ex * ex) / (d1 + ex * Cos(na - ph + PI)) geo2topo(@mdl(gl + n8), d0, rv, gt, bt, rt) dragon(dra_osc_topo_desc%) = gt ' vc(nodo%, latitud%) = d0 vc(nodo%, declinacion%) = @edeclinacion(vc(nodo%, longitud%), etrue%) vc(nodo%, ascensionrecta%) = @reduccion(sol%, vc(nodo%, longitud%), -1) sinodico%(nodo%) = Sub(Add(Sgn(vc(nodo%, velocidad%)), 2), Abs(vc(nodo%, veloc idad%)) < p4) ' ' MEAN LUNAR APOGEE gl = @mdl(263.35324312 + @mdl(4069.01363525 * w2) + w2 * w2 * (-37.1582 + w2 * (-0.044970 + w2 * 0.00018948)) / ns) b0 = Deg(Atn(Sin(Rad(gl - cd(vlnodo%))) * Tan(Rad(clm)))) g0 = @mdl(gl + @reduccion(lun%, @mdl(gl - cd(vlnodo%)), -1)) + cd(lnut%) r0 = axm * (d1 + exm)

vp = (401.05 + w2 * (-0.002034672 + w2 * (-0.000003693))) / ns If basenoire% = 1 Or basenoire% = 0 vc(BML%, longitud%) = g0 + cd(lnut%) vc(BML%, latitud%) = b0 vc(BML%, rvector%) = r0 vc(BML%, velocidad%) = vp EndIf dragon(apo_mean_bari%) = g0 + cd(lnut%) 'bari2geo(g0, b0, d2 * axm * exm, gl, bl, rv) 'dragon(foco_mean_geo%) = gl + cd(lnut%) 'geo2topo(gl + cd(lnut%), bl, rv, gt, bt, rt) 'dragon(foco_mean_topo%) = gt 'bari2geo(g0, b0, r0, gl, bl, rv) 'dragon(apo_mean_geo%) = gl + cd(lnut%) 'geo2topo(gl + cd(lnut%), bl, rv, gt, bt, rt) 'dragon(apo_mean_topo%) = gt 'bari2geo(@mdl(g0 + n8), -b0, axm * (d1 - exm), gl, bl, rv) 'dragon(peri_mean_geo%) = gl + cd(lnut%) 'geo2topo(gl, bl, rv, gt, bt, rt) 'dragon(peri_mean_topo%) = gt ' ' TRUE LUNAR APOGEE If baseswephem? swissephempos(BML%, dj, SE_SPEED) gl = r(longitud%) bl = r(latitud%) rv = r(rvector%) dl = v(longitud%) Else gl = @mdl(Deg(ph + PI) + @reduccion(lun%, @mdl(Deg(ph + PI - na)), -1) + cd( lnut%)) bl = Deg(Atn(Sin(ph + PI - na) * Tan(in))) rv = se * (d1 + ex) dl = vp + @vnodo(23, 80) EndIf If basenoire% = 2 vc(BML%, longitud%) = gl vc(BML%, latitud%) = bl vc(BML%, rvector%) = rv vc(BML%, velocidad%) = vp + dl EndIf dragon(apo_osc_geo%) = gl geo2topo(gl, bl, rv, gt, bt, rt) dragon(apo_osc_topo%) = gt geo2topo(gl, bl, d2 * se * ex, gt, bt, rt) dragon(foco_osc_topo%) = gt geo2topo(@mdl(gl + n8), -bl, se * (d1 - ex), gt, bt, rt) dragon(peri_osc_topo%) = gt ' polar2rect(vc(BML%, longitud%), vc(BML%, latitud%), d1, r()) ecuatoriales(etrue%, r()) rect2polar(r(), gl, bl, rv) vc(BML%, declinacion%) = bl vc(BML%, ascensionrecta%) = gl sinodico%(BML%) = Sub(Add(Sgn(vc(BML%, velocidad%)), 2), Abs(vc(BML%, velocida d%)) < p4) ' If basetopo? ' TOPOCENTRIC NODE AND APOGEE For pl% = nodo% To BML%

If (pl% = BML% And basenoire% = 2) Or (pl% = nodo% And basenodo% = 2) gl = vc(pl%, ascensionrecta%) bl = vc(pl%, declinacion%) rv = vc(pl%, rvector%) polar2rect(gl, bl, rv, g()) Sub g(xi%), geos(xi%) Sub g(yi%), geos(yi%) Sub g(zi%), geos(zi%) rect2polar(g(), gl, bl, rv) vc(pl%, ascensionrecta%) = gl vc(pl%, declinacion%) = bl vc(pl%, rvector%) = rv ecuatoriales(-etrue%, g()) rect2polar(g(), gl, bl, rv) vc(pl%, longitud%) = gl vc(pl%, latitud%) = bl EndIf Next pl% EndIf ' EndProc ' >Procedure geo2topo(lon As Double, lat As Double, dis As Double, ByRef g#, ByRef b#, ByRef v#) Naked polar2rect(lon, lat, dis, r()) ecuatoriales(etrue%, r()) Sub r(xi%), geos(xi%) Sub r(yi%), geos(yi%) Sub r(zi%), geos(zi%) ecuatoriales(-etrue%, r()) rect2polar(r(), g#, b#, v#) EndProc ' >Procedure bari2geo(lon As Double, lat As Double, dis As Double, ByRef gr#, ByRe f br#, ByRef vr#) Local Double dX, dY, dZ, U, dg, db, dr, sina, cosa, sind, cosd polar2rect(lon, lat, dis, r()) lon = vc(lun%, ascensionrecta%) lat = vc(lun%, declinacion%) dis = vc(lun%, rvector%) * au / eqr polar2rect(lon, lat, dis, p()) U = emr / (d1 + emr) * 4.26636039246966e-5 'Sin(Rad(8.8 / ns)) dX = U * p(1) dY = U * p(2) dZ = U * p(3) ecuatoriales(etrue%, r()) Sub r(1), dX Sub r(2), dY Sub r(3), dZ ecuatoriales(-etrue%, r()) rect2polar(r(), gr#, br#, vr#) EndProc ' >Procedure elp2000(w As Double) Local Double d, gl, bl, rv, dl, db, dr, j% If baseswephem? swissephempos(lun%, dj, SE_SPEED + SE_NONUT + SE_TRUEPOS + SE_NOABERR) Else expansion(w, rvector%, r(), v()) EndIf

'------------------------------------gl = r(xi%), bl = r(yi%), rv = r(zi%) dl = v(xi%), db = v(yi%), dr = v(zi%) '------------------------------------d = axlu / au xyzvel(Rad(gl), Rad(bl), rv / d, Rad(dl), Rad(db), dr / d, r(), v()) osculacion(lun%, r(), v()) Mul se, d osc(lun%, ax%) = se Mat Mul r(), d Mat Mul v(), d '----------------------------------------------For j% = xi% To zi% helior(lun%, j%) = r(j%) - helior(sol%, j%) heliov(lun%, j%) = v(j%) - heliov(sol%, j%) Next j% planetaberr(lun%, gl, bl, rv) '----------------------------------------------d = (se * (d1 + ex) - rv) * mc / (d2 * se * ex) vcguarde(lun%, gl, bl, rv, d) '----------------------------------------------If Not basetopo? For j% = xi% To zi% g(j%) = r(j%) - geos(j%) Next j% dragon(topoluna%) = Deg(@artan2(g(zi%) * cd(esin%) + g(yi%) * cd(ecos%), g(x i%))) Else dragon(topoluna%) = vc(lun%, longitud%) EndIf If opcion% = efm% dragon(iper%) = @apogeo(d0, 5) dragon(iapo%) = @apogeo(z5, 4) EndIf dragon(luz%) = lum(lun%, kfase%) * mc basefaselunar% = Succ(Trunc(@mdl(gl - vc(sol%, longitud%)) / ng * 28)) orbitalunar EndProc ' >Procedure delaunay(t As Double) Local Double w10, w11, w12, w13, w14, w20, w21, w22, w23, w24, w30, w31, w32, w33, w34, w1, w2, w3 Local Double eart0, eart1, eart2, eart3, eart4, peri0, peri1, peri2, peri3, pe ri4, eart, peri, pr Local Const Dw1_0 = -0.07008 / ns Local Const Dw1_1 = -0.35106 / ns Local Const Dw1_2 = -0.03743 / ns Local Const Dw1_3 = -0.00018865 / ns Local Const Dw1_4 = -0.00001024 / ns Local Const Dw2_0 = 0.20794 / ns Local Const Dw2_1 = 0.08017 / ns Local Const Dw2_2 = 0.00470602 / ns Local Const Dw2_3 = -0.00025213 / ns Local Const Dw3_0 = -0.07215 / ns Local Const Dw3_1 = -0.04317 / ns Local Const Dw3_2 = -0.00261070 / ns Local Const Dw3_3 = -0.00010712 / ns Local Const Deart_0 = -0.00033 / ns Local Const Deart_1 = 0.00732 / ns Local Const Dperi = -0.00749 / ns

' w10 = Dw1_0 + 218.31665475 w11 = Dw1_1 + 1732559343.73604 / ns w12 = Dw1_2 + -6.8084 / ns w13 = Dw1_3 + 0.66040e-2 / ns w14 = Dw1_4 + -0.31690e-4 / ns w20 = Dw2_0 + 83.3532429861 w21 = Dw2_1 + 14643420.3171 / ns w22 = Dw2_2 + -38.2631 / ns w23 = Dw2_3 + -0.45047e-1 / ns w24 = 0.21301e-3 / ns w30 = Dw3_0 + 125.0445550444 w31 = Dw3_1 + -6967919.5383 / ns w32 = Dw3_2 + 6.3590 / ns w33 = Dw3_3 + 0.76250e-2 / ns w34 = -0.35860e-4 / ns eart0 = Deart_0 + 100.4664274583 eart1 = Deart_1 + 129597742.293 / ns eart2 = -0.020200 / ns eart3 = 0.90000e-5 / ns eart4 = 0.15000e-6 / ns peri0 = Dperi + 102.93734935 peri1 = 1161.24342 / ns peri2 = 0.529265 / ns peri3 = -0.11814e-3 / ns peri4 = 0.11379e-4 / ns w1 = @mdl(w10 + t * (w11 + t * (w12 + t * (w13 + t * w14)))) w2 = @mdl(w20 + t * (w21 + t * (w22 + t * (w23 + t * w24)))) w3 = @mdl(w30 + t * (w31 + t * (w32 + t * (w33 + t * w34)))) peri = @mdl(peri0 + t * (peri1 + t * (peri2 + t * (peri3 + t * peri4)))) eart = @mdl(eart0 + t * (eart1 + t * (eart2 + t * (eart3 + t * eart4)))) dla(arglat%) = @mdl(w1 - w3) dla(anomalia%) = @mdl(w1 - w2) dla(elong%) = @mdl(w1 - eart + n8) dla(anomsol%) = @mdl(eart - peri) mppdla(elong%) = dla(elong%) mppdla(arglat%) = dla(arglat%) mppdla(anomalia%) = dla(anomalia%) mppdla(anomsol%) = dla(anomsol%) mppdla(5) = @mdl(252.2508935886 + 538101628.66888 / ns * t) mppdla(6) = @mdl(181.9790995608 + 210664136.45777 / ns * t) mppdla(7) = @mdl(eart0 + eart1 * t) mppdla(8) = @mdl(355.4343452161 + 68905077.65936 / ns * t) mppdla(9) = @mdl( 34.3514942756 + 10925660.57335 / ns * t) mppdla(10) = @mdl( 50.0774729153 + 4399609.33632 / ns * t) mppdla(11) = @mdl(314.0512095094 + 1542482.57845 / ns * t) mppdla(12) = @mdl(304.3491134364 + 786547.89700 / ns * t) mppdla(13) = w1 + (5029.0966 - 0.29965) / ns * t mppdla(14) = w1 pr = @precesion(j2000, dj + cd(dt%)) cd(vlluna%) = @mdl(w1 + pr) cd(vlsol%) = @mdl(eart + n8 + pr) cd(ecsol%) = sec(sol%, ec%, rp%) w31 = -1934.13633 w32 = 20.735e-04 w33 = 2.139e-06 w34 = -1.650e-08 cd(vlnodo%) = @mdl(w30 + t * (w31 + t * (w32 + t * (w33 + t * w34)))) masa(lun%) = Rad(w11 + t * (d2 * w12 + t * (d3 * w13 + t * d4 * w14)) + cd(pre cspeed%)) / jq

' EndProc ' >Procedure revolucion(lon0 As Double, t As Double) Local iter As Double Local Const f = 481267.88134 Local Dim r(xyz%) As Double, v(xyz%) As Double iter = d1 While Abs(iter) > darcsec delaunay(t) expansion(t, longitud%, r(), v()) iter = lon0 - r(xi%) - cd(lnut%) Sub iter, ng * (iter < (-n8)) Add iter, ng * (iter > n8) t = iter / f + t Wend delaunay(t) expansion(t, longitud%, r(), v()) iter = lon0 - r(xi%) - cd(lnut%) Sub iter, ng * (iter < (-n8)) Add iter, ng * (iter > n8) dj = (iter / f + t) * jq + j2000 - cd(dt%) EndProc >Procedure revollunar Local Double lapso, dsvp, djx, modo, epoca, ts2, raas, qq, pp, dd, ar, dh, sa, ff Local pos% Local Const paso = d2 / n4 If @fecha If @loclon If @loclat lapso = Trunc((dj - tx) / mesl) * mesl If basebija? Or basesideral? Then q$ = "Precession-corrected|" Else q$ = "|" Alert 2, q$ + " LUNAR RETURN", 1, " Direct | Converse ", n% If n% = 2 modo = -d1 dj = tx - lapso Else modo = d1 dj = tx + lapso EndIf efemerides(0, 0) If basebija? Or basesideral? dsvp = svpx - cd(svp%) Else dsvp = d0 EndIf revolucion(radix(lun%, longitud%) + dsvp, w2) encabezado(" LUNReturn") dgnom$ = Trim$(titulo$) bandera% = 4 efemerides(sol%, ultimo%) pantalla Mat Cpy rx2() = vc() Alert 0 | 16, "PROGRESS THE|LUNAR RETURN?|(Nicewander method)", 2, " YE S | NO", n% If n% = 1 djx = dj epoca = dj - modo * tu / n4 ' starting date

ts2 = ts ' starting RAMC raas = vc(lun%, ascensionrecta%) ' starting RAAS baja(xi%) pausa? = False suspendwrite? = True cmdStop.Visible = True tb.Visible = True tb.Text = nul$ tb.ScrollBars = basVertical pb.Refresh pb.Min = 0 pb.Max = 28 pb.Visible = True For dd = d0 To mesl Step paso pb.Value = CInt(dd) dj = epoca + modo * dd baselow? = (dj > lowmin And dj < lowmax) pos% = 49 efemerides(sol%, mar%) If modo < d0 impfecha(tx * d2 - dj, 0, 0, 0, 2, q$) ftab(13, Str$(Round(n4 - tu)) + "h") qq = raas - vc(lun%, ascensionrecta%) Else impfecha(dj, 0, 0, 0, 2, q$) ftab(13, Str$(Round(tu)) + "h") qq = vc(lun%, ascensionrecta%) - raas EndIf If dd > d1 Then qq = mdl(qq) ' ***************** ' Luna progresada ' ***************** dj = djx + qq / acc / ng expansion((dj - j2000) / jq, longitud%, r(), v()) fsigno(0, r(1), 0, signo%, q$, q2$) corrfont ftab(19, q2$) pp = @mdl(ts2 + modo * qq) fsigno(0, @reduccion(sol%, pp, 1), 0, signo%, q$, q2$) corrfont ftab(27, q2$) fsigno(0, @ascndt(pp, tanlat), 0, signo%, q$, q2$) corrfont ftab(34, q2$) freal(pp, 3, 2, 41, q$) ff = d1 For pl% = lun% To ultimo% Exit If pl% > nombrados% Or pausa? ' ********************************* ' planetas de la revolucion lunar ' ********************************* ar = rx2(pl%, ascensionrecta%) semiarco(ar, rx2(pl%, declinacion%), dh, qq, sa, dh, prueba?) rvparanes(ar, pp, ff, " mS", CInt(modo), pos%) rvparanes(@mdl(ar + n8), pp, ff, " iL", CInt(modo), pos%) rvparanes(@mdl(ar - sa), pp, ff, " aL", CInt(modo), pos%) rvparanes(@mdl(ar + sa), pp, ff, " dL", CInt(modo), pos%) ' ******************** ' planetas radicales ' ********************

ar = radix(pl%, ascensionrecta%) semiarco(ar, radix(pl%, declinacion%), dh, qq, sa, dh, prueba?) rvparanes(ar, pp, ff, " mR", CInt(modo), pos%) rvparanes(@mdl(ar + n8), pp, ff, " iR", CInt(modo), pos%) rvparanes(@mdl(ar - sa), pp, ff, " aR", CInt(modo), pos%) rvparanes(@mdl(ar + sa), pp, ff, " dR", CInt(modo), pos%) ' ********************** ' planetas en transito ' ********************** If pl% > lun% And pl% < jup% ar = vc(pl%, ascensionrecta%) semiarco(ar, vc(pl%, declinacion%), dh, qq, sa, dh, prueba?) rvparanes(ar, pp, ff, " mT", CInt(modo), pos%) rvparanes(@mdl(ar + n8), pp, ff, " iT", CInt(modo), pos%) rvparanes(@mdl(ar - sa), pp, ff, " aT", CInt(modo), pos%) rvparanes(@mdl(ar + sa), pp, ff, " dT", CInt(modo), pos%) EndIf Next pl% tb.Text = tb.Text + Left$(nuevalinea$, 78) + crlf$ baja(xi%) Next dd baselow? = False cmdStop.Visible = False pb.Visible = False Color black%, white% Print AT(2, 1); "Progressed date Moon M.C. Asc RAMC a=Asc , d=desc, i=IC, m=MC" Color white%, atras% pantalla llenaradix EndIf EndIf EndIf EndIf EndProc ' >Function apogeo(fac As Double, ci%) As Double Local Double k, t, jde, d, m, f, i%, j% Local Dim dp(6, 2) As Double, r(xyz%) As Double, v(xyz%) As Double If baseswephem? If ci% = 5 And fac = d0 swissephempos(-SE_INTP_PERG, dj, 0) Else swissephempos(-SE_INTP_APOG, dj, 0) EndIf Return swedata(xi%) Else k = Trunc((ano - 1999.97) * 13.2555) + fac - d3 For j% = af% To ff% Add k, d1 t = k / 1325.55 jde = 2451534.6698 + 27.55454988 * k + t * t * (-6.886e-04 + t * (-1.098e06 + t * 5.2e-09)) delaunay((jde - jp - j2000) / jq) d = Rad(dla(elong%)) m = Rad(dla(anomsol%)) f = Rad(dla(arglat%)) For i% = 1 To 63 Add jde, apo(i%, ci%) * Sin(apo(i%, 1) * d + apo(i%, 2) * m + apo(i%, 3) * f)

Next i% t = (jde - jp - j2000) / jq delaunay(t) expansion(t, longitud%, r(), v()) If j% > 1 If Abs(r(xi%) - dp(Pred(j%), 2)) > n8 Add r(xi%), ng EndIf EndIf dp(j%, 2) = r(xi%) dp(j%, 1) = jde Next j% lagrange(6, dj + jp, dp(), k) delaunay(w2) Return k EndIf EndFunc ' >Procedure waltemath Local Double gl, bl ' *** DARK MOON Solar Fire *** bl = (dj - j1900 + cd(dt%)) / jq osc(aux%, ec%) = 0.1587 osc(aux%, cl%) = Rad(2.5) lm = @mdl(86.6801406 + 109037.5358 * bl) ph = @mdl(151.297051 + 1247.484675 * bl) na = @mdl(113.3494484 - 1143.450993 * bl) gl = @mdl(@eqcentro(aux%, lm, 1) + lm + ph) dragon(dark_SF%) = gl + @reduccion(aux%, @mdl(gl - na), -1) ' *** DARK MOON Swiss Ephemeris *** bl = (dj - 2414290.95827875 + jp + cd(dt%)) / jq lm = @mdl(70.3407215 + 109023.2634989 * bl ) ph = @mdl(144.3892785 + 1261.75697735 * bl) na = @mdl(136.24878256 - 1131.71719709 * bl) gl = @mdl(@eqcentro(aux%, lm, 1) + lm + ph) dragon(dark_SE%) = gl + @reduccion(aux%, @mdl(gl - na), -1) EndProc ' ' ###################################################################### ' IMPLEMENTATION MODULE MFecha ' ###################################################################### ' >Function f2000(j As Double) As Double Local dias%, f As Double, bisiesto? getfecha(j, jd|, jm|, ja%) dias% = Add(meses%(jm|, 2), jd|) bisiesto? = (Mod(ja%, 4) = 0) If basegregoriano? And Mod(ja%, kc%) = 0 Then bisiesto? = Not Mod(ja%, 400) meses%(2, 1) = Add(29, Not bisiesto?) Add dias%, (Not bisiesto?) And (jm| > 2) f = Abs(ja%) + (dias% + tu / n4) / (365 - bisiesto?) If ja% Then Mul f, Sgn(ja%) Return f EndFunc ' >Function semana(j As Double) As Int Naked Return Succ(Mod(CInt(Trunc(j + jp)), caldeo%)) EndFunc ' >Procedure getfecha(dj As Double, ByRef jd|, ByRef jm|, ByRef ja%)

Local Double j, a, b, c, d, e, f dj = dj + jp + z5 j = Trunc(dj) f = Frac(dj) a = j If basegregoriano? And dj >= 2299160.5 a = Trunc((j - 1867216.25) / 36524.25) a = j + d1 + a - Trunc(a / d4) EndIf b = a + 1524 c = Trunc((b - 122.1) / j5) d = Trunc(j5 * c) e = Trunc((b - d) / 30.6001) jd| = Trunc(b - d - Trunc(30.6001 * e) + f) jm| = Add(Pred(Trunc(e)), Mul(k2%, (e > 13.5))) ja% = Sub(Sub(c, 4716), jm| < 3) tu = f * n4 EndProc ' >Procedure getdj(jd|, jm|, ja%) Local j% If jm| < 3 Dec ja% Add jm|, k2% EndIf If Not basegregoriano? j% = 0 Else j% = ja% \ kc% j% = Add(Sub(2, j%), (j% \ 4)) EndIf Add j%, jd| Add j%, 1720995 Add j%, Trunc(j5 * ja% + 0.75 * (ja% < 0)) Add j%, Trunc(30.6001 * (Succ(jm|))) dj = j% - jp - z5 EndProc ' >Procedure auxfecha getfecha(dj, jd|, jm|, ja%) basesemana% = @semana(dj + z5) vcfecha$(rsemana%) = dia$(basesemana%) vcfecha$(rdia%) = Str$(jd|) vcfecha$(rmes%) = mes$(jm|) vcfecha$(rano%) = Str$(ja%) If basegregoriano? vcfecha$(rnsos%) = " " Else vcfecha$(rnsos%) = " OS" EndIf fsegundos(k4%, -1, tu, 0, q$) vcfecha$(rhora%) = q$ nortesur(geos(lat%), 0, q$) vcfecha$(rlat%) = Trim$(q$) esteoeste(geos(lon%), 0, q$) vcfecha$(rlon%) = Trim$(q$) EndProc ' >Procedure encabezado(t$) Local b$

If Not aborta? If baseimpresora? And Not baseprinter? ftab(Sub(40, Len(dgnom$) Div 2), Upper$(dgnom$)) baja(xi%) EndIf titulo$ = t$ auxfecha q$ = " " + Left$(vcfecha$(rsemana%), 3) q$ = q$ + " " + vcfecha$(rmes%) + " " + Trim$(vcfecha$(rdia%)) + " " + Trim$ (vcfecha$(rano%)) If basetu? q$ = q$ + " UT " + vcfecha$(rhora%) Else q$ = q$ + " ET " + vcfecha$(rhora%) EndIf q$ = q$ + " Lat" + vcfecha$(rlat%) + " Lon" + vcfecha$(rlon%) Cls b$ = "RIYAL " + b$ + q$ + titulo$ b$ = Space$(@centro(b$)) + b$ Color black%, RGB(255, 255, 192) lfk% = 0 escribe(-1, b$ + Space$(Sub(80, Len(b$)))) Color white%, atras% baja(yi%) EndIf EndProc ' >Procedure impfecha(t As Double, jd|, jm|, ja%, x%, ByRef q$) Naked If t <> d0 Then @getfecha(t, jd|, jm|, ja%) q$ = Str$(jd|, 2) + " " + Trim$(Left$(mes$(jm|), 3)) + " " + Str$(ja%, 4) If x% > 0 Then ftab(x%, q$) If x% < 0 Then q$ = Left$(q$, 2) + "." + Str$(Mod(tu / n4 * md), 1) + Right$(q$, 9) ftab(0, q$) EndIf EndProc ' ' ###################################################################### ' IMPLEMENTATION MODULE MFormato ' ###################################################################### ' >Procedure cambiafont(altura%) Naked SetFont OEM_FIXED_FONT, altura%, , , , , OEM_CHARSET Select altura% Case 14 fh% = 18 fa% = 10 Case 9 fh% = 12 fa% = 8 EndSelect EndProc ' >Function centro(s$) As Int Naked Return Sub(rmargin, Len(s$)) \ 2 EndFunc ' >Procedure baja(l%) Local m% For m% = 1 To l%

If Not suspendwrite? Then Add lfk%, fh% skqclip$ = skqclip$ + nuevalinea$ + crlf$ nuevalinea$ = Str$(" ", rmargin) If baseimpresora? If Not baseprinter? Print # 1 Else Lprint EndIf EndIf Next m% EndProc ' >Procedure escribe(x%, s$) Local sk$ sk$ = s$ For i% = 1 To Len(s$) If Mid$(s$, i%, 1) = deg1$ Then Mid$(sk$, i%, 1) = deg2$ If Mid$(s$, i%, 1) = bar1$ Then Mid$(sk$, i%, 1) = bar2$ Next i% If x% = -1 If baseimpresora? If Not baseprinter? Print # 1, sk$; Else Lprint sk$; EndIf EndIf If Not suspendwrite? Then Text 0, lfk%, s$ skqclip$ = skqclip$ + sk$ Else If baseimpresora? If Not baseprinter? toFile.Visible = True Print # 1, Tab(x%); sk$; Else Lprint Tab(x%); sk$; EndIf EndIf If Not suspendwrite? Text Mul(x%, fa%), lfk%, s$ EndIf Mid$(nuevalinea$, x%, Len(sk$)) = sk$ EndIf EndProc ' >Procedure txt(cual%) Naked Color cual% EndProc ' >Procedure salecolor(p%) Naked Select p% Case qui% To Pred(wr6%), bu8% To Pred(tl6%), Succ(qb1%) To finpl% rtb.SelColor = crema% Color pink% Case nodo% To m_c%, lim% rtb.SelColor = brwhite% Color brwhite% Case lun% To plu% rtb.SelColor = yellow%

Color yellow% Case wr6% To qb1% rtb.SelColor = cyan% Color cyan% Case astraea% To allplanets% rtb.SelColor = green% Color green% Case Succ(lim%) To kl% rtb.SelColor = brblue% Color brblue% Default rtb.SelColor = white% Color white% EndSelect EndProc ' >Procedure ftab(x%, s$) Naked If x% = xcentro% x% = @centro(s$) escribe(x%, s$) Else escribe(Succ(x%), s$) EndIf EndProc ' >Procedure sexagesimal(l%, ByRef g As Double) Local x%, y As Double x% = Trunc(Abs(g)) y = Round(Frac(Abs(g)) * n6, l%) If y NEAR n6 y = d0 Inc x% EndIf g = (Mod(x%, kg%) + y / mc) * Sgn(g) EndProc ' >Procedure fminutos(u%, g As Double, l%, x%, ByRef a$) Naked sexagesimal(l%, g) If l% a$ = Str$(g, 8, 3) a$ = a$ + Right$(a$) If u% = k4% Mid$(a$, 8) = "." Else Mid$(a$, 8) = "'" EndIf Else a$ = Str$(g, 7, 2) EndIf If u% = k4% Mid$(a$, 5) = "h" If l% = 0 Then a$ = a$ + "m" Else ' ==> 360 Mid$(a$, 5) = deg$ If l% = 0 Then a$ = a$ + "'" EndIf If x% Then ftab(x%, a$) EndProc ' >Procedure nortesur(g As Double, x%, ByRef a$) Naked

sexagesimal(0, g) a$ = Str$(Abs(g), 5, 2) If g < d0 Mid$(a$, 3) = "s" Else Mid$(a$, 3) = "n" EndIf If x% Then ftab(x%, a$) EndProc ' >Procedure esteoeste(g As Double, x%, ByRef a$) Naked sexagesimal(0, g) a$ = Str$(Abs(g), 6, 2) If g < d0 Mid$(a$, 4) = "e" Else Mid$(a$, 4) = "w" EndIf If x% Then ftab(x%, a$) EndProc ' >Procedure fsegundos(l%, j%, f As Double, ix%, ByRef a$) Local gra%, min%, seg% gra% = Trunc(Abs(f)) min% = Trunc(Frac(Abs(f)) * n6) seg% = Round(Frac(Frac(Abs(f)) * n6) * n6) If seg% = k6% seg% = 0 Inc min% EndIf If min% = k6% min% = 0 Inc gra% EndIf a$ = Str$((gra% + min% / mc + seg% / mz) * Sgn(f), 8, 4) If j% = 0 a$ = Mid$(a$, 1, 3) + " " + Mid$(a$, 5, 2) + " " + Right$(a$, 2) If l% = k4% Then a$ = Right$(a$, 8) Else If l% = kg% If f <= (-mc) a$ = Str$((gra% + min% / mc + seg% / mz), 9, 4) a$ = "-" + Trim$(Mid$(a$, 2, 3)) + deg$ + Mid$(a$, 6, 2) + "'" + Right$(a$ , 2) + sec$ Else a$ = Mid$(a$, 1, 3) + deg$ + Mid$(a$, 5, 2) + "'" + Right$(a$, 2) + sec$ EndIf Else '==>24 a$ = Mid$(a$, 2, 2) + "h" + Mid$(a$, 5, 2) + "m" + Right$(a$, 2) + "s" If j% = -1 Then a$ = Trim$(a$) EndIf If ix% Then ftab(ix%, a$) EndProc ' >Procedure farcseconds(g As Double, ByRef z$) Naked g = @mdl(g + p4 + cd(ayanamsa%)) signo% = Succ(Trunc(g / n3)) fsegundos(kg%, 1, Frac(g / n3) * n3, 0, z$) Mid$(z$, 1) = nul$ z$ = z$ + spc$ + sgaux$(signo%) EndProc

' >Procedure fseg2(l%, f As Double, ix%, ByRef a$) Local gra%, min%, segs As Double gra% = Trunc(Abs(f)) segs = Frac(Abs(f)) * n6 min% = Trunc(segs) segs = Round(Frac(segs) * n6, 1) If segs NEAR n6 segs = d0 Inc min% EndIf If min% = k6% min% = 0 Inc gra% EndIf a$ = Str$((Mod(gra%, l%) + min% / mc + segs / mz) * Sgn(f), 9, 5) If l% = kg% a$ = Left$(a$, 3) + deg$ + Mid$(a$, 5, 2) + "'" + Mid$(a$, 7, 2) + sec$ + Ri ght$(a$) Else '==>24 a$ = Mid$(a$, 2, 2) + "h" + Mid$(a$, 5, 2) + "m" + Mid$(a$, 7, 2) + "s" + Ri ght$(a$) EndIf If ix% Then ftab(ix%, a$) EndProc ' >Procedure fsigno(l%, g As Double, x%, ByRef signo%, ByRef a$, ByRef b$) Naked g = @mdl(g + cd(ayanamsa%)) signo% = Succ(Trunc(g / n3)) g = Frac(g / n3) * n3 sexagesimal(l%, g) If g NEAR n3 g = d0 Inc signo% EndIf If signo% > k2% Then Sub signo%, k2% If l% b$ = Str$(g, 6, 3) b$ = b$ + Right$(b$) Mid$(b$, 6) = "." a$ = b$ + " " + sgaux$(signo%) b$ = Left$(b$, 2) + Left$(sgaux$(signo%), 2) + Mid$(b$, 4, 2) + Right$(b$, 2 ) If signo% = kd% Then Mid$(b$, 4, 1) = "p" Else b$ = Str$(g, 5, 2) a$ = b$ + " " + sgaux$(signo%) b$ = Left$(b$, 2) + sgfont$(signo%) + Right$(b$, 2) EndIf Mid$(a$, 3) = "," If x% Then ftab(x%, a$) EndProc ' >Procedure corrfont q2$ = Left$(q2$, 2) + Left$(sgaux$(signo%), 2) + Right$(q2$, 2) If signo% = kd% Then Mid$(q2$, 4, 1) = "p" EndProc ' >Procedure freal(l As Double, izq%, der%, x%, ByRef a$) Naked a$ = Str$(l, Add(Add(izq%, der%), 1), der%)

If x% Then ftab(x%, a$) EndProc ' ' ###################################################################### ' IMPLEMENTATION MODULE MFunciones ' ###################################################################### ' >Procedure everett(n%, p As Double, ByRef x%(), ByRef f#, ByRef d#) Local Double q, v2, v4, e2, e4, fy, fx, f0, f1, f2, f3, d20, d21, d40, d41 q = d1 - p v2 = (q + d1) * q * (q - d1) / d6 e2 = (p + d1) * p * (p - d1) / d6 v4 = v2 * (q + d2) * (q - d2) / d2 / md e4 = e2 * (p + d2) * (p - d2) / d2 / md fy = x%(Sub(n%, 2)) fx = x%(Pred(n%)) f0 = x%(n%) f1 = x%(Succ(n%)) f2 = x%(Add(n%, 2)) f3 = x%(Add(n%, 3)) d20 = f1 - d2 * f0 + fx d21 = f2 - d2 * f1 + f0 d40 = f2 - d4 * f1 + d6 * f0 - d4 * fx + fy d41 = f3 - d4 * f2 + d6 * f1 - d4 * f0 + fx f# = q * f0 + p * f1 + v2 * d20 + e2 * d21 + v4 * d40 + e4 * d41 v2 = (d3 * q * q - d1) / d6 e2 = (d3 * p * p - d1) / d6 v4 = (d5 * q * q * q * q - n5 * q * q + d4) / n2 / md e4 = (d5 * p * p * p * p - n5 * p * p + d4) / n2 / md d# = f1 - f0 - v2 * d20 + e2 * d21 - v4 * d40 + e4 * d41 EndProc ' >Procedure lagrange(np%, z As Double, ByRef dp() As Double, ByRef l#) Local i%, j%, c As Double l# = d0 For i% = 1 To np% c = d1 For j% = 1 To np% If j% <> i% Then c = c * (z - dp(j%, 1)) / (dp(i%, 1) - dp(j%, 1)) Next j% Add l#, c * dp(i%, 2) Next i% EndProc ' >Function disminuye(x%, y%) As Int Naked While x% > y% Sub x%, y% Wend While x% < 1 Add x%, y% Wend Return x% EndFunc ' >Procedure brinque(max%, ByRef cual%) Naked While cual% <= finpl% And Not planets_in_wheel?(cual%) Inc cual% EndWhile If max% <> maximo% And max% <> ultimo% If cual% = max% Then cual% = nodo%

EndIf If cual% = Succ(ultimo%) Then cual% = nodo% If cual% = nodo% And basenodo% = 0 Then Inc cual% If cual% = BML% And basenoire% = 0 Then Inc cual% EndProc ' >Function truedist(p1%, p2%) As Double Local Double ax, bx, ay, by ax = vc(p1%, ascensionrecta%) bx = vc(p2%, ascensionrecta%) ay = vc(p1%, declinacion%) by = vc(p2%, declinacion%) ax = @invhav(@hav(ay - by) + Cos(Rad(ay)) * Cos(Rad(by)) * @hav(ax - bx)) Return ax EndFunc ' >Function angdist(a As Double, b As Double) As Double Naked a = @mdl(a - b) If a > n8 Then a = ng - a Return a EndFunc ' >Function hav(d As Double) As Double Naked Return Square(Sin(Rad(d) * z5)) EndFunc >Function invhav(d As Double) As Double Naked Return Deg(Acos(d1 - d2 * d)) EndFunc >Function mdl(l As Double) As Double Naked Return Frac(l / ng) * ng - ng * (l < d0) EndFunc >Function rmdl(l As Double) As Double Naked Return Frac(l / d2pi) * d2pi - d2pi * (l < d0) EndFunc >Function vmg(q() As Double) As Double Naked Return Sqr(q(xi%) * q(xi%) + q(yi%) * q(yi%) + q(zi%) * q(zi%)) EndFunc >Function decimal(g) Local h, m, s, x, y x = Abs(g) y = Frac(x) * mc + p13 h = Trunc(x) m = Trunc(y) s = Frac(y) * mc Return (h + m / n6 + s / ns) * Sgn(g) EndFunc ' >Function artan2(x As Double, y As Double) As Double Naked If x NEAR d0 Return -PI * (y < d0) Else If y NEAR d0 Return dpi2 - PI * (x < d0) Else y = Atn(x / y) Return y - PI * (y < d0) - PI * (x < d0) EndIf EndFunc ' >Procedure dcosenos(l As Double, b As Double, ByRef s1#, ByRef c1#, ByRef s2#, B yRef c2#) Naked

s1# = Sin(Rad(l)) c1# = Cos(Rad(l)) s2# = Sin(Rad(b)) c2# = Cos(Rad(b)) EndProc ' >Procedure velxyz(g() As Double, p() As Double, ByRef dl As Double, ByRef db As Double, ByRef dr As Double) Local Double r, sinb r = @vmg(g()) sinb = g(zi%) / r dr = (g(xi%) * p(xi%) + g(yi%) * p(yi%) + g(zi%) * p(zi%)) / r dl = (g(xi%) * p(yi%) - g(yi%) * p(xi%)) / (g(xi%) * g(xi%) + g(yi%) * g(yi%)) db = (r * p(zi%) - g(zi%) * dr) / (r * r * Sqr(d1 - sinb * sinb)) EndProc ' >Procedure xyzvel(gl#, bl#, rv#, dl#, db#, dr#, ByRef r() As Double, ByRef v() A s Double) Local Double rcosb, sengl, cosgl rcosb = Cos(bl#) * rv# sengl = Sin(gl#) cosgl = Cos(gl#) r(xi%) = rcosb * cosgl r(yi%) = rcosb * sengl r(zi%) = rv# * Sin(bl#) Div dr#, rv# v(xi%) = r(xi%) * dr# - r(zi%) * db# * cosgl - r(yi%) * dl# v(yi%) = r(yi%) * dr# - r(zi%) * db# * sengl + r(xi%) * dl# v(zi%) = r(zi%) * dr# + db# * rcosb EndProc ' >Procedure polar2rect(g As Double, l As Double, v As Double, ByRef q() As Double ) Local c As Double g = Rad(g) l = Rad(l) c = Cos(l) q(xi%) = v * c * Cos(g) q(yi%) = v * c * Sin(g) q(zi%) = v * Sin(l) EndProc ' >Procedure rect2polar(ByVal q() As Double, ByRef g As Double, ByRef l As Double, ByRef v As Double) Naked g = Deg(@artan2(q(yi%), q(xi%))) v = Square(q(xi%)) + Square(q(yi%)) l = Deg(Atn(q(zi%) / Sqr(v))) v = Sqr(v + Square(q(zi%))) EndProc ' >Procedure seriesen(g As Double, ByRef s#, ByRef s2#, ByRef s3#, ByRef s4#, ByRe f s5#) Local c As Double s# = Sin(Rad(g)) c = Cos(Rad(g)) s2# = d2 * s# * c s3# = d3 * s# - d4 * s# * s# * s# s4# = d4 * s# * c * c * c - d4 * s# * s# * s# * c s5# = d5 * s# * c * c * c * c - md * s# * s# * s# * c * c + s# * s# * s# * s# * s#

EndProc ' >Procedure cotrans(ar As Double, dc As Double, ByRef gl As Double, ByRef bl As D ouble, phi As Double) Local Double sinar, cosar, sindc, cosdc, sineps, coseps, a, b a = Rad(Abs(phi)) sineps = Sin(a) coseps = Cos(a) dcosenos(ar, dc, sinar, cosar, sindc, cosdc) If phi > d0 a = coseps * sindc - sineps * cosdc * sinar b = sineps * sindc + coseps * cosdc * sinar Else a = coseps * sindc + sineps * cosdc * sinar b = -sineps * sindc + coseps * cosdc * sinar EndIf gl = Deg(@artan2(b, cosar * cosdc)) bl = Deg(Asin(a)) EndProc ' ' PLANET GROUP FUNCTIONS >Function inrange(p%, lo%, hi%) As Boolean If (p% < lo% Or p% > hi%) Then Return False Else Return True EndFunc >Procedure clear_seq ArrayFill pl_test_vec?(), False EndProc >Function first_in_seq() As Int Local p% For p% = lun% To allplanets% If pl_test_vec?(p%) Then Return p% Next p% Return 0 EndFunc >Function last_in_seq() As Int Local p% For p% = allplanets% DownTo lun% If pl_test_vec?(p%) Then Return p% Next p% Return 0 EndFunc >Function is_in_seq(p%) As Boolean Naked Return pl_test_vec?(p%) EndFunc >Procedure set_in_seq(p%) Naked pl_test_vec?(p%) = True EndProc ' ' ###################################################################### ' IMPLEMENTATION MODULE MGraficos ' ###################################################################### ' >Procedure fullscreen Cls Menu Kill If alta? Then abra_bigw ra = 1.1 xv% = 0 yv% = 0 av% = _X

hv% = _Y xcentro% = Add(xv%, av% \ 2) ycentro% = Add(yv%, hv% \ 2) Clip xv%, yv%, Succ(av%), Succ(hv%) SetFont "riyal32", 8, True Global doble? = False Global corta? = False Select opcion% Case ctl%, hrz% Win_1.BackColor = black% atras% = black% EndSelect If blanco? GraphMode R2_COPYPEN Win_1.BkColor = brwhite% brblanco% = brwhite% Color brwhite% DefFill 37 PBox xv%, yv%, Succ(av%), Succ(hv%) Else brblanco% = white% EndIf GraphMode 1 Win_1.ControlBox = True Win_1.Caption = version$ If granventana? And opcion <> nat% Then nombre$ = titulos$(xmenu%(opcion%)) If basenamed? And ultimo% > plu% Then ultimo% = nombrados% Clip 0, 0, av%, hv% EndProc ' >Procedure grpantalla If Not aborta? Then toquemouse Clr doble?, corta? cambiafont(14) ultimo% = Pred(brinca%) GraphMode 1, OPAQUE DefLine 0, 1 Cls drawmenu altaresolucion atras% = basefondo% Win_1.BackColor = atras% Win_1.ForeColor = white% Win_1.ControlBox = True Win_1.Sizeable = False Win_1.MaxButton = False Win_1.Caption = version$ Clip Off EndProc ' >Function radio(k As Double) As Double Naked Return CFloat(hv%) / mc * (k + d3 + Mul(k3%, corta?)) * z5 EndFunc ' >Procedure xyrect(d#, r#, ByRef ix%, ByRef iy%) ix% = Sub(xcentro%, CInt(ra * r# * CosQ(d#))) iy% = Sub(ycentro%, CInt(r# * SinQ(d#))) EndProc ' >Function angulo(gl As Double) As Double

Local Double m, p = d0 If doble? If Not corta? gl = @mdl(gl + cd(ayanamsa%)) If basesideral? Then p = n3 - cd(ayanamsa%) EndIf If Not base_eu? signo% = @rxsector(gl) m = @mdl(puntarx(Succ(signo%)) - puntarx(signo%)) m = n3 * @mdl(gl - puntarx(signo%) - cusprx(primera%) + p) / m Else m = @mdl(gl - cusprx(primera%) + p) EndIf Else If Not base_eu? signo% = @sector(gl) m = @mdl(punta(Succ(signo%)) - punta(signo%)) m = n3 * @mdl(gl - punta(signo%) - cuspide(primera%)) / m Else m = @mdl(gl - cuspide(primera%)) EndIf EndIf m = ng - m + n3 * (Pred(signo%)) * (Not base_eu?) Return @mdl(m) EndFunc ' >Procedure domos Local ix%, iy%, glon As Double, z%, r As Double GraphMode R2_COPYPEN, OPAQUE r = @radio(90) Color yellow% DefFill 5 PEllipse xcentro%, ycentro%, r * ra, r r = @radio(86) Color RGB(240, 228, 166) Color brblanco% DefFill 38 If blanco? Then DefFill 8 PEllipse xcentro%, ycentro%, r * ra, r DefLine 2, 1 Color black%, brblanco% For i% = 1 To k2% If (Not base_eu?) Or (opcion% = bru%) glon = Mul(k3%, i%) Color grey% DefLine 2, 1 Else If doble? Then glon = ng - puntarx(i%) Else glon = ng - punta(i%) If i% = 1 Or i% = 4 Or i% = 7 Or i% = 10 Color black% DefLine 0, 1 Else Color grey% DefLine 4, 1 EndIf EndIf xyrect(glon, r, ix%, iy%) Line ix%, iy%, xcentro%, ycentro% Next i% If Not base_eu? Then etiquetas

EndProc ' >Procedure etiquetas Local ix%, iy%, glon As Double, z%, r As Double GraphMode R2_COPYPEN, OPAQUE If opcion% <> bru% r = @radio(Sub(92, base_eu?)) For z% = 1 To k2% If Not base_eu? glon = ng - @mdl(Pred(z%) * n3) Else If doble? Then glon = ng - puntarx(z%) Else glon = ng - punta(z%) EndIf xyrect(glon, r, ix%, iy%) Sub iy%, 7 If doble? Then q$ = Trim$(rxfntcasa$(z%)) Else q$ = Trim$(fontcasa$(z%)) Select z% Case 1 Sub ix%, Sub(Mul(Len(q$), 10), 12) Case 2 Sub ix%, Sub(Mul(Len(q$), 10), 8) Sub iy%, 4 Case 3 Sub ix%, Sub(Mul(Len(q$), fa%), 3) Sub iy%, 2 Case 4 Sub ix%, Mul(Len(q$), 7) \ 2 Add iy%, 3 Case 5 Sub ix%, 2 Add iy%, 2 Case 6 Sub ix%, 3 Sub iy%, 1 Case 7 Sub ix%, 4 Add iy%, 2 Case 8 Sub ix%, 2 Add iy%, 3 Case 9 Add iy%, 2 Case 10 Sub ix%, Mul(Len(q$), 7) \ 2 Add iy%, 0 Case 11, 12 Sub ix%, Mul(Len(q$), 8) Add iy%, 0 Default Inc dummy% EndSelect Color brcyan%, atras% If blanco? Then Color black%, brwhite% EndIf Text ix%, iy%, q$ Next z% EndIf EndProc '

>Procedure gpuntos(top%) Local Double glon, r, l, ix%, iy%, f$, b%, bmedia%, l1%, l2%, l0% Const bmax% = 3600000 DefFill 0 Color purple% r = @radio(Add(83, Mul(3, corta?))) If base_eu? Or opcion% = bru% For pl% = 1 To top% glon = spx%(pl%) / mz xyrect(glon, r, ix%, iy%) PCircle ix%, iy%, 4 Next pl% EndIf If corta? Then b% = 60000 Else b% = 40000 bmedia% = b% Div 2 For pl% = 1 To Pred(top%) ' del Asc. a la derecha l1% = spx%(pl%) ' valor mas alto antes de 360 l2% = spx%(Succ(pl%)) ' valor inmediato inferior l0% = Sub(bmax%, bmedia%) ' valor maximo aceptado If l1% > l0% l1% = l0% spx%(pl%) = l0% EndIf ' disminuimos corriendolos a la derecha If Sub(l1%, l2%) < b% spx%(Succ(pl%)) = Sub(l1%, b%) EndIf Next pl% For pl% = top% DownTo 2 ' del Asc. a la izquierda l1% = spx%(pl%) ' valor mas bajo antes de cero l2% = spx%(Pred(pl%)) ' valor inmediato superior If l1% < bmedia% ' valor minimo aceptado l1% = bmedia% spx%(pl%) = l1% EndIf ' aumentamos corriendolos a la izquierda If Sub(l2%, l1%) < b% spx%(Pred(pl%)) = Add(l1%, b%) EndIf Next pl% DefLine 1, 16 r = @radio(Add(Add(76, base_eu?), Mul(3, corta?))) GraphMode R2_MERGEPEN Color black%, RGB(193, 193, 193) If blanco? Color black%, brwhite% EndIf For pl% = 1 To top% glon = spx%(pl%) / mz ix% = Sub(k2%, CInt(glon) / n3) Select ix% Case 9 To 11 l = r + d3 + d6 * Abs(CosQ(glon)) Case 0, 12 l = r + md + d2 Case 1, 2 l = r + n2 + d2 Case 3, 4

l = r + d4 + d6 Case 5 l = r + d5 Case 6 l = r + d2 Default l = r EndSelect f$ = fila$(pl%) xyrect(glon, l, ix%, iy%) Text ix%, Sub(iy%, fa%), Left$(f$) ' Sa Sub l, fh% + CosQ(glon) xyrect(glon, l, ix%, iy%) Text Sub(ix%, 4), Sub(iy%, fa%), Mid$(f$, 2, 2) ' 23 Sub l, fh% xyrect(glon, l, ix%, iy%) Text Sub(ix%, 4), Sub(iy%, fa%), Mid$(f$, 4, 1) ' Le Sub l, fh% xyrect(glon, l, ix%, iy%) Text Sub(ix%, 4), Sub(iy%, fa%), Mid$(f$, 5, 2) ' 34 If opcion% <> bru% And Not doble? Sub l, Pred(fh%) xyrect(glon, l, ix%, iy%) Text Sub(ix%, 4), Sub(iy%, fa%), Right$(f$, 2)' r EndIf Next pl% EndProc ' >Procedure sombras Local acolor%, bcolor%, a%, b%, r As Double, i%, x2%, y2% If Not base_eu? r = 3.9466667 + sideral(1) * (opcion% = hel%) For i% = 1 To k2% If basesideral? Add r, sideral(i%) spx%(i%) = CInt(@mdl(n8 - @angulo(@mdl(Abs(cd(svp%) - ng) + r)))) Else spx%(i%) = CInt(@mdl(n8 - @angulo(@mdl(Mul(i%, k3%)) - cd(ayanamsa%)))) EndIf Next i% spx%(13) = spx%(1) Color black% If blanco? Color white% GraphMode R2_COPYPEN r = @radio(88) DefLine 0, 11 Ellipse xcentro%, ycentro%, r * ra, r, 0, kg% Color black% DefLine 0, 1 Ellipse xcentro%, ycentro%, @radio(90) * ra, @radio(90), 0, kg% Ellipse xcentro%, ycentro%, @radio(86) * ra, @radio(86), 0, kg% EndIf r = @radio(90) DefLine 0, 1 Ellipse xcentro%, ycentro%, r * ra, r, 0, kg% r = @radio(88) Color brblue% DefLine 0, 11 If Not blanco? Then GraphMode R2_MERGEPEN

For i% = 1 To k2% a% = spx%(i%) b% = spx%(Succ(i%)) If Sub(b%, a%) < 0 And Odd(i%) Ellipse xcentro%, ycentro%, r * ra, r, 0, b% Ellipse xcentro%, ycentro%, r * ra, r, a%, kg% Else If Odd(i%) Ellipse xcentro%, ycentro%, r * ra, r, a%, b% EndIf Next i% Else Color white% DefLine 1, 11 Ellipse xcentro%, ycentro%, @radio(88) * ra, @radio(88), 0, kg% If blanco? GraphMode R2_COPYPEN Color black% DefLine 0, 1 Ellipse xcentro%, ycentro%, @radio(90) * ra, @radio(90), 0, kg% EndIf GraphMode 1 DefLine 0, 1 For i% = 0 To 360 Step 5 r = @angulo(i% - cd(ayanamsa%)) xyrect(r, @radio(91), ix%, iy%) If i% Mod k3% xyrect(r, @radio(86), x2%, y2%) Else xyrect(r, @radio(79), x2%, y2%) EndIf Line ix%, iy%, x2%, y2% Next i% etiquetas EndIf EndProc ' >Function gcentro() As Int Naked Return Sub(xcentro%, CInt(CFloat(Len(q$)) * 3.7)) ' *** x/2*8 *** EndFunc ' >Procedure datos Local a%, b%, cm% = RGB(193, 193, 193) a% = Sub(xcentro%, 60) b% = Sub(ycentro%, 50) GraphMode Mul(-R2_COPYPEN, Not blanco?) Color cm% DefFill 38 PBox a%, b%, Add(a%, 120), Add(b%, 105) Color black%, cm% If dgnom$ = nul$ If Not (Abs(dj - tx) NEAR d0) Or doble? q$ = Trim$(titulo$) Else q$ = "Radix" EndIf Else q$ = Upper$(dgnom$) EndIf If blanco? Then Color black%, brwhite%

EndIf SetFont "fixedsys", , False Text @gcentro, Sub(ycentro%, 33), q$ q$ = Trim$(vcfecha$(rdia%)) + " " + Left$(vcfecha$(rmes%), 3) + " " + Trim$(vc fecha$(rano%)) Text @gcentro, Sub(ycentro%, 20), q$ q$ = vcfecha$(rhora%) + " UT" Text @gcentro, Sub(ycentro%, 7), q$ If opcion% <> hel% q$ = vcfecha$(rlat%) + "/" + vcfecha$(rlon%) Text @gcentro, Add(ycentro%, 6), q$ fsegundos(k4%, -1, ts / n5, 0, q$) Text @gcentro, Add(ycentro%, 19), q$ EndIf If opcion% = nat% q$ = Trim$(hdom$(sistema%)) Text @gcentro, Add(ycentro%, 32), q$ EndIf EndProc ' >Procedure dispare(ByRef posit#(), ByRef j%) Local last%, salte% salte% = aries% If basedom% = zod% last% = Max(ultimo%, Mul(BML%, -(basenoire% > 0))) Else If doble? last% = Add(m_c%, Abs(posit#(m_c%, longitud%) - cusprx(decima%)) < p4) If Abs(posit#(asc%, longitud%) - cusprx(primera%)) < p4 Then salte% = asc% Else last% = Add(m_c%, Abs(posit#(m_c%, longitud%) - cuspide(decima%)) < p4) If Abs(posit#(asc%, longitud%) - cuspide(primera%)) < p4 Then salte% = asc % EndIf EndIf j% = 0 For pl% = lun% To last% If planets_in_wheel?(pl%) If pl% = Succ(ultimo%) Then pl% = nodo% If pl% = nodo% And basenodo% = 0 Then Inc pl% If pl% = BML% And basenoire% = 0 Then Inc pl% If pl% <= last% And pl% <> salte% Inc j% spi%(j%) = j% If basedom% = zod% spx%(j%) = CInt((ng - @mdl(posit#(pl%, longitud%) + cd(ayanamsa%))) * mz) Else spx%(j%) = CInt(@angulo(posit#(pl%, longitud%)) * mz) EndIf If corta? fsigno(0, posit#(pl%, longitud%), 0, signo%, q$, q2$) fila$(Add(kc%, j%)) = plfont$(pl%) + q2$ + " " Else fila$(Add(kc%, j%)) = plfont$(pl%) + fontplan$(pl%) EndIf EndIf EndIf Next pl% QSort spx%(-), j%, spi%()

For pl% = 1 To j% fila$(pl%) = fila$(Add(spi%(pl%), kc%)) Next pl% EndProc >Procedure grnatal Local rd As Double, j%, x2%, y2%, ix%, iy% fullscreen If Not (Abs(dj - tx) NEAR d0) And Not ingress? Alert 2, "How do you| want it? ", 2, "normal|bi-wheel", n% If n% = 2 Then doble? = True If n% = 0 Then aborta? = True EndIf If Not aborta? vcangulos domificacion igualizar(0) dispare(vc(), j%) domos gpuntos(j%) sombras If doble? corta? = True Swap cd(ayanamsa%), ayanx rd = @radio(84) GraphMode R2_COPYPEN, TRANSPARENT DefLine 0, 11 Color RGB(173, 173, 200) Ellipse xcentro%, ycentro%, rd * ra, rd rd = @radio(86) Color grey% DefLine 0, 1 Ellipse xcentro%, ycentro%, rd * ra, rd If Not blanco? rd = @radio(82) DefLine 3, 1 Ellipse xcentro%, ycentro%, rd * ra, rd EndIf If base_eu? For i% = 0 To 360 Step 10 rd = @angulo(i% - cd(ayanamsa%)) xyrect(rd, @radio(86), ix%, iy%) If i% Mod k3% DefLine 0, 1 xyrect(rd, @radio(82), x2%, y2%) Else DefLine 0, 2 xyrect(rd, @radio(82), x2%, y2%) EndIf Line ix%, iy%, x2%, y2% Next i% EndIf DefLine 0, 1 dispare(radix(), j%) gpuntos(j%) Swap cd(ayanamsa%), ayanx EndIf EndIf datos grpantalla EndProc

' >Procedure octoscopio Local s$, s2$, u$, cusp%, tp Local Const c22 = 22.5 Local Dim median$(12) Restore topoi For cusp% = 1 To k2% Read median$(cusp%) Next cusp% topoi: Data "Regiomontanus octotopos 3"," octotopos 2"," oc totopos 1" Data " octotopos 8"," MC/ASC "," MC /DESC " Data " Campanus octotopos 3"," octotopos 2"," oc totopos 1" Data " octotopos 8"," MC/ASC "," MC /DESC " encabezado(" OCTOSCOPE") fsegundos(k4%, -1, ts / n5, 0, q$) fsegundos(kg%, 1, geos(lon%), 0, s$) If geos(lon%) >= d0 Then s$ = "+" + Trim$(s$) fsegundos(kg%, 1, geos(lat%), 0, s2$) If geos(lat%) >= d0 Then s2$ = "+" + Trim$(s2$) Color black%, cyan% ftab(13, "ARMC=" + Trim$(q$) + " Lon=" + Trim$(s$) + " Lat=" + Trim$(s2$)) Color white%, atras% baja(4) tp = c22 For cusp% = 1 To 4 octo(cusp%) = @asoblicua(ts, tanlat, Rad(tp)) octo(Add(cusp%, 6)) = @asoblicua(ts, tanlat, Atn(geos(ucos%) * Tan(Rad(tp))) ) Add tp, c5 Next cusp% octo(5) = @asoblicua(ts, tanlat, Rad(c5)) octo(6) = @asoblicua(ts, tanlat, Rad(c5 + n9)) octo(11) = @asoblicua(ts, tanlat, Atn(geos(ucos%) * Tan(Rad(c5)))) octo(12) = @asoblicua(ts, tanlat, Atn(geos(ucos%) * Tan(Rad(c5 + n9)))) For cusp% = ascendente% To mediocielo% farcseconds(cuspide(cusp%) + cd(ayanamsa%) * (basedom% = zod%), s$) ftab(28, casa$(cusp%) + " = " + s$) baja(xi%) Next cusp% baja(xi%) For cusp% = 1 To k2% farcseconds(octo(cusp%) + cd(ayanamsa%) * (basedom% = zod%), s$) ftab(14, median$(cusp%) + " = " + s$) baja(xi%) If cusp% = 6 Then baja(xi%) Next cusp% pantalla 'Local rd As Double, j%, x2%, y2%, ix%, iy% 'octo(1) = @asoblicua(ts, tanlat, Rad(c5)) 'octo(2) = @asoblicua(ts, tanlat, Rad(n9 + c5)) 'fullscreen 'vcangulos 'dispare(vc(), j%) 'domos 'gpuntos(j%)

'sombras 'datos 'grpantalla EndProc ' >Procedure grhelio Local a As Double, j%, base%, t$ t$ = nombre$ nombre$ = "Heliocentric" base% = basedom% If base% <> zod% basedom% = zod% vcangulos domificacion igualizar(0) EndIf fullscreen j% = 0 For pl% = sol% To ultimo% If planets_in_wheel?(pl%) Inc j% a = @mdl(heliop(pl%, hlon%) - n8 * (pl% = sol%)) spx%(j%) = CInt((ng - @mdl(a + cd(ayanamsa%))) * mz) spi%(j%) = pl% fsigno(0, a, 0, signo%, q$, q2$) fila$(Add(kg%, j%)) = plfont$(pl%) + q2$ + " " EndIf Next pl% QSort spx%(-), j%, spi%() For pl% = 1 To j% fila$(pl%) = fila$(Add(spi%(pl%), Pred(kg%))) Next pl% domos gpuntos(j%) sombras datos If base% <> zod% basedom% = base% vcangulos domificacion EndIf nombre$ = t$ grpantalla EndProc ' >Procedure brujula Local az As Double, h As Double, j% fullscreen Sub xcentro%, 40 j% = 0 For pl% = lun% To ultimo% If planets_in_wheel?(pl%) Inc j% acimutaltura(vc(pl%, ascensionrecta%), vc(pl%, declinacion%), az, h) spx%(j%) = CInt(@mdl(n9 - az) * mz) spi%(j%) = pl% fsigno(0, az - cd(ayanamsa%) + n9, 0, signo%, q$, q2$) fila$(Add(kg%, j%)) = plfont$(pl%) + q2$ + " '" EndIf Next pl%

QSort spx%(-), j%, spi%() For pl% = 1 To j% fila$(pl%) = fila$(Add(spi%(pl%), kg%)) Next pl% domos gpuntos(j%) j% = 0 For pl% = lun% To ultimo% If planets_in_wheel?(pl%) Inc j% acimutaltura(vc(pl%, ascensionrecta%), vc(pl%, declinacion%), az, h) spx%(j%) = CInt(-h * mz) spi%(j%) = pl% EndIf Next pl% QSort spx%(), j%, spi%() Color white%, atras% For pl% = 1 To j% nortesur(-spx%(pl%) / mz, 0, q2$) q$ = plfont$(spi%(pl%)) + " " + q2$ Text Sub(av%, 85), Add(Sub(Sub(hv%, fh%), Mul(j%, 14)), Mul(14, Pred(pl%))), q$ Next pl% cambiafont(14) Color brwhite%, atras% Text Sub(xcentro%, fa% Div 2), Sub(ycentro%, Add(65, fa%)), "N" Text Sub(xcentro%, fa% Div 2), Add(ycentro%, 60), "S" Text Sub(xcentro%, Add(67, fa%)), Sub(ycentro%, fh% Div 2), "W" Text Add(xcentro%, 65), Sub(ycentro%, fh% Div 2), "E" datos grpantalla EndProc ' ' ###################################################################### ' IMPLEMENTATION MODULE MUraniano ' ###################################################################### ' Procedure uranianos Local Double l, rv, z, w, plb%, s$ Local Dim spm$(kl%) Restore transnep w = (dj - j1900 - cd(dt%)) / jq encabezado(" URANIANS") For pl% = 1 To 8 @txt(cyan%) Read s$, l, z, rv l = Rad(@mdl(l + w * z - vc(sol%, longitud%))) l = Deg(@artan2(rv * Sin(l), rv * Cos(l) + vc(sol%, rvector%))) l = @mdl(l + vc(sol%, longitud%)) fsigno(0, l, 0, signo%, q$, q2$) corrfont n% = Add(Mul(18, pl% Mod 4), 4) ftab(n%, s$ + "=" + q2$) If pl% = 4 baja(xi%) EndIf Next pl% bandera% = 0 baja(yi%) If baseasteroides? And Not basenamed?

If @withinrange(finpl%) Open ExecPath + "asteroid.fle" for Input As # 6 orden% = 0 deg$ = deg3$ '--------------------------------' ADD THE PLANETS AND THE ANGLES For plb% = lun% To m_c% If plb <> aries% sumalista(plb%, vc(plb%, longitud%)) EndIf Next plb% '--------------------------------' ADD THE INTERNAL ASTEROIDS For plb% = Succ(planeta%) To allplanets% If @withinrange(plb%) tabephem(plb%) sumalista(plb%, vc(plb%, longitud%)) EndIf Next plb% '--------------------------------sumalista(lim%, cuspide(vertex%)) '--------------------------------' ADD THE EXTERNAL ASTEROIDS If baseswextra% For plb% = 1 To baseswextra% If @withinrange(plb%) If @swiss_aster(lim%, swextra%(plb%)) pqposicion(aux%) sumalista(Add(plb%, lim%), vc(aux%, longitud%)) Else sumalista(Add(plb%, lim%), d0) EndIf EndIf Next plb% EndIf '--------------------------------' SAVE THE ORIGINAL LIST OF NAMES For plb% = 1 To Succ(orden%) spm$(plb%) = spk$(Add(plb%, plb% > aries%)) Next plb% '--------------------------------' SHOW THE EXTERNAL ASTEROIDS If baseswextra% QSort spk$(), orden%, spj%() contador% = 0 For plb% = 1 To orden% If spj%(plb%) > lim% Inc contador% q$ = spk$(plb%) + "= " + Left$(fila$(spj%(plb%)), 10) @txt(yellow%) n% = Add(5, Mul(24, Pred(@disminuye(contador%, 3)))) ftab(n%, q$) If Mod(contador%, 3) = 0 baja(xi%) EndIf EndIf Next plb% EndIf '--------------------------------deg$ = deg1$

Close # 6 pantalla If Not aborta? encabezado(" SORT ALL") QSort spx%(), orden%, spi%() suspendwrite? = True rtb.ScrollBars = basVertical rtb.Refresh rtb.SelStart = 0 rtb.SelColor = white% rtb.Visible = True rtb.SelText = Space$(13) + "Lon Lat Dec i range"#10 For plb% = 1 To orden% salecolor(spi%(plb%)) q$ = spm$(spi%(plb%)) + "= " + fila$(spi%(plb%)) rtb.SelText = q$ rtb.SelText = #10 ftab(6, q$) baja(xi%) Next plb% rtb.SelColor = brblue% EndIf EndIf EndIf pantalla EndProc '-----------------------------------------transnep: Data "CUPIDO ",104.5959,138.5369,40.998370 Data "HADES ",337.4517,101.2176,50.667443 Data "ZEUS ",104.0904, 80.4057,59.214362 Data "KRONOS ", 17.7346, 70.3863,64.816896 Data "APOLLON ",138.0354, 62.5000,70.361652 Data "ADMETOS ", -8.6780, 58.3468,73.736476 Data "VULCANUS", 55.9826, 54.2986,77.445895 Data "POSEIDON",165.3595, 48.6486,83.493733 ' >Procedure ejescomunes Local Double ax, bx, cx, dx, mp, lp, dp Local pl1%, pl2%, pl3%, pl4%, v$, v2$, raya$ Local ListItem LVIt suspendwrite? = True encabezado(" MIDPOINTS") vcangulos contador% = 1 baja(xi%) deg$ = deg2$ SV(2).Clear SV(2).Visible = True For pl1% = lun% To m_c% brinque(brinca%, pl1%) For pl2% = pl1% To m_c% brinque(brinca%, pl2%) ax = vc2(pl1%) bx = vc2(pl2%) mp = @mdl(ax + bx) For pl3% = Succ(pl1%) To m_c% brinque(brinca%, pl3%) If pl3% <> pl2% And pl3% <> pl1%

Hdis

Yrs

For pl4% = pl3% To m_c% brinque(brinca%, pl4%) If pl4% <> pl2% And pl4% <> pl1% cx = vc2(pl3%) dx = vc2(pl4%) lp = @mdl(cx + dx) dp = Abs(mp - lp) If dp < d2 Or dp > 358 If Not (pl3% = pl4% And pl1% = pl2%) If pl3% = pl4% Or pl1% = pl2% If pl1% = pl2% v$ = Left$(plaux$(pl1%), 7) raya$ = plaux$(pl1%) + ";" + nul$ Else v$ = Left$(plaux$(pl1%), 3) + "+" + Left$(plaux$(pl2%), 3) raya$ = plaux$(pl1%) + ";" + plaux$(pl2%) EndIf fsigno(0, mp * z5, 0, signo%, q$, q2$) v$ = v$ + " (" + q$ + ")" + "=" raya$ = raya$ + ";" + q$ fminutos(kg%, @mdl(mp * z5 + cd(ayanamsa%)), 0, 0, q$) raya$ = raya$ + ";" + q$ If pl3% = pl4% v$ = v$ + Left$(plaux$(pl3%), 7) raya$ = raya$ + ";" + plaux$(pl3%) + ";" + nul$ Else v$ = v$ + Left$(plaux$(pl3%), 3) + "+" + Left$(plaux$(pl4% ), 3) raya$ = raya$ + ";" + plaux$(pl3%) + ";" + plaux$(pl4%) EndIf fsigno(0, lp * z5, 0, signo%, q$, q2$) v$ = v$ + " (" + q$ + ")" raya$ = raya$ + ";" + q$ dp = Abs(dp + ng * (dp > 358)) * z5 fminutos(kg%, Abs(dp + n9 * (dp > 89)), 0, 0, q$) raya$ = raya$ + ";" + q$ ftab(13, v$ + q$) Set LVIt = SV(2).Add LVIt.AllText = raya$ Inc contador% baja(xi%) EndIf EndIf EndIf EndIf Next pl4% EndIf Exit If aborta? Next pl3% Exit If aborta? Next pl2% Exit If aborta? Next pl1% pantalla SV(2).Visible = False EndProc ' ' * por parejas * >Procedure normasi Local Double d, ax, bx, pl1%, pl2%, s$

encabezado(" PAIRS") vcangulos contador% = 0 s$ = "Midpoint Sum Subtr Dexter Sinister" ftab(16, s$) baja(yi%) If baseimpresora? Then sayredir pb.Min = 0 pb.Max = aries% For pl1% = lun% To aries% brinque(brinca%, pl1%) pb.Value = pl1% For pl2% = Succ(pl1%) To aries% brinque(brinca%, pl2%) Inc contador% q$ = Left$(plaux$(pl1%), 3) + "/" + Left$(plaux$(pl2%), 3) ftab(4, q$) ax = vc2(pl1%) bx = vc2(pl2%) If bx > ax Then Swap ax, bx d = ax - bx fsigno(0, (ax + bx) * z5, 15, signo%, q$, q2$) fsigno(0, ax + bx, 27, signo%, q$, q2$) fsigno(0, d, 39, signo%, q$, q2$) fsigno(0, ax + d, 51, signo%, q$, q2$) fsigno(0, bx - d, 63, signo%, q$, q2$) If contador% > @limite() And Not baseimpresora? pantalla Exit If aborta? encabezado(" PAIRS") ftab(16, s$) baja(yi%) Else baja(xi%) EndIf Next pl2% Exit If aborta? Next pl1% pantalla EndProc ' ' * por secuencia * >Procedure normasii Local Double d, ax, bx, pl1%, pl2%, s1$, s2$, cuenta%, i%, j%, l%, top% encabezado(" SEQUENCE") vcangulos cuenta% = 0 For pl1% = lun% To m_c% brinque(brinca%, pl1%) Inc cuenta% spi%(cuenta%) = cuenta% spx%(cuenta%) = CInt(vc2(pl1%) * mz) s1$ = Left$(plaux$(pl1%), 3) fila$(cuenta%) = s1$ For pl2% = Succ(pl1%) To m_c% brinque(brinca%, pl2%) ax = vc2(pl1%) bx = vc2(pl2%) d = @mdl(ax - bx) If d > n8

d = ng - d Swap ax, bx EndIf s2$ = Left$(plaux$(pl2%), 3) Inc cuenta% spx%(cuenta%) = CInt(@mdl((ax + bx) * z5) * mz) spi%(cuenta%) = cuenta% fila$(cuenta%) = s1$ + "/" + s2$ Inc cuenta% spx%(cuenta%) = CInt(@mdl((ax + bx) * z5 + n8) * mz) spi%(cuenta%) = cuenta% fila$(cuenta%) = s1$ + "/" + s2$ Next pl2% Next pl1% QSort spx%(), cuenta%, spi%() baja(xi%) l% = @limite() '32x3 columnas If baseimpresora? Then sayredir pb.Min = 0 pb.Max = Succ(Div(cuenta%, l%)) For j% = 1 To pb.Max pb.Value = j% top% = Div(l%, 3) i% = 1 Repeat If i% > l% Sub i%, Pred(l%) baja(xi%) EndIf pl1% = Add(Mul(25, i% \ top%), Mul(25, Mod(i%, top%) = 0)) pl2% = Add(i%, Mul(l%, Pred(j%))) If pl2% <= cuenta% fsigno(0, spx%(pl2%) / mz, Add(5, pl1%), signo%, q$, q2$) ftab(Add(15, pl1%), fila$(spi%(pl2%))) EndIf Add i%, top% Until i% = Add(l%, top%) If Not baseimpresora? pantalla Exit If aborta? encabezado(titulo$) Else baja(xi%) EndIf baja(xi%) Next j% If baseimpresora? Then pantalla Cls EndProc ' >Procedure composite Print "Composite. Enter data for the second chart:" If @fecha If @hora If @loclon If @loclat encabezado(" COMPOSITE") bandera% = 0 armonica = d2 efemerides(sol%, ultimo%)

vcangulos orden% = 0 For pl% = lun% To m_c% brinque(brinca%, pl%) sumalista(pl%, @mdl((vc(pl%, longitud%) + radix(pl%, longitud%)) * z 5)) Next pl% salidalimpia pantalla llenaradix EndIf EndIf EndIf EndIf EndProc ' >Procedure harmonics Local modo% Do Print "Harmonic 1-999 ==> ('0'=exit) "; Form Input 3, q$ armonica = Val(q$) If armonica NEAR d0 Then aborta? = True Exit If (armonica > d0 And armonica < ml) Or aborta? Loop If Not aborta? If armonica = 9 Alert 2 | 16, nul$, 1, " NAVAMSA | NOVIEN", modo% Else modo% = 1 EndIf encabezado(" RADIX" + q$) orden% = 0 For pl% = lun% To m_c% brinque(brinca%, pl%) If modo% = 2 sumalista(pl%, @mdl( @mdl(vc(pl%, longitud%) - n3 + cd(ayanamsa%)) * arm onica - cd(ayanamsa%) + n3)) Else sumalista(pl%, @mdl( @mdl(vc(pl%, longitud%) + cd(ayanamsa%)) * armonica - cd(ayanamsa%))) EndIf Next pl% salidalimpia pantalla EndIf EndProc ' >Procedure altzodiac Local pl1% dlgplanetas("the zero point", pl1%, n%, m_c%, 1) If pl1% > 0 And pl1% <= m_c% encabezado(" ALTZODIAC") orden% = 0 For pl% = lun% To m_c% brinque(brinca%, pl%) sumalista(pl%, @mdl(vc(pl%, longitud%) - vc(pl1%, longitud%))) Next pl% salidalimpia pantalla

EndIf EndProc ' >Procedure microscope Local pl1%, pl2% dlgplanetas("the harmonic pair", pl1%, pl2%, m_c%, 2) If pl1% = pl2% Then pl2% = 0 If (pl1% > 0 And pl1% <= m_c%) And (pl2% > 0 And pl2% <= m_c%) armonica = ng / @angdist(vc(pl1%, longitud%), vc(pl2%, longitud%)) encabezado(" MICROSCOPE") orden% = 0 For pl% = lun% To m_c% brinque(brinca%, pl%) sumalista(pl%, @mdl(vc(pl%, longitud%) * armonica)) Next pl% salidalimpia pantalla EndIf EndProc ' >Procedure salidalimpia QSort spx%(), orden%, spi%() baja(xi%) For j% = 1 To (orden% Div 2) pl% = spi%(j%) salecolor(pl%) ftab(13, plaux$(pl%) + " = ") ftab(26, fila$(pl%)) @txt(white%) pl% = spi%(Add(j%, orden% Div 2)) salecolor(pl%) ftab(43, plaux$(pl%) + " = ") ftab(56, fila$(pl%)) @txt(white%) baja(xi%) If j% = (orden% Div 2) And Odd(orden%) pl% = spi%(orden%) salecolor(pl%) ftab(43, plaux$(pl%) + " = ") ftab(56, fila$(pl%)) @txt(white%) baja(xi%) EndIf Next j% EndProc ' >Procedure planetocentric Local bpl%, p%, l As Double, b As Double, d As Double dlgplanetas("the center planet", p%, n%, ultimo%, 1) If (p% = 0 Or inrange(p%, nodo%, m_c%)) Print range$ prueba? = False EndIf If prueba? tb.ScrollBars = basVertical tb.Visible = True deg$ = deg3$ encabezado(" PLANETOCENTRIC") suspendwrite? = True ftab(3, "center: " + Upper$(plaux$(p%)))

ftab(28, "Longitude") ftab(44, "Latitude") ftab(56, "Distance") tb.Text = tb.Text + Left$(nuevalinea$, 78) + crlf$ + crlf$ baja(yi%) astercheck(n%) For bpl% = lun% To ultimo% If bpl% <> p% For i% = 1 To 3 If bpl% = lun% g(i%) = -helior(sol%, i%) - helior(p%, i%) Else If bpl% = sol% g(i%) = -helior(p%, i%) Else g(i%) = helior(bpl%, i%) - helior(p%, i%) EndIf Next i% rect2polar(g(), l, b, d) If bpl% = lun% Then q$ = "Earth " Else q$ = plaux$(bpl%) ftab(11, q$ + " =") fsigno(1, l, 27, signo%, q$, q2$) fminutos(kg%, b, 0, 43, q$) ftab(57, Str$(d, 6, 2)) tb.Text = tb.Text + Left$(nuevalinea$, 78) + crlf$ baja(xi%) EndIf Next bpl% pantalla EndIf EndProc ' >Procedure resonancias EndProc ' '###################################################################### ' ALL LISTS MODULE '###################################################################### ' >Procedure abra_bigw If alta? Win_1.Visible = False Win_1.Sizeable = True SizeW 1, Sub(desk_X, 45), Sub(desk_Y, 35) Win_1.Center 0 Win_1.Visible = True SV(3).Width = Sub(desk_X, 50) SV(5).Width = Sub(desk_X, 50) SV(6).Width = Sub(desk_X, 50) cmdEsc.Left = Sub(Sub(desk_X, 40) Div 2, 70) Else cmdEsc.Left = 340 EndIf cmdEsc.Caption = "close list" EndProc ' >Procedure estrellas Local mag As Single, m As Single, debajo?, ip%, ipl% Local Double dh, sa, sad, h, ar, dc, gl, bl, rv, az, alt Local cat$, raya$ Local ListItem LVIt

Alert 2, "|limiting magnitude?", 3, "1|2|3|4|5", n% m = CFloat(n%) deg$ = deg2$ abra_bigw SV(3).Clear SV(3).Visible = True suspendwrite? = True For ip% = 1 To Add(cuantas%, ultimo%) ipl% = Sub(ip%, cuantas%) If inrange(ipl%, lun%, ultimo%) cat$ = spc$ + plaux$(ipl%) ar = vc(ipl%, ascensionrecta%) dc = vc(ipl%, declinacion%) mag = d2 Else starcatalog(ip%, ar, dc, mag, cat$) EndIf If mag <= m raya$ = cat$ polar2rect(ar, dc, d1, r()) ecuatoriales(-etrue%, r()) rect2polar(r(), gl, bl, rv) acimutaltura(ar, dc, az, alt) semiarco(ar, dc, dh, sa, sad, h, debajo?) fseg2(k4%, ar / n5, 0, q$) raya$ = raya$ + ";" + q$ fsegundos(kg%, 1, dc, 0, q$) raya$ = raya$ + ";" + q$ farcseconds(gl, q2$) raya$ = raya$ + ";" + q2$ nortesur(bl, 0, q$) raya$ = raya$ + ";" + q$ fsigno(0, @reduccion(sol%, ar, 1), 0, signo%, q$, q2$) corrfont raya$ = raya$ + ";" + q2$ fsegundos(kg%, 1, az, 0, q$) raya$ = raya$ + ";" + q$ fsegundos(kg%, 1, alt, 0, q$) raya$ = raya$ + ";" + q$ fminutos(k4%, @modulaparanes(ar), 1, 0, q$) raya$ = raya$ + ";" + q$ fminutos(k4%, @modulaparanes(@mdl(ar + n8)), 1, 0, q$) raya$ = raya$ + ";" + q$ If sad < n8 fminutos(k4%, @modulaparanes(@mdl(ar - sad)), 1, 0, q$) raya$ = raya$ + ";" + q$ fminutos(k4%, @modulaparanes(@mdl(ar + sad)), 1, 0, q$) raya$ = raya$ + ";" + q$ Else raya$ = raya$ + ";circunpolar;circunpolar" EndIf Set LVIt = SV(3).Add LVIt.AllText = raya$ EndIf Exit If aborta? Next ip% cmdEsc.Visible = True toquemouse cierrelista(3) EndProc

' >Procedure asteroides Local top%, j0, leefile?, neo?, raya$, s1$, s2$, s3$, s4$, s5$, s6$, s7$, s8$, lvit As ListItem If Exist(ExecPath + "named.dat") Open ExecPath + "named.dat" for Input As # 11 leefile? = True Else Alert 1, "|NO ELEMENTS FILE!", 1, " ENTER ", n% EndIf If leefile? deg$ = deg2$ pb.Refresh pb.Min = 0 pb.Max = SE_ASTER_NOM% pb.Visible = True SV(4).Clear elements.Clear efemerides(0, 0) vsop82(sol%, sol%) Close # 3 While Not EOF(# 11) Input # 11, s1$, s2$, s3$, s4$, s5$, s6$, s7$, s8$ Set lvit = elements.Add lvit.AllText = s1$ + ";" + s8$ + ";" + s3$ + ";" + s7$ + ";" + s4$ + ";" + s6$ + ";" + s5$ + ";" + s2$ pb.Value = elements.Count j0 = Val(s2$) - jp se = Val(s8$) lm = Rad(Val(s3$)) ex = Val(s7$) ph = Rad(Val(s4$)) in = Rad(Val(s6$)) na = Rad(Val(s5$)) ph = @rmdl(ph + na) lm = @rmdl(lm + ph + kg / (se ^ 1.5) * (dj - j0)) osc(aux%, ax%) = se osc(aux%, vl%) = lm osc(aux%, ec%) = ex osc(aux%, pn%) = ph osc(aux%, cl%) = in osc(aux%, an%) = na vectores(aux%, r(), v()) transformacion(j2000fecha%, ecliptica%, r()) transformacion(j2000fecha%, ecliptica%, v()) pqposicion(aux%) raya$ = s1$ astlist(raya$, aux%) raya$ = raya$ + ";" + Str$(elements.Count) Set lvit = SV(4).Add lvit.AllText = raya$ Wend Close # 11 SV(4).Visible = True top% = elements.Count pb.Visible = False For pl% = lun% To plu% raya$ = plaux$(pl%) astlist(raya$, pl%)

raya$ = raya$ + ";" + Str$(Add(pl%, top%)) Set lvit = SV(4).Add lvit.AllText = raya$ Next pl% cmdEsc.Caption = "close list" cmdEsc.Left = 340 cmdEsc.Visible = True Repeat Do : Sleep : Until prueba? Or aborta? If SV(4).SelectedCount And prueba? orden% = Val(SV(4).SelectedItem.SubItems(7)) If orden% <= top% elements.SelectedItem = elements.Item(orden%) s1$ = elements.SelectedItem.SubItems(0) j0 = Val(elements.SelectedItem.SubItems(7)) - jp se = Val(elements.SelectedItem.SubItems(1)) lm = Rad(Val(elements.SelectedItem.SubItems(2))) ex = Val(elements.SelectedItem.SubItems(3)) ph = Rad(Val(elements.SelectedItem.SubItems(4))) in = Rad(Val(elements.SelectedItem.SubItems(5))) na = Rad(Val(elements.SelectedItem.SubItems(6))) neo? = ((se * (d1 - ex)) <= d1) If Not neo? ph = @rmdl(ph + na) lm = @rmdl(lm + ph) osc(aux%, ax%) = se osc(aux%, vl%) = lm osc(aux%, ec%) = ex osc(aux%, pn%) = ph osc(aux%, cl%) = in osc(aux%, an%) = na vectores(aux%, r(), v()) integrat(j0, dj, n4) transformacion(j2000fecha%, ecliptica%, r()) transformacion(j2000fecha%, ecliptica%, v()) osculacion(aux%, r(), v()) pqposicion(aux%) raya$ = Upper$(Trim$(s1$)) + "|" impfecha(dj, 0, 0, 0, 0, q$) raya$ = raya$ + Trim$(q$) + "|" fminutos(k4%, tu, 0, 0, q$) raya$ = raya$ + Trim$(q$) + "|lon = " fsigno(0, vc(aux%, longitud%), 0, signo%, q$, q2$) raya$ = raya$ + Trim$(q$) + "|lat = " nortesur(vc(aux%, latitud%), 0, q$) raya$ = raya$ + Trim$(q$) + "|dec = " nortesur(vc(aux%, declinacion%), 0, q$) raya$ = raya$ + Trim$(q$) + "|IAU = " iauconstel(vc(aux%, ascensionrecta%), vc(aux%, declinacion%), q$) raya$ = raya$ + Trim$(q$) Else raya$ = "objects coming inside|the Earth's orbit are|not yet integra ted." EndIf Alert 4, raya$, 1, Space$(20) + "OK" + Space$(20), n% prueba? = False EndIf EndIf Until aborta? cierrelista(4)

elements.Clear EndIf EndProc ' >Procedure astorb(eb$, ByRef j As Double, ByRef m As Double, ByRef o$, ByRef u$, rk5?) Naked m = dj jd| = Val(Mid$(eb$, 113, 2)) ' EPOCH DAY jm| = Val(Mid$(eb$, 111, 2)) ' EPOCH MONTH ja% = Val(Mid$(eb$, 107, 4)) ' EPOCH YEAR getdj(jd|, jm|, ja%) j = dj ' EPOCH JD dj = m se = Val(Mid$(eb$, 169, 13)) ' SEMIMAJOR AXIS lm = Rad(Val(Mid$(eb$, 116, 10))) ' MEAN ANOMALY ex = Val(Mid$(eb$, 159, 10)) ' ECCENTRICITY ph = Rad(Val(Mid$(eb$, 127, 10))) ' ARGUMENT OF PERIHELION in = Rad(Val(Mid$(eb$, 148, 10))) ' INCLINATION na = Rad(Val(Mid$(eb$, 138, 10))) ' ASCENDING NODE ph = @rmdl(ph + na) ' LONGITUDE OF PERIHELION lm = @rmdl(lm + ph) ' MEAN LONGITUDE If Not rk5? Then lm = @rmdl(lm + kg / (se ^ 1.5) * (dj - j)) osc(aux%, ax%) = se osc(aux%, vl%) = lm osc(aux%, ec%) = ex osc(aux%, pn%) = ph osc(aux%, cl%) = in osc(aux%, an%) = na o$ = Mid$(eb$, 8, 10) ' NAME u$ = Mid$(eb$, 1, 6) ' NUMBER m = Val(Mid$(eb$, 43, 7)) ' ABSOLUTE MAGNITUDE EndProc ' >Procedure astlist(ByRef ry$, p%) Naked freal(vc(p%, longitud%), 3, 2, 0, q$) ry$ = ry$ + ";" + q$ fsigno(0, vc(p%, longitud%), 0, signo%, q$, q2$) ry$ = ry$ + ";" + q$ + spc$ + retr$(sinodico%(p%)) iauconstel(vc(p%, ascensionrecta%), vc(p%, declinacion%), q$) ry$ = ry$ + ";" + q$ nortesur(vc(p%, latitud%), 0, q$) ry$ = ry$ + ";" + q$ nortesur(vc(p%, declinacion%), 0, q$) ry$ = ry$ + ";" + q$ ' ORBITAL PERIOD freal(Sqr(osc(p%, ax%) ^ d3), 5, 1, 0, q$) ry$ = ry$ + ";" + q$ EndProc ' >Procedure se_list(p%, ByRef ry$, ByRef swd(), nom As String) Naked SEnombre(p%, nom) ry$ = nom If p% > kz% ry$ = Str$(num_names%(orden%), 6) + spc$ + ry$ Else If p% >= 40 And p% <= 47 ry$ = "UR " + ry$ EndIf fseg2(kg%, swd(1), 0, q$) ' LONGITUDE ry$ = ry$ + ";" + q$ fsigno(0, swd(1), 0, signo%, q$, q2$)' ZODIACAL

ry$ = ry$ + ";" + q$ fseg2(kg%, swd(4), 0, q$) ' VELOCITY ry$ = ry$ + ";" + q$ fseg2(kg%, swd(2), 0, q$) ' LATITUDE ry$ = ry$ + ";" + q$ freal(swd(3), 4, 7, 0, q$) ' DISTANCE ry$ = ry$ + ";" + q$ Set lvit = SV(7).Add lvit.AllText = ry$ EndProc ' >Procedure SwissEphem Local Int ipla Local Double jd Local String s1, nom Local Dim cusps(13) As Double, ascmc(10) As Double If Exist(ExecPath + "swedll32.dll") deg$ = deg2$ pb.Refresh pb.Min = 4 pb.Max = SE_ASTER_NOM% pb.Visible = True SV(7).Clear SV(7).SetFont "courier new" SV(7).FontBold = True jd = dj + jp + cd(dt%) If DirExists(se_path$) swe_set_ephe_path(se_path$) '@swe_set_sid_mode(SE_SIDM_USER + SE_SIDBIT_ECL_T0, 1802031.7973, d0) '@swe_set_sid_mode(0, d0, d0) For orden% = 5 To SE_ASTER_NOM% Print AT(1, 2); orden% If InKey = esc$ orden% = SE_ASTER_NOM% Else If num_names%(orden%) = 0 Inc orden% Else pb.Value = orden% ipla = Add(num_names%(orden%), kz%) flag = SE_SPEED '+ SEFLG_SIDEREAL If swe_calc(jd, ipla, flag, swedata(1), eb) > 0 se_list(ipla, eb, swedata(), nom) EndIf EndIf EndIf Next orden% Else SEpathAlert EndIf SV(7).Visible = True For ipla = 0 To 47 If ipla = 14 Then ipla = 17 If ipla = 21 Then ipla = 40 If swe_calc(jd, ipla, flag, swedata(1), eb) > 0 se_list(ipla, eb, swedata(), nom) EndIf Next ipla swe_houses(jd - cd(dt%), geos(lat%), -geos(lon%), Asc("P"), cusps(1), ascmc( 1))

For pl% = 1 To 4 If pl% <> 3 If pl% = 1 Then eb = "Ascendant" If pl% = 2 Then eb = "Midheaven" If pl% = 4 Then eb = "Vertex" fseg2(kg%, ascmc(pl%), 0, q$) eb = eb + ";" + q$ fsigno(0, ascmc(pl%), 0, signo%, q$, q2$) eb = eb + ";" + q$ + ";" + nul$ + ";" + nul$ + ";" + nul$ Set lvit = SV(7).Add lvit.AllText = eb EndIf Next pl% SV(7).Sort 0, True @swe_close() pb.Visible = False cmdEsc.Caption = "close list" cmdEsc.Left = 340 cmdEsc.Visible = True toquemouse cierrelista(7) Else SEdllAlert EndIf EndProc ' >Procedure Sedgwick Local eb$, raya$, debajo?, lvit As ListItem Local Double gl, bl, ar, dc, rv, dh, sa, h, sad abra_bigw SV(6).Clear SV(6).Visible = True deg$ = deg2$ Restore deepspace For pl% = 1 To Add(246, plu%) If pl% <= 246 Read q$ raya$ = q$ ar = @num(20, kc%) + @num(21, kd%) + @num(22, 1) + (@num(23, kd%) + @num(2 4, 1)) / n6 + (@num(25, kd%) + @num(26, 1)) / ns dc = @num(28, kd%) + @num(29, 1) + (@num(31, kd%) + @num(32, 1)) / n6 If Mid$(q$, 30, 1) = "S" Then dc = -dc eb$ = Left$(raya$, 18) polar2rect(ar, dc, d1, g()) Sub g(xi%), ab * pq(vsol%, xi%) Sub g(yi%), ab * pq(vsol%, yi%) Sub g(zi%), ab * pq(vsol%, zi%) transformacion(j2000fecha%, ecuador%, g()) tres(g(), nut()) rect2polar(g(), ar, dc, rv) ecuatoriales(-etrue%, g()) rect2polar(g(), gl, bl, rv) Else n% = Sub(pl%, 246) ar = vc(n%, ascensionrecta%) dc = vc(n%, declinacion%) eb$ = plaux$(n%) gl = vc(n%, longitud%) bl = vc(n%, latitud%) EndIf

freal(gl, 3, 2, 0, q$) eb$ = eb$ + ";" + q$ fsigno(1, gl, 0, signo%, q$, q2$) eb$ = eb$ + ";" + q$ iauconstel(gl, bl, q$) eb$ = eb$ + ";" + q$ nortesur(bl, 0, q$) eb$ = eb$ + ";" + q$ nortesur(dc, 0, q$) eb$ = eb$ + ";" + q$ semiarco(ar, dc, dh, sa, sad, h, debajo?) fminutos(k4%, @modulaparanes(ar), 1, 0, q$) eb$ = eb$ + ";" + q$ fminutos(k4%, @modulaparanes(@mdl(ar + n8)), 1, 0, q$) eb$ = eb$ + ";" + q$ If sad < n8 fminutos(k4%, @modulaparanes(@mdl(ar - sad)), 1, 0, q$) eb$ = eb$ + ";" + q$ fminutos(k4%, @modulaparanes(@mdl(ar + sad)), 1, 0, q$) eb$ = eb$ + ";" + q$ Else eb$ = eb$ + ";circunpolar;circunpolar" EndIf If pl% <= 246 eb$ = eb$ + ";" + Mid$(raya$, 34, Len(raya$)) EndIf Set lvit = SV(6).Add lvit.AllText = eb$ Next pl% SV(6).Sort 0, True cmdEsc.Visible = True toquemouse cierrelista(6) deepspace: Data "SGR 0525-66 0762212 65S59 Soft Gamma Ray Repeater" EndProc ' >Procedure distant Local j0 As Double, mag As Double, leefile?, raya$, nom$, num$, eb$, class As String, peri Local lvit As ListItem Local Const jupiter = 5.20, neptune = 30.11, pluto = 39.54, urano = 19.22, sdo = 50 If Exist(ExecPath + "distant.dat") Open ExecPath + "distant.dat" for Input As # 11 leefile? = True Else Alert 1, "|NO DISTANT FILE!", 1, " ENTER ", n% EndIf If leefile? abra_bigw deg$ = deg2$ pb.Refresh pb.Min = 0 pb.Max = 1037 pb.Visible = True SV(5).Clear efemerides(0, 0) vsop82(sol%, sol%)

Close # 3 orden% = 0 While Not EOF(# 11) Input # 11, eb$ Inc orden% pb.Value = orden% astorb(eb$, j0, mag, nom$, num$, False) vectores(aux%, r(), v()) transformacion(j2000fecha%, ecliptica%, r()) transformacion(j2000fecha%, ecliptica%, v()) pqposicion(aux%) ' CLASSIFICATION peri = se * (d1 - ex) If peri < jupiter class = "damocloid" Else If se < neptune class = "centaur" Else If se >= sdo class = "scattered" ElseIf se < pluto And peri < (neptune + urano) / d2 class = "pluto steed" ElseIf se >= (pluto - z5) And se <= (pluto + z5) class = "plutino" Else class = "cubewano" EndIf EndIf EndIf raya$ = nom$ + ";" + num$ + ";" + class astlist(raya$, aux%) ' HELIO DISTANCE freal(heliop(aux%, hdis%), 4, 1, 0, q$) raya$ = raya$ + ";" + q$ ' APHELION freal(se * (d1 + ex), 4, 1, 0, q$) raya$ = raya$ + ";" + q$ ' PERIHELION freal(peri, 4, 1, 0, q$) raya$ = raya$ + ";" + q$ ' ESTIMATED SIZE IN KM j0 = 3.12 - 0.2 * mag - z5 * Log(0.08) / Log(md) freal(md ^ j0, 4, 0, 0, q$) raya$ = raya$ + ";" + q$ ' CURRENT EPHEMERIS UNCERTAINTY j0 = Val(Mid$(eb$, 192, 7)) If j0 > ml Then freal(j0 / ns, 5, 1, 0, q$) q$ = q$ + " deg" Else freal(j0, 9, 1, 0, q$) EndIf raya$ = raya$ + ";" + q$ ' CEU SECULAR CHANGE j0 = Val(Mid$(eb$, 201, 7)) * jq If j0 > ml Then freal(j0 / ns, 5, 1, 0, q$) q$ = q$ + " deg" Else

freal(j0, 9, 1, 0, q$) EndIf raya$ = raya$ + ";" + q$ ' PEAK UNCERTAINTY AFTER 10 YEARS j0 = Val(Mid$(eb$, 235, 7)) If j0 > ml Then freal(j0 / ns, 5, 1, 0, q$) q$ = q$ + " deg" Else freal(j0, 9, 1, 0, q$) EndIf raya$ = raya$ + ";" + q$ + ";" + nom$ + ";" + eb$ Set lvit = SV(5).Add lvit.AllText = raya$ Wend Close # 11 SV(5).Sort 0, True SV(5).Visible = True pb.Visible = False 'For pl% = lun% To plu% 'raya$ = plaux$(pl%) + ";" + nul$ 'astlist(raya$, pl%) 'Set lvit = SV(5).Add 'lvit.AllText = raya$ 'Next pl% cmdEsc.Visible = True Repeat Do : Sleep : Until prueba? Or aborta? If SV(5).SelectedCount And prueba? eb$ = SV(5).SelectedItem.SubItems(17) astorb(eb$, j0, mag, nom$, num$, True) vectores(aux%, r(), v()) integrat(j0, dj, n4) transformacion(j2000fecha%, ecliptica%, r()) transformacion(j2000fecha%, ecliptica%, v()) osculacion(aux%, r(), v()) pqposicion(aux%) eb$ = Trim$(num$) + spc$ + Upper$(nom$) + "|" impfecha(dj, 0, 0, 0, 0, q$) eb$ = Trim$(eb$) + Trim$(q$) + "|" fminutos(k4%, tu, 0, 0, q$) eb$ = eb$ + Trim$(q$) + "|lon = " fsigno(0, vc(aux%, longitud%), 0, signo%, q$, q2$) eb$ = eb$ + Trim$(q$) + "|lat = " nortesur(vc(aux%, latitud%), 0, q$) eb$ = eb$ + Trim$(q$) + "|dec = " nortesur(vc(aux%, declinacion%), 0, q$) eb$ = eb$ + Trim$(q$) + "|IAU = " iauconstel(vc(aux%, ascensionrecta%), vc(aux%, declinacion%), q$) eb$ = eb$ + Trim$(q$) Alert 4, eb$, 1, Space$(20) + "OK" + Space$(20), n% prueba? = False EndIf Until aborta? cierrelista(5) EndIf EndProc ' >Procedure Riyal_test_error Local Double gl, bl, rv, dj0, dj1, maxheli, maxgeoc, rmsheli, rmsgeoc, cg, ch

Local paso As Single, bpl%, cpl%, vec%, tu?, light?, salehelio?, ry$ Local Long ipla If Exist(ExecPath + "swedll32.dll") If DirExists(se_path$) swe_set_ephe_path(se_path$) dlgplanetas("test planet", bpl%, cpl%, allplanets%, 1) If Not aborta? deg$ = deg2$ ipla = mpcnumber%(bpl%) salehelio? = bpl% <> lun% And bpl% <> nodo% And bpl% <> BML% If ipla = kz% Alert 1, "UNNUMBERED PLANET!|NO SWISS EPHEMERIS FILE", 1, Space(25) + "ENTER" + Space(25), n% aborta? = True Else Alert 2, "|CHOOSE THE COORDINATE TO COMPARE:", 1, " longitude |latitud e|distance|cancel", vec% If vec% < 4 dlgephemstep(dj0, dj1, paso) If Not @withinrange(bpl%) Print range$ aborta? = True EndIf Else aborta? = True EndIf EndIf If Not aborta? abralostodos(True) tu? = basetu? light? = geometricas? basetu? = False geometricas? = False SV(8).Clear SV(8).SetFont "courier new" SV(8).FontBold = True pb.Refresh pb.Min = dj0 pb.Max = dj1 pb.Visible = True contador% = 0 maxheli = p10 maxgeoc = p10 rmsheli = d0 rmsgeoc = d0 cg = d0 ch = d0 For dj = dj0 To dj1 Step paso If @withinrange(bpl%) Inc contador% tabephem(bpl%) flag = SE_SPEED flag = swe_calc(dj + jp, ipla, flag, swedata(xi%), eb) If flag > 0 pb.Value = dj impfecha(dj, 0, 0, 0, 0, q$) ry$ = q$ gl = vc(bpl%, vec%) - swedata(vec%) If vec% = rvector% freal(gl * au, 6, 1, 0, q$)

Else If gl > n8 Then Sub gl, ng If gl < -n8 Then Add gl, ng fseg2(kg%, gl, 0, q$) EndIf If Abs(maxgeoc) < Abs(gl) Then maxgeoc = gl Inc cg Add rmsgeoc, gl * gl ry$ = ry$ + ";" + q$ If salehelio? flag = SE_HELCTR + SE_J2000 + SE_TRUEPOS + SE_NOABERR + SE_NON UT If bpl% = sol% flag = swe_calc(dj + jp, 14, flag, swedata(xi%), eb) Else flag = swe_calc(dj + jp, ipla, flag, swedata(xi%), eb) EndIf If flag > 0 g(xi%) = helior(bpl%, xi%) g(yi%) = helior(bpl%, yi%) g(zi%) = helior(bpl%, zi%) If bpl% = sol% Then Mat Neg g() transformacion(fechaj2000%, ecliptica%, g()) rect2polar(g(), gl, bl, rv) g(xi%) = gl g(yi%) = bl g(zi%) = rv gl = g(vec%) - swedata(vec%) If vec% = rvector% freal(gl * au, 6, 1, 0, q$) Else If gl > n8 Then Sub gl, ng If gl < -n8 Then Add gl, ng fseg2(kg%, gl, 0, q$) EndIf If Abs(maxheli) < Abs(gl) Then maxheli = gl Inc ch Add rmsheli, gl * gl ry$ = ry$ + ";" + q$ EndIf Else ry$ = ry$ + ";--" EndIf ry$ = ry$ + ";" + Upper$(plaux$(bpl%)) + Str$(contador%, 6) + " Riyal-SwissEphem" Set lvit = SV(8).Add lvit.AllText = ry$ Else dj = dj1 EndIf EndIf Next dj '################################################## If flag > 0 If vec% = rvector% freal(au * (rmsgeoc / cg) ^ z5, 6, 1, 0, q$) q$ = Trim(q$) + " Km" Else fseg2(kg%, (rmsgeoc / cg) ^ z5, 0, q$) EndIf

If salehelio? If vec% = rvector% freal(au * (rmsheli / ch) ^ z5, 6, 1, 0, q2$) q2$ = Trim(q2$) + " Km" Else fseg2(kg%, (rmsheli / ch) ^ z5, 0, q2$) EndIf ry$ = ";rms=" + q$ + ";rms=" + q2$ Else ry$ = ";rms=" + q$ + ";" EndIf If vec% = rvector% freal(au * maxgeoc, 6, 1, 0, q$) q$ = Trim(q$) + " Km" Else fseg2(kg%, maxgeoc, 0, q$) EndIf If salehelio? If vec% = rvector% freal(au * maxheli, 6, 1, 0, q2$) q2$ = Trim(q2$) + " Km" Else fseg2(kg%, maxheli, 0, q2$) EndIf ry$ = ry$ + ";geoc=" + q$ + " helio=" + q2$ Else ry$ = ry$ + ";geoc=" + q$ EndIf Set lvit = SV(8).Add lvit.AllText = ry$ Set lvit = SV(8).Add lvit.AllText = nul$ Set lvit = SV(8).Add lvit.AllText = nul$ '################################################## Else SEnombre(ipla, q$) SEerrAlert(bpl%, q$) EndIf @swe_close() If contador% If contador% > 1 SV(8).Visible = True pb.Visible = False cmdEsc.Caption = "close list" cmdEsc.Left = 340 cmdEsc.Visible = True toquemouse cierrelista(8) EndIf EndIf abralostodos(False) basetu? = tu? geometricas? = light? llenaradix EndIf EndIf Else SEpathAlert EndIf

@swe_close() Else SEdllAlert EndIf EndProc ' >Procedure cierrelista(l%) Naked cmdEsc.Visible = False cmdEsc.Caption = "cancel" cmdEsc.Left = 240 SV(l%).Visible = False SV(l%).Clear If opcion% <> tst% Then llenaradix cierre_bigw EndProc ' '###################################################################### ' IMPLEMENTATION MODULE MPosicion '###################################################################### ' >Procedure osculacion(pl%, ByVal r() As Double, ByVal v() As Double) Local Double rr, n, h, e, vv, d, kk, mu, esine Local Dim ee(xyz%) As Double, hh(xyz%) As Double mu = masa(pl%) If pl% = lun% Mul mu, mu Else Mul mu, kg EndIf rr = @vmg(r()) Mat Mul kk = r()*v() Mat Mul vv = v()*v() d = vv - mu / rr ' *** VECTOR DE EXCENTRICIDAD EN *** ' *** LA DIRECCION DEL PERICENTRO *** ee(xi%) = d * r(xi%) - kk * v(xi%) ee(yi%) = d * r(yi%) - kk * v(yi%) ee(zi%) = d * r(zi%) - kk * v(zi%) ' *** VECTOR DE MOMENTO ANGULAR (h=r x v) *** ' *** PERPENDICULAR AL PLANO DE LA ORBITA *** hh(xi%) = r(yi%) * v(zi%) - r(zi%) * v(yi%) '==> vector del nodo hh(yi%) = r(zi%) * v(xi%) - r(xi%) * v(zi%) '==> vector del nodo hh(zi%) = r(xi%) * v(yi%) - r(yi%) * v(xi%) n = Sqr(hh(xi%) * hh(xi%) + hh(yi%) * hh(yi%)) e = @vmg(ee()) h = @vmg(hh()) in = @artan2(n / h, hh(zi%) / h) na = @artan2(hh(xi%) / n, -hh(yi%) / n) ph = @rmdl(@artan2(ee(zi%) * h / (e * n), (ee(yi%) * hh(xi%) - ee(xi%) * hh(yi %)) / (e * n)) + na) se = h * h * mu / (mu * mu - e * e) ex = e / mu esine = kk / masa(pl%) / Sqr(se) lm = @rmdl(@artan2(esine, d1 - rr / se) - esine + ph) If pl <> lun% Then elementospr(j2000fecha%) osc(pl%, ax%) = se osc(pl%, vl%) = lm osc(pl%, ec%) = ex osc(pl%, pn%) = ph osc(pl%, cl%) = in

osc(pl%, an%) = na 'If pl% = lun% 'n = lm - na 'h = se * (d1 - ex * ex) 'd = mu '/ Sqr(h) 'vv = rr * Sin(n) / Sin(in) 'kk = -h / ex * Cos(lm - ph) + (rr + h) * ex * Sin(lm - ph) + rr * Square(Tan( in)) * Sin(n) 'Print vv * d, kk * d 'Stop 'osc(pl%, vn%) = vv 'osc(pl%, vp%) = kk 'EndIf EndProc ' >Procedure magnitud(pl%) Local Double d, r, v, i, m, k, e, f, g, h, b v = heliop(pl%, hdis%) ' distancia Sol-planeta d = vc(pl%, rvector%) ' distancia Tierra-planeta r = vc(sol%, rvector%) ' distancia Sol-Tierra ' ######################## ' ### angulo de fase ### ' ######################## f = (d * d + v * v - r * r) / (d2 * d * v) If Abs(f) > d1 /*topocntrico*/ Then f = d1 * Sgn(f) i = Deg(Acos(f)) lum(pl%, iangulo%) = i ' ######################## ' ## fraccin iluminada ## ' ######################## k = z5 * (d1 + f) lum(pl%, kfase%) = k ' ######################## ' ## brillo del disco #### ' ######################## lum(pl%, lbrillo%) = k * f * f / (v * v) ' ######################## ' ### elongacin #### ' ######################## lum(pl%, elon%) = @truedist(pl%, sol%) ' ######################## ' ## magnitud estelar ## ' ######################## m = d5 * Log10(d * v) + pldef(pl%, vmag%) + pldef(pl%, fmag%) * i Select pl% Case lun% If k < d1 And k > d0 Then Add m, -2.5 * Log10(k) Case mer% Add m, i * i * (-0.000273 + i * 2.0E-06) Case ven% Add m, i * i * (0.000239 + i * (-6.5E-07)) Case sat% i = Rad(28.075216 + w2 * (-0.012998 + w2 * 4.0E-06)) f = Rad(169.50847 + w2 * (1.394681 + w2 * 0.000412)) d = Rad(vc(sat%, latitud%)) k = Abs(Sin(i) * Cos(d) * Sin(Rad(vc(sat%, longitud%)) - f) - Cos(i) * Sin(d )) Add m, k * (-2.6 + k * 1.25) Case qui% To finpl% b = Exp(-3.33 * (Tan(Rad(i / d2)) ^ 0.63))

f = Exp(-1.87 * (Tan(Rad(i / d2)) ^ 1.22)) Sub m, pldef(pl%, fmag%) * i Add m, -2.5 * Log10((d1 - pldef(pl%, fmag%)) * b + pldef(pl%, fmag%) * f) Default Inc dummy% EndSelect lum(pl%, vmagnitud%) = m EndProc ' >Procedure vcguarde(pl%, gl As Double, bl As Double, rv As Double, d As Double) Local j%, db As Double, dr As Double, dl As Double ' velxyz(r(), v(), dl, db, dr) ' ecuatoriales(emedio%, r()) ' *** XYZ ECUADOR MEDIO Y *** ecuatoriales(emedio%, v()) ' *** EQUINOCCIO DE FECHA *** tres(r(), nut()) ' *** NUTACION==>VERDADERAS *** If basetopo? For j% = xi% To zi% g(j%) = r(j%) - geos(j%) r(j%) = g(j%) Next j% ecuatoriales(-etrue%, g()) rect2polar(g(), gl, bl, rv) Else Add gl, cd(lnut%) EndIf ' vc(pl%, longitud%) = gl vc(pl%, latitud%) = bl vc(pl%, rvector%) = rv vc(pl%, distancia%) = d vc(pl%, velocidad%) = Deg(dl) vc(pl%, velobl%) = Deg(db) If pl% < aux% vc(pl%, semidiametro%) = pldef(pl%, semidiam%) / rv / ns EndIf ' velxyz(r(), v(), dl, db, dr) rect2polar(r(), gl, bl, rv) 'If @lleno = 2 Then prigurosa(tx, dj, gl, bl) vc(pl%, ascensionrecta%) = gl vc(pl%, declinacion%) = bl vc(pl%, velorv%) = dr vc(pl%, veloar%) = Deg(dl) vc(pl%, veldec%) = Deg(db) ' g(xi%) = helior(pl%, xi%) g(yi%) = helior(pl%, yi%) g(zi%) = helior(pl%, zi%) p(xi%) = heliov(pl%, xi%) p(yi%) = heliov(pl%, yi%) p(zi%) = heliov(pl%, zi%) velxyz(g(), p(), dl, db, dr) rect2polar(g(), gl, bl, rv) heliop(pl%, hlon%) = gl heliop(pl%, hlat%) = bl heliop(pl%, hdis%) = rv heliop(pl%, hdb%) = Deg(db) heliop(pl%, hdr%) = Deg(dr)

' fsigno(0, vc(pl%, longitud%), 0, signo%, q$, q2$) q$ = q$ + " " + retr$(sinodico%(pl%)) q2$ = q2$ + retr$(sinodico%(pl%)) indicepl%(pl%, 1) = signo% xplan$(pl%) = q$ fontplan$(pl%) = q2$ prohibe%(pl%) = False ' If bandera% <> 0 If pl% <> sol% And Not bandera% >= 8 If pl% <= finpl% magnitud(pl%) EndIf Select pl% Case mer% sumalista(sol%, vc(sol%, longitud%)) sumalista(pl%, vc(pl%, longitud%)) Default If planets_in_wheel?(pl%) Then sumalista(pl%, vc(pl%, longitud%)) EndSelect If pl% = ultimo% vcangulos For j% = nodo% To m_c% brinque(brinca%, j%) sumalista(j%, @mdl(vc(j%, longitud%))) Next j% QSort spx%(), orden%, spi%() For j% = 1 To (orden% Div 2) salida(j%, spi%(j%)) salida(Add(j%, orden% Div 2), spi%(Add(j%, orden% Div 2))) baja(xi%) If j% = (orden% Div 2) And Odd(orden%) salida(orden%, spi%(orden%)) baja(xi%) EndIf Next j% EndIf EndIf EndIf ' EndProc ' >Procedure sumalista(pl%, glon As Double) Local p%, q3$ Inc orden% If armonica <= d0 spx%(orden%) = CInt(glon * mz) Else spx%(orden%) = CInt(Frac(@mdl(glon + cd(ayanamsa%)) / n3) * n3 * mz) EndIf spi%(orden%) = pl% spj%(orden%) = pl% If pl% > lim% '-----------------------------------------------' EXTERNAL - GET SWISS EPHEMERIS OBJECT NAME SEnombre(swextra%(Sub(pl%, lim%)), q$) spk$(orden%) = q$ '-----------------------------------------------Else

spk$(orden%) = plaux$(pl%) EndIf If Not prohibe%(lim%) fsigno(0, glon, 0, signo%, q$, q2$) corrfont fila$(pl%) = q2$ Else fila$(pl%) = " n.a." EndIf '----------------------------------------------------------------------------' ADDITIONAL ORBITAL DATA If opcion% = all% And Not prohibe%(lim%) If Not (pl% = lim%) p% = pl%, q3$ = q2$ If pl% > lim% Then p% = aux% '==> CHECK IF IT IS EXTERNAL OBJECT q3$ = q3$ + spc$ + retr$(sinodico%(p%)) nortesur(vc(p%, latitud%), 0, q$) q3$ = q3$ + " " + q$ nortesur(vc(p%, declinacion%), 0, q$) q3$ = q3$ + " " + q$ iauconstel(vc(p%, ascensionrecta%), vc(p%, declinacion%), q$) q3$ = q3$ + " " + q$ If (pl% > planeta% Or pl% <= finpl%) q3$ = q3$ + " " + Str$(heliop(p%, hdis%), 5, 1) freal(Sqr(osc(p%, ax%) ^ d3), 4, 0, 0, q$) q$ = q$ + " " + Str$(Deg(osc(p%, cl%)), 5, 1) If pl% > nep% q$ = q$ + " " + Trim$(Str$(osc(p%, ax%) * (d1 - osc(p%, ec%)), 3, 1)) q$ = q$ + "->" + Trim$(Str$(osc(p%, ax%) * (d1 + osc(p%, ec%)), 3, 1)) EndIf q3$ = q3$ + " " + q$ EndIf fila$(pl%) = q3$ EndIf EndIf EndProc ' >Procedure salida(cual%, pl%) Local gl As Double prueba? = (cual% > orden% Div 2) If Not prueba? And (ingress? Or Not (bandera% = 4 Or bandera% = 2)) n% = 10 Else n% = 0 EndIf If cual% = 1 If (bandera% = 4 Or bandera% = 2) And Not ingress? If Not basesideral? fminutos(kg%, cd(ayanamsa%), 0, 0, q$) q$ = "p=" + Trim$(q$) Else q$ = "Transit" q2$ = "Radix" ftab(16, q2$ + Str$(spc$, 33) + q2$) EndIf ftab(27, q$) ftab(65, q$) EndIf baja(xi%) EndIf

If bandera% > 0 salecolor(pl%) ftab(Add(Sub(3, Mul(38, prueba?)), n%), plaux$(pl%) + "=") If (bandera% = 4 Or bandera% = 2) And Not tx = d0 fsigno(0, radix(pl%, longitud%) - cd(ayanamsa%) - ayanx * basesideral?, 0, signo%, q$, q2$) ftab(Sub(14, Mul(38, prueba?)), q$) ftab(Sub(26, Mul(38, prueba?)), xplan$(pl%)) Else ftab(Add(Sub(14, Mul(39, prueba?)), n%), xplan$(pl%)) EndIf @txt(white%) EndIf EndProc ' >Procedure display Local gl As Double ' tb.ScrollBars = basVertical tb.Visible = True deg$ = deg3$ encabezado(" DISPLAY") suspendwrite? = True ftab(15, "Longitude IAU") ftab(32, "Latitude") ftab(42, "Ascension") ftab(55, "Dec") ftab(62, "g%") ftab(66, "velocity") tb.Text = tb.Text + Left$(nuevalinea$, 78) + crlf$ + crlf$ baja(yi%) astercheck(n%) For pl% = lun% To m_c% If pl% = Succ(ultimo%) Then pl% = nodo% ftab(3, plaux$(pl%) + " =") 'fseg2(kg%, vc(pl%, longitud%), 14, q$) farcseconds(vc(pl%, longitud%), q$) indicepl%(pl%, 1) = signo% q$ = Left$(q$, 3) + Left$(sgaux$(signo%), 2) + Mid$(q$, 5, 6) If signo% = kd% Then Mid$(q$, 5, 1) = "p" iauconstel(vc(pl%, ascensionrecta%), vc(pl%, declinacion%), q2$) ftab(14, q$ + " " + q2$) fminutos(kg%, vc(pl%, latitud%), 0, 31, q$) fsegundos(k4%, 1, vc(pl%, ascensionrecta%) / n5, 42, q2$) nortesur(vc(pl%, declinacion%), 54, q$) ftab(61, Str$(vc(pl%, distancia%), 3, 0)) If pl% = BML% And Not baseswephem? fminutos(kg%, vc(pl%, velocidad%), 0, 64, q$) Else fsegundos(kg%, 1, vc(pl%, velocidad%), 65, q2$) EndIf tb.Text = tb.Text + Left$(nuevalinea$, 78) + crlf$ baja(xi%) Next pl% pantalla ' If Not aborta? suspendwrite? = False tb.Text = nul$ encabezado(" GEONODES")

suspendwrite? = True ftab(15, "Ascending") ftab(25, "Descending") ftab(36, "Helio") ftab(48, "Perihel") ftab(57, "Aphel") ftab(66, "Helio") tb.Text = tb.Text + Left$(nuevalinea$, 78) + crlf$ + crlf$ baja(yi%) For pl% = mer% To ultimo% ftab(5, plaux$(pl%) + " =") fsigno(0, @geonode(pl%, d0), 0, signo%, q$, q2$) corrfont ftab(17, q2$) fsigno(0, @geonode(pl%, n8), 0, signo%, q$, q2$) corrfont ftab(26, q2$) fsigno(0, Deg(osc(pl%, an%)), 0, signo%, q$, q2$) corrfont ftab(35, q2$) fsigno(0, @geoapsis(pl%, d0), 0, signo%, q$, q2$) corrfont ftab(48, q2$) fsigno(0, @geoapsis(pl%, n8), 0, signo%, q$, q2$) corrfont ftab(57, q2$) gl = @mdl(Deg(osc(pl%, pn%) - osc(pl%, an%))) fsigno(0, Deg(osc(pl%, pn%)) + @reduccion(pl%, gl, -1), 0, signo%, q$, q2$ ) corrfont ftab(66, q2$) tb.Text = tb.Text + Left$(nuevalinea$, 78) + crlf$ baja(xi%) Next pl% pantalla EndIf ' If Not aborta? suspendwrite? = False tb.Text = nul$ encabezado(" HELIO") suspendwrite? = True ftab(16, "HelioLon") ftab(27, "HelioLat") ftab(37, "Radiovec") ftab(47, "h%") ftab(51, "CrossA") ftab(62, "GeoDist") ftab(72, "Vm") tb.Text = tb.Text + Left$(nuevalinea$, 78) + crlf$ + crlf$ baja(yi%) For pl% = sol% To ultimo% ftab(4, plaux$(pl%) + " =") fsigno(0, heliop(pl%, hlon%), 16, signo%, q$, q2$) nortesur(heliop(pl%, hlat%), 28, q$) ftab(36, Str$(heliop(pl%, hdis%), 9, 5)) If pl% = lun% ftab(46, " --") Else ftab(46, Str$(@distancia(-pl%, heliop(pl%, hdis%)), 3, 0))

EndIf fminutos(kg%, @crossangle(pl%), 0, 50, q$) ftab(60, Str$(vc(pl%, rvector%), 9, 5)) ftab(70, Str$(lum(pl%, vmagnitud%), 5, 1)) tb.Text = tb.Text + Left$(nuevalinea$, 78) + crlf$ baja(xi%) Next pl% pantalla EndIf ' If Not aborta? suspendwrite? = False tb.Text = nul$ encabezado(" OSCULAT2000") suspendwrite? = True ftab(20, "ax") ftab(30, "M") ftab(40, "ec") ftab(50, "w") ftab(59, "cl") ftab(68, "an") tb.Text = tb.Text + Left$(nuevalinea$, 78) + crlf$ + crlf$ baja(yi%) For pl% = lun% To ultimo% ftab(3, plaux$(pl%) + " =") ftab(16, Str$(osc(pl%, ax%), 8, 4)) lm = osc(pl%, vl%) ph = osc(pl%, pn%) in = osc(pl%, cl%) na = osc(pl%, an%) If osc(Abs(pl%), ax%) > d0 Then elementospr(fechaj2000%) ftab(27, Str$(Deg(@rmdl(lm - ph)), 7, 3)) ftab(36, Str$(osc(pl%, ec%), 8, 4)) ftab(47, Str$(Deg(@rmdl(ph - na)), 7, 3)) ftab(56, Str$(Deg(in), 7, 3)) ftab(66, Str$(Deg(na), 7, 3)) tb.Text = tb.Text + Left$(nuevalinea$, 78) + crlf$ baja(xi%) Next pl% pantalla EndIf ' EndProc ' >Procedure vsop87d(bpl%, ByRef r() As Double, ByRef v() As Double) Local Double b, aa, bb, cc, vec%, j%, t%, s% Mat Clr r() Mat Clr v() 'milisecs% = oTimer s% = Sub(Mul(pptl%(bpl%, longitud%, rp%), 3), 2) For vec% = longitud% To rvector% Mat Clr sumasen() Mat Clr sumacos() For t% = t0% To t5% For j% = 1 To pptl%(bpl%, vec%, t%) aa = vsopm(s%) : s%++ bb = vsopm(s%) : s%++ cc = vsopm(s%) : s%++ b = bb + cc * pt(t1%) Add sumacos(t%), aa * Cos(b)

Sub sumasen(t%), aa * Sin(b) * cc Next j% Next t% For t% = t1% To t5% Mul sumasen(t%), pt(t%) Add sumasen(t%), pt(Pred(t%)) * sumacos(t%) * Sub(t%, 2) Mul sumacos(t%), pt(t%) Next t% For t% = t0% To t5% Add r(vec%), sumacos(t%) Add v(vec%), sumasen(t%) Next t% Next vec% Mat Mul v(), d1 / (jq * md) 'reloj%(bpl%) = Sub(oTimer, milisecs%) If pl% = sol% Mat Neg r() Mat Neg v() EndIf If pl% < plu% osculacion(pl%, r(), v()) EndIf transformacion(j2000fecha%, ecliptica%, r()) transformacion(j2000fecha%, ecliptica%, v()) EndProc ' >Procedure plutoxyz(d, t, ByRef r()) Local Double tt, xx, b, aa, bb, cc, vec%, j%, t%, s% Mat Clr r() tt = t * mc xx = -d1 + d2 * (d + jp + cd(dt%) - 626150.5) / 2185000 If xx >= -d1 And xx <= d1 r(xi%) = 0.154154 * xx + 9.922274 r(yi%) = 0.064073 * xx + 10.016090 r(zi%) = -0.042746 * xx - 3.947474 s% = Sub(Mul(ipsl%(plu%, longitud%, rp%), 3), 2) For vec% = xi% To zi% Mat Clr sumasen() For t% = t0% To t2% For j% = 1 To ipsl%(plu%, vec%, t%) aa = ipsplu(s%) : s%++ ' amplitude bb = ipsplu(s%) : s%++ ' frequency cc = ipsplu(s%) : s%++ ' phase b = aa * Sin(Rad(cc) + bb * tt) Add sumasen(t%), b Next j% Next t% Mul sumasen(t1%), xx Mul sumasen(t2%), xx * xx For t% = t0% To t2% Add r(vec%), sumasen(t%) Next t% Next vec% EndIf EndProc >Procedure ips2000(bpl%, ByRef r() As Double, ByRef v() As Double) 'Local Double b, aa, bb, cc, vec%, j%, t%, s% 'Mat Clr r() 'Mat Clr v() 's% = Sub(Mul(ipsl%(bpl%, longitud%, rp%), 3), 2)

'For vec% = longitud% To rvector% 'Mat Clr sumasen() 'Mat Clr sumacos() 'For t% = t0% To t5% 'For j% = 1 To ipsl%(bpl%, vec%, t%) 'aa = ips2m(s%) : s%++ 'bb = ips2m(s%) : s%++ 'cc = ips2m(s%) : s%++ 'b = bb * w2 / md + cc 'Add sumasen(t%), aa * Sin(b) 'Add sumacos(t%), aa * Cos(b) * bb 'Next j% 'Next t% 'For t% = t1% To t5% 'Mul sumacos(t%), pt(t%) 'Add sumacos(t%), pt(Pred(t%)) * sumasen(t%) * Sub(t%, 2) 'Mul sumasen(t%), pt(t%) 'Next t% 'For t% = t0% To t5% 'Add r(vec%), sumasen(t%) 'Add v(vec%), sumacos(t%) 'Next t% 'Next vec% 'If pl% = sol% 'expand(w2, rvector%) 'polar2rect(g(xi%), g(yi%), g(zi%), p()) 'Mat Mul p(), emr / (d1 + emr) 'Sub r(xi%), p(xi%) 'Sub r(yi%), p(yi%) 'Sub r(zi%), p(zi%) 'Mat Neg r() 'Mat Neg v() 'EndIf 'Mat Mul v(), d1 / (jq * md) 'osculacion(pl%, r(), v()) 'transformacion(j2000fecha%, ecliptica%, r()) 'transformacion(j2000fecha%, ecliptica%, v()) EndProc ' >Function geoapsis(pl%, gl As Double) As Double Local Double l, r, e, gp If osc(pl%, ax%) = d0 Then Return d0 l = Deg(@rmdl(osc(pl%, pn%) - osc(pl%, an%))) gp = osc(pl%, pn%) + Rad(@reduccion(pl%, l, -1)) e = osc(pl%, ec%) l = Rad(gl) r = osc(pl%, ax%) * (d1 - e * e) / (d1 + e * Cos(l)) l = @rmdl(gp + Rad(gl) - Rad(vc(sol%, longitud%))) l = Deg(@artan2(r * Sin(l), r * Cos(l) + vc(sol%, rvector%))) Return @mdl(l + vc(sol%, longitud%)) EndFunc >Function geonode(pl%, gl As Double) As Double Local Double l, r, e If osc(pl%, ax%) = d0 Then Return d0 e = osc(pl%, ec%) l = osc(pl%, an%) + Rad(gl) - osc(pl%, pn%) r = osc(pl%, ax%) * (d1 - e * e) / (d1 + e * Cos(l)) l = @rmdl(osc(pl%, an%) + Rad(gl) - Rad(vc(sol%, longitud%))) l = Deg(@artan2(r * Sin(l), r * Cos(l) + vc(sol%, rvector%))) Return @mdl(l + vc(sol%, longitud%))

EndFunc ' >Function kepler() As Double Local Double m, f, e, sinm m = @rmdl(lm - ph) sinm = Sin(m) e = m + ex * (sinm / (d1 - Sin(m + ex) + sinm)) Repeat f = e e = m + ex * Sin(f) Until Abs(f - e) < p6 '0.2" Return e EndFunc ' >Procedure vectores(pl%, ByRef r() As Double, ByRef v() As Double) Local Double a, b, c, d, e, f, h, j% se = osc(pl%, ax%) ex = osc(pl%, ec%) lm = osc(pl%, vl%) ph = osc(pl%, pn%) na = osc(pl%, an%) in = osc(pl%, cl%) a = Cos(ph - na) b = Sin(ph - na) c = Cos(na) d = Sin(na) e = Cos(in) f = Sin(in) h = se * Sqr(d1 - ex * ex) pq(xpi%, xi%) = (a * c - b * d * e) * se pq(xpi%, yi%) = (a * d + b * c * e) * se pq(xpi%, zi%) = b * f * se pq(xqi%, xi%) = (-b * c - a * d * e) * h pq(xqi%, yi%) = (-b * d + a * c * e) * h pq(xqi%, zi%) = a * f * h e = @kepler() d = Sin(e) c = Cos(e) h = c - ex For j% = xi% To zi% r(j%) = h * pq(xpi%, j%) + d * pq(xqi%, j%) v(j%) = c * pq(xqi%, j%) - d * pq(xpi%, j%) Next j% Mat Mul v(), masa(pl%) / (@vmg(r()) * Sqr(se)) EndProc ' >Function distancia(pl%, r As Double) As Double Local Double ppl, apl, mn, mx If osc(Abs(pl%), ax%) = d0 Then Return d0 ppl = osc(Abs(pl%), ax%) * (d1 - osc(Abs(pl%), ec%)) apl = osc(Abs(pl%), ax%) * (d1 + osc(Abs(pl%), ec%)) If pl% > 0 Select pl% Case sol% asol = apl psol = ppl mn = ppl mx = apl Case mer%, ven% mn = psol - apl

mx = apl + asol Default mn = ppl - asol mx = apl + asol EndSelect Else mn = ppl mx = apl EndIf Return (mc - (r - mn) / (mx - mn) * mc) EndFunc ' >Procedure planetaberr(pl%, ByRef lon, ByRef lat, ByRef dis) Local df, f, xr As Double If Not geometricas? ' ********************************************************* ' KAPLAN ET AL, "THE ASTRONOMICAL JOURNAL" 97(4):1200,1202 ' ********************************************************* If pl% = sol% dis = @vmg(r()) ' ***************** ' SOLAR ABERRATION ' ***************** Repeat f = @vmg(r()) * ab For j% = xi% To zi% r(j%) = helior(sol%, j%) - f * heliov(sol%, j%) Next j% df = Abs(@vmg(r()) * ab - f) Until df < p7 rect2polar(r(), lon, lat, xr) Else ' *********** ' LIGHT-TIME ' *********** Repeat f = @vmg(r()) * ab For j% = xi% To zi% r(j%) = helior(pl%, j%) - f * heliov(pl%, j%) + helior(sol%, j%) Next j% df = Abs(@vmg(r()) * ab - f) Until df < p7 dis = @vmg(r()) ' ****************** ' ANNUAL ABERRATION ' ****************** Sub r(xi%), f * heliov(sol%, xi%) Sub r(yi%), f * heliov(sol%, yi%) Sub r(zi%), f * heliov(sol%, zi%) rect2polar(r(), lon, lat, xr) EndIf Else rect2polar(r(), lon, lat, dis) EndIf EndProc ' >Procedure pqposicion(pl%) Local Double dist, gl, bl, rv, dl, j% For j% = xi% To zi% helior(pl%, j%) = r(j%)

heliov(pl%, j%) = v(j%) Next j% If pl% = sol% For j% = xi% To zi% g(j%) = r(j%) p(j%) = v(j%) Next j% ecuatoriales(emedio%, g()) ecuatoriales(emedio%, p()) For j% = xi% To zi% pq(rsol%, j%) = g(j%) pq(vsol%, j%) = p(j%) Next j% Else For j% = xi% To zi% Add r(j%), helior(sol%, j%) Add v(j%), heliov(sol%, j%) Next j% EndIf planetaberr(pl%, gl, bl, rv) dist = @distancia(pl%, rv) dl = r(xi%) * v(yi%) - r(yi%) * v(xi%) sinodico%(pl%) = Sub(Add(Sgn(dl), 2), Abs(dl) < p4) vcguarde(pl%, gl, bl, rv, dist) EndProc ' ' ###################################################################### ' IMPLEMENTATION MODULE MPrecesion ' ###################################################################### ' >Procedure ecuatoriales(qx%, ByRef q() As Double) Local y As Double y = q(yi%) If qx% > 0 ' *** ECLIPTICAS A ECUATORIALES *** q(yi%) = y * eq(qx%, ecos%) - q(zi%) * eq(qx%, esin%) q(zi%) = y * eq(qx%, esin%) + q(zi%) * eq(qx%, ecos%) Else ' *** ECUATORIALES A ECLIPTICAS *** q(yi%) = q(zi%) * eq(-qx%, esin%) + y * eq(-qx%, ecos%) q(zi%) = q(zi%) * eq(-qx%, ecos%) - y * eq(-qx%, esin%) EndIf EndProc ' >Function edeclinacion(glon As Double, qx%) As Double Naked Return Deg(Asin(eq(qx%, esin%) * Sin(Rad(glon)))) EndFunc ' >Function pol(a1#, a2#, a3#, a4#, a5#, a6#, a7#, t As Double) As Double Naked Return t * (a1# + t * (a2# + t * (a3# + t * (a4# + t * (a5# + t * (a6# + t * a 7#)))))) EndFunc ' >Function precesion(epoca As Double, fecha As Double) As Double Local Double t, u, f1, f2, f3, f4 t = (fecha - epoca) / jq / md u = (epoca - j2000) / jq / md ' PRECESION ACUMULADA: f1 = 50287.96195 + u * (221.08696 + u * (0.221775 + u * (-0.9408 + u * (-0.009 + u * 0.001))))

f2 = 110.54348 + u * (0.217287 + u * (-1.4111 + u * (-0.018 + u * 0.0026))) f3 = 0.07964 + u * (-0.941 + u * (-0.018 + u * 0.0035)) f4 = -0.23857 + u * (-0.00383 + u * 0.0026) pr = @pol(f1, f2, f3, f4, -0.00383 + u * 0.00018, 0.00018, 0.00001, t) * rsec cd(precspeed%) = f1 / md / ns ' ANGULO ENTRE LAS DOS ECLIPTICAS: f1 = 469.98973 + u * (-6.69852 + u * (0.031101 + u * (-0.0019 - u * 0.0001))) f2 = -3.34926 + u * (0.0448 + u * (0.031101 + u * (-0.0002 + u * 0.0001))) f3 = -0.12559 + u * (-0.0004 + u * (-0.0002 + u * 0.0001)) f4 = 0.00113 + u * (-0.0001 + u * 0.0001) ae = t * (f1 + t * (f2 + t * (f3 + t * f4))) * rsec ' NODO DE LA ECLIPTICA MOVIL SOBRE LA FIJA: er = 629546.7936 + u * (32928.8103 + u * (95.76172 + u * (-0.005 + u * (-0.459 - u * 0.01)))) f1 = -8679.5758 + u * (-14.45779 + u * (-0.113 + u * (-0.448 - u * 0.019))) f2 = 15.7992 + u * (-0.019 + u * (-0.432 - u * 0.023)) f3 = -0.5371 + u * (-0.208 - u * 0.015) f4 = -0.4797 - u * 0.005 er = (er + @pol(f1, f2, f3, f4, 0.0072, d0, d0, t)) * rsec Return Deg(pr) EndFunc ' >Procedure prigurosa(epoca As Double, fecha As Double, ByRef ar#, ByRef dc#) Local Double t, u, f1, f2, f3, a, b, c, pth, pz0, pz1 u = (fecha - j2000) / jq / md t = (epoca - fecha) / jq / md ' -----------------------------------------------------------' cantidades numericas BdL 1994 y Bretagnon 2003, truncado t4: ' -----------------------------------------------------------f1 = 20041.90936 + u * (-85.3396 + u * (-0.209472 + u * 0.3642)) f2 = -42.66980 + u * (-0.209472 + u * 0.5463) f3 = -41.82364 + u * 0.0359 pth = t * (f1 + t * (f2 + t * (f3 - t * 0.07291))) * rsec 'Theta f1 = 23060.80472 + u * (139.8868 + u * (-0.000615 - u * 0.5918)) f2 = 30.23262 + u * (-0.249116 - u * 0.384) f3 = 18.01752 - u * 0.1326 pz0 = (2.72767 + t * (f1 + t * (f2 + t * (f3 - t * 0.05708)))) * rsec 'Zeta f1 = 23060.76070 + u * (139.8868 + u * (-0.000615 - u * 0.5918)) f2 = 109.56768 + u * (0.247887 - u * 1.3913) f3 = 18.26676 - u * 1.14 pz1 = (-2.72767 + t * (f1 + t * (f2 + t * (f3 - t * 0.28276)))) * rsec 'z ' ------------------------------------------------------------ar# = Rad(ar#) + pz0 dc# = Rad(dc#) a = Cos(dc#) * Sin(ar#) b = Cos(pth) * Cos(dc#) * Cos(ar#) - Sin(pth) * Sin(dc#) c = Sin(pth) * Cos(dc#) * Cos(ar#) + Cos(pth) * Sin(dc#) ar# = @mdl(Deg(@artan2(a, b) + pz1)) dc# = Deg(Asin(c)) If basebija? And epoca = tx polar2rect(ar#, dc#, d1, g()) ' subtract the instantaneous nutation tresxtres(g(), nut()) ' add the radix nutation tres(g(), rxnut()) rect2polar(g(), ar#, dc#, c) EndIf EndProc ' >Procedure bija(epoca As Double, fecha As Double, ByRef gl As Double, ByRef bl A

s Double) Local Double a, b, c, d, cosb, sinb ~@precesion(epoca, fecha) sinb = Sin(ae) cosb = Sqr(d1 - sinb * sinb) gl = er - Rad(gl) a = Cos(gl) b = Sin(gl) d = Sin(Rad(bl)) c = Sqr(d1 - d * d) bl = Deg(Asin(cosb * d + sinb * c * b)) gl = @mdl(Deg(pr + er - @artan2(cosb * c * b - sinb * d, c * a))) If basesideral? Sub gl, cd(lnut%) EndIf EndProc ' >Procedure elementospr(eje%) Local Double a, r, s, p0, sini, cosi, sina, cosa, sinr, cosr Select eje% Case fechaj2000% ~@precesion(dj, j2000) Case j2000fecha% ~@precesion(j2000, dj) EndSelect p0 = ph 'perihelio de la epoca Sub ph, na 'argumento del perihelio a = ae s = er + pr r = na - er sini = Sin(in) cosi = Cos(in) sina = Sin(a) cosa = Cos(a) sinr = Sin(r) cosr = Cos(r) na = @rmdl(@artan2(sini * sinr, -sina * cosi + cosa * sini * cosr) + s) ph = @rmdl(@artan2(-sina * sinr, sini * cosa - cosi * sina * cosr) + ph + na) in = cosi * cosa + sini * sina * cosr If Abs(in) NEAR d1 in = d0 Else in = Acos(in) EndIf lm = @rmdl(lm + ph - p0) EndProc ' >Procedure prmatriz(tipo%, plano%) Local Double s, c, s11, s12, s13, c11, c12, c13, t, e, p t = pt(t1%) ' OBLICUIDAD J2000 [P03b, 2005] e = 84381.406 * rsec eq(e2000%, esin%) = Sin(e) eq(e2000%, ecos%) = Cos(e) ' OBLICUIDAD MEDIA DE LA FECHA [P03b - Capitaine, Wallace & Chapront, 2005] Add e, @pol(-468.36769, -0.01831, 2.0034, -0.00576, -0.0434, d0, d0, t) * rsec eq(emedio%, esin%) = Sin(e) eq(emedio%, ecos%) = Cos(e) ' OBLICUIDAD VERDADERA DE LA FECHA Add e, Rad(cd(enut%))

cd(esin%) = Sin(e) cd(ecos%) = Cos(e) eq(etrue%, esin%) = cd(esin%) eq(etrue%, ecos%) = cd(ecos%) cd(oblicuidad%) = Deg(e) ' PRECESION ECLIPTICA [P03b - Capitaine, Wallace & Chapront, 2005] pr = @pol(50287.96195, 110.54348, 0.07964, -0.23857, -0.00383, 0.00018, 0.0000 1, t) * rsec ae = @pol(469.98973, -3.34926, -0.12559, 0.00113, -0.0022, d0, d0, t) * rsec er = (629546.7936 + @pol(-8679.5758, 15.7992, -0.5371, -0.497, 0.0072, d0, d0, t)) * rsec s11 = Sin(-(er + pr)) c11 = Cos(-(er + pr)) s12 = Sin(ae) c12 = Cos(ae) s13 = Sin(er) c13 = Cos(er) prec(xi%, xi%) = c11 * c13 - c12 * s13 * s11 prec(xi%, yi%) = c11 * s13 + c12 * c13 * s11 prec(xi%, zi%) = s11 * s12 prec(yi%, xi%) = -s11 * c13 - c12 * s13 * c11 prec(yi%, yi%) = -s11 * s13 + c12 * c13 * c11 prec(yi%, zi%) = c11 * s12 prec(zi%, xi%) = s12 * s13 prec(zi%, yi%) = -s12 * c13 prec(zi%, zi%) = c12 ' PRECESION ECUATORIAL [P03b - Capitaine, Wallace & Chapront, 2005] s = @pol(20041.91903, -42.94934, -41.82264, -0.07089, -0.01274, 0.00036, 0.000 09, t) * rsec c = (2.650545 + @pol(23060.80472, 29.88499, 18.01828, -0.05971, -0.03173, -0.0 0013, d0, t)) * rsec p = (-2.650545 + @pol(23060.77181, 109.27348, 18.26837, -0.28596, -0.02904, -0 .00005, d0, t)) * rsec s11 = Sin(s) c11 = Cos(s) s12 = Sin(c) c12 = Cos(c) s13 = Sin(p) c13 = Cos(p) fk5(xi%, xi%) = c12 * c13 * c11 - s12 * s13 fk5(xi%, yi%) = -c12 * s13 - s12 * c13 * c11 fk5(xi%, zi%) = -c13 * s11 fk5(yi%, xi%) = s12 * c13 + c12 * s13 * c11 fk5(yi%, yi%) = +c12 * c13 - s12 * s13 * c11 fk5(yi%, zi%) = -s13 * s11 fk5(zi%, xi%) = c12 * s11 fk5(zi%, yi%) = -s12 * s11 fk5(zi%, zi%) = c11 ' NUTACION [Kaplan et al (1989) p.1202] s = Rad(cd(lnut%)) s11 = Sin(s) c11 = Cos(s) s13 = eq(emedio%, esin%) c13 = eq(emedio%, ecos%) nut(xi%, xi%) = c11 nut(xi%, yi%) = -s11 * c13 nut(xi%, zi%) = -s11 * s13 nut(yi%, xi%) = s11 * cd(ecos%) nut(yi%, yi%) = c11 * c13 * cd(ecos%) + s13 * cd(esin%) nut(yi%, zi%) = c11 * s13 * cd(ecos%) - c13 * cd(esin%)

nut(zi%, xi%) = s11 * cd(esin%) nut(zi%, yi%) = c11 * c13 * cd(esin%) - s13 * cd(ecos%) nut(zi%, zi%) = c11 * s13 * cd(esin%) + c13 * cd(ecos%) EndProc ' >Procedure transformacion(tipo%, plano%, ByRef q() As Double) Naked If plano% = ecliptica% Select tipo% Case j2000fecha%, j2000epoca% tres(q(), prec()) Case fechaj2000%, epocaj2000% tresxtres(q(), prec()) Case B1950J2000% tres(q(), pr1950()) Case j2000b1950% tresxtres(q(), pr1950()) EndSelect Else If plano% = ecuador% Select tipo% Case j2000fecha%, j2000epoca% tres(q(), fk5()) Case fechaj2000%, epocaj2000% tresxtres(q(), fk5()) Case B1950J2000% tres(q(), de118()) Case j2000b1950% tresxtres(q(), de118()) EndSelect EndIf EndProc ' >Procedure tresxtres(ByRef q() As Double, ByVal t() As Double) Local Double x, y, z x = q(xi%) * t(xi%, xi%) + q(yi%) * t(yi%, xi%) + q(zi%) * t(zi%, xi%) y = q(xi%) * t(xi%, yi%) + q(yi%) * t(yi%, yi%) + q(zi%) * t(zi%, yi%) z = q(xi%) * t(xi%, zi%) + q(yi%) * t(yi%, zi%) + q(zi%) * t(zi%, zi%) q(xi%) = x q(yi%) = y q(zi%) = z EndProc >Procedure tres(ByRef q() As Double, ByVal t() As Double) Local Double x, y, z x = q(xi%) * t(xi%, xi%) + q(yi%) * t(xi%, yi%) + q(zi%) * t(xi%, zi%) y = q(xi%) * t(yi%, xi%) + q(yi%) * t(yi%, yi%) + q(zi%) * t(yi%, zi%) z = q(xi%) * t(zi%, xi%) + q(yi%) * t(zi%, yi%) + q(zi%) * t(zi%, zi%) q(xi%) = x q(yi%) = y q(zi%) = z EndProc ' >Procedure galaxC(ByRef gclon As Double, ByRef gclat As Double) ' *** CENTRO GALACTICO *** Local r As Double polar2rect((17.75 + 40.0383 / ns) * n5, -(29.00 + 28.069 / ns), d1, g()) transformacion(j2000fecha%, ecuador%, g()) Sub g(xi%), ab * pq(vsol%, xi%) Sub g(yi%), ab * pq(vsol%, yi%) Sub g(zi%), ab * pq(vsol%, zi%) 'Mat Norm g(), 0 ecuatoriales(-emedio%, g())

rect2polar(g(), gclon, gclat, r) gclon = gclon + cd(lnut%) EndProc >Procedure galaxP(ByRef gplon As Double, ByRef gplat As Double) ' *** POLO GALACTICO *** Local r As Double polar2rect(192.25, 27.4, d1, g()) transformacion(B1950J2000%, ecuador%, g()) transformacion(j2000fecha%, ecuador%, g()) Sub g(xi%), ab * pq(vsol%, xi%) Sub g(yi%), ab * pq(vsol%, yi%) Sub g(zi%), ab * pq(vsol%, zi%) 'Mat Norm g(), 0 ecuatoriales(-emedio%, g()) rect2polar(g(), gplon, gplat, r) gplon = gplon + cd(lnut%) EndProc ' ' ###################################################################### ' IMPLEMENTATION MODULE MTablas ' ###################################################################### ' >Procedure astronomicas Local item%, off%, gl As Double, bl As Double, rv As Double If opcion% = fdj% encabezado(" ASTRONOM") baja(xi%) EndIf domificacion For item% = 1 To 40 off% = Sub(2, Mul(43, Even(item%))) @txt(white%) Select item% Case 1 ftab(off%, "Year") freal(@f2000(dj), 5, 3, 0, q$) q$ = Trim$(q$) Case 3 ftab(off%, "Date") q$ = vcfecha$(rmes%) + " " + Trim$(Str$(jd| + tu / n4, 6, 2)) + vcfecha$(r nsos%) Case 5 horaplanetaria ftab(off%, "Planetary Hour") q$ = vcfecha$(rcaldea%) Case 7 ftab(off%, "Julian Day") freal(dj + jp, 7, 5, 0, q$) Case 9 ftab(off%, "Delta-t") fseg2(k4%, cd(dt%) * n4, 0, q$) If cd(dt%) > d1 q$ = Str$(Trunc(cd(dt%)) * n4) + Mid$(q$, 3, Len(q$)) EndIf Case 11 ftab(off%, "Universal Time") fseg2(k4%, tu, 0, q$) Case 13 ftab(off%, "Local Time") fseg2(k4%, @mdl(tu * n5 - geos(lon%)) / n5, 0, q$)

Case 15 ftab(off%, "Equation Time") fseg2(k4%, cd(eqt%), 0, q$) Case 17 ftab(off%, "Apparent Time") fseg2(k4%, @mdl(tu * n5 - geos(lon%)) / n5 + cd(eqt%), 0, q$) Case 19 galaxC(gl, bl) farcseconds(gl, q$) nortesur(bl, 0, q2$) q$ = Mid$(q$, 2, Len(q$)) + spc$ + bar$ + q2$ ftab(off%, "Galactic Center") Case 21 galaxP(gl, bl) farcseconds(gl, q$) nortesur(bl, 0, q2$) q$ = Mid$(q$, 2, Len(q$)) + spc$ + bar$ + q2$ ftab(off%, "Galactic Node") Case 23 polar2rect(243.875, -60.9, d1, g()) transformacion(j2000fecha%, ecuador%, g()) Sub g(xi%), ab * pq(vsol%, xi%) Sub g(yi%), ab * pq(vsol%, yi%) Sub g(zi%), ab * pq(vsol%, zi%) ecuatoriales(-emedio%, g()) rect2polar(g(), gl, bl, rv) farcseconds(gl + cd(lnut%), q$) nortesur(bl, 0, q2$) q$ = Mid$(q$, 2, Len(q$)) + spc$ + bar$ + q2$ ftab(off%, "Great Attractor") Case 25 barycenter @txt(brcyan%) ftab(off%, "Helio Barycenter") nortesur(helior(aux%, latitud%), 0, q2$) farcseconds(helior(aux%, longitud%), q$) q$ = Mid$(q$, 2, Len(q$)) + spc$ + bar$ + q2$ Case 27 ftab(off%, "Vernal Point") farcseconds(cd(svp%), q$) q$ = Mid$(q$, 2, Len(q$)) Case 29 ftab(off%, "Mean Sun Apogee") fsigno(1, @mdl(cd(vlsol%) - dla(anomsol%) + n8), 0, signo%, q$, q2$) Case 31 ftab(off%, "True Sun Apogee") fsigno(1, @mdl(Deg(osc(sol%, pn%)) + n8), 0, signo%, q$, q2$) Case 33 ftab(off%, "Nutation") freal(cd(lnut%) * ns, 3, 1, 0, q$) q$ = q$ + sec$ Case 35 bl = 50287.96195 + @pol(221.08696, 0.221775, -0.9408, -0.009, 0.001, d0, d 0, w2 / md) ftab(off%, "precession speed") freal(bl / ml, 3, 2, 0, q$) q$ = q$ + sec$ Case 37 ftab(off%, "Obliquity") fseg2(kg%, cd(oblicuidad%), 0, q$)

Case 39 ftab(off%, "Ayanamsa") fseg2(kg%, @mdl(ng - cd(svp%)), 0, q$) Case 2 ftab(off%, "Lunar Velocity") fsegundos(kg%, 1, vc(lun%, velocidad%), 0, q$) q$ = Trim$(q$) Case 4 ftab(off%, "Lunar Phase") q$ = Str$(dragon(luz%), 4, 1) + "% (" + Trim$(Str$(basefaselunar%)) + "/28 )" q$ = Trim$(q$) Case 6 ftab(off%, "Parallax Moon") fsigno(1, dragon(topoluna%), 0, signo%, q$, q2$) Case 8 ftab(off%, "Mean Node") fsigno(1, dragon(dra_mean_bari%), 0, signo%, q$, q2$) Case 10 @txt(brcyan%) ftab(off%, "True Node") fsigno(0, dragon(dra_osc_geo%), 0, signo%, q$, q2$) Case 12 @txt(pink%) ftab(off%, " --topocentric") fsigno(0, dragon(dra_osc_topo_asc%), 0, signo%, q$, q2$) Case 14 @txt(pink%) ftab(off%, " --descending") fsigno(0, dragon(dra_osc_topo_desc%), 0, signo%, q$, q2$) Case 16 ftab(off%, "Mean Apogee") fsigno(1, dragon(apo_mean_bari%), 0, signo%, q$, q2$) Case 18 @txt(brcyan%) ftab(off%, "True Apogee") fsigno(0, dragon(apo_osc_geo%), 0, signo%, q$, q2$) Case 20 @txt(pink%) ftab(off%, " --topocentric") fsigno(0, dragon(apo_osc_topo%), 0, signo%, q$, q2$) Case 22 @txt(pink%) ftab(off%, " --perigee") fsigno(0, dragon(peri_osc_topo%), 0, signo%, q$, q2$) Case 24 @txt(pink%) ftab(off%, " --empty focus") fsigno(0, dragon(foco_osc_topo%), 0, signo%, q$, q2$) Case 26 ftab(off%, "Natural Apogee") dragon(iper%) = @apogeo(d0, 5) dragon(iapo%) = @apogeo(z5, 4) fsigno(0, dragon(iapo%), 0, signo%, q$, q2$) Case 28 ftab(off%, "Natural Perigee") fsigno(0, dragon(iper%), 0, signo%, q$, q2$) If Not baseswephem? Then q$ = Left$(q$, 2) + spc$ + Right$(q$, 3) Case 30 ftab(off%, "Corrected Apog.")

gl = @mdl(cd(vlluna%) - dla(anomalia%) + n8) bl = Rad(@mdl(solis - gl)) Add gl, 12.3 * Sin(d2 * bl) fsigno(0, @mdl(gl), 0, signo%, q$, q2$) q$ = Left$(q$, 2) + spc$ + Right$(q$, 3) Case 32 ftab(off%, "White Moon") fsigno(0, @mdl(242.2205556 + w2 * 5143.541816), 0, signo%, q$, q2$) Case 34 waltemath ftab(off%, "Dark Moon S.F.") fsigno(0, dragon(dark_SF%), 0, signo%, q$, q2$) Case 36 ftab(off%, "Dark Moon S.E.") fsigno(0, dragon(dark_SE%), 0, signo%, q$, q2$) Case 38 ftab(off%, "Fortuna D.") fsigno(0, cuspide(fortuna%), 0, signo%, q$, q2$) Case 40 ftab(off%, "Fortuna N.") fsigno(0, @mdl(d2 * cuspide(ascendente%) - cuspide(fortuna%)), 0, signo%, q$, q2$) Default q$ = nul$ Inc dummy% EndSelect If q$ <> nul$ ftab(Sub(19, Mul(40, Even(item%))), "= " + q$) EndIf @txt(brcyan%) ftab(Sub(off%, 1), bar$) ftab(Sub(off%, 2), bar$) If Even(item%) baja(xi%) EndIf Next item% If opcion% = fdj% baja(xi%) pantalla EndIf EndProc ' >Procedure llenaelem(m%, n%, l%, pl%) Local j%, q% j% = Add(Mod(Mul(l%, n%), k2%), n%) q% = Pred(Add((j% \ n%), m%)) Add elemento%(q%), 7 Select pl% Case sol%, lun%, asc% Add elemento%(q%), 8 Case qui% To finpl% Sub elemento%(q%), 6 Default Inc dummy% EndSelect EndProc >Procedure elemcuali Local alto%, ancho%, j%, l%, m%, ix%, iy%, base% buffer? = baseimpresora? baseimpresora? = False

Global Dim elemento%(9) ArrayFill elemento%(), 0 For pl% = lun% To plu% l% = Succ(Trunc(@mdl(vc(pl%, longitud%) + cd(ayanamsa%)) / n3)) llenaelem(1, 4, l%, pl%) llenaelem(4, 3, l%, pl%) Next pl% l% = Succ(Trunc(@mdl(cuspide(ascendente%) + cd(ayanamsa%)) / n3)) llenaelem(1, 4, l%, asc%) llenaelem(4, 3, l%, asc%) elemento%(8) = Add(elemento%(5), elemento%(7)) elemento%(9) = Add(elemento%(4), elemento%(6)) base% = @limite() baseimpresora? = False encabezado(" ELEMQUAL") ftab(xcentro%, "Planets=7% Sun/Moon/Asc=15% Centaurs=0%") Print AT(2, Pred(base%)); String$(78, "_") ancho% = 80 \ kd% q$ = " " For j% = 1 To 9 q$ = Str$(elemento%(j%)) + "%" alto% = CInt(CFloat(base%) / 135 * CFloat(elemento%(j%))) ix% = Sub(Mul(j%, ancho%), ancho% \ 4) iy% = Pred(Sub(base%, alto%)) @txt(white%) Print AT(ix%, Pred(iy%)); q$; Print AT(ix%, base%); elem$(j%); GraphMode 4 Color yellow%, atras% DefFill 12 If elemento%(j%) PBox Sub(Mul(ix%, fa%), fa%), Sub(Mul(iy%, fh%), fh%), Mul(Add(ix%, ancho% \ 2), fa%), Sub(Mul(Add(iy%, alto%), fh%), 4) Else Print AT(ix%, iy%); String$(ancho% \ 2, Chr$(220)); EndIf Next j% toquemouse baseimpresora? = buffer? Erase elemento%() EndProc ' >Procedure fila Local i%, lim% i% = Len(q$) lim% = 77 If i% < lim% Then lim% = i% If i% > lim% If Mid$(q$, Succ(lim%), 1) <> spc$ For lim% = 77 DownTo 0 Exit If Mid$(q$, Succ(lim%), 1) = spc$ Next lim% EndIf ftab(0, Left$(q$, lim%)) baja(xi%) ftab(2, Right$(q$, Sub(i%, lim%))) Add contador%, 2 Else ftab(0, q$) Inc contador%

EndIf If Not opcion% = ora% If contador% > @limite() And Not baseimpresora? pantalla encabezado(titulo$) Else baja(xi%) EndIf EndIf EndProc >Procedure simbolos Local gl% Color white%, atras% contador% = 0 If opcion% = ora% Print AT(21, 10); "Write the question and press 'ENTER'" Locate 15, 12 Form Input 48, nombre$ Cls gl% = Succ(Random(kg%)) fsigno(0, CFloat(gl%) - cd(ayanamsa%), 0, signo%, q$, q2$) q$ = q$ + " S: " + cuadro$(gl%, 1) + " " lfk% = Mul(12, fh%) fila toquemouse Else encabezado(" SABIANS") vcangulos For pl% = lun% To BML% If Not aborta? brinque(brinca%, pl%) If pl% <= BML% gl% = Succ(Trunc(@mdl(vc(pl%, longitud%) + cd(ayanamsa%)))) fsigno(0, @mdl(vc(pl%, longitud%) + cd(ayanamsa%)), 0, signo%, q$, q2$ ) Color black%, green% ftab(0, Upper$(plaux$(pl%)) + spc$ + q$) Color white%, atras% Inc contador% baja(xi%) q$ = "S: " + cuadro$(gl%, 1) + " " fila q$ = "V: " + cuadro$(gl%, 2) + " " fila q$ = "C: " + cuadro$(gl%, 3) + " " fila EndIf If pl% = nodo% gl% = Succ(Trunc(@mdl(vc(nodo%, longitud%) + cd(ayanamsa%) + n8))) fsigno(0, @mdl(vc(nodo%, longitud%) + cd(ayanamsa%) + n8), 0, signo%, q$, q2$) Color black%, green% ftab(0, "SOUTH N " + q$) Color white%, atras% Inc contador% baja(xi%) q$ = "S: " + cuadro$(gl%, 1) + " " fila q$ = "V: " + cuadro$(gl%, 2) + " " fila

q$ = "C: " + cuadro$(gl%, 3) + " " fila EndIf EndIf Next pl% If Not aborta? For pl% = ascendente% To fortuna% gl% = Succ(Trunc(@mdl(cuspide(pl%) + cd(ayanamsa%)))) fsigno(0, @mdl(cuspide(pl%) + cd(ayanamsa%)), 0, signo%, q$, q2$) Color black%, green% ftab(0, Upper$(casa$(pl%)) + spc$ + q$) Color white%, atras% Inc contador% baja(xi%) q$ = "S: " + cuadro$(gl%, 1) fila q$ = "V: " + cuadro$(gl%, 2) fila q$ = "C: " + cuadro$(gl%, 3) fila Next pl% EndIf pantalla EndIf EndProc ' >Function regente(l%, i%) As Int Naked signo% = indicepl%(l%, 1) Return regen%(signo%, Add(1, Mul(4, i%))) EndFunc >Procedure esenciales Local i%, j%, pl%, pl2%, guia% For i% = 0 To 1 For j% = 1 To k2% regen%(j%, 9) = 0 ' *** numero de planetas en cada signo indicepl%(j%, 2) = 0 ' *** frecuencia de disponentes Next j% For pl% = lun% To plu% ' ****************************** ' *** DOMICILIO Y EXALTACION *** ' ****************************** For j% = 1 To 4 If pl% = regen%(indicepl%(pl%, 1), Add(j%, Mul(4, i%))) esen$(j%, 2) = esen$(j%, 2) + plaux$(pl%) + " " digni(pl%, (Odd(j%) And i%) Or j% = 1, 100, Left$(esen$(j%, 1), 3)) EndIf Next j% ' *********************** ' *** RECEPCION MUTUA *** ' *********************** For pl2% = Succ(pl%) To plu% If pl% = @regente(pl2%, i%) And pl2% = @regente(pl%, i%) esen$(5, 2) = esen$(5, 2) + Left$(plaux$(pl%), 3) + "-" + Left$(plaux$ (pl2%), 3) + " " digni(pl%, i%, 60, "Mu" + Left$(plaux$(pl2%), 3)) digni(pl2%, i%, 60, "Mu" + Left$(plaux$(pl%), 3)) EndIf Next pl2% Inc regen%(signo%, 9) ' *** acumula numero de planetas en cada signo Next pl%

' ***************** ' *** SOLITARIO *** ' ***************** For pl% = lun% To plu% If pl% = @regente(pl%, i%) If regen%(signo%, 9) = 1 esen$(7, 2) = esen$(7, 2) + plaux$(pl%) + " " digni(pl%, i%, 100, "singletone") EndIf EndIf Next pl% ' ************************ ' *** DISPONENTE FINAL *** ' ************************ For pl2% = lun% To plu% j% = pl2% guia% = 0 Do pl% = j% j% = @regente(pl%, i%) If pl% = j% Inc indicepl%(pl%, 2) ' *** acumula frecuencia de disponentes Exit If True EndIf Inc guia% Exit If guia% > kd% Loop Next pl2% For pl% = lun% To plu% If indicepl%(pl%, 2) > 3 guia% = Mul(indicepl%(pl%, 2), kd%) esen$(6, 2) = esen$(6, 2) + plaux$(pl%) + " (" + Str$(guia%) + "%) " digni(pl%, True, Mul(guia%, 2), Left$(esen$(6, 1), 4)) EndIf Next pl% If i% = 0 ftab(1, "TRADITIONAL:") Else ftab(1, "MODERN:") EndIf baja(yi%) For j% = 1 To 7 ftab(12, esen$(j%, 1) + " = " + esen$(j%, 2)) esen$(j%, 2) = nul$ baja(xi%) Next j% If i% = 0 baja(yi%) Else pantalla EndIf Next i% EndProc >Procedure digni(pl%, prueba?, q%, s$) If prueba? Add almuten%(pl%), q% fila$(pl%) = fila$(pl%) + " " + s$ EndIf EndProc >Procedure accidentales

Local gl, alto, ancho, base% For pl% = lun% To ultimo% gl = vc(pl%, longitud%) base% = @sector(gl) indicepl%(pl%, 2) = base% ' *** posicion de casa del planeta Add regen%(base%, 10), bplan(pl%) ' *** lista de planetas en cada casa Add almuten%(pl%), CInt(Abs(vc(pl%, distancia%))) Add almuten%(pl%), CInt(Abs(vc(pl%, declinacion%)) / z5) digni(pl%, Even(sinodico%(pl%)), 100, "stat") digni(pl%, (indicepl%(pl%, 2) Mod 3) = 1, 60, "ang") digni(pl%, indicepl%(pl%, 2) = 1, 60, "1st") digni(pl%, indicepl%(pl%, 2) = 10, 60, "10th") digni(pl%, pl% = @regente(asc%, 1), 90, "rulAsc") alto = Abs(@angdist(gl, vc(asc%, longitud%))) digni(pl%, alto < n5, 90, "15Asc") digni(pl%, alto < d5, 60, "5Asc") digni(pl%, indicepl%(pl%, 1) = indicepl%(asc%, 1), 50, "sgAsc") digni(pl%, alto > (n8 - d5), 90, "5Des") alto = Abs(@angdist(gl, vc(m_c%, longitud%))) digni(pl%, alto < n4, 90, "24MC") digni(pl%, alto < d5, 60, "5MC") digni(pl%, indicepl%(pl%, 1) = indicepl%(m_c%, 1), 50, "sgMC") digni(pl%, alto > (n8 - d5), 90, "5IC") If pl% <> sol% digni(pl%, pl% = @regente(sol%, 1), 50, "rulS") alto = Abs(@angdist(@mdl(gl * d4), @mdl(solis * d4))) digni(pl%, alto < 32, 200, "hardS") digni(pl%, alto < md, 100, "2.5") digni(sol%, alto < md, 100, "+") alto = Abs(@angdist(gl, solis)) digni(pl%, alto < 126 And alto > 114, 200, "triS") digni(pl%, alto < 62 And alto > 58, 200, "sexS") digni(pl%, alto < z5, 100, "caz") If Abs(@angdist(@mdl(gl * n2), @mdl(solis * n2))) < n2 digni(pl%, True, 100, "1S") digni(sol%, True, 100, "+") EndIf alto = Abs(Abs(vc(pl%, declinacion%)) - Abs(vc(sol%, declinacion%))) digni(pl%, alto < d1, 90, "pSun") EndIf If pl% <> lun% digni(pl%, pl% = @regente(lun%, 1), 50, "rulM") alto = Abs(@angdist(@mdl(gl * d4), @mdl(vc(lun%, longitud%) * d4))) digni(pl%, alto < n2, 200, "hardM") digni(pl%, alto < d6, 100, "1.5") digni(lun%, alto < d6, 100, "+") alto = Abs(@angdist(gl, vc(lun%, longitud%))) digni(pl%, alto < 123 And alto > 117, 200, "triM") digni(pl%, alto < 62 And alto > 58, 200, "sexM") If Abs(@angdist(@mdl(gl * n2), @mdl(vc(lun%, longitud%) * n2))) < n2 digni(pl%, True, 100, "1M") digni(lun%, True, 100, "+") EndIf alto = Abs(Abs(vc(pl%, declinacion%)) - Abs(vc(lun%, declinacion%))) digni(pl%, alto < d1, 90, "pMoon") EndIf alto = Abs(@angdist(gl, cuspide(fortuna%))) digni(pl%, alto < d2, 100, "Fort") alto = Abs(@angdist(@mdl(gl * d4), @mdl(vc(nodo%, longitud%) * d4))) digni(pl%, alto < d6, 100, "Node")

Next pl% EndProc >Procedure patrones Local i%, j%, q%, pl%, pl2%, guia% ' ******************************** ' *** solitario por hemisferio *** ' ******************************** For i% = 1 To 10 Step 3 ' *** 1,4,7,10 (hemisferios) guia% = 0 ' *** cuantos por hemisferio For j% = 0 To 5 ' *** 6 casas cada uno q% = regen%(@disminuye(Add(i%, j%), k2%), 10) ' *** lista de planetas If q% ' *** si hay planetas... For pl% = lun% To plu% ' *** cual planeta es If Btst(q%, Pred(pl%)) Inc guia% ' *** sume cuantos hay en la casa pl2% = pl% ' *** este esta en la casa EndIf Next pl% EndIf Next j% If guia% = 1 Then digni(pl2%, True, 200, "HEM") ' *** si hay solo 1... Next i% ' *** siguiente hemisferio ' ****************************** ' *** segadores y dirigentes *** ' ****************************** For pl% = lun% To plu% spx%(pl%) = CInt((ng - vc(pl%, longitud%)) * mz) spi%(pl%) = pl% Next pl% QSort spx%(), plu%, spi%() For q% = Add(plu%, 2) To Succ(Mul(plu%, 2)) guia% = Sub(q%, Succ(plu%)) i% = spx%(@disminuye(Add(guia%, 1), plu%)) j% = Sub(i%, spx%(guia%)) spx%(q%) = Sub(j%, Mul(Mul(kg%, kz%), j% < 0)) Next q% spx%(Succ(plu%)) = spx%(Succ(Mul(plu%, 2))) spi%(Succ(plu%)) = spi%(1) guia% = 800000 For q% = 1 To plu% i% = spx%(Add(q%, plu%)) ' *** distancia por atras j% = spx%(Add(q%, Succ(plu%))) ' *** area de barrida pl% = spi%(q%) ' *** planeta entre ambos espacios If j% > 1000000 ' *** es dirigente o segador If j% > 1800000 ' *** es un paquete: sumar las alas digni(pl%, True, 100, "wing") digni(spi%(Succ(q%)), True, 100, "wing") Else digni(pl%, True, 100, "lead") digni(spi%(Succ(q%)), True, 100, "rec") EndIf digni(spi%(@disminuye(Add(Pred(q%), 10), 10)), i% < 20000, 100, "l/wing") EndIf digni(pl%, i% > guia% And j% > guia%, 200, "hand") digni(spi%(Succ(q%)), pl% = sol% And j% < guia%, 90, "orie") Next q% EndProc >Procedure dignidades Local ln%, tp%, q1$

encabezado(" WEIGHTING") baja(xi%) vcangulos domificacion For pl% = lun% To ultimo% fila$(pl%) = nul$ almuten%(pl%) = 0 Next pl% For j% = 1 To k2% regen%(j%, 10) = 0 Next j% esenciales accidentales patrones j% = 0 For pl% = lun% To ultimo% Inc j% spx%(j%) = almuten%(pl%) spi%(j%) = pl% Next pl% QSort spx%(), j%, spi%() encabezado(titulo$) For pl% = j% DownTo Sub(j%, @limite()) baja(xi%) q1$ = plaux$(spi%(pl%)) + ": " + Str$(spx%(pl%), 4) q2$ = fila$(spi%(pl%)) tp% = 60 ln% = Len(q2$) If ln% < tp% Then q$ = q1$ + q2$ Else If Mid$(q2$, Succ(tp%), 1) <> spc$ For tp% = 77 DownTo 0 Exit If Mid$(q2$, Succ(tp%), 1) = spc$ Next tp% EndIf ftab(1, q1$ + Left$(q2$, tp%)) baja(xi%) q$ = Space(15) + Right$(q2$, Sub(ln%, tp%)) EndIf ftab(1, q$) Next pl% pantalla EndProc ' ' ###################################################################### ' CREATE EPHEM MODULE ' ###################################################################### ' >Procedure siguientepaso(paso As Single, dj1 As Double, efem%, ByRef dj, ByRef s alir?) Local Const oneonly% = 1, regular% = 2, group% = 3, onepair% = 4, apsides% = 5 , precession% = 6 Select efem% Case oneonly%, precession% Add dj, paso + (86 - 16 * alta?) * paso * (k$ = "P") Case group%, onepair%, apsides% Add dj, paso + (54 - kd% * alta?) * paso * (k$ = "P") Case regular% If k$ = "P"

If jm| = 1 getdj(1, k2%, Pred(ja%)) Else getdj(1, Pred(jm|), ja%) EndIf j% = 0 Else Add dj, d1 EndIf EndSelect salir? = (dj > dj1 And paso > d0) Or (dj < dj1 And paso < d0) salir? = salir? Or k$ = esc$ k$ = nul$ EndProc ' >Procedure sumeprec(ByRef bj As Double) If tx = d0 bj = d0 Else q$ = " precession correction from the time of the radix found in memory|" q$ = q$ + " will be added to all longitudes unless otherwise specified now." Alert 3, q$, 1, "precessed| plain-tropical ", n% If n% = 2 bj = d0 Else bj = - @precesion(tx, dj) - cd(lnut%) + rxcd(lnut%) EndIf EndIf EndProc ' >Procedure barisol Local v$, bpl%, dj0 As Double, dj1 As Double, paso As Single, salir? dlgephemstep(dj0, dj1, paso) If checklong(dj0, dj1, sol%) cambiafont(9) Win_1.ForeColor = RGB(210, 210, 210) rmargin = 96 v$ = "SOLAR BARYCENTER lon vel lat distance from the Sun" ftab(0, v$) baja(yi%) contador% = 1 dj = dj0 If baseimpresora? Then sayredir Do If Not aborta? If @withinrange(sol%) barycenter impfecha(dj, 0, 0, 0, 1, q$) farcseconds(helior(aux%, hlon%), q$) q$ = Left$(q$, 3) + Left$(sgaux$(signo%), 2) + Mid$(q$, 5, 6) If signo% = kd% Then Mid$(q$, 5, 1) = "p" ftab(16, q$) fsegundos(kg%, 1, heliov(aux%, hlon%), 30, q$) fsegundos(kg%, 1, helior(aux%, hlat%), 43, q$) ftab(60, Str$(helior(aux%, hdis%), 10, 8) + " au") ftab(74, Str$(helior(aux%, hdis%) * au - 695987, 10, 0) + " Km") If contador% > Sub(Add(15, @limite()), Mul(3, alta?)) And Not baseimpr esora?

toquemouse Exit If aborta? contador% = 0 ftab(0, v$) baja(yi%) Else baja(xi%) EndIf siguientepaso(paso, dj1, 1, dj, salir?) Exit If salir? Inc contador% Else Exit If True EndIf EndIf Exit If aborta? Loop EndIf EndProc ' >Procedure efemsingle Local v$, bpl%, sel%, dj0 As Double, dj1 As Double, corr As Double, paso As Si ngle, salir? dlgplanetas("only 1 planet", bpl%, sel%, allplanets%, 1) If (bpl% = 0 Or bpl% = asc% Or bpl% = m_c%) Print range$ prueba? = False EndIf If prueba? dlgephemstep(dj0, dj1, paso) If checklong(dj0, dj1, bpl%) cambiafont(9) Win_1.ForeColor = RGB(200, 200, 200) rmargin = 96 If bpl% = lun% v$ = "UT lon iau lat dec distance velocity Apog ee Node" Else If bpl% = nodo% Or bpl% = BML% v$ = "UT lon iau lat dec distance velocity" Else If bpl% = sol% v$ = "UT lon iau lat dec gdist velocity" Else v$ = "UT lon iau lat dec gdist velocity helio hdist Ang" EndIf ftab(2, Upper$(plaux$(bpl%)) + Space$(6) + v$) baja(yi%) contador% = 1 dj = dj0 If baseimpresora? Then sayredir sumeprec(corr) Do If Not aborta? If @withinrange(bpl%) efemerides(0, 0) vsop82(sol%, sol%) If bpl% <> sol% Then tabephem(bpl%) pl% = bpl% impfecha(dj, 0, 0, 0, 1, q$) fsegundos(k4%, 0, tu, 14, q$)

'ftab(22, Str$(vc(pl%, longitud%))) If bpl% >= astraea% fsigno(0, @mdl(vc(pl%, longitud%) + corr), 0, signo%, q$, q2$) q$ = spc$ + q$ + spc$ Else farcseconds(@mdl(vc(pl%, longitud%) + corr), q$) q$ = Left$(q$, 3) + Left$(sgaux$(signo%), 2) + Mid$(q$, 5, 6) If signo% = kd% Then Mid$(q$, 5, 1) = "p" EndIf iauconstel(vc(pl%, ascensionrecta%), vc(pl%, declinacion%), q2$) ftab(22, bar$ + " " + q$ + " " + q2$) If pl% = sol% sel% = 2 ftab(43, Str$(vc(sol%, latitud%) * ns, 4, 1) + sec$) Else sel% = 0 nortesur(vc(pl%, latitud%), 42, q$) EndIf nortesur(vc(pl%, declinacion%), Add(49, sel%), q$) If pl% >= sol% And Not (pl% = nodo% Or pl% = BML%) ftab(Add(55, sel%), Str$(vc(pl%, rvector%), 7, 3)) fsegundos(kg%, 0, vc(pl%, velocidad%), Add(63, sel%), q$) If pl% > sol% fsigno(0, heliop(pl%, hlon%), 0, signo%, q$, q2$) corrfont ftab(74, q2$) ftab(82, Str$(heliop(pl%, hdis%), 6, 2)) fminutos(kg%, @crossangle(pl%), 0, 89, q$) EndIf Else If pl% = lun% Or pl% = nodo% Or pl% = BML% ftab(54, Str$(vc(pl%, rvector%) * au, 8, 0) + " km") If pl% = BML% fminutos(kg%, vc(pl%, velocidad%), 0, 67, q$) Else fsegundos(kg%, 0, vc(pl%, velocidad%), 67, q$) EndIf If pl% = lun% fsigno(0, vc(BML%, longitud%), 0, signo%, q$, q2$) corrfont ftab(79, q2$) fsigno(0, vc(nodo%, longitud%), 0, signo%, q$, q2$) corrfont ftab(88, q2$) EndIf EndIf If contador% > Sub(Add(15, @limite()), Mul(3, alta?)) And Not baseim presora? toquemouse Exit If aborta? contador% = 0 ftab(2, Upper$(plaux$(bpl%)) + Space$(6) + v$) baja(yi%) Else baja(xi%) EndIf siguientepaso(paso, dj1, 1, dj, salir?) Exit If salir? Inc contador% Else Exit If True

EndIf EndIf Exit If aborta? Loop EndIf EndIf EndProc ' >Procedure efemregular Local dj0 As Double, dj1 As Double, corr As Double, j%, bpl%, mes|, paso As Si ngle, salir? Local Dim insta0%(planeta%), signo0%(planeta%) dlgephemstep(dj0, dj1, paso) If Not aborta? @getfecha(dj0, jd|, jm|, ja%) getdj(1, jm|, ja%) j% = 0 sumeprec(corr) While @withinrange(sol%) Inc j% efemerides(0, 0) vsop82(sol%, sol%) @getfecha(dj, jd|, jm|, ja%) If mes| <> jm| Or j% = 1 mes| = jm| q$ = Trim$(Left$(mes$(jm|), 3)) + "'" + Right$(Str$(ja%), 2) ftab(0, q$) For bpl% = lun% To plu% ftab(Pred(Add(Mul(7, bpl%), 2)), Left$(plaux$(bpl%), 3)) Next bpl% baja(yi%) Add contador%, 2 EndIf For bpl% = lun% To plu% If bpl% <> sol% If bpl% = lun% elp2000(w2) vcangulos Else If bpl% <> nodo% vsop82(bpl%, bpl%) EndIf EndIf Next bpl% impfecha(d0, jd|, jm|, ja%, 0, q$) ftab(1, Left$(q$, 2) + Left$(dia$(@semana(dj + z5)), 2) + bar$ + bar$) For bpl% = lun% To plu% fsigno(0, @mdl(vc(bpl%, longitud%) + corr), 0, signo%, q$, q2$) corrfont If j% > 1 If Sgn(vc(bpl%, velocidad%)) <> insta0%(bpl%) Or j% = 2 Or jd| = 2 If Sgn(vc(bpl%, velocidad%)) < 0 Mid$(q2$, 3, 2) = "Rx" Else If j% = 2 Or jd| = 2 If signo% = signo0%(bpl%) Mid$(q2$, 3, 2) = " " Else Mid$(q2$, 3, 2) = Left$(sgaux$(signo), 2) EndIf Else Mid$(q2$, 3, 2) = "Dx"

EndIf Else If signo% = signo0%(bpl%) And jd| > 1 Mid$(q2$, 3, 2) = " " EndIf EndIf n% = Mul(7, bpl%) ftab(n%, q2$) ftab(Add(6, n%), bar$) insta0%(bpl%) = Sgn(vc(bpl%, velocidad%)) signo0%(bpl%) = signo% Next bpl% If contador% > @limite() And Not baseimpresora? toquemouse Exit If aborta? contador% = 0 j% = 0 Else baja(xi%) Inc contador% EndIf mes| = jm| If jd| = meses%(jm|, 1) If contador% >= Sub(@limite(), 3) And Not baseimpresora? toquemouse Exit If aborta? contador% = 0 j% = 0 Else If contador% And paso = d1 baja(xi%) Inc contador% EndIf EndIf siguientepaso(d1, dj1, 2, dj, salir?) Exit If salir? Wend Else Print range$ EndIf Erase insta0%(), signo0%() EndProc ' >Procedure efemgroup Local bpl%, la%, lz%, j% = 0, cuantos%, dj0 As Double, dj1 As Double, paso As Single, dist, salir? prueba? = True dlgplanetas("up to seven planets", la%, lz%, allplanets%, 7) prueba? = (la% > 0) If aborta? Then prueba? = False If (Not aborta?) And prueba? dlgephemstep(dj0, dj1, paso) If checklong(dj0, dj1, lz%) If paso = d0 Then aborta? = True If Not aborta? If baseimpresora? Then sayredir contador% = 0 dj = dj0 While @withinrange(la%) And @withinrange(lz%) Inc j% efemerides(0, 0) vsop82(sol%, sol%)

@getfecha(dj, jd|, jm|, ja%) If j% = 1 cuantos% = 0 For bpl% = la% To lz% If @is_in_seq(bpl%) Inc cuantos% ftab(Add(16, Mul(Pred(cuantos%), 9)), Left$(plaux$(bpl%), 5)) EndIf Next bpl% baja(yi%) Add contador%, 2 EndIf cuantos% = 0 For bpl% = la% To lz% If @is_in_seq(bpl%) Inc cuantos% tabephem(bpl%) If cuantos% = 1 impfecha(dj, 0, 0, 0, 0, q$) ftab(1, q$ + bar$ + bar$) EndIf fsigno(0, vc(bpl%, longitud%), 0, signo%, q$, q2$) corrfont ftab(Add(15, Mul(Pred(cuantos%), 9)), q2$) ftab(Add(22, Mul(Pred(cuantos%), 9)), bar$) EndIf Next bpl% If contador% > @limite() And Not baseimpresora? toquemouse Exit If aborta? contador% = 0 j% = 0 Else baja(xi%) Inc contador% EndIf siguientepaso(paso, dj1, 3, dj, salir?) Exit If salir? Wend EndIf EndIf Else Print range$ EndIf EndProc ' >Procedure efempair Local bpl%, la%, lz%, j% = 0, dj0 As Double, dj1 As Double, paso As Single, di st, salir? prueba? = True dlgplanetas("the desired pair", la%, lz%, allplanets%, 2) If la% = lz% Then lz% = 0 If la% > 0 If lz% > 0 prueba? = (la% > 0 And lz% > 0) If lz% < la% Then Swap lz%, la% Else Print " You must choose a second planet!" prueba? = False EndIf

If aborta? Then prueba? = False Else aborta? = True EndIf If (Not aborta?) And prueba? dlgephemstep(dj0, dj1, paso) If checklong(dj0, dj1, lz%) If paso <= d0 Then aborta? = True If Not aborta? If baseimpresora? Then sayredir contador% = 0 dj = dj0 While @withinrange(la%) And @withinrange(lz%) Inc j% efemerides(0, 0) vsop82(sol%, sol%) @getfecha(dj, jd|, jm|, ja%) If j% = 1 ftab(17, "UT") ftab(27, Left$(plaux$(la%), 5)) ftab(40, Left$(plaux$(lz%), 5)) ftab(53, "ecl.") ftab(62, "true") ftab(71, "midp") baja(yi%) Add contador%, 2 EndIf ftab(12, bar$) ftab(23, bar$) ftab(36, bar$) ftab(49, bar$) ftab(58, bar$) ftab(68, bar$) ftab(77, bar$) For bpl% = la% To lz% If @is_in_seq(bpl%) tabephem(bpl%) EndIf Next bpl% impfecha(dj, 0, 0, 0, 1, q$) fsegundos(k4%, 0, tu, 14, q$) If la% >= astraea% fsigno(0, vc(la%, longitud%), 0, signo%, q$, corrfont ftab(27, q2$) Else farcseconds(vc(la%, longitud%), q$) q$ = Left$(q$, 3) + Left$(sgaux$(signo%), 2) If signo% = kd% Then Mid$(q$, 5, 1) = "p" ftab(24, q$) EndIf If lz% >= astraea% fsigno(0, vc(lz%, longitud%), 0, signo%, q$, corrfont ftab(40, q2$) Else farcseconds(vc(lz%, longitud%), q$) q$ = Left$(q$, 3) + Left$(sgaux$(signo%), 2) If signo% = kd% Then Mid$(q$, 5, 1) = "p" ftab(37, q$)

q2$)

+ Mid$(q$, 5, 6)

q2$)

+ Mid$(q$, 5, 6)

EndIf dist = @mdl(vc(la%, longitud%) - vc(lz%, longitud%)) If dist > n8 Then dist = ng - dist freal(dist, 3, 2, 51, q$) freal(@truedist(la%, lz%), 3, 3, 60, q$) fsigno(0, @mdl((vc(lz%, longitud%) + vc(la%, longitud%)) * z5), 0, sig no%, q$, q2$) corrfont ftab(70, q2$) If contador% > @limite() And Not baseimpresora? toquemouse Exit If aborta? contador% = 0 j% = 0 Else baja(xi%) Inc contador% EndIf siguientepaso(paso, dj1, 4, dj, salir?) Exit If salir? Wend EndIf EndIf Else Print range$ EndIf EndProc ' >Procedure efemapsides Local bpl%, sel%, j%, ktab%, mes|, dj0 As Double, dj1 As Double, paso As Singl e, gl, v$, salir? dlgplanetas("the desired orbit", bpl%, sel%, finpl%, 1) If bpl% > 0 prueba? = (bpl% > 0 And bpl% < nodo%) Else prueba? = False EndIf If prueba? dlgephemstep(dj0, dj1, paso) If checklong(dj0, dj1, bpl%) If paso <= d0 Then aborta? = True If baseimpresora? Then sayredir getdj(jd|, jm|, ja%) contador% = 0 dj = dj0 While @withinrange(bpl%) efemerides(0, 0) vsop82(sol%, sol%) @getfecha(dj, jd|, jm|, ja%) If contador% = 0 If bpl% = lun% v$ = "Oscu Mean TopoA TopoP TopoF nApo nPeri" Else v$ = "Aphel hNode gAsc gDesc gPer gAph" EndIf ftab(3, Upper$(plaux$(bpl%))) ftab(16, v$) baja(yi%) Add contador%, 2 EndIf

If bpl% = lun% elp2000(w2) vcangulos Else If bpl% <> nodo% vsop82(bpl%, bpl%) EndIf impfecha(dj, 0, 0, 0, 0, q$) ftab(2, q$ + bar$) gl = @mdl(Deg(osc(bpl%, pn%)) + n8) If bpl% = lun% gl = dragon(apo_osc_geo%) sumasen(1) = dragon(apo_mean_bari%) sumasen(2) = dragon(apo_osc_topo%) sumasen(3) = dragon(peri_osc_topo%) sumasen(4) = dragon(foco_osc_topo%) sumasen(5) = dragon(iapo%) sumasen(6) = dragon(iper%) Else sumasen(1) = Deg(osc(bpl%, an%)) sumasen(2) = @geonode(bpl%, d0) sumasen(3) = @geonode(bpl%, n8) sumasen(4) = @geoapsis(bpl%, d0) sumasen(5) = @geoapsis(bpl%, n8) EndIf fsigno(0, gl, 0, signo%, q$, q2$) corrfont ftab(15, q2$) ftab(22, bar$) For sel% = 1 To Sub(5, bpl% = lun%) fsigno(0, sumasen(sel%), 0, signo%, q$, q2$) corrfont n% = Add(26, Mul(9, Pred(sel%))) ftab(Sub(n%, 2), q2$) ftab(Add(5, n%), bar$) Next sel% ftab(69, Str$(osc(bpl%, ax%), 8, 2)) If contador% > @limite() And Not baseimpresora? toquemouse Exit If aborta? contador% = 0 Else baja(xi%) Inc contador% EndIf siguientepaso(paso, dj1, 5, dj, salir?) Exit If salir? Wend EndIf Else Print range$ EndIf EndProc ' >Procedure efemphysical Local bpl%, sel%, j%, ktab%, mes|, dj0 As Double, dj1 As Double, paso As Singl e, gl, v$, salir? dlgplanetas("only 1 planet", bpl%, sel%, finpl%, 1) If bpl% > 0 prueba? = (bpl% > 0 And bpl% < nodo%) And bpl% <> sol% Else

prueba? = False EndIf If prueba? dlgephemstep(dj0, dj1, paso) If checklong(dj0, dj1, bpl%) If paso <= d0 Then aborta? = True If baseimpresora? Then sayredir getdj(jd|, jm|, ja%) contador% = 0 dj = dj0 While @withinrange(bpl%) efemerides(0, 0) vsop82(sol%, sol%) @getfecha(dj, jd|, jm|, ja%) If contador% = 0 v$ = " Phase Angle Brightness Magnitude Elongation" ftab(3, Upper$(plaux$(bpl%))) ftab(14, v$) baja(yi%) Add contador%, 2 EndIf If bpl% = lun% elp2000(w2) vcangulos Else If bpl% <> sol% vsop82(bpl%, bpl%) EndIf magnitud(bpl%) impfecha(dj, 0, 0, 0, 0, q$) ftab(2, q$ + bar$) For sel% = kfase% To elon% n% = Add(17, Mul(12, Pred(sel%))) ftab(Sub(n%, 2), Str$(lum(bpl%, sel%), 7, 2)) Next sel% If contador% > @limite() And Not baseimpresora? toquemouse Exit If aborta? contador% = 0 Else baja(xi%) Inc contador% EndIf siguientepaso(paso, dj1, 5, dj, salir?) Exit If salir? Wend EndIf Else Print range$ EndIf EndProc ' >Procedure efemprec Local v$, gl As Double, bl As Double, dj0 As Double, dj1 As Double, paso As Si ngle, salir? dlgephemstep(dj0, dj1, paso) cambiafont(9) Win_1.ForeColor = RGB(200, 200, 200) rmargin = 96 v$ = " Zero Point Vernal Point Galactic Center Calactic Pole Ecliptic Ro tation"

ftab(2, "PRECESSION" + Space$(5) + v$) baja(xi%) @txt(pink%) ftab(18, zsideral$(baseayanamsa%)) baja(xi%) @txt(RGB(200, 200, 200)) contador% = 1 If baseimpresora? Then sayredir dj = dj0 Do If Not aborta? If @withinrange(sol%) efemerides(0, 0) vsop82(sol%, sol%) If Not aborta? impfecha(dj, 0, 0, 0, 1, q$) ftab(13, bar$) fseg2(kg%, cd(svp%), 18, q$) 'fsegundos(kg%, 0, cd(svp%), 18, q$) iauconstel(d0, d0, q2$) ftab(34, q2$) ftab(42, bar$) galaxC(gl, bl) fsegundos(kg%, 0, gl, 48, q$) galaxP(gl, bl) fsegundos(kg%, 0, @mdl(gl + n9), 64, q$) ftab(77, bar$) fsegundos(kg%, 0, Deg(er), 82, q$) If contador% > Sub(Add(15, @limite()), Mul(3, alta?)) And Not baseimpr esora? toquemouse Exit If aborta? contador% = 0 ftab(2, "PRECESSION" + Space$(5) + v$) baja(xi%) @txt(pink%) ftab(18, zsideral$(baseayanamsa%)) baja(xi%) @txt(RGB(200, 200, 200)) Else baja(xi%) EndIf siguientepaso(paso, dj1, 6, dj, salir?) Exit If salir? Inc contador% EndIf Else Exit If True EndIf EndIf Exit If aborta? Loop EndProc ' >Procedure paranatellontas Local hasta%, sel%, q% = 0 hasta% = ultimo% ultimo% = allplanets% q$ = "one object only|group of objects| apsides and node |precession|physical ephemerides"

q$ = q$ + "| solar system barycenter " Alert 2 | 16, nul$, 1, q$ + "|CANCEL", sel% If sel% > 0 And sel% < 7 abralostodos(True) bandera% = 0 q% = 1 If sel% = 1 Then efemsingle If sel% = 2 Alert 2 | 16, nul$, 2, " regular planets |select group|one pair|CANCEL", q % If q% = 1 Then efemregular If q% = 2 Then efemgroup If q% = 3 Then efempair If q% = 4 Then q% = 0 EndIf If sel% = 3 Then efemapsides If sel% = 4 Then efemprec If sel% = 5 Then efemphysical If sel% = 6 Then barisol If q% > 0 plaux$(aux%) = "Aries " cambiafont(14) rmargin = 80 Win_1.ForeColor = white% pantalla contador% = 0 abralostodos(False) llenaradix EndIf EndIf ultimo% = hasta% EndProc ' >Function checklong(j0, j1, p%) If p% > plu% If (j0 <= D1702 Or j1 > D2018) And Not Exist(ExecPath + "long.fle") q$ = "for dates before 6 Feb 1701 or after 10 Sep 2018,|" q$ = q$ + "the file 'long.fle' must be in the program's directory.||" Alert 3 | 16, q$, 1, " OK ", n% aborta? = True prueba? = False Return False Else Return True EndIf Else Return True EndIf EndFunc ' ' ###################################################################### ' IMPLEMENTATION MODULE MVSOP ' ###################################################################### ' >Procedure cpjv(pl%, piso, f|, serie%) Local Double a, b, d, p, l%, i%, j%, k% Local Dim fp%(ff%, xyz%), dp%(ff%) Local Const paso As Double = 200 d = (dj + cd(dt%) - piso + jp) / paso ' dj al inicio del archivo p = Frac(d) ' factor de interpolacin

' ----------------------------' 3 coordenadas x kd planetas ' ----------------------------l% = Mul(Mul(serie%, xyz%), Sub(pl%, kd%))' piso de coordenadas l% = Add(Mul(Trunc(d), xyz%), l%) ' X de la fecha 0 Sub l%, Mul(2, xyz%) ' retroceda 2 fechas For i% = af% To ff% ' lea 6 fechas para interpolar For j% = xi% To zi% Seek # f|, Mul(l%, 4) fp%(i%, j%) = Cvl(Input$(4, # f|)) Inc l% Next j% Next i% For i% = xi% To zi% For j% = af% To ff% dp%(j%) = fp%(j%, i%) Next j% everett(3, p, dp%(), a, b) If f| = 5 Select pl% Case sed%, cr5%, oo7%, pj3%, fp5%, gb2%, vq4% r(i%) = a * p6 v(i%) = b * p6 / paso Default r(i%) = a * p7 v(i%) = b * p7 / paso EndSelect Else r(i%) = a * p7 v(i%) = b * p7 / paso EndIf Next i% If f| = 7 Then pl% = aux% osculacion(pl%, r(), v()) transformacion(j2000fecha%, ecliptica%, r()) transformacion(j2000fecha%, ecliptica%, v()) EndProc >Procedure masteroid(plb%, f%) Local Double a, b, d, p, l%, i%, j%, k% Local Dim fp%(ff%, xyz%), dp%(ff%) Local Const paso As Double = 80 d = (dj + cd(dt%) - piso1700 + jp) / paso ' dj al inicio de archivo p = Frac(d) ' factor de interpolacin ' ----------------------------' 3 coordenadas x kd planetas ' ----------------------------l% = Mul(Mul(1461, xyz%), Pred(plb%)) ' piso de coordenadas l% = Add(Mul(Trunc(d), xyz%), l%) ' X de la fecha 0 Sub l%, Mul(2, xyz%) ' retroceda 2 fechas For i% = af% To ff% ' lea 6 fechas para interpolar For j% = xi% To zi% Seek # f%, Mul(l%, 4) fp%(i%, j%) = Cvl(Input$(4, # f%)) Inc l% Next j% Next i% For i% = xi% To zi% For j% = af% To ff% dp%(j%) = fp%(j%, i%) Next j%

everett(3, p, dp%(), a, b) If f% = 6 Select plb% Case 6, 8, 10, 11 r(i%) = a * p7 v(i%) = b * p7 / paso Default r(i%) = a * p8 v(i%) = b * p8 / paso EndSelect Else r(i%) = a * p7 v(i%) = b * p7 / paso EndIf Next i% If f% = 6 osculacion(Pred(Add(plb%, astraea%)), r(), v()) Else osculacion(Add(plb%, kd%), r(), v()) EndIf transformacion(j2000fecha%, ecliptica%, r()) transformacion(j2000fecha%, ecliptica%, v()) EndProc >Procedure damocles(bpl%, ByRef osc#()) Local Double a, b, d, p, l%, i%, j%, h% Local Dim fp%(ff%, ff%), dp%(ff%) d = (dj + cd(dt%) - piso1700 + jp) / 40 ' dj al inicio de archivo p = Frac(d) ' factor de interpolacin l% = Mul(Mul(2921, ff%), Pred(bpl%)) ' piso de coordenadas l% = Add(Mul(Trunc(d), ff%), l%) ' X de la fecha 0 Sub l%, Mul(2, ff%) ' retroceda 2 fechas For i% = af% To ff% ' lea 6 fechas para interpolar For j% = af% To ff% Seek # 4, Mul(l%, 4) fp%(i%, j%) = Cvl(Input$(4, # 4)) Inc l% Next j% Next i% For i% = af% To ff% ' 6 coordinates For j% = af% To ff% ' 6 dates dp%(j%) = fp%(j%, i%) Next j% If i% = bf% For j% = bf% To ff% If dp%(j%) < dp%(Pred(j%)) For h% = Pred(j%) DownTo 1 Sub dp%(h%), 360000000 Next h% j% = ff% EndIf Next j% EndIf everett(3, p, dp%(), a, b) osc#(aux%, i%) = a * p6 Next i% EndProc >Procedure pluton(plb%) Local a As Double, b As Double, d As Double, p As Double, i%, j%, k%, l% Local Dim fp%(ff%, xyz%), dp%(ff%) Local Const paso As Double = 160

d = (dj + cd(dt%) + 392.5 + jp) / paso p = Frac(d) l% = Succ(Mul(52848, Sub(plb%, jup%))) l% = Add(Mul(Trunc(d), xyz%), l%) Sub l%, Mul(2, xyz%) For i% = af% To ff% For j% = xi% To zi% fp%(i%, j%) = pluto%(l%) Inc l% Next j% Next i% For i% = xi% To zi% For j% = af% To ff% dp%(j%) = fp%(j%, i%) Next j% everett(3, p, dp%(), a, b) r(i%) = a * p7 v(i%) = b * p7 / paso Next i% osculacion(plb%, r(), v()) transformacion(j2000fecha%, ecliptica%, r()) transformacion(j2000fecha%, ecliptica%, v()) EndProc ' >Procedure psecular(pl%) Local pol%, el% For el% = ax% To an% sec(pl%, el%, rp%) = sec(pl%, el%, t6%) For pol% = t5% DownTo t0% sec(pl%, el%, rp%) = sec(pl%, el%, rp%) * pt(t1%) + sec(pl%, el%, pol%) Next pol% Next el% EndProc ' >Procedure approxlow(pl%, ByRef se As Double, ByRef lm As Double) Local Double dmu, arga, argl, j%, i% j% = Pred(pl%) dmu = 0.3595362 * pt(t1%) For i% = 1 To 8 arga = @rmdl(kp(j%, i%) * dmu) argl = @rmdl(kq(j%, i%) * dmu) Add se, (ca(j%, i%) * Cos(arga) + sa(j%, i%) * Sin(arga)) Add lm, (cl(j%, i%) * Cos(argl) + sl(j%, i%) * Sin(argl)) Next i% arga = @rmdl(kp(j%, 9) * dmu) Add se, pt(t1%) * (ca(j%, 9) * Cos(arga) + sa(j%, 9) * Sin(arga)) For i% = 9 To kd% argl = @rmdl(kq(j%, i%) * dmu) Add lm, pt(t1%) * (cl(j%, i%) * Cos(argl) + sl(j%, i%) * Sin(argl)) Next i% EndProc ' >Procedure pluto406 plutoxyz(dj + d1 / n4, w2 + d1 / n4 / jq, r()) Mat Cpy v() = r() plutoxyz(dj, w2, r()) Mat Sub v(), r() Mat Mul v(), n4 osculacion(plu%, r(), v()) transformacion(j2000fecha%, ecliptica%, r())

transformacion(j2000fecha%, ecliptica%, v()) EndProc ' >Procedure barycenter Local Double gl, bl, rv, dl, db, dr If baseswephem? swissephempos(sol%, dj, SE_SPEED + SE_NONUT + SE_TRUEPOS + SE_BARYCTR + SE_N OABERR) gl = swedata(xi%) bl = swedata(yi%) rv = swedata(zi%) dl = swedata(4) db = swedata(5) dr = swedata(6) Else efemerides(0, 0) vsop87d(10, g(), p()) Mat Neg g() Mat Neg p() rect2polar(g(), gl, bl, rv) velxyz(g(), p(), dl, db, dr) dl = Deg(dl) db = Deg(db) EndIf helior(aux%, hlon%) = gl helior(aux%, hlat%) = bl helior(aux%, hdis%) = rv heliov(aux%, hlon%) = dl heliov(aux%, hlat%) = db heliov(aux%, hdis%) = dr EndProc ' >Procedure vsop82(first%, last%) Naked Local d, f If first% = sol% And last% = sol% ~@precesion(j2000, dj) EndIf For pl% = first% To last% If baseswephem? And pl% <= plu% swissephempos(pl%, dj, SE_SPEED + SE_NONUT + SE_TRUEPOS + SE_J2000 - Mul(S E_HELCTR, pl% > sol%)) If flag >= 0 Then pqposicion(pl%) Else Select pl% Case sol% To nep% If baselow? psecular(pl%) se = sec(pl%, ax%, rp%) lm = @rmdl(sec(pl%, vl%, rp%)) ex = sec(pl%, ec%, rp%) ph = sec(pl%, pn%, rp%) in = sec(pl%, cl%, rp%) na = sec(pl%, an%, rp%) approxlow(pl%, se, lm) elementospr(j2000fecha%) osc(pl%, ax%) = se osc(pl%, vl%) = lm osc(pl%, ec%) = ex osc(pl%, pn%) = ph osc(pl%, cl%) = in

osc(pl%, an%) = na vectores(pl%, r(), v()) If pl% = sol% Mat Neg r() Mat Neg v() EndIf Else If pl% <= mar% ' INNER PLANETS 'If Or(dj < ips2min, dj > ips2max) Or Not ips2? vsop87d(pl%, r(), v()) 'Else 'ips2000(pl%, r(), v()) 'EndIf Else ' OUTER PLANETS If dj > fin409 vsop87d(pl%, r(), v()) Else 'If Or(dj < ips2min, dj > ips2max) Or Not ips2? pluton(pl%) 'Else 'ips2000(pl%, r(), v()) 'EndIf EndIf EndIf pqposicion(pl%) Case qui% To finpl% If baseswephem? If And(mpcnumber%(pl%) And @withinrange(pl%)) If @swiss_aster(pl%, mpcnumber%(pl%)) Then pqposicion(pl%) EndIf Else If baselong? And (dj <= D1702 Or dj >= D2018) cpjv(pl%, piso0600, 5, 3850) Else cpjv(pl%, piso1700, 2, 585) EndIf pqposicion(pl%) EndIf Case -aux% pl% = aux% se = osc(pl%, ax%) lm = @rmdl(osc(pl%, vl%)) ex = osc(pl%, ec%) ph = osc(pl%, pn%) in = osc(pl%, cl%) na = osc(pl%, an%) elementospr(j2000fecha%) osc(pl%, ax%) = se osc(pl%, vl%) = lm osc(pl%, ec%) = ex osc(pl%, pn%) = ph osc(pl%, cl%) = in osc(pl%, an%) = na vectores(pl%, r(), v()) pqposicion(pl%) Case plu% pluto406 pqposicion(pl%) Default

Inc dummy% EndSelect EndIf Next pl% EndProc ' >Procedure tabephem(ByRef bpl%) Naked If Not (opcion% = all% Or opcion% = efm%) efemerides(0, 0) vsop82(sol%, sol%) EndIf If bpl% <> sol% Select bpl% Case lun%, nodo% To m_c% elp2000(w2) vcangulos Case mer% To finpl% vsop82(bpl%, bpl%) Case aux% If seaux <= d0 Print "USER object not defined -- press any key" aborta? = True KeyGet n% Else osc(aux%, ax%) = seaux osc(aux%, vl%) = @rmdl(Rad(lmaux + phaux + naaux) + kg / (seaux ^ 1.5) * (dj - j0aux + jp)) osc(aux%, ec%) = exaux osc(aux%, pn%) = Rad(@mdl(phaux + naaux)) osc(aux%, cl%) = Rad(inaux) osc(aux%, an%) = Rad(naaux) vsop82(-aux%, -aux%) EndIf Default 'If bpl% >= ceres% And bpl% < astraea% ' DAMOCLES FILE 'damocles(Sub(bpl%, planeta%), osc()) 'se = osc(aux%, ax%) 'lm = @rmdl(Rad(@mdl(osc(aux%, vl%) + osc(aux%, pn%)))) 'ex = osc(aux%, ec%) 'ph = Rad(osc(aux%, pn%)) 'in = Rad(osc(aux%, cl%)) 'na = Rad(osc(aux%, an%)) 'elementospr(j2000fecha%) 'osc(bpl%, ax%) = se 'osc(bpl%, vl%) = lm 'osc(bpl%, ec%) = ex 'osc(bpl%, pn%) = ph 'osc(bpl%, cl%) = in 'osc(bpl%, an%) = na 'vectores(bpl%, r(), v()) 'pqposicion(bpl%) If bpl% < lim% ' ASTEROID FILE masteroid(Succ(Sub(bpl%, astraea%)), 6) pqposicion(bpl%) Else If baseswephem? If mpcnumber%(bpl%) And @withinrange(bpl%) If @swiss_aster(bpl%, mpcnumber%(bpl%)) Then pqposicion(bpl%)

EndIf EndIf EndIf EndSelect EndIf EndProc ' >Procedure swissephempos(p%, j, flg As Long) Local hl#, hb#, hr#, jl#, jb#, jr# If p% < 0 SEnombre(-p%, plaux$(aux%)) flag = swe_calc(j + jp + cd(dt%), -p%, flg, swedata(xi%), eb) p% = aux% Else flag = swe_calc(j + jp + cd(dt%), mpcnumber%(p%), flg, swedata(xi%), eb) EndIf If flag < 0 prohibe%(p%) = True SEerrAlert(mpcnumber%(p%), plaux$(p%)) Mat Clr r() Mat Clr v() ElseIf @inrange(p%, sol%, plu%) prohibe%(p%) = False hl# = Rad(swedata(af%)) hb# = Rad(swedata(bf%)) hr# = swedata(cf%) jl# = Rad(swedata(df%)) jb# = Rad(swedata(ef%)) jr# = swedata(ff%) xyzvel(hl#, hb#, hr#, jl#, jb#, jr#, r(), v()) osculacion(pl%, r(), v()) transformacion(j2000fecha%, ecliptica%, r()) transformacion(j2000fecha%, ecliptica%, v()) Else prohibe%(p%) = False r(xi%) = swedata(af%) r(yi%) = swedata(bf%) r(zi%) = swedata(cf%) v(xi%) = swedata(df%) v(yi%) = swedata(ef%) v(zi%) = swedata(ff%) EndIf EndProc >Function swiss_aster(p%, numero%) Local hl#, hb#, hr#, jl#, jb#, jr#, q3$ flag = SE_SPEED + SE_NONUT + SE_TRUEPOS + SE_HELCTR + SE_J2000 flag = swe_calc(dj + jp + cd(dt%), numero%, flag, swedata(xi%), eb) If flag < 0 prohibe%(p%) = True If p% > allplanets% SEnombre(numero%, q3$) Else q3$ = plaux$(p%) EndIf 'SEerrAlert(p%, q3$) ArrayFill swedata(), d0 ArrayFill r(), d0 ArrayFill v(), d0 Return False Else

prohibe%(p%) = False hl# = Rad(swedata(af%)) hb# = Rad(swedata(bf%)) hr# = swedata(cf%) jl# = Rad(swedata(df%)) jb# = Rad(swedata(ef%)) jr# = swedata(ff%) xyzvel(hl#, hb#, hr#, jl#, jb#, jr#, r(), v()) If p% = lim% Then p% = aux% osculacion(p%, r(), v()) transformacion(j2000fecha%, ecliptica%, r()) transformacion(j2000fecha%, ecliptica%, v()) Return True EndIf EndFunc >Procedure SEnombre(p%, ByRef raya$) Local nom As String, ln%, k% Local Const campo% = 9 nom = String(20, 0) swe_get_planet_name(p%, nom) raya$ = Left$(nom, Pred(InStr(nom, Chr$(0)))) eb = raya$ ln% = Len(raya$) If ln% < campo% For k% = Succ(ln%) To campo% raya$ = raya$ + spc$ Next k% Else raya$ = Left$(raya$, campo%) EndIf EndProc >Procedure SEerrAlert(p%, id$) If p% > kz% Then Sub p%, kz% Alert 1, "SWISS EPHEM ERROR|" + Str$(p%) + " = " + Upper$(id$), 1, Space(20) + "ENTER" + Space(20), n% EndProc >Procedure SEdllAlert Alert 1, "|NO SWEDLL32.DLL IN DIRECTORY", 1, Space(30) + "ENTER" + Space(30), n% EndProc >Procedure SEpathAlert Alert 1, "|THE SE EPHEMERIS PATH IS WRONG!", 1, Space(34) + "ENTER" + Space(34 ), n% EndProc ' ' ###################################################################### ' NUMERICAL INTEGRATION MODULE ' ###################################################################### ' >Procedure integrat(j0, j1, iss) Local nsp, j%, k%, q%, steps%, i% = 0 Global hdp, base% = 1, n1% = 2 Global Dim plr(xyz%), plv(xyz%) Global nq% = 9 ' NUMBER OF PERTURBING PLANETS Global Dim rk(nq%, 4), vk(nq%, xyz%), pk(nq%, 4), ak(nq%, xyz%) Global Dim rq(nq%, xyz%), vq(nq%, xyz%), re(nq%, xyz%), ve(nq%, xyz%), fx(nq%, xyz%), gx(nq%, xyz%) Global Dim f1(nq%, xyz%), f2(nq%, xyz%), f3(nq%, xyz%), f4(nq%, xyz%), f5(nq%, xyz%), f6(nq%, xyz%) Global Dim g1(nq%, xyz%), g2(nq%, xyz%), g3(nq%, xyz%), g4(nq%, xyz%), g5(nq%,

xyz%), g6(nq%, xyz%) Repeat ' DIVIDE DOUBLED STEPSIZE BY HALF UNTIL # OF STEPS >0 Mul iss, z5 steps% = Abs(Trunc((j1 - j0) / iss)) ' NUMBER OF STEPS Until steps% > 0 nsp = (j1 - j0) / CFloat(steps%) ' STEP SIZE FOR INTEGRATION hdp = kg * nsp dj = j0 efemerides(0, 0) ' TIME T AND PRECESSION FOR STARTING DA TE For k% = xi% To zi% plr(k%) = r(k%) ' STARTING POSITION AND VELOCITY VECTOR plv(k%) = v(k%) / kg Next k% pb.Refresh pb.Min = 0 pb.Max = steps% pb.Visible = True Repeat If i% ' ON STARTING DATE DO NOTHING pb.Value = i% Add dj, nsp ' JD OF NEW DATE If nq% > base% For pl% = sol% To nep% ' CALCULATE PERTURBING BODIES j% = Add(Sub(pl%, sol%), n1%) If j% <= nq% If baseswephem? flag = SE_SPEED + SE_NONUT + SE_TRUEPOS + SE_NOABERR + SE_XYZ + S E_HELCTR + SE_J2000 If pl% = sol% swissephempos(-14, dj - nsp, flag) Else swissephempos(pl%, dj - nsp, flag) EndIf Else psecular(pl%) se = sec(pl%, ax%, rp%) lm = @rmdl(sec(pl%, vl%, rp%)) ex = sec(pl%, ec%, rp%) ph = sec(pl%, pn%, rp%) in = sec(pl%, cl%, rp%) na = sec(pl%, an%, rp%) approxlow(pl%, se, lm) osc(pl%, ax%) = se osc(pl%, vl%) = lm osc(pl%, ec%) = ex osc(pl%, pn%) = ph osc(pl%, cl%) = in osc(pl%, an%) = na vectores(pl%, r(), v()) EndIf For k% = xi% To zi% re(j%, k%) = r(k%) ve(j%, k%) = v(k%) / kg Next k% EndIf Next pl% EndIf For k% = xi% To zi%

rq(base%, k%) = plr(k%) BEFORE)

' POSITION AND VELOCITY OF OBJECT (DAY

vq(base%, k%) = plv(k%) Next k% For q% = n1% To nq% ' POSITION AND VELOCITY OF PERTURBING B ODIES (DAY BEFORE) For k% = xi% To zi% rq(q%, k%) = re(q%, k%) vq(q%, k%) = ve(q%, k%) Next k% Next q% cowell ' INTEGRATE AND ACCELERATE For k% = xi% To zi% plr(k%) = rk(base%, k%) ' REINITIALIZE FOR NEXT ITERATION plv(k%) = vk(base%, k%) Next k% EndIf Inc i% efemerides(0, 0) ' TIME T AND PRECESSION OF NEXT DATE Until dj NEAR j1 For k% = xi% To zi% r(k%) = rk(base%, k%) ' POSITION AND VELOCITY ON TARGET DATE v(k%) = vk(base%, k%) * kg Next k pb.Visible = False Clr hdp, nq%, base%, n1% Erase f1(), f2(), f3(), f4(), f5(), f6(), g1(), g2(), g3(), g4(), g5(), g6() Erase plr(), plv(), rk(), vk(), pk(), ak(), rq(), vq(), re(), ve(), fx(), gx() EndProc ' >Procedure cowell Local q%, k% Local Const d7 = 7, d8 = 8, d9 = 9, d16 = 16, d32 = 32 ' ***** PASO 1 ***** For q% = base% To nq% For k% = xi% To zi% rk(q%, k%) = rq(q%, k%) vk(q%, k%) = vq(q%, k%) pk(q%, k%) = rk(q%, k%) - rk(base%, k%) Next k% Next q% acceleration For k% = xi% To zi% For q% = base% To nq% f1(q%, k%) = fx(q%, k%) g1(q%, k%) = gx(q%, k%) Next q% Next k% ' ***** PASO 2 ***** For q% = base% To nq% For k% = xi% To zi% rk(q%, k%) = rq(q%, k%) + f1(q%, k%) / d4 vk(q%, k%) = vq(q%, k%) + g1(q%, k%) / d4 pk(q%, k%) = rk(q%, k%) - rk(base%, k%) Next k% Next q% acceleration For k% = xi% To zi% For q% = base% To nq% f2(q%, k%) = fx(q%, k%)

g2(q%, k%) = gx(q%, k%) Next q% Next k% ' ***** PASO 3 ***** For q% = base% To nq% For k% = xi% To zi% rk(q%, k%) = rq(q%, k%) vk(q%, k%) = vq(q%, k%) pk(q%, k%) = rk(q%, k%) Next k% Next q% acceleration For k% = xi% To zi% For q% = base% To nq% f3(q%, k%) = fx(q%, k%) g3(q%, k%) = gx(q%, k%) Next q% Next k% ' ***** PASO 4 ***** For q% = base% To nq% For k% = xi% To zi% rk(q%, k%) = rq(q%, k%) vk(q%, k%) = vq(q%, k%) pk(q%, k%) = rk(q%, k%) Next k% Next q% acceleration For k% = xi% To zi% For q% = base% To nq% f4(q%, k%) = fx(q%, k%) g4(q%, k%) = gx(q%, k%) Next q% Next k% ' ***** PASO 5 ***** For q% = base% To nq% For k% = xi% To zi% rk(q%, k%) = rq(q%, k%) vk(q%, k%) = vq(q%, k%) pk(q%, k%) = rk(q%, k%) Next k% Next q% acceleration For k% = xi% To zi% For q% = base% To nq% f5(q%, k%) = fx(q%, k%) g5(q%, k%) = gx(q%, k%) Next q% Next k% ' ***** PASO 6 ***** For q% = base% To nq% For k% = xi% To zi% rk(q%, k%) = rq(q%, k%) k%) + n2 * f4(q%, k%) - d8 * vk(q%, k%) = vq(q%, k%) k%) + n2 * g4(q%, k%) - d8 * pk(q%, k%) = rk(q%, k%) Next k% Next q% acceleration For k% = xi% To zi%

+ (f1(q%, k%) + f2(q%, k%)) / d8 + (g1(q%, k%) + g2(q%, k%)) / d8 - rk(base%, k%)

- (f2(q%, k%) - d2 * f3(q%, k%)) / d2 - (g2(q%, k%) - d2 * g3(q%, k%)) / d2 - rk(base%, k%)

+ (d3 * f1(q%, k%) + d9 * f4(q%, k%)) / d16 + (d3 * g1(q%, k%) + d9 * g4(q%, k%)) / d16 - rk(base%, k%)

- (d3 * f1(q%, k%) - d2 * f2(q%, k%) - n2 * f3(q%, f5(q%, k%)) / d7 - (d3 * g1(q%, k%) - d2 * g2(q%, k%) - n2 * g3(q%, g5(q%, k%)) / d7 - rk(base%, k%)

f6(base%, k%) = fx(base%, k%) g6(base%, k%) = gx(base%, k%) Next k% For k% = xi% To zi% rk(base%, k%) = rq(base%, k%) + (d7 * f1(base%, k%) + d32 * f3(base%, k%) + n2 * f4(base%, k%) + d32 * f5(base%, k%) + d7 * f6(base%, k%)) / n9 vk(base%, k%) = vq(base%, k%) + (d7 * g1(base%, k%) + d32 * g3(base%, k%) + n2 * g4(base%, k%) + d32 * g5(base%, k%) + d7 * g6(base%, k%)) / n9 Next k% EndProc ' >Function fnmg(x, y, z) As Double Naked ' VECTOR MAGNITUDE Return Sqr(x * x + y * y + z * z) EndFunc >Function fng(m, rk, r, ak) As Double Naked ' ACCELERATION FUNCTION Return -(d1 + m) * rk / (r * r * r) + ak EndFunc >Function fnak(m, pk, p, rk, r) As Double Naked ' ATTRACTION FUNCTION Return m * (pk / (p * p * p) - rk / (r * r * r)) EndFunc ' >Procedure acceleration Local q%, k%, m Local Const cero% = 4 For q% = n1% To nq% rk(q%, cero%) = @fnmg(rk(q%, xi%), rk(q%, yi%), rk(q%, zi%)) pk(q%, cero%) = @fnmg(pk(q%, xi%), pk(q%, yi%), pk(q%, zi%)) For k% = xi% To zi% m = masa(q%) / kg - d1 ak(q%, k%) = @fnak(m, pk(q%, k%), pk(q%, cero%), rk(q%, k%), rk(q%, cero%) ) Next k% Next q% For k% = xi% To zi% ak(base%, k%) = d0 For q% = n1% To nq% Add ak(base%, k%), ak(q%, k%) Next q% Next k% rk(base%, cero%) = @fnmg(rk(base%, xi%), rk(base%, yi%), rk(base%, zi%)) For k% = xi% To zi% fx(base%, k%) = hdp * vk(base%, k%) gx(base%, k%) = hdp * @fng(d0, rk(base%, k%), rk(base%, cero%), ak(base%, k% )) For q% = n1% To nq% m = masa(q%) / kg - d1 fx(q%, k%) = hdp * vk(q%, k%) gx(q%, k%) = hdp * @fng(m, rk(q%, k%), rk(q%, cero%), d0) Next q% Next k% EndProc ' ' ###################################################################### ' IMPLEMENTATION MODULE LECTURAS ' ###################################################################### ' >Procedure lunarefem

Local coef, c% Restore elp200085 For i% = 1 To 560 For j% = 1 To 5 Read main(i%, j%) Next j% Next i% For i% = 1 To 883 Read c% For j% = 1 To 15 Read pert(i%, j%) Next j% Next i% elp200085: Data 0, 0, 1, 0, 22639.55000 EndProc ' >Procedure plutoephem Restore plu406 Mat Read ipsplu() plu406: Data 0.00383668, 0.0015755335, 104.77382 EndProc ' >Procedure estrellas_fijas Dim a, b, i%, cat As catalogo Restore fijas For i% = 1 To 1078 Read a, b, cat.movar, cat.movdc, cat.paralax, cat.radvel, cat.mag, q$ cat.ar2000 = @decimal(a) cat.dc2000 = @decimal(b) cat.nombre = Trim$(q$) usnostars(i%) = cat Next i% fijas: ' ref: FK5. If not in FK5, then "Yale Bright Star Catalog" 4th ed. Data 0.01357, -77.0357, -282, -177, 11, 24, 47, theOct EndProc ' >Procedure dibujelas Restore asterismos For i% = 1 To 357 Read ra, rb, se, q$ IAU_constel(i%).ral = ra * n5 IAU_constel(i%).rau = rb * n5 IAU_constel(i%).decl = se IAU_constel(i%).con = q$ Next i% asterismos: Data 0.0000, 24.0000, 88.0000, UMi EndProc ' >Procedure grados Restore monomeros For i% = 1 To kg% Read cuadro$(i%, 1) Next i% For i% = 1 To kg% Read cuadro$(i%, 2) Next i%

For i% = 1 To kg% Read cuadro$(i%, 3) Next i% monomeros: '##B# ' Sabianos Data "A woman rises out of water, a seal rises and embraces her. Realization" ' EndProc ' >Procedure asternoms Restore asternames For i% = 1 To SE_ASTER_NOM% If i% <= 3707 num_names%(i%) = i% Else Read num_names%(i%) EndIf Next i% asternames: Data 3709,3710,3711,3712,3713,3714,3715,3716,3717,3718,3719,3720,3721,3722,372 3,3724,3725,3726,3727,3728 EndProc ' >Procedure lecturas Local k%, t% ' Try BLoad ExecPath + "vsopm.fle", V:vsopm(1) BLoad ExecPath + "pluton.fle", V:pluto%(1) Catch lostfiles EndCatch 'q$ = ExecPath + "ips2m.fle" 'If Exist(q$) 'BLoad q$, V:ips2m(1) 'ips2? = True 'Else 'ips2? = False 'EndIf ' grados lunarefem plutoephem estrellas_fijas dibujelas asternoms Restore estas For i% = 1620 To 2019 Read deltat%(Sub(i%, 1619)) Next i% estas: ' 1620 1621 1622 1623 1624 1625 1626 1627 1628 1629 ' ---------------------------------------------------------Data 12400,11900,11500,11000,10600,10200, 9800, 9500, 9100, 8800 ' For i% = 1 To 77 For j% = 1 To 11 Read cfnut%(i%, j%) Next j%

Next i% Data 0, 0, 0, 0, 1, -172064161, -174666, 33386, 92052331, 9086, 15377 ' ' ###################################################################### ' Simon, Bretagnon, Chapront at als: Astron. Astroph. 282, 663 (1994) ' ###################################################################### ' For k% = ax% To an% For j% = sol% To nep% For i% = t0% To t6% Read sec(j%, k%, i%) Next i% If Not (k% = ax% Or k% = ec%) Mul sec(j%, k%, t0%), dtr For t% = t1% To t6% Mul sec(j%, k%, t%), rsec Next t% EndIf Next j% Next k% ' ax Data 1.0000010178, 0, 0, 0, 0, 0, 0 ' Mat Read kp() Mat Read ca() Mat Read sa() Mat Read kq() Mat Read cl() Mat Read sl() Mat Mul sa(), p7 Mat Mul ca(), p7 Mat Mul sl(), p7 Mat Mul cl(), p7 ' kp Data 16002, 21863, 32004, 10931, 14529, 16368, 15318, 32794, 0 ' Mat Read vf() Mat Mul vf(), dtr For i% = 1 To 80 Mul vf(i%, df%), p4 Mul vf(i%, ef%), p6 Mul vf(i%, ff%), p6 * p2 Next i% Data -1.4979, 49.1562, -75869.8120, 35.458, 4.231, -2.001 ' EndProc ' Procedure leecgf Global version$ = "RIYAL for Windows" Global ExecPath$ = Iif("/" = Mid(App.Path, Len(App.Path)), App.Path, App.Path & "\") Global zt$, zlon$, zlat$, zgeom$, ztu$, zbija$, zsid$, ztopo$, znodo$, znoire$ Global zdom$, zaster$, zayan$, zayan_a$, zayan_b$, style$, se_path$ Global baseswextra% = 0 Local zswisseph$, zswlist$ If Exist(ExecPath + "riyal.cgf") Open ExecPath + "riyal.cgf" for Input As # 1 Line Input # 1, zt$, zlon$, zlat$, zgeom$, ztu$, zbija$, zsid$, ztopo$, znod o$, znoire$ Line Input # 1, zdom$, zaster$, zayan$, style$

' READ OPTIONAL SWISS EPHEMERIS LINES ' swextra%() only exists conditionally On Error Resume Next Line Input # 1, se_path$, zayan_a$, zayan_b$, zswisseph$, zswlist$ If Err = 0 se_path$ = Left$(se_path$, Pred(InStr(se_path$, ";"))) baseswextra% = Val(zswlist$) If baseswextra% > 0 Global Dim swextra%(baseswextra%) For i% = 1 To baseswextra% If Not EOF(# 1) Input # 1, swextra%(i%) Add swextra%(i%), kz% EndIf Next i% EndIf EndIf Close # 1 zlon$ = Left(zlon$, 8) zlat$ = Left(zlat$, 7) zdom$ = Upper$(Left(Trim$(zdom$), 4)) zayan_a$ = Trim(Str$(Val(zayan_a$))) zayan_b$ = Trim(Str$(Val(zayan_b$))) Global tz As Single = Val(zt$) Global geometricas? = Val(zgeom$) Global basetu? = Val(ztu$) Global basebija? = Val(zbija$) Global basesideral? = Val(zsid$) Global basetopo? = Val(ztopo$) Global base_eu? = Val(style$) Global basenodo% = Val(znodo$) Global basenoire% = Val(znoire$) Global baseasteroides? = Val(zaster$) Global baseayanamsa% = Val(zayan$) Global baseswephem? = Val(zswisseph$) Else lostfiles EndIf Global baselong? = Exist(ExecPath + "long.fle") Global zfecha$ = Date$ If (baseswextra% Or baseswephem?) And Not Exist(ExecPath + "swedll32.dll") SEdllAlert baseswextra% = 0 baseswephem? = False EndIf EndProc ' >Procedure lostfiles Alert 1, "INSTALLATION FILE| READ ERROR|PROGRAM WILL END", 1, Space(20) + "E NTER" + Space(20), n% endwin EndProc $DatFile