Code: Select all
;....................................................................................
;.: COMPUTATION ON DATES:.
; ============================
; Astronomical Julian Day
; ============================
; Author Mesa
; PureBasic v4.61b, v4.xx
;
; According to "Astronomie pratique et informatique"
; C. Dumoulin and JP Parisot, Ed Masson (scientific level: Master)
;
; The Julian day is universally used by astronomers and historians.
; Its accuracy is of the order of one minute of time between the years -5000 and +8000 (at least)
;
; Calculation of Julian day (JD Julian Day)
; Is essential to astronomical calculations
; But also To make calculations on calendar dates.
;
; Date arithmetic: addition, subtraction, etc. ...
;
; Eg: On June 6, 1944 at 6h 10' 24"+ 3 months 4 days 1 hour 47' 12" = ?
;......................................................................................
;OS : All
;Institut de mecanique celeste et de calcul des ephemerides
;http://www.imcce.fr/fr/grandpublic/temps/jour_julien.php
;http://www.imcce.fr/en/grandpublic/temps/jour_julien.php
Procedure.d jd(Year, Month, Day, Hour, Minute, Second); julian day at 0h UT (Universal Time)
Protected y.d=0
Protected m.d=0
Protected a.d=0
Protected jj.d=0
Protected z.d=0
If Month<3
y=Year-1
m=Month+12
Else
y=Year
m=Month
EndIf
jj=Int(365.25*(y+4716))+Int(30.6001*(m+1))+Day-1524.5
; Consideration of the Gregorian reform
; At Thursday, October 4, 1582 will succeed Friday, October 15, 1582
;
a=Year+(Month/100)+(Day/10000)
If a>1582.1014;
a = Int(y/100)
jj = jj + 2 - a + Int(a/4)
EndIf
;Add h m s
jj + (Hour + Minute/60 + Second/3600)/24
ProcedureReturn jj
EndProcedure
Procedure.d jd2(Year, Month, Day, Hour, Minute, Second); julian day at 0h UT (Universal Time)
; --Does not work before October 15, 1582 but faster than jd()--
Protected j.d
Protected m
Protected a
Protected jj.d
a=Year
m=Month
j=Day+(Hour + Minute/60 + Second/3600)/24
jj=367*a -Int(1.75*(Int((m+9)/12)+a))
jj-Int(0.75*(1+Int((Int((m-9)/7)+a)*0.01)))
jj+Int((275*m)/9)+j+1721028.5
ProcedureReturn jj
EndProcedure
Procedure.s jd2Date(jj.d) ; Compute Date from a Julian Day
Protected j1.d,f.d,dm.d,h.d
Protected z,aa,al,b,c,d,e,an
Protected result.s
j1=jj+0.5
z=Int(j1)
f=j1-z
If z<2299161
aa=z
Else
al=Int((z-1867216.25)/36524.25)
aa=z+1+al-Int(al/4)
EndIf
b=aa+1524
c=Int((b-122.1)/365.25)
d=Int(365.25*c)
e=Int((b-d)/30.6001)
dm=b-d-Int(30.6001*e)+f
If e<14
m=e-1
Else
m=e-13
EndIf
If m>2
an=c-4716
Else
an=c-4715
EndIf
h=24*(dm-Int(dm))
result=Str(an)+"/"+Str(m)+"/"+Str(Int(dm))+" "+StrD(h); Year Month Day Hours(fraction of hours)
ProcedureReturn result
EndProcedure
Procedure.b DayOfWeekJD(jj.d)
;Return 0=Sunday, 1 Monday, 2=Tuesday, 3=Wednesday, 4=Thursday, 5=Friday, 6=Saturday
Protected j.d
Protected result.b
j=jj+1.5
result=Int(j-7*Int(j/7));j%7
ProcedureReturn result
EndProcedure
Procedure DayOfYearJD(Year, Month, Day) ;Return the rank of days in the year
Protected result
result = 1+ jd(Year, Month, Day, 0, 0, 0) - jd(Year, 1, 1, 0, 0, 0)
ProcedureReturn result
EndProcedure
Procedure.b IsLeapYear(year) ; Return : 0 = is not leap year, 1 = is leap year
;Bissextile in French
Protected result.b
If year < 1582 ; Too complicated, believe me !
ProcedureReturn 0 ; -1
EndIf
If year%4=0
If y%100<>0
result=1
ElseIf year%400=0
result=1
EndIf
result=1
EndIf
ProcedureReturn result
EndProcedure
Debug ("_____________.: JULIAN DAYs :.______________")
Debug "Gregorian Day : -4712,1,1 :-> Julian Day = " + StrD(jd(-4712,1,1,0,0,0),2)
Debug " Consideration of the Gregorian reform"
Debug " At Thursday, October 4, 1582 will succeed Friday, October 15, 1582"
Debug "Gregorian Day : 1582,10,4 :-> Julian Day = " + StrD(jd(1582,10,4,0,0,0),2)
Debug "Gregorian Day : 1582,10,15 :-> Julian Day = " + StrD(jd(1582,10,15,0,0,0),2)
Debug " Consideration of the Gregorian reform OK"
Debug "Gregorian Day : 1789,7,14 :-> Julian Day = " + StrD(jd(1789,7,14,0,0,0),2)
Debug "Gregorian Day : 1900,1,1 :-> Julian Day = " + StrD(jd(1900,1,1,0,0,0),2)
Debug "Gregorian Day : 2000,1,1 :-> Julian Day = " + StrD(jd(2000,1,1,0,0,0),2)
Debug "judgment Day ;) : 2012,12,21,12,12,12 :-> Julian Day = " + StrD(jd(2012,12,21,12,12,12),6)
Debug "Gregorian Day : 3000,1,1 :-> Julian Day = whew ;)) " + StrD(jd(3000,1,1,0,0,0),2)
Debug ""
Debug("___________Quick JD_____________")
Debug "Quick computing but no Consideration of the Gregorian reform"
Debug "Gregorian Day : 1582,10,15 :-> Julian Day = " + StrD(jd2(1582,10,15,0,0,0),2)
Debug "Gregorian Day : 1789,7,14 :-> Julian Day = " + StrD(jd2(1789,7,14,0,0,0),2)
Debug "Gregorian Day : 1900,1,1 :-> Julian Day = " + StrD(jd2(1900,1,1,0,0,0),2)
Debug "Gregorian Day : 2000,1,1 :-> Julian Day = " + StrD(jd2(2000,1,1,0,0,0),2)
Debug "Judgment Day ;) : 2012,12,21,12,12,12 :-> Julian Day = " + StrD(jd2(2012,12,21,12,12,12),6)
Debug ""
Debug("___________JD -> Grego_(Y, M, D, h)____________")
Debug "Julian Day = -0.50 :-> Gregorian Day : " + jd2Date(-0.50)
; Consideration of the Gregorian reform
Debug " At Thursday, October 4, 1582 will succeed Friday, October 15, 1582"
Debug "Julian Day = 2299159.50 :-> Gregorian Day : " + jd2Date(2299159.50)
Debug "Julian Day = 2299160.50 :-> Gregorian Day : " + jd2Date(2299160.50)
Debug " Consideration of the Gregorian reform OK"
Debug "Julian Day = 2374673.50 :-> Gregorian Day : " + jd2Date(2374673.50)
Debug "Julian Day = 2415020.50 :-> Gregorian Day : " + jd2Date(2415020.50)
Debug "Julian Day = 2451544.50 :-> Gregorian Day : " +jd2Date(2451544.50)
Debug "Julian Day =2456283.008472 :-> Gregorian Day : " + jd2Date(2456283.008472)
Debug "Julian Day = 2816787.50 :-> Gregorian Day : " + jd2Date(2816787.50)
Debug ""
; Debug("___________Day of Week____________")
; Debug "0=Sunday, 1 Monday, 2=Tuesday, 3=Wednesday, 4=Thursday, 5=Friday, 6=Saturday"
; Debug " At Thursday, October 4, 1582 will succeed Friday, October 15, 1582"
; Debug "Day of Week of 1582,10,4 is " + Str(DayOfWeekJD(jd(1582,10,4,0,0,0)))
; Debug "Day of Week of 1582,10,15 is " + Str(DayOfWeekJD(jd(1582,10,15,0,0,0)))
; Debug "Day of Week of 2000,1,1 is " + Str(DayOfWeekJD(jd(1582,10,15,0,0,0)))
; Debug ""
Debug("___________Day of Week____________")
; Debug "0=Sunday, 1 Monday, 2=Tuesday, 3=Wednesday, 4=Thursday, 5=Friday, 6=Saturday"
; Debug " At Thursday, October 4, 1582 will succeed Friday, October 15, 1582"
days.s ="Sunday,Monday,Tuesday,Wednesday,Thursday,Friday,Saturday"
Debug "Day of Week of 1582,10,4 is " + StringField(days.s,DayOfWeekJD(jd(1582,10,4,0,0,0))+1 ,",")
Debug "Day of Week of 1582,10,15 is " + StringField(days.s,DayOfWeekJD(jd(1582,10,15,0,0,0))+1 ,",")
Debug "Day of Week of 2000,1,1 is " + StringField(days.s,DayOfWeekJD(jd(2000,1,1,0,0,0))+1 ,",")
Debug ""
Debug("___________Today____________")
Today$=FormatDate("%yyyy/%mm/%dd %hh:%ii:%ss", Date())
jdToday.d=jd(Year(Date()),Month(Date()),Day(Date()),Hour(Date()),Minute(Date()),Second(Date()))
dow=DayOfWeekJD(jdToday)
dow$=""
;0=Sunday, 1 Monday, 2=Tuesday, 3=Wednesday, 4=Thursday, 5=Friday, 6=Saturday
Select dow
Case 0 : dow$="Sunday "
Case 1 : dow$="Monday "
Case 2 : dow$="Tuesday "
Case 3 : dow$="Wednesday "
Case 4 : dow$="Thursday "
Case 5 : dow$="Friday "
Case 6 : dow$="Saturday "
EndSelect
Debug "Today :" + dow$ + Today$
Debug "Julian Day " + StrD(jdToday)
Debug "Day n° " + Str(DayOfYearJD(Year(Date()), Month(Date()), Day(Date()))) + " of the year"
isleap$ =" is a leap year"
isnotleapyear$ = " is not a leap year"
If IsLeapYear(Year(Date())) = 1
Debug Str(Year(Date())) + isleap$
Else
Debug Str(Year(Date())) + isnotleapyear$
EndIf
MessageRequester("Listen","Let's do some math.",0)
ClearDebugOutput()
Debug "Let's do some math."
Debug "What's the date of : 373 days after the 2000/1/1 0h ?"
Newjd.d=jd(2000,1,1,0,0,0) + 373
Debug jd2Date(Newjd)
Debug ""
Debug "What's the date of : 119 days before the 2000/1/1 0h ?"
Debug jd2Date(jd(2000,1,1,0,0,0) - 119)
Debug ""
Debug "What's the date of : 3 weeks after the 2000/1/1 0h ?"
Debug jd2Date(jd(2000,1,1,0,0,0) + 7*3)
Debug ""
Debug "What's the number of days between the 2000/1/1 12h 14m 37s And the 3000/1/1 6h 56m 12s ?"
jd1.d=jd(2000,1,1,12,14,37)
jd2.d=jd(3000,1,1,6,56,12)
Debug jd2-jd1
Debug ""
Debug "baby will be born 9 month from today :"
Debug jd2Date(jdToday + 9*30.5)