Function DateSaison(ByVal Y As Double, ByVal K As Integer) As String
' Le code est une adaptation du codage en QuickBasic vers VB2008.
' Le site originel se trouve l'adresse : http://sites.rapidus.net/algauthi/intro.htm
' Y : Annee
' K : 0 3 selon la saison
' 0 : EQUINOXE DE PRINTEMPS
' 1 : SOLSTICE D'ETE
' 2 : EQUINOXE D'AUTOMNE
' 3 : SOLSTICE D'HIVER
' Paramtres
Dim Y1, JD, T, RAD, L, M, C, OME, AP, TEST, COR, Z, F, A, X, B, D, E, DayDec, MN, FRAC, Day, Minute, Heure As Double
Dim Mois As String
'Calcul jour
Y1 = Y / 1000
Select Case KCase 0
JD = 1721139.2855 + 365.2421376 * Y + 0.067919 * Y1 ^ 2 - 0.0027879 * Y1 ^ 3
Case 1
JD = 1721233.2486 + 365.2417284 * Y - 0.053018 * Y1 ^ 2 + 0.009332 * Y1 ^ 3
Case 2
JD = 1721325.6978 + 365.2425055 * Y - 0.126689 * Y1 ^ 2 + 0.0019401 * Y1 ^ 3
Case 3
JD = 1721414.392 + 365.2428898 * Y - 0.010965 * Y1 ^ 2 - 0.0084885 * Y1 ^ 3
End Select
RAD = Math.PI / 180
Do
T = (JD - 2415020) / 36525
'GEOMETRIC MEAN doubleITUDE
L = 279.69668 + (36000.76892 * T) + 0.0003025 * T ^ 2
'SUN MEAN ANOMALIE
M = (358.47583 + (35999.04975 * T) - 0.00015 * T ^ 2 - 0.0000033 * T ^ 3) / 360
M = (M - Math.Floor(M)) * 360
'EQUATION AU CENTRE
C = (1.91946 - 0.004789 * T - 0.000014 * T ^ 2) * Math.Sin(M * RAD) + (0.020094 - 0.0001 * T) * Math.Sin(M * 2) + (0.000293 * Math.Sin(M * 3))
'TRUE LONGITUDE DU SOLEIL
OME = (259.18 - 1934.142 * T) / 360
OME = (OME - Math.Floor(OME)) * 360 * RAD
AP = (L + C - 0.00569 - 0.00479 * Math.Sin(OME)) / 360
AP = (AP - Math.Floor(AP)) * 360
'CORRECTION
TEST = JD
COR = 58 * Math.Sin((K * 90 - AP) * RAD)
JD = JD + COR
Loop While JD - TEST > 0.001
JD = JD + 0.5
Z = Math.Floor(JD)
If Z < 2299161 Then
A = Z
Else
X = Math.Floor((Z - 1867216.25) / 36524.25)
A = Z + 1 + X - Math.Floor(X / 4)
End If
B = A + 1524
C = Math.Floor((B - 122.1) / 365.25)
D = Math.Floor(365.25 * C)
E = Math.Floor((B - D) / 30.6001)
F = JD - Z
DayDec = B - D - Math.Floor(30.6001 * E) + F
If E < 13.5 Then
MN = E - 1
Else
MN = E - 13
End If
Mois = vbNullString
Select Case MN
Case 3
Mois = "MARS"
Case 6
Mois = "JUIN"
Case 9
Mois = "SEPTEMBRE"
Case 12
Mois = "DECEMBRE"
End Select
FRAC = DayDec - Math.Floor(DayDec)
Day = Math.Floor(DayDec)
Heure = Math.Floor(FRAC * 24)
Minute = (FRAC * 24 - Heure) * 60
DateSaison = Day & " " & Mois & " " & Heure & "H" & Math.Floor(Minute) & "MIN"
End Function