=====================  LEVERS ET COUCHERS DE LA LUNE =====================

      '  *******************************
      '  THIS PROGRAM COMPUTES THE
      '  TIMES OF MOONRISE AND MOON-SET
      '  ANYWHERE IN THE WORLD.
      '  FROM SKY & TELESCOPE, JULY,
      '  1989, PAGE 78.
      '  ********************************

      ' Programme piqué dans les archives de SKY & TELESCOPE
      ' http://www.skypub.com/resources/software/basic/basic.html
      ' A cette adresse Il y a des tas d'autres routines en 'Basic à vapeur'
      ' ie qui fonctionnent très bien mais qui sont tout cochonnés
      ' avec des tas de goto et des variables à 2 caractères.

      ' MoonUp.bas 
      ' Rajouts de trucs, modifs des noms de variables,
      ' saquage des numéros de ligne et des vilains goto par       '       ' www.FreeNRG.info
      ' Précision 2/3 minutes.
      ' Vérification possible chez:
      ' http://aa.usno.navy.mil/data/docs/RS_OneYear.html

      DECLARE SUB Init ()
      DECLARE SUB Farguments (t!, ra!, dec!, dist!)
      DECLARE FUNCTION Interpolation! (p!, f0!, f1!, f2!)
      DECLARE SUB JourJul (Annee!, Mois!, Jour!, t!)
      DECLARE SUB TempsSideral (t!, Zoneh!, LongitudeGeo!, t0!)

      DIM SHARED Message$(4)
      DIM SHARED NomMois$(12)
      DIM Moon(3, 3)

      CONST Pi = 3.14159265#
      CONST DeuxPi = 2 * Pi
      CONST DegRad = Pi / 180
      CONST k1 = 15 * DegRad * 1.0027379#
      CONST FfmtTit = "  LEVERS ET COUCHERS DE LA LUNE POUR \       \ #### "
      CONST FfmtCor = "  LATITUDE ###.##ø  LONGITUDE ####.##ø ZONE HORAIRE = ###"
      CONST FmtDate = "   ##/##/#### "
      CONST Fmtlever = "   ##/##/####  ##h ##m  LEVER   (AZIMUTH = ###.#ø)"
      CONST Fmtcouch = "   ##/##/####  ##h ##m  COUCHER (AZIMUTH = ###.#ø)"
      CONST Ecran = 4, Imprimante = 5
      
      CLS
         OPEN "scrn:" FOR RANDOM AS #Ecran
         OPEN "lpt1:" FOR OUTPUT AS #Imprimante
         Sortie = Ecran

         Init

         'Modifier selon besoins
         latitudeGeo = 48.38   '48ø 23'
         LongitudeGeo = -4.5   '4ø 30' W
         ZoneHoraire = 1
         Annee = 2001
         Mois = 10
         NbJmois = 31

         PRINT #Sortie, ""
         PRINT #Sortie, USING FfmtTit; NomMois$(Mois); Annee
         PRINT #Sortie, USING FfmtCor; latitudeGeo; LongitudeGeo; ZoneHoraire

         LongitudeGeo = LongitudeGeo / 360
         Zoneh = ZoneHoraire / 24
         FOR Jour = 1 TO NbJmois
            JourJul Annee, Mois, Jour, t
            TempsSideral t, Zoneh, LongitudeGeo, t0
            t = t + Zoneh
            GOSUB Main
            IF (Sortie = Ecran) THEN a$ = INPUT$(1)
         NEXT Jour
      END

'------------------------------------------------------------------------

Main:
         FOR i = 1 TO 3 'boucle position
             Farguments t, ra, dec, dist
             Moon(i, 1) = ra
             Moon(i, 2) = dec
             Moon(i, 3) = dist
             t = t + .5
         NEXT i
         IF (Moon(2, 1) <= Moon(1, 1)) THEN
            Moon(2, 1) = Moon(2, 1) + DeuxPi
         END IF
         IF (Moon(3, 1) <= Moon(2, 1)) THEN
            Moon(3, 1) = Moon(3, 1) + DeuxPi
         END IF
         z1 = DegRad * (90.567 - 41.685 / Moon(2, 3))
         s = SIN(latitudeGeo * DegRad)
         c = COS(latitudeGeo * DegRad)
         z = COS(z1)
         Lever = 0
         Coucher = 0
         PRINT #Sortie, ""
         a0 = Moon(1, 1)
         d0 = Moon(1, 2)
         FOR c0 = 0 TO 23
            p = (c0 + 1) / 24
            f0 = Moon(1, 1)
            f1 = Moon(2, 1)
            f2 = Moon(3, 1)
            a2 = Interpolation(p, f0, f1, f2)
            f0 = Moon(1, 2)
            f1 = Moon(2, 2)
            f2 = Moon(3, 2)
            d2 = Interpolation(p, f0, f1, f2)
            GOSUB TestEvent
            a0 = a2
            d0 = d2
            v0 = v2
       NEXT
       IF (Lever = 0) AND (Coucher = 0) THEN
         IF (v2 < 0) THEN
             PRINT #Sortie, USING FmtDate; Jour; Mois; Annee;
             PRINT #Sortie, Message$(3)
          ELSEIF (v2 > 0) THEN
             PRINT #Sortie, USING FmtDate; Jour; Mois; Annee;
             PRINT #Sortie, Message$(4)
         END IF
        ELSEIF (Lever = 0) THEN
             PRINT #Sortie, USING FmtDate; Jour; Mois; Annee;
             PRINT #Sortie, Message$(1)
        ELSEIF (Coucher = 0) THEN
             PRINT #Sortie, USING FmtDate; Jour; Mois; Annee;
             PRINT #Sortie, Message$(2)
       END IF
    RETURN

    
