====================== CALCUL DES PHASES DE LA LUNE ========== 'phaselun.bas 'Traduit du PASCAL. 'Les routines sont dans le fichier nrpas13.zip 'Qui peut, au choix, être récupéré chez 'http://www.programmersheaven.com/zone24/cat416/ 'http://www.filelibrary.com/Contents/DOS/77/21.html 'http://www.efg2.com/Lab/Library/Delphi/MathInfo/Resources.htm '*** PAS TRES PRECIS... (15/20 minutes parfois) *** DECLARE SUB InverseJJulien (jjul AS LONG, jour AS INTEGER, mois AS INTEGER, annee AS INTEGER) DECLARE SUB flmoon (n AS INTEGER, nph AS INTEGER, jd AS LONG, frac AS DOUBLE) DECLARE FUNCTION JourJulien& (jour AS INTEGER, mois AS INTEGER, annee AS INTEGER) DIM mois AS INTEGER, jour AS INTEGER, annee AS INTEGER DIM jjul AS LONG, j1 AS LONG, j2 AS LONG DIM i1 AS INTEGER, i2 AS INTEGER, i3 AS INTEGER DIM secs AS SINGLE DIM n AS INTEGER, nph AS INTEGER, frac AS DOUBLE DIM timzon AS SINGLE DIM phase$(0 TO 3) DIM sortie AS INTEGER CONST ecran = 5, imprimante = 6 CONST zon = 0! 'CHANGER SELON ZONE. NE PAS LAISSER EN CONSTANTE phase$(0) = "Nouvelle lune" phase$(1) = "Premier quartier" phase$(2) = "Pleine lune" phase$(3) = "Dernier quartier" CLS OPEN "scrn:" FOR RANDOM AS #ecran OPEN "lpt1:" FOR OUTPUT AS #imprimante sortie = ecran timzon = zon / 24! PRINT #sortie, "Calcul de la date des quelques prochaines phases de la lune" INPUT "Donner la date de d‚part: (ex 31, 1, 2001): "; jour, mois, annee 'Nombre approx de pleines lunes depuis janvier 1900 n = INT(12.37 * (annee - 1900 + INT((mois - .5) / 12!))) nph = 2 j1 = JourJulien&(jour, mois, annee) flmoon n, nph, j2, frac n = n + INT((j1 - j2) / 28!) PRINT #sortie, "": PRINT #sortie, "": PRINT #sortie, "" PRINT #sortie, " Date Heure TU Phase" PRINT #sortie, " -------------------------------------------" FOR i = 1 TO 20 flmoon n, nph, j2, frac frac = 24! * (frac + timzon) IF (frac < 0!) THEN j2 = j2 - 1 frac = frac + 24! END IF IF (frac > 12!) THEN j2 = j2 + 1 frac = frac - 12! ELSE frac = frac + 12! END IF i1 = INT(frac) secs = 3600! * (frac - i1) i2 = INT(secs / 60!) InverseJJulien j2, jour, mois, annee PRINT #sortie, USING " ##/##/####"; jour; mois; annee; PRINT #sortie, USING " ## h ## min "; i1; i2; PRINT #sortie, phase$(nph) IF (nph = 3) THEN nph = 0 n = n + 1 ELSE nph = nph + 1 END IF NEXT i END ' ' ' ' ' ' SUB flmoon (n AS INTEGER, nph AS INTEGER, jd AS LONG, frac AS DOUBLE) DIM c AS DOUBLE, t AS DOUBLE, t2 AS DOUBLE DIM xas AS DOUBLE DIM xtra AS DOUBLE DIM am AS DOUBLE DIM i AS INTEGER CONST rad = 3.14159265# / 180# c = n + nph / 4 t = c / 1236.85 t2 = SQR(t) xas = 359.2242 + 29.105356# * c am = 306.0253 + 385.816918# * c + .01073 * t2 jd = 2415020 + 28& * n + 7 * nph xtra = .75933 + 1.53058868# * c + (.0001178 - 1.55E-07 * t) * t2 IF ((nph = 0) OR (nph = 2)) THEN xtra = xtra + (.1734 - .000393 * t) * SIN(rad * xas) - .4068 * SIN(rad * am) ELSEIF ((nph = 1) OR (nph = 3)) THEN xtra = xtra + (.1721 - .0004 * t) * SIN(rad * xas) - .628 * SIN(rad * am) ELSE PRINT #sortie, ("pause dans FLMOON - nph inconnu.") a$ = INPUT$(1) END IF IF (xtra >= 0!) THEN i = INT(xtra) ELSE i = INT(xtra - 1#) END IF jd = jd + i frac = xtra - i END SUB ' ' ' ' ' ' SUB InverseJJulien (julian AS LONG, jour AS INTEGER, mois AS INTEGER, annee AS INTEGER) CONST igreg2 = 2299161 DIM je AS LONG, jd AS LONG, jc AS LONG, jb AS LONG DIM jalpha AS LONG, ja AS LONG IF (julian >= igreg2) THEN jalpha = INT(((julian - 1867216) - .25) / 36524.25) ja = julian + 1 + jalpha - INT(.25 * jalpha) ELSE ja = julian END IF jb = ja + 1524 jc = INT(6680& + ((jb - 2439870) - 122.1) / 365.25) jd = 365& * jc + INT(.25 * jc) je = INT((jb - jd) / 30.6001) jour = jb - jd - INT(30.6001 * je) mois = je - 1 IF (mois > 12) THEN mois = mois - 12 annee = jc - 4715 IF (mois > 2) THEN annee = annee - 1 IF (annee <= 0) THEN annee = annee - 1 END SUB ' ' ' ' ' ' FUNCTION JourJulien& (jour AS INTEGER, mois AS INTEGER, annee AS INTEGER) 'Retourne-1 si annee=0 (l'an z‚ro n'existe pas) CONST igreg = 588829 DIM an AS INTEGER DIM ja AS LONG, jm AS LONG DIM jy AS LONG, jul AS LONG DIM grego AS LONG an = annee IF (an = 0) THEN JourJulien& = -1 EXIT FUNCTION END IF IF (an < 0) THEN an = an + 1 IF (mois > 2) THEN jy = an jm = mois + 1 ELSE jy = an - 1 jm = mois + 13 END IF jul = INT(365.25 * jy) + INT(30.6001 * jm) + jour + 1720995 grego = jour + 31& * (mois + 12& * an) IF (grego >= igreg) THEN ja = INT(.01 * jy) jul = jul + 2 - ja + INT(.25 * ja) END IF JourJulien& = jul END FUNCTION ============================= SORTIES DU PROGRAMME ===================== Calcul de la date des quelques prochaines phases de la lune Date Heure TU Phase ------------------------------------------- 1/11/2001 5 h 49 min Pleine lune 8/11/2001 12 h 5 min Dernier quartier 15/11/2001 6 h 41 min Nouvelle lune 22/11/2001 23 h 34 min Premier quartier 30/11/2001 21 h 3 min Pleine lune 7/12/2001 19 h 43 min Dernier quartier 14/12/2001 21 h 2 min Nouvelle lune 22/12/2001 20 h 52 min Premier quartier 30/12/2001 10 h 55 min Pleine lune 6/ 1/2002 4 h 3 min Dernier quartier 13/ 1/2002 13 h 37 min Nouvelle lune 21/ 1/2002 17 h 28 min Premier quartier 28/ 1/2002 23 h 5 min Pleine lune 4/ 2/2002 13 h 53 min Dernier quartier 12/ 2/2002 7 h 35 min Nouvelle lune 20/ 2/2002 11 h 42 min Premier quartier 27/ 2/2002 9 h 33 min Pleine lune 6/ 3/2002 1 h 39 min Dernier quartier 14/ 3/2002 1 h 47 min Nouvelle lune 22/ 3/2002 2 h 21 min Premier quartier
septix