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