TestEvent: 'TEST AN HOUR FOR AN EVENT
        l0 = t0 + c0 * k1
        l2 = l0 + k1
        IF (a2 < a0) THEN a2 = a2 + 2 * Pi
        h0 = l0 - a0
        h2 = l2 - a2
        h1 = (h2 + h0) / 2 'angle horaire
        d1 = (d2 + d0) / 2 'dec
        IF (c0 <= 0) THEN
           v0 = s * SIN(d0) + c * COS(d0) * COS(h0) - z
        END IF
        v2 = s * SIN(d2) + c * COS(d2) * COS(h2) - z
        IF (SGN(v0) <> SGN(v2)) THEN
            v1 = s * SIN(d1) + c * COS(d1) * COS(h1) - z
            a = 2 * v2 - 4 * v1 + 2 * v0
            b = 4 * v1 - 3 * v0 - v2
            d = b * b - 4 * a * v0
            IF (d >= 0) THEN
               d = SQR(d)
               e = (-b + d) / (2 * a)
               IF ((e > 1) OR (e < 0)) THEN
                  e = (-b - d) / (2 * a)
               END IF
               t3 = c0 + e + 1 / 120 'arrondi
               Heure = INT(t3)
               Minute = CINT((t3 - Heure) * 60)
               h7 = h0 + e * (h2 - h0)
               n7 = -COS(d1) * SIN(h7)
               d7 = c * SIN(d1) - s * COS(d1) * COS(h7)
               Azimuth = ATN(n7 / d7) / DegRad
               IF (d7 < 0) THEN Azimuth = Azimuth + 180
               IF (Azimuth < 0) THEN Azimuth = Azimuth + 360
               IF (Azimuth > 360) THEN Azimuth = Azimuth - 360
               IF (v0 < 0 AND v2 > 0) THEN
                  PRINT #Sortie, USING Fmtlever; Jour; Mois; Annee; Heure; Minute; Azimuth
                  Lever = 1
               END IF
               IF (v0 > 0 AND v2 < 0) THEN
                  PRINT #Sortie, USING Fmtcouch; Jour; Mois; Annee; Heure; Minute; Azimuth
                  Coucher = 1
               END IF
            END IF
         END IF
      RETURN

'
'
'
'
'
'
      SUB Farguments (t, ra, dec, dist) 'FUNDAMENTAL ARGUMENTS
        l = .606434 + .03660110129# * t
        m = .374897 + .03629164709# * t
        f = .259091 + .0367481952# * t
        d = .827362 + .03386319198# * t
        n = .347343 - .00014709391# * t
        g = .993126 + .0027377785# * t
        l = l - INT(l)
        m = m - INT(m)
        f = f - INT(f)
        d = d - INT(d)
        n = n - INT(n)
        g = g - INT(g)
        l = l * DeuxPi
        m = m * DeuxPi
        f = f * DeuxPi
        d = d * DeuxPi
        n = n * DeuxPi
        g = g * DeuxPi
        v = .39558 * SIN(f + n)
        v = v + .082 * SIN(f)
        v = v + .03257 * SIN(m - f - n)
        v = v + .01092 * SIN(m + f + n)
        v = v + .00666 * SIN(m - f)
        v = v - .00644 * SIN(m + f - 2 * d + n)
        v = v - .00331 * SIN(f - 2 * d + n)
        v = v - .00304 * SIN(f - 2 * d)
        v = v - .0024 * SIN(m - f - 2 * d - n)
        v = v + .00226 * SIN(m + f)
        v = v - .00108 * SIN(m + f - 2 * d)
        v = v - .00079 * SIN(f - n)
        v = v + .00078 * SIN(f + 2 * d + n)
        u = 1 - .10828 * COS(m)
        u = u - .0188 * COS(m - 2 * d)
        u = u - .01479 * COS(2 * d)
        u = u + .00181 * COS(2 * m - 2 * d)
        u = u - .00147 * COS(2 * m)
        u = u - .00105 * COS(2 * d - g)
        u = u - .00075 * COS(m - 2 * d + g)
        w = .10478 * SIN(m)
        w = w - .04105 * SIN(2 * f + 2 * n)
        w = w - .0213 * SIN(m - 2 * d)
        w = w - .01779 * SIN(2 * f + n)
        w = w + .01774 * SIN(n)
        w = w + .00987 * SIN(2 * d)
        w = w - .00338 * SIN(m - 2 * f - 2 * n)
        w = w - .00309 * SIN(g)
        w = w - .0019 * SIN(2 * f)
        w = w - .00144 * SIN(m + n)
        w = w - .00144 * SIN(m - 2 * f - n)
        w = w - .00113 * SIN(m + 2 * f + 2 * n)
        w = w - .00094 * SIN(m - 2 * d + g)
        w = w - .00092 * SIN(2 * m - 2 * d)
        'RA, DEC, DIST
        s = w / SQR(u - v * v)
        ra = l + ATN(s / SQR(1 - s * s))
        s = v / SQR(u)
        dec = ATN(s / SQR(1 - s * s))
        dist = 60.40974 * SQR(u)
      END SUB

