AUTRLUNE.TXT

===================  PLEINES LUNES ET NOUVELLES LUNES ================

     'moon.bas

     'NEW AND FULL MOONS
     '-------------------------------------------
     'APPEARED IN ASTRONOMICAL
     'COMPUTING, SKY & TELE- SCOPE, MARCH, 1985
     '------------------------------------------
     'Rajouts: www.FreeNRG.info
     '*****  PRECISION 3/4 minutes *****
     
     DECLARE SUB InverseJJulien (julian AS LONG, jour AS INTEGER, mois AS INTEGER, annee AS INTEGER)

     DIM julian AS LONG
     DIM jour AS INTEGER, mois AS INTEGER, annee AS INTEGER
     DIM Nomsmois$(12)
     DIM heures AS INTEGER 

     CONST r1 = 3.14159265# / 180
     CONST ecran = 4, imprimante = 5
     CONST FmtOut = "    #### \   \  ##  ##  ##  (\           \)"

     CLS
         OPEN "scrn:" FOR RANDOM AS #ecran
         OPEN "lpt1:" FOR OUTPUT AS #imprimante
         sortie = ecran
         GOSUB init
         INPUT "ANNEE "; y
         PRINT #sortie, ""
         GOSUB calculs
     END

calculs:
        u = 0
        k0 = INT((y - 1900) * 12.3685)
        t = (y - 1899.5) / 100
        t2 = t * t
        t3 = t * t * t
        j0 = 2415020 + 29 * k0
        f0 = .0001178# * t2 - .000000155# * t3
        f0 = f0 + .75933 + .53058868# * k0
        f0 = f0 - .000837 * t - .000335 * t2
        j = j + INT(f)
        f = f - INT(f)
        m0 = k0 * .08084821133#
        m0 = 360 * (m0 - INT(m0)) + 359.2242
        m0 = m0 - .0000333# * t2
        m0 = m0 - .00000347# * t3
        m1 = k0 * .07171366128#
        m1 = 360 * (m1 - INT(m1)) + 306.0253
        m1 = m1 + .0107306# * t2
        m1 = m1 + .00001236# * t3
        b1 = k0 * .08519585128#
        b1 = 360 * (b1 - INT(b1)) + 21.2964
        b1 = b1 - .0016528# * t2
        b1 = b1 - .00000239# * t3
        PRINT #sortie, "    An   Mois    j   h   m"
        FOR k9 = 0 TO 28
           j = j0 + 14 * k9
           f = f0 + .765294 * k9
           k = k9 / 2
           m5 = (m0 + k * 29.10535608#) * r1
           m6 = (m1 + k * 385.81691806#) * r1
           b6 = (b1 + k * 390.67050646#) * r1
           f = f - .4068 * SIN(m6)
           f = f + (.1734 - .000393 * t) * SIN(m5)
           f = f + .0161 * SIN(2 * m6)
           f = f + .0104 * SIN(2 * b6)
           f = f - .0074 * SIN(m5 - m6)
           f = f - .0051 * SIN(m5 + m6)
           f = f + .0021 * SIN(2 * m5)
           f = f + .001 * SIN(2 * b6 - m6)
           f = f + .5
           j = j + INT(f)
           f = f - INT(f)
           IF (u = 0) THEN txt$ = "Nouvelle lune"
           IF (u = 1) THEN txt$ = "Pleine lune"
           julian = j
           xheures = f * 24
           heures = INT(xheures)
           minutes = CINT((xheures - heures) * 60)
           InverseJJulien julian, jour, mois, annee
           PRINT #sortie, USING FmtOut; annee; Nomsmois$(mois); jour; heures; minutes; txt$
           u = u + 1
           IF (u = 2) THEN u = 0
        NEXT
   RETURN

init:
       Nomsmois$(1) = "JANV."
       Nomsmois$(2) = "FEVR."
       Nomsmois$(3) = "MARS "
       Nomsmois$(4) = "AVRIL"
       Nomsmois$(5) = "MAI  "
       Nomsmois$(6) = "JUIN "
       Nomsmois$(7) = "JUIL."
       Nomsmois$(8) = "JUIL."
       Nomsmois$(9) = "SEPT."
       Nomsmois$(10) = "OCT. "
       Nomsmois$(11) = "NOV. "
       Nomsmois$(12) = "DEC. "
    RETURN

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


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

    An   Mois    j   h   m
    2000 DEC.   25  17  24  (Nouvelle lune)
    2001 JANV.   9  20  24  (Pleine lune  )
    2001 JANV.  24  13   6  (Nouvelle lune)
    2001 FEVR.   8   7  12  (Pleine lune  )
    2001 FEVR.  23   8  20  (Nouvelle lune)
    2001 MARS    9  17  24  (Pleine lune  )
    2001 MARS   25   1  24  (Nouvelle lune)
    2001 AVRIL   8   3  22  (Pleine lune  )
    2001 AVRIL  23  15  30  (Nouvelle lune)
    2001 MAI     7  13  53  (Pleine lune  )
    2001 MAI    23   2  47  (Nouvelle lune)
    2001 JUIN    6   1  39  (Pleine lune  )
    2001 JUIN   21  11  56  (Nouvelle lune)
    2001 JUIL.   5  15   4  (Pleine lune  )
    2001 JUIL.  20  19  44  (Nouvelle lune)
    2001 JUIL.   4   5  56  (Pleine lune  )
    2001 JUIL.  19   2  56  (Nouvelle lune)
    2001 SEPT.   2  21  43  (Pleine lune  )
    2001 SEPT.  17  10  27  (Nouvelle lune)
    2001 OCT.    2  13  49  (Pleine lune  )
    2001 OCT.   16  19  21  (Nouvelle lune)
    2001 NOV.    1   5  42  (Pleine lune  )
    2001 NOV.   15   6  39  (Nouvelle lune)
    2001 NOV.   30  20  50  (Pleine lune  )
    2001 DEC.   14  20  49  (Nouvelle lune)
    2001 DEC.   30  10  41  (Pleine lune  )
    2002 JANV.  13  13  30  (Nouvelle lune)
    2002 JANV.  28  22  51  (Pleine lune  )
    2002 FEVR.  12   7  42  (Nouvelle lune)