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