'
'
'
'
'
'
      SUB Init

         Message$(1) = "PAS DE LEVER DE LA LUNE"
         Message$(2) = "PAS DE COUCHER DE LA LUNE"
         Message$(3) = "LA LUNE RESTE SOUS L'HORIZON"
         Message$(4) = "LA LUNE RESTE AU DESSUS DE L'HORIZON"

         NomMois$(1) = "JANVIER"
         NomMois$(2) = "FEVRIER"
         NomMois$(3) = "MARS"
         NomMois$(4) = "AVRIL"
         NomMois$(5) = "MAI"
         NomMois$(6) = "JUIN"
         NomMois$(7) = "JUILLET"
         NomMois$(8) = "AOUT"
         NomMois$(9) = "SEPTEMBRE"
         NomMois$(10) = "OCTOBRE"
         NomMois$(11) = "NOVEMBE"
         NomMois$(12) = "DECEMBRE"

      END SUB

'
'
'
'
'
'
      FUNCTION Interpolation (p, f0, f1, f2)
          a = f1 - f0
          b = f2 - f1 - a
          Interpolation = f0 + p * (2 * a + b * (2 * p - 1))
      END FUNCTION

'
'
'
'
'
'
      SUB JourJul (Annee, Mois, Jour, t)
          g = 1
          IF (Annee < 1582) THEN g = 0
          d1 = INT(Jour)
          f = Jour - d1 - .5
          j = -INT(7 * (INT((Mois + 9) / 12) + Annee) / 4)
          IF (g <> 0) THEN
            s = SGN(Mois - 9)
            a = ABS(Mois - 9)
            j3 = INT(Annee + s * INT(a / 7))
            j3 = -INT((INT(j3 / 100) + 1) * 3 / 4)
         END IF
         j = j + INT(275 * Mois / 9) + d1 + g * j3
         j = j + 1721027 + 2 * g + 367 * Annee
         IF (f < 0) THEN
            f = f + 1
            j = j - 1
         END IF
         t = (j - 2451545) + f
      END SUB

'
'
'
'
'
'
      SUB TempsSideral (t, Zoneh, LongitudeGeo, t0) 'pour 0H ZONE TIME
          t0 = t / 36525
          s = 24110.5 + 8640184.813# * t0
          s = s + 86636.6 * Zoneh + 86400 * LongitudeGeo
          s = s / 86400
          s = s - INT(s)
          t0 = s * 360 * DegRad
      END SUB


===================== SORTIES DU PROGRAMME ===============

  LEVERS ET COUCHERS DE LA LUNE POUR OCTOBRE   2001 
  LATITUDE  48.38ø  LONGITUDE   -4.50ø ZONE HORAIRE =   1

    1/10/2001   3h 46m  COUCHER (AZIMUTH = 258.6ø)
    1/10/2001  17h  5m  LEVER   (AZIMUTH =  97.4ø)

    2/10/2001   4h 51m  COUCHER (AZIMUTH = 266.1ø)
    2/10/2001  17h 24m  LEVER   (AZIMUTH =  90.0ø)

    3/10/2001   5h 56m  COUCHER (AZIMUTH = 273.8ø)
    3/10/2001  17h 43m  LEVER   (AZIMUTH =  82.5ø)

    4/10/2001   7h  2m  COUCHER (AZIMUTH = 281.6ø)
    4/10/2001  18h  3m  LEVER   (AZIMUTH =  75.1ø)

    5/10/2001   8h 11m  COUCHER (AZIMUTH = 289.0ø)
    5/10/2001  18h 26m  LEVER   (AZIMUTH =  68.1ø)

    6/10/2001   9h 20m  COUCHER (AZIMUTH = 295.8ø)
    6/10/2001  18h 53m  LEVER   (AZIMUTH =  61.9ø)

    7/10/2001  10h 30m  COUCHER (AZIMUTH = 301.6ø)
    7/10/2001  19h 27m  LEVER   (AZIMUTH =  56.7ø)

    8/10/2001  11h 39m  COUCHER (AZIMUTH = 305.7ø)
    8/10/2001  20h 10m  LEVER   (AZIMUTH =  53.4ø)

    9/10/2001  12h 42m  COUCHER (AZIMUTH = 307.5ø)
    9/10/2001  21h  3m  LEVER   (AZIMUTH =  52.4ø)

   10/10/2001  13h 38m  COUCHER (AZIMUTH = 306.7ø)
   10/10/2001  22h  9m  LEVER   (AZIMUTH =  54.2ø)

   11/10/2001  14h 24m  COUCHER (AZIMUTH = 303.3ø)
   11/10/2001  23h 23m  LEVER   (AZIMUTH =  58.6ø)

   12/10/2001  15h  1m  COUCHER (AZIMUTH = 297.5ø)
   12/10/2001 PAS DE LEVER DE LA LUNE

   13/10/2001   0h 43m  LEVER   (AZIMUTH =  65.2ø)
   13/10/2001  15h 32m  COUCHER (AZIMUTH = 290.1ø)

   14/10/2001   2h  4m  LEVER   (AZIMUTH =  73.5ø)
   14/10/2001  15h 58m  COUCHER (AZIMUTH = 281.6ø)

   15/10/2001   3h 27m  LEVER   (AZIMUTH =  82.7ø)
   15/10/2001  16h 22m  COUCHER (AZIMUTH = 272.4ø)

   16/10/2001   4h 49m  LEVER   (AZIMUTH =  92.2ø)
   16/10/2001  16h 46m  COUCHER (AZIMUTH = 263.3ø)

   17/10/2001   6h 10m  LEVER   (AZIMUTH = 101.7ø)
   17/10/2001  17h 11m  COUCHER (AZIMUTH = 254.4ø)

   18/10/2001   7h 30m  LEVER   (AZIMUTH = 110.3ø)
   18/10/2001  17h 38m  COUCHER (AZIMUTH = 246.6ø)

   19/10/2001   8h 48m  LEVER   (AZIMUTH = 117.7ø)
   19/10/2001  18h  9m  COUCHER (AZIMUTH = 239.9ø)

   20/10/2001  10h  2m  LEVER   (AZIMUTH = 123.4ø)
   20/10/2001  18h 45m  COUCHER (AZIMUTH = 235.1ø)

   21/10/2001  11h  9m  LEVER   (AZIMUTH = 126.9ø)
   21/10/2001  19h 30m  COUCHER (AZIMUTH = 232.4ø)

   22/10/2001  12h  6m  LEVER   (AZIMUTH = 128.0ø)
   22/10/2001  20h 21m  COUCHER (AZIMUTH = 232.1ø)

   23/10/2001  12h 54m  LEVER   (AZIMUTH = 126.9ø)
   23/10/2001  21h 19m  COUCHER (AZIMUTH = 233.9ø)

   24/10/2001  13h 32m  LEVER   (AZIMUTH = 123.9ø)
   24/10/2001  22h 21m  COUCHER (AZIMUTH = 237.6ø)

   25/10/2001  14h  4m  LEVER   (AZIMUTH = 119.3ø)
   25/10/2001  23h 25m  COUCHER (AZIMUTH = 242.7ø)

   26/10/2001  14h 29m  LEVER   (AZIMUTH = 113.7ø)
   26/10/2001 PAS DE COUCHER DE LA LUNE

   27/10/2001   0h 29m  COUCHER (AZIMUTH = 248.9ø)
   27/10/2001  14h 52m  LEVER   (AZIMUTH = 107.3ø)

   28/10/2001   1h 34m  COUCHER (AZIMUTH = 255.8ø)
   28/10/2001  15h 11m  LEVER   (AZIMUTH = 100.2ø)

   29/10/2001   2h 39m  COUCHER (AZIMUTH = 263.2ø)
   29/10/2001  15h 30m  LEVER   (AZIMUTH =  92.9ø)

   30/10/2001   3h 44m  COUCHER (AZIMUTH = 270.9ø)
   30/10/2001  15h 48m  LEVER   (AZIMUTH =  85.3ø)

   31/10/2001   4h 51m  COUCHER (AZIMUTH = 278.8ø)
   31/10/2001  16h  8m  LEVER   (AZIMUTH =  77.7ø)