JULDAY.TXT

     
     =============== CALCUL DU JOUR JULIEN ET INVERSE =================

     'julday.bas

     'Traduit du PASCAL par www.FreeNRG.info.
     '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
     
     DECLARE FUNCTION JourJulien& (jour AS INTEGER, mois AS INTEGER, annee AS INTEGER)
     DECLARE SUB InverseJJulien (julian AS LONG, jour AS INTEGER, mois AS INTEGER, annee AS INTEGER)

     DIM mois AS INTEGER, jour AS INTEGER, annee AS INTEGER
     DIM deltaj AS INTEGER
     DIM julian AS LONG
     DIM sortie AS INTEGER

     CONST fmt1 = "       Le Jour Julien du ##/##/#### est #######"
     CONST fmt2 = "       Le ##/##/#### corespond au Jour Julien #######"
     CONST fmt3 = "       date #### jours plus tard: ##/##/####"

     CONST ecran = 5, imprimante = 6

     CLS
         OPEN "scrn:" FOR RANDOM AS #ecran
         OPEN "lpt1:" FOR OUTPUT AS #imprimante
         sortie = ecran
         PRINT #sortie, "       Test du programme julday.bas"
         PRINT #sortie, ""
         mois = 5
         jour = 23
         annee = 1968
         julian = JourJulien&(jour, mois, annee)
         PRINT #sortie, USING fmt1; jour; mois; annee; julian
         InverseJJulien julian, jour, mois, annee
         PRINT #sortie, USING fmt2; jour; mois; annee; julian
         PRINT #sortie, ""
         deltaj = 450
         InverseJJulien julian + deltaj, jour, mois, annee
         PRINT #sortie, USING fmt3; deltaj; jour; mois; annee
     END

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

       Test du programme julday.bas

       Le Jour Julien du 23/ 5/1968 est 2440000
       Le 23/ 5/1968 corespond au Jour Julien 2440000

       date  450 jours plus tard: 16/ 8/1969