1 CLS 2 DEFDBL A-Z 5 DIM FLAG(11) 10 DEF FNLIF (W) = INT(W) - (FLAG(0) - 1) * INT((SGN(W) - 1) / 2) 15 DEF FNRAD (W) = .01745329252# * W 20 DEF FNDEG (W) = 57.29577951000013# * W 25 DEF FNUNW (W, Z) = W - FNLIF(W / Z) * Z 30 PRINT : FLAG(0) = 1 31 PRINT "SADEYA/INFORTECNICA" 32 PRINT "www.sadeya.org www.infortecnica.com Tel 93 433 42 43" 33 PRINT 35 PRINT "ECLIPSES DE SOL Y LUNA, CIRCUNSTANCIAS TOPOCENTRICAS" 40 PRINT : COUNT = 0: SW = 0 45 IF FLAG(11) = 1 THEN GOTO 80 50 INPUT "LONGITUD GEOGRAFICA (G,M,S; O-)"; XD, XM, XS 55 SW1 = -1: GOSUB 1000: LNG = X 60 INPUT "LATITUD GEOGRAFICA (G,M,S; S-)"; XD, XM, XS 65 GOSUB 1000: PHI = FNRAD(X) 70 INPUT "ALTURA EN METROS "; HT 75 IF SW = 1 THEN GOTO 90 80 INPUT "INICIO CHEQUEO (D,M,A)"; DY, MN, YR 85 INPUT "MESES A CHEQUEAR"; NMO 90 PRINT : HT = HT / 6378140! 95 IF SW = 0 THEN TP$ = "S": COUNT = COUNT + 1 100 FLAG(3) = 0: FLAG(5) = 0: GOSUB 7000: SW = 0 105 PRINT "...en "; DY0; "/"; MN; "/"; YR 110 IF ERR6 = 2 THEN GOTO 250 115 IF ERR6 <> 0 THEN GOTO 265 120 IF TP$ = "L" THEN PRINT : PRINT TAB(20); "ECLIPSE DE LUNA" 125 IF TP$ = "S" THEN PRINT : PRINT TAB(20); "ECLIPSE DE SOL" 130 PRINT TAB(20); "----- -------" 135 X = FNUNW(Z1H + 8.33333E-03, 24): SW1 = 1: GOSUB 1000 140 PRINT : XDA = XD: XMA = XM 145 PRINT TAB(10); "TU. MAXIMO DEL ECLIPSE:"; TAB(35); XD; ":"; XM 150 X = FNUNW(Z2H1 + 8.33333E-03, 24): GOSUB 1000 155 PRINT TAB(10); "EL ECLIPSE EMPIEZA A"; TAB(35); XD; ":"; XM 160 X = FNUNW(Z2H2 + 8.33333E-03, 24): GOSUB 1000 165 PRINT TAB(10); "EL ECLIPSE FINALIZA A"; TAB(35); XD; ":"; XM 170 IF TP$ = "S" THEN GOTO 230 175 IF ERR7 <> 1 THEN GOTO 185 180 PRINT TAB(10); "** SIN FASE DE SOMBRA **": GOTO 230 185 X = FNUNW(Z2H3 + 8.33333E-03, 24): GOSUB 1000 190 PRINT TAB(10); "LA SOMBRA SE INICIA A"; TAB(35); XD; ":"; XM 195 X = FNUNW(Z2H4 + 8.33333E-03, 24): GOSUB 1000 200 PRINT TAB(10); "LA SOMBRA FINALIZA A"; TAB(35); XD; ":"; XM 205 IF ERR7 = 2 THEN PRINT TAB(10); "** NO ES TOTAL **": GOTO 230 210 X = FNUNW(Z2H5 + 8.33333E-03, 24): GOSUB 1000 215 PRINT TAB(10); "INICIO DE LA TOTALIDAD"; TAB(35); XD; ":"; XM 220 X = FNUNW(Z2H6 + 8.33333E-03, 24): GOSUB 1000 225 PRINT TAB(10); "FIN DE LA TOTALIDAD"; TAB(35); XD; ":"; XM 230 PRINT TAB(10); "MAGNITUD DEL ECLIPSE "; INT((MG * 100) + .5) / 100: PRINT 235 INPUT "CONTINUAR (Y/N)"; AN$ 240 IF AN$ = "Y" THEN GOSUB 500 245 IF TP$ = "L" THEN GOTO 265 250 INPUT "OTRA LOCALIZACION (Y/N)"; AN$ 255 IF AN$ = "N" THEN GOTO 265 260 SW = 1: FLAG(11) = 0: GOTO 50 265 IF TP$ = "S" THEN TP$ = "L": GOTO 100 270 DY = DY0 + 14: FLAG(1) = 0: GOSUB 1100 275 FLAG(2) = 0: GOSUB 1200 280 IF COUNT < NMO THEN GOTO 95 285 PRINT 290 INPUT "NUEVO CALCULO (Y/N)"; AN$ 295 IF AN$ = "N" THEN STOP 300 INPUT "NUEVA LOCALIZACION (Y/N)"; AN$ 305 IF AN$ = "Y" THEN FLAG(11) = 0 310 GOTO 40 497 REM 498 REM Subroutine DISPLAY 499 REM 500 PRINT "******": PRINT 505 RETURN 997 REM 998 REM Subroutine MINSEC 999 REM 1000 IF SW1 = -1 THEN GOTO 1035 1005 SN = SGN(X): XP = ABS(X): XD = INT(XP) 1010 A = (XP - XD) * 60: XM = INT(A) 1015 XS = INT((A - XM) * 600 + .5) / 10 1020 S$ = "+" 1025 IF SN = -1 THEN S$ = "-" 1030 RETURN 1035 SN = 1 1040 IF XD < 0 OR XM < 0 OR XS < 0 THEN SN = -1 1045 XD1 = ABS(XD): XM1 = ABS(XM): XS1 = ABS(XS) 1050 X = ((((XS1 / 60) + XM1) / 60) + XD1) * SN 1055 RETURN 1097 REM 1098 REM Subroutine JULDAY 1099 REM 1100 IF FLAG(1) = 1 THEN RETURN 1105 DEF FNITG (W) = INT(W) + FLAG(0) * SGN(W) * INT((SGN(W) - 1) / 2) 1110 MN1 = MN: YR1 = YR: FLAG(1) = 1: B = 0 1115 IF YR1 < 0 THEN YR1 = YR1 + 1 1120 IF MN < 3 THEN MN1 = MN + 12: YR1 = YR1 - 1 1125 IF YR < 1582 THEN GOTO 1145 1130 IF YR = 1582 AND MN < 10 THEN GOTO 1145 1135 IF YR = 1582 AND MN = 10 AND DY < 15 THEN GOTO 1145 1140 A = INT(YR1 / 100): B = 2 - A + INT(A / 4) 1145 IF YR1 < 0 THEN GOTO 1155 1150 C = INT(365.25 * YR1) - 694025!: GOTO 1160 1155 C = FNITG((365.25 * YR1) - .75) - 694025! 1160 D = INT(30.6001 * (MN1 + 1)) 1165 DJD = B + C + D + DY - .5 1170 RETURN 1197 REM 1198 REM Subroutine CALDAY 1199 REM 1200 IF FLAG(2) = 1 THEN RETURN 1205 REM def FNLIF(W) = INT(W) - (FLAG(0) - 1) * INT((SGN(W) - 1) / 2) 1210 D = DJD + .5: I = FNLIF(D): F = D - I 1215 IF F = 1 THEN F = 0: I = I + 1 1220 IF I <= -115860! THEN GOTO 1235 1225 A = FNLIF((I / 36524.25) + .99835726#) + 14 1230 I = I + 1 + A - FNLIF(A / 4) 1235 B = FNLIF((I / 365.25) + .802601) 1240 CE = I - FNLIF((365.25 * B) + .750001) + 416 1245 G = FNLIF(CE / 30.6001): MN = G - 1 1250 DY = CE - FNLIF(30.6001 * G) + F: YR = B + 1899 1255 IF G > 13.5 THEN MN = G - 13 1260 IF MN < 2.5 THEN YR = B + 1900 1265 IF YR < 1 THEN YR = YR - 1 1270 FLAG(2) = 1: RETURN 1297 REM 1298 REM Subroutine GTIME 1299 REM 1300 IF FLAG(3) = 1 THEN GOTO 1340 1305 XMN = MN: XDY = DY: FLAG(3) = 1 1310 FLAG(1) = 0: GOSUB 1100: XDJD = DJD 1315 MN = 1: DY = 0: FLAG(1) = 0 1320 GOSUB 1100: T = DJD / 36525! 1325 R = 6.6460656# + (.051262 + (T * 2.581E-05)) * T 1330 R1 = 2400 * (T - ((YR - 1900) / 100)): B = 24 - R - R1 1335 T0 = ((XDJD - DJD) * .0657098) - B 1340 IF SW2 = 1 THEN GOTO 1365 1345 IF T0 < 0 THEN T0 = T0 + 24 1350 GTM = TIM - T0 1355 IF GTM < 0 THEN GTM = GTM + 24 1360 GTM = GTM * .9972695677#: GOTO 1380 1365 GTM = (TIM * 1.002737908#) + T0 1370 IF GTM > 24 THEN GTM = GTM - 24 1375 IF GTM < 0 THEN GTM = GTM + 24 1380 X = GTM: SW1 = 1: GOSUB 1000 1385 HS = XD: MS = XM: SS = XS 1390 MN = XMN: DY = XDY: DJD = XDJD 1395 RETURN 1597 REM 1598 REM Subroutine HRANG 1599 REM 1600 LST = GST + (LNG / 15) 1605 IF LST > 24 THEN LST = LST - 24 1610 IF LST < 0 THEN LST = LST + 24 1615 P = LST - X 1625 IF P < 0 THEN P = P + 24 1630 RETURN 1697 REM 1698 REM Subroutine OBLIQ 1699 REM 1700 IF FLAG(5) = 1 THEN RETURN 1705 FLAG(5) = 1 1710 GOSUB 1100: T = DJD / 36525! 1715 C = (((-.00181 * T) + .0059) * T + 46.845) * T 1720 EPS = 23.45229444# - (C / 3600) 1725 EPSR = EPS * .01745329252# 1730 RETURN 1797 REM 1798 REM Subroutine EQECL 1799 REM 1800 IF FLAG(7) = 1 THEN GOTO 1830 1805 DEF FNASN (W) = ATN(W / (SQR(1.000001 - W * W) + 9.999999E-21)) 1810 PI = 3.1415926535#: TPI = 2 * PI: FLAG(7) = 1 1815 IF FLAG(6) = 0 THEN DEPS = 0 1820 GOSUB 1700: EPS1 = FNRAD(EPS + DEPS) 1825 SEPS = SIN(EPS1): CEPS = COS(EPS1) 1830 CY = COS(Y): SY = SIN(Y) 1835 IF ABS(CY) < 9.999999E-21 THEN CY = 9.999999E-21 1840 TY = SY / CY: CX = COS(X): SX = SIN(X) 1845 SQ = (SY * CEPS) - (CY * SEPS * SX * SW3) 1850 Q = FNASN(SQ): A = (SX * CEPS) + (TY * SEPS * SW3) 1855 P = ATN(A / CX) 1860 IF CX < 0 THEN P = P + PI 1865 IF P > TPI THEN P = P - TPI 1870 IF P < 0 THEN P = P + TPI 1875 RETURN 2697 REM 2698 REM Subroutine NUTAT 2699 REM 2700 IF FLAG(6) = 1 THEN RETURN 2705 REM DEF FNRAD(W) = .01745329252# * W 2710 FLAG(6) = 1: FLAG(7) = 0 2715 GOSUB 1100: T = DJD / 36525!: T2 = T * T 2720 A = 100.0021358# * T: B = 360 * (A - INT(A)) 2725 LS = 279.697 + .000303 * T2 + B 2730 A = 1336.855231# * T: B = 360 * (A - INT(A)) 2735 LD = 270.434 - .001133 * T2 + B 2740 A = 99.99736056000026# * T: B = 360 * (A - INT(A)) 2745 MS = 358.476 - .00015 * T2 + B 2750 A = 13255523.59# * T: B = 360 * (A - INT(A)) 2755 MD = 296.105 + .009192 * T2 + B 2760 A = 5.372616667# * T: B = 360 * (A - INT(A)) 2765 NM = 259.183 + .002078 * T2 - B 2770 TLS = 2 * FNRAD(LS): NM = FNRAD(NM) 2775 TNM = 2 * FNRAD(NM): MS = FNRAD(MS) 2780 TLD = 2 * FNRAD(LD): MD = FNRAD(MD) 2785 DPSI = (-17.2327 - .01737 * T) * SIN(NM) + (-1.2729 - .00013 * T) * SIN(TLS) + .2088 * SIN(TNM) - .2037 * SIN(TLD) + (.1261 - .00031 * T) * SIN(MS) + .0675 * SIN(MD) - (.0497 - .00012 * T) * SIN(TLS + MS) - .0342 * SIN(TLD - NM) - .0261 * _ SIN(TLD + MD) 2786 DPSI = DPSI + .0214 * SIN(TLS - MS) - .0149 * SIN(TLS - TLD + MD) + .0124 * SIN(TLS - NM) + .0114 * SIN(TLD - MD) 2790 DEPS = (9.21 + .00091 * T) * COS(NM) + (.5522 - .00029 * T) * COS(TLS) - .0904 * COS(TNM) + .0884 * COS(TLD) + .0216 * COS(TLS + MS) + .0183 * COS(TLD - NM) + .0113 * COS(TLD + MD) - .0093 * COS(TLS - MS) - .0066 * COS(TLS - NM) 2795 DPSI = DPSI / 3600: DEPS = DEPS / 3600 2800 RETURN 2897 REM 2898 REM Subroutine PARALLAX 2899 REM 2900 IF FLAG(11) = 1 THEN GOTO 2930 2905 CPHI = COS(PHI): SPHI = SIN(PHI) 2910 U = ATN(.996647 * SPHI / CPHI) 2915 CU = COS(U): SU = SIN(U): FLAG(11) = 1 2920 RSP = (.996647 * SU) + (HT * SPHI) 2925 RCP = CU + (HT * CPHI): TPI = 6.283185308# 2930 RP = 1 / SIN(EHP) 2935 IF SW6 = -1 THEN GOTO 2945 2940 GOSUB 2980: RETURN 2945 X1 = X: Y1 = Y: DP1 = 0: DQ1 = 0 2950 GOSUB 2980: DP2 = P - X: DQ2 = Q - Y 2955 IF (ABS(DP2 - DP1) < .000001) AND (ABS(DQ2 - DQ1) < .000001) THEN GOTO 2970 2960 X = X1 - DP2: Y = Y1 - DQ2 2965 DP1 = DP2: DQ1 = DQ2: GOTO 2950 2970 P = X1 - DP2: Q = Y1 - DQ2 2975 X = X1: Y = Y1: RETURN 2980 CX = COS(X): SY = SIN(Y): CY = COS(Y) 2985 TDX = (RCP * SIN(X)) / ((RP * CY) - (RCP * CX)) 2990 DX = ATN(TDX): P = X + DX: CP = COS(P) 2995 IF P > TPI THEN P = P - TPI 3000 IF P < 0 THEN P = P + TPI 3005 Q = ATN(CP * (RP * SY - RSP) / (RP * CY * CX - RCP)) 3010 RETURN 3097 REM 3098 REM Subroutine ANOMALY 3099 REM 3100 TPI = 6.283185308# 3105 M = MA - TPI * INT(MA / TPI): EA = M 3110 DLA = EA - (S * SIN(EA)) - M 3115 IF ABS(DLA) < .000001 THEN GOTO 3130 3120 DLA = DLA / (1 - (S * COS(EA))) 3125 EA = EA - DLA: GOTO 3110 3130 TNU2 = SQR((1 + S) / (1 - S)) * TAN(EA / 2) 3135 NU = 2 * ATN(TNU2) 3140 RETURN 3297 REM 3298 REM Subroutine SUN 3299 REM 3300 GOSUB 1100: T = DJD / 36525!: T2 = T * T 3305 REM DEF FNRAD(W)=1.745329252E-2*W 3310 A = 100.0021359# * T: B = 360 * (A - INT(A)) 3315 LS = 279.69668# + .0003025 * T2 + B 3320 A = 99.99736042000039# * T: B = 360 * (A - INT(A)) 3325 MS = 358.47583# - (.00015 + .0000033 * T) * T2 + B 3330 S = .016751 - .0000418 * T - 1.26E-07 * T2 3335 MA = FNRAD(MS): GOSUB 3100 3340 A = 62.55209472000015# * T: B = 360 * (A - INT(A)) 3345 A1 = FNRAD(153.23 + B) 3350 A = 125.1041894# * T: B = 360 * (A - INT(A)) 3355 B1 = FNRAD(216.57 + B) 3360 A = 91.56766028# * T: B = 360 * (A = INT(A)) 3365 C1 = FNRAD(312.69 + B) 3370 A = 1236.853095# * T: B = 360 * (A - INT(A)) 3375 D1 = FNRAD(350.74 - .00144 * T2 + B) 3380 E1 = FNRAD(231.19 + 20.2 * T) 3385 A = 183.1353208# * T: B = 360 * (A - INT(A)) 3390 H1 = FNRAD(353.4 + B) 3395 DL = .00134 * COS(A1) + .00154 * COS(B1) + .002 * COS(C1) + .00179 * SIN(D1) + .00178 * SIN(E1) 3400 DR = 5.43E-06 * SIN(A1) + 1.575E-05 * SIN(B1) + 1.627E-05 * SIN(C1) + 3.076E-05 * COS(D1) + 9.27E-06 * SIN(H1) 3405 LSN = NU + FNRAD(LS - MS + DL): TPI = 6.283185308000017# 3410 RSN = 1.0000002# * (1 - S * COS(EA)) + DR 3415 IF LSN < 0 THEN LSN = LSN + TPI: GOTO 3415 3420 IF LSN > TPI THEN LSN = LSN - TPI: GOTO 3420 3425 RETURN 5997 REM 5998 REM Subroutine MOON 5999 REM 6000 GOSUB 1100: T = DJD / 36525!: T2 = T * T 6005 REM DEF FNRAD(W)=1.745329252E-2*W 6010 M1 = 27.32158213#: M2 = 365.2596407# 6015 M3 = 27.55455094#: M4 = 29.53058868000006# 6020 M5 = 27.21222039#: M6 = 6798.363307000009# 6025 M1 = DJD / M1: M2 = DJD / M2: M3 = DJD / M3 6030 M4 = DJD / M4: M5 = DJD / M5: M6 = DJD / M6 6035 M1 = 360 * (M1 - INT(M1)): M2 = 360 * (M2 - INT(M2)) 6040 M3 = 360 * (M3 - INT(M3)): M4 = 360 * (M4 - INT(M4)) 6045 M5 = 360 * (M5 - INT(M5)): M6 = 360 * (M6 - INT(M6)) 6050 LD = 270.434164# + M1 - (.001133 - .0000019 * T) * T2 6055 MS = 358.475833# + M2 - (.00015 + .0000033 * T) * T2 6060 MD = 296.1046080000003# + M3 + (.009192 + .0000144 * T) * T2 6065 DE = 350.737486# + M4 - (.001436 - .0000019 * T) * T2 6070 F = 11.250889# + M5 - (.003211 + .0000003 * T) * T2 6075 N = 259.183275# - M6 + (.002078 + .000022 * T) * T2 6080 A = FNRAD(51.2 + 20.2 * T): SA = SIN(A) 6085 SN = SIN(FNRAD(N)) 6090 B = 346.56 + (132.87 - .0091731 * T) * T 6100 SB = .003964 * SIN(FNRAD(B)) 6105 C = FNRAD(N + 275.05 - 2.3 * T): SC = SIN(C) 6110 LD = LD + .000233 * SA + SB + .001964 * SN 6115 MS = MS - .001778 * SA 6120 MD = MD + .000817 * SA + SB + .002541 * SN 6125 F = F + SB - .024691 * SN - .004328 * SC 6130 DE = DE + .002011 * SA + SB + .001964 * SN 6135 E = 1 - (.002495 + 7.52E-06 * T) * T: E2 = E * E 6140 LD = FNRAD(LD): MS = FNRAD(MS): N = FNRAD(N) 6145 DE = FNRAD(DE): F = FNRAD(F): MD = FNRAD(MD) 6150 L = 6.28875 * SIN(MD) + 1.27402 * SIN(2 * DE - MD) + .658309 * SIN(2 * DE) + .213616 * SIN(2 * MD) - E * .185596 * SIN(MS) - .114336 * SIN(2 * F) + .058793 * SIN(2 * (DE - MD)) + .057212 * E * SIN(2 * DE - MS - MD) + .05332 * SIN(2 * DE + MD _ ) + .045874 * E * SIN(2 * DE - MS) + .041024 * E * SIN(MD - MS) 6151 L = L - .034718 * SIN(DE) - E * .030465 * SIN(MS + MD) + .015326 * SIN(2 * (DE - F)) - .012528 * SIN(2 * F + MD) - .01098 * SIN(2 * F - MD) + .010674 * SIN(4 * DE - MD) + .010034 * SIN(3 * MD) + .008548 * SIN(4 * DE - 2 * MD) - E * .00791 * _ SIN(MS - MD + 2 * DE) - E * .006783 * SIN(2 * DE + MS) 6152 L = L + .005162 * SIN(MD - DE) + E * .005 * SIN(MS + DE) + .003862 * SIN(4 * DE) + E * .004049 * SIN(MD - MS + 2 * DE) + .003996 * SIN(2 * (MD + DE)) + .003665 * SIN(2 * DE - 3 * MD) + E * .002695 * SIN(2 * MD - MS) + .002602 * SIN(MD - 2 * _ (F + DE)) + E * .002396 * SIN(2 * (DE - MD) - MS) - .002349 * SIN(MD + DE) 6153 L = L + E2 * .002249 * SIN(2 * (DE - MS)) - E * .002125 * SIN(2 * MD + MS) - E2 * .002079 * SIN(2 * MS) + E2 * .002059 * SIN(2 * (DE - MS) - MD) - .001773 * SIN(MD + 2 * (DE - F)) - .001595 * SIN(2 * (F + DE)) + E * .00122 * SIN(4 * DE - MS _ - MD) - .00111 * SIN(2 * (MD + F)) + .000892 * SIN(MD - 3 * DE) 6154 L = L - E * .000811 * SIN(MS + MD + 2 * DE) + E * .000761 * SIN(4 * DE - MS - 2 * MD) + E2 * .000704 * SIN(MD - 2 * (MS + DE)) + E * .000693 * SIN(MS - 2 * (MD - DE)) + E * .000598 * SIN(2 * (DE - F) - MS) + .00055 * SIN(MD + 4 * DE) + _ .000538 * SIN(4 * MD) + E * .000521 * SIN(4 * DE - MS) + .000486 * SIN(2 * MD - DE) 6155 L = L + E2 * .000717 * SIN(MD - 2 * MS) 6160 LAM = LD + FNRAD(L): TPI = 6.283185308000017# 6165 IF LAM < 0 THEN LAM = LAM + TPI: GOTO 6165 6170 IF LAM > TPI THEN LAM = LAM - TPI: GOTO 6170 6175 G = 5.12819 * SIN(F) + .280606 * SIN(MD + F) + .277693 * SIN(MD - F) + .173238 * SIN(2 * DE - F) + .055413 * SIN(2 * DE + F - MD) + .046272 * SIN(2 * DE - F - MD) + .032573 * SIN(2 * DE + F) + .017198 * SIN(2 * MD + F) + 9.266999E-03 * SIN(2 _ * DE + MD - F) + .008823 * SIN(2 * MD - F) + E * .008247 * SIN(2 * DE - MS - F) 6176 G = G + .004323 * SIN(2 * (DE - MD) - F) + .0042 * SIN(2 * DE + F + MD) + E * .003372 * SIN(F - MS - 2 * DE) + E * .002472 * SIN(2 * DE + F - MS - MD) + E * .002222 * SIN(2 * DE + F - MS) + E * .002072 * SIN(2 * DE - F - MS - MD) + E * _ .001877 * SIN(F - MS + MD) + .001828 * SIN(4 * DE - F - MD) - E * .001803 * SIN(F + MS) - .00175 * SIN(3 * F) 6177 G = G + E * .00157 * SIN(MD - MS - F) - .001487 * SIN(F + DE) - E * .001481 * SIN(F + MS + MD) + E * .001417 * SIN(F - MS - MD) + E * .00135 * SIN(F - MS) + .00133 * SIN(F - DE) + .001106 * SIN(F + 3 * MD) + .00102 * SIN(4 * DE - F) + _ .000833 * SIN(F + 4 * DE - MD) + .000781 * SIN(MD - 3 * F) + .00067 * SIN(F + 4 * DE - 2 * MD) 6178 G = G + .000606 * SIN(2 * DE - 3 * F) + .000597 * SIN(2 * (DE + MD) - F) + E * .000492 * SIN(2 * DE + MD - MS - F) + .00045 * SIN(2 * (MD - DE) - F) + .000439 * SIN(3 * MD - F) + .000423 * SIN(F + 2 * (DE + MD)) + .000422 * SIN(2 * DE - F - _ 3 * MD) - E * .000367 * SIN(MS + F + 2 * DE - MD) - E * .000353 * SIN(MS + F + 2 * DE) + .000331 * SIN(F + 4 * DE) 6179 G = G + E * .000317 * SIN(2 * DE + F - MS + MD) + E2 * .000306 * SIN(2 * (DE - MS) - F) - .000283 * SIN(MD + 3 * F) 6185 W1 = .0004664 * COS(N): W2 = .0000754 * COS(C) 6190 BET = FNRAD(G) * (1 - W1 - W2) 6195 HP = .950724 + .051818 * COS(MD) + .009531 * COS(2 * DE - MD) + .007843 * COS(2 * DE) + .002824 * COS(2 * MD) + .000857 * COS(2 * DE + MD) + E * .000533 * COS(2 * DE - MS) + E * .000401 * COS(2 * DE - MD - MS) + E * .00032 * COS(MD - MS) - _ .000271 * COS(DE) - E * .000264 * COS(MS + MD) - .000198 * COS(2 * F - MD) 6196 HP = HP + .000173 * COS(3 * MD) + .000167 * COS(4 * DE - MD) - E * .000111 * COS(MS) + .000103 * COS(4 * DE - 2 * MD) - .000084 * COS(2 * MD - 2 * DE) - E * .000083 * COS(2 * DE + MS) + .000079 * COS(2 * DE + 2 * MD) + .000072 * COS(4 * DE) _ + E * .000064 * COS(2 * DE - MS + MD) - E * .000063 * COS(2 * DE + MS - MD) + E * .000041 * COS(MS + DE) 6197 HP = HP + E * .000035 * COS(2 * MD - MS) - .000033 * COS(3 * MD - 2 * DE) - .00003 * COS(MD + DE) - .000029 * COS(2 * (F - DE)) - E * .000029 * COS(2 * MD + MS) + E2 * .000026 * COS(2 * (DE - MS)) - .000023 * COS(2 * (F - DE) + MD) + E * _ .000019 * COS(4 * DE - MS - MD) 6205 HP = FNRAD(HP) 6210 RETURN 6697 REM 6698 REM Subroutine MOONNF 6699 REM 6700 DY0 = DY: MN0 = MN: YR0 = YR 6705 REM DEF FNLIF(W)=INT(W)-(FLAG(0)-1)*INT((SGN(W)-1)/2) 6710 REM DEF FNUNW(W,Z)=W-FNLIF(W/Z)*Z 6715 REM DEF FNRAD(W)=1.745329252E-2*W 6720 REM DEF FNDEG(W)=5.729577951E1*W 6725 MN = 1: DY = 0: FLAG(1) = 0: GOSUB 1100 6730 DJD0 = DJD: MN = MN0: DY = DY0 6735 FLAG(1) = 0: GOSUB 1100 6740 K = (YR0 - 1900 + ((DJD - DJD0) / 365)) * 12.3685 6745 K = FNLIF(K + .5): TN = K / 1236.85 6750 TF = (K + .5) / 1236.85: T = TN: GOSUB 6775 6755 JD0N = A: JD1N = B: NF = F 6760 T = TF: K = K + .5: GOSUB 6775 6765 JD0F = A: JD1F = B: FF = F 6770 RETURN 6775 T2 = T * T: A = 29.53 * K 6780 C = FNRAD(166.56 + (132.87 - .009173 * T) * T) 6785 B = 5.8868E-04 * K + (.0001178 - 1.55E-07 * T) * T2 + .00033 * SIN(C) + .75933 6790 MS = 359.2242 + 360 * FNUNW(K / 12.36886, 1) - (.0000333 + 3.47E-06 * T) * T2 6795 MM = 306.0253 + 360 * FNUNW(K / .9330851, 1) + (.0107306 + 1.236E-05 * T) * T2 6800 F = 21.2964 + 360 * FNUNW(K / .9214926, 1) - (.0016528 + 2.39E-06 * T) * T2 6805 MS = FNUNW(MS, 360): MM = FNUNW(MM, 360) 6810 F = FNUNW(F, 360): MS = FNRAD(MS) 6815 MM = FNRAD(MM): F = FNRAD(F) 6820 DDJD = (.1734 - .000393 * T) * SIN(MS) + .0021 * SIN(2 * MS) - .4068 * SIN(MM) + .0161 * SIN(2 * MM) - .0004 * SIN(3 * MM) + .0104 * SIN(2 * F) - .0051 * SIN(MS + MM) - .0074 * SIN(MS - MM) + .0004 * SIN(2 * F + MS) - .0004 * SIN(2 * F - MS) _ - 6.000001E-04 * SIN(2 * F + MM) + .001 * SIN(2 * F - MM) + .0005 * SIN(MS + 2 * MM) 6825 A1 = INT(A): B = B + DDJD + (A - A1): B1 = INT(B) 6830 A = A1 + B1: B = B - B1 6835 RETURN 6997 REM 6998 REM Subroutine ECLIPSE 6999 REM 7000 ERR6 = 0: ERR7 = 0: PI = 3.141592654# 7005 REM DEF FNLIF(W)=INT(W)-(FLAG(0)-1)*INT((SGN(W)-1)/2) 7010 REM DEF FNUNW(W,Z)=W-FNLIF(W/Z)*Z 7015 TPI = 2 * PI: GOSUB 6700 7020 IF TP$ = "L" THEN DF = ABS(FNUNW(FF, PI)) 7025 IF TP$ <> "L" THEN DF = ABS(FNUNW(NF, PI)) 7030 IF DF > .37 THEN DF = PI - DF 7035 IF DF < .242600766# THEN PRINT "** eclipse seguro...": GOTO 7050 7040 IF DF < .37 THEN PRINT "** eclipse posible...": GOTO 7050 7045 PRINT "no eclipse...": ERR6 = 1 7050 DJD = JD0N + .5: X = JD1N - .5: DPSI = 0 7055 IF TP$ = "L" THEN DJD = JD0F + .5: X = JD1F - .5 7060 IF X < 0 THEN X = X + 1: DJD = DJD - 1 7065 FLAG(2) = 0: GOSUB 1200: DY0 = DY 7070 IF ERR6 <> 0 THEN RETURN 7075 DY = DY + X - (1 / 24): XDD = X: FLAG(1) = 0 7080 GOSUB 3300: L1 = LSN: GOSUB 6000 7085 LM1 = LAM: BT1 = BET: HP1 = HP: DY = DY + (1 / 12) 7090 FLAG(1) = 0: GOSUB 3300: DLS = LSN - L1 7095 IF DLS < 0 THEN DLS = DLS + TPI 7100 GOSUB 6000: LM2 = LAM: BT2 = BET: HP2 = HP 7105 IF TP$ = "L" THEN GOTO 7135 7110 FLAG(6) = 0: GOSUB 2700: X = LM1: Y = BT1 7115 XH = XDD * 24: TIM = XH - 1: EHP = HP1 7120 GOSUB 7380: LM1 = P: BT1 = Q 7125 X = LM2: Y = BT2: TIM = XH + 1: EHP = HP2 7130 GOSUB 7380: LM2 = P: BT2 = Q 7135 XH = XDD * 24: DLM = LM2 - LM1 7140 IF DLM < 0 THEN DLM = DLM + TPI 7145 XH0 = XH + 1 - (2 * BT2 / (BT2 - BT1)) 7150 LH = (DLM - DLS) / 2: Q = 0 7155 LM0 = LM1 + (DLM * (XH0 - XH + 1) / 2) 7160 FLAG(1) = 0: DY = DY0 + (XH0 / 24) - 5.771605E-03 7165 GOSUB 3300: LSN = LSN + FNRAD(DPSI - .00569) 7170 IF TP$ = "L" THEN LSN = FNUNW(LSN + PI, TPI): GOTO 7185 7175 X = LSN: Y = 0: TIM = FNUNW(DY * 24, 24) 7180 EHP = 4.263452E-05 / RSN: GOSUB 7380: LSN = P 7185 BT1 = BT1 - Q: BT2 = BT2 - Q: PS0 = 4.263E-05 7190 ZH = (LSN - LM0) / LH: TC = XH0 + ZH 7195 SH = (((BT2 - BT1) * (TC - XH - 1) / 2) + BT2) / LH 7200 SH2 = SH * SH: ZH2 = ZH * ZH: PS = PS0 / (RSN * LH) 7205 Z1H = (ZH * ZH2 / (ZH2 + SH2)) + XH0 7210 HP0 = (HP1 + HP2) / (2 * LH): RM = .272446 * HP0 7215 RS = 4.65242E-03 / (LH * RSN): HPD = HP0 * .99834 7220 RU = (HPD - RS + PS) * 1.02: RP = (HPD + RS + PS) * 1.02 7225 PH = ABS(SH * ZH / SQR(SH2 + ZH2)) 7230 Z3H = (LSN - LM1) / LH: Z4H = (LSN - LM2) / LH 7235 S3H = BT1 / LH: S4H = BT2 / LH 7240 DEF FNZ (A, B, C, D) = (A * A) - ((B - (C * C)) * A / D) 7245 IF TP$ = "L" THEN GOTO 7280 7250 R = RM + RS: ZD2 = FNZ((Z1H - XH0), ZH2, R, ZH) 7255 IF ZD2 < 0 THEN GOTO 7370 7260 ZD = SQR(ZD2): Z2H1 = Z1H - ZD 7265 Z2H2 = FNUNW((Z1H + ZD), 24) 7270 IF Z2H1 < 0 THEN Z2H1 = Z2H1 + 24 7275 MG = (RM + RS - PH) / (2 * RS): RETURN 7280 R = RM + RP: ZD2 = FNZ((Z1H - XH0), ZH2, R, ZH) 7285 IF ZD2 < 0 THEN GOTO 7375 7290 ZD = SQR(ZD2): Z2H1 = Z1H - ZD 7295 Z2H2 = FNUNW((Z1H + ZD), 24) 7300 IF Z2H1 < 0 THEN Z2H1 = Z2H1 + 24 7305 R = RM + RU: ZD2 = FNZ((Z1H - XH0), ZH2, R, ZH) 7310 MG = (RM + RP - PH) / (2 * RM) 7315 IF ZD2 < 0 THEN ERR7 = 1: RETURN 7320 ZD = SQR(ZD2): Z2H3 = Z1H - ZD 7325 Z2H4 = FNUNW((Z1H + ZD), 24) 7330 IF Z2H3 < 0 THEN Z2H3 = Z2H3 + 24 7335 R = RU - RM: ZD2 = FNZ((Z1H - XH0), ZH2, R, ZH) 7340 MG = (RM + RU - PH) / (2 * RM) 7345 IF ZD2 < 0 THEN ERR7 = 2: RETURN 7350 ZD = SQR(ZD2): Z2H5 = Z1H - ZD 7355 Z2H6 = FNUNW((Z1H + ZD), 24) 7360 IF Z2H5 < 0 THEN Z2H5 = Z2H5 + 24 7365 RETURN 7370 PRINT "...pero no en el lugar": ERR6 = 2: RETURN 7375 PRINT "...pero no ocurre": ERR6 = 1: RETURN 7380 SW3 = -1: GOSUB 1800: CN = 3.819718634# 7385 X1 = P * CN: SW2 = 1: FLAG(3) = 0: GOSUB 1300 7390 GST = GTM: X = X1: GOSUB 1600: SW6 = 1 7395 X = P / CN: Y = Q: GOSUB 2900: Y = Q: X = P * CN 7400 GOSUB 1600: X = P / CN: SW3 = 1: GOSUB 1800 7405 RETURN