Problème avec le calcul de l'heure de midi

Bonjour le forum,
Si pour ce qui concerne les levers et couchers de soleil, les résultats du code de Mr Ravet sont corrects quoique légèrement différents des valeurs affichées dans le logiciel « Calendes » (ville : Brussels ; coordonnées Lon = -4.403087 et Lat = 50.824559.), j’ai un souci avec l’heure de midi. Elle semble « calée » sur 11h42. Ci-dessous, quelques exemples
Je calcule l’heure de midi en me basant sur

Code:

' Heure TU du milieu de la journée
h = 12 + (lo / hr)

et je la formate

Code:

midi = Format(Int(h), "00") & ":" & Format((h - Int(h)) * 60, "00"),

la variable « h » étant définie comme double
Le code est repris, in extenso, en fin de message.
Un membre du forum pourrait-il prendre le temps pour m’aider à corriger le problème.
D’avance merci.

GiHem

Exemples
Jour = 12, Mois = 11
Code : Lever = 07:49, Coucher = 17:03, midi = 11:42
Calendes : Lever = 07:53, Coucher = 17:00
Jour = 21, Mois = 12
Code : Lever = 08:43, Coucher = 16:53, midi = 11:42
Calendes : Lever = 08:43, Coucher = 16:39
Jour = 21, Mois = 3
Code : Lever = 06:40, Coucher = 18:58,  midi = 11:42
Calendes : Lever = 06:43, Coucher = 18:57
Jour = 21, Mois = 6
Code : Lever = 05:48, Coucher = 21:49, midi = 11:42
Calendes : Lever = 04:29, Coucher = 21:00
Code

Code:

Option Explicit

Public Lon As Double, Lat As Double

Const k = 0.0172024
Const jm = 308.67
Const jl = 21.55
Const E = 0.0167
Const ob = 0.4091
Const PI = 3.14159265358979
'64 bits
#If Win64 Then
Declare PtrSafe Sub GetSystemTime Lib "kernel32" (lpSystemTime As HeureSyst)
#Else
'32 bits
Declare  Sub GetSystemTime Lib "kernel32" (lpSystemTime As HeureSyst)
#End If
' Détermine l'ecart entre l'heure système et l'heure TU. grace a la function Delta.
Type HeureSyst
        GMTAnnee As Integer
        GMTMois As Integer
        GMTJourSemaine As Integer
        GMTJour As Integer
        GMTHeure As Integer
        GMTMinute As Integer
        GMTSeconde As Integer
        GMTMillisecondes As Integer
    End Type

Public Function Delta() As String
Dim Tmp As Single
Dim SysTime As HeureSyst
Call GetSystemTime(SysTime)
Tmp = Time - (SysTime.GMTHeure / 24 + SysTime.GMTMinute / 1440 + SysTime.GMTSeconde / 86400)
' si les deux jours sont <>
If Tmp < 0 Then Tmp = Tmp + 24
If Tmp > 24 Then Tmp = Tmp - 24
Delta = Tmp
End Function

' Hauteur du soleil au lever et au coucher
'http://olravet.fr/
‘Public Sub CalculSol(lev, couch, midi)
Public Sub CalculSol()
Dim lev As String, couch As String, midi As String
Dim Jou As Integer, Moi As Integer, CalculSol As String, Lon As Double, Lat As Double, Mo As Integer, Jo As Integer
Dim dr As Double, hr As Double, ht As Double, lo As Double, la As Double, j As Integer, m As Integer, L As Integer
Dim S As Double, x As Double, Y As Double, Z As Double, R As Integer, rx As Double, ry As Double
Dim ET As Double, DC As Double, cs As Double, ah As Double, Pm As Double, hs As Integer
Dim fh As Date, h As Double
Jou = Day(Now())
Moi = Month(Now())
‘Mes coordonnées
Lon = -4.403087
Lat = 50.824559
Mo = Moi
Jo = Jou
dr = PI / 180
hr = PI / 12
ht = -50 / 60
ht = ht * dr
' Fuseau horaire et coordonnées géographiques
fh = Hour(Delta)
la = Lat
lo = Lon
la = la * dr
lo = lo * dr
' Date
If Mo < 3 Then Mo = Mo + 12
' Heure TU du milieu de la journée
h = 12 + (lo / hr)
' Nombre de jours écoulés depuis le 1 Mars O h TU
j = Int(30.61 * (Mo + 1)) + Jo + (h / 24) - 123
'j = Now() - DateSerial(Year(Now()), 1, 1)

' Anomalie et longitude moyenne
m = k * (j - jm)
L = k * (j - jl)
' Longitude vraie
S = L + 2 * E * Sin(m) + 1.25 * E * E * Sin(2 * m)
' Coordonnées rectangulaires du soleil dans le repère équatorial
x = Cos(S): Y = Cos(ob) * Sin(S)
Z = Sin(ob) * Sin(S)

' Equation du temps et déclinaison
R = L
rx = Cos(R) * x + Sin(R) * Y
ry = -Sin(R) * x + Cos(R) * Y
x = rx
Y = ry
ET = Atn(Y / x)
DC = Atn(Z / Sqr(1 - Z * Z))

' Angle horaire au lever et au coucher
cs = (Sin(ht) - Sin(la) * Sin(DC)) / Cos(la) / Cos(DC)
If cs > 1 Then CalculSol = "Ne se lève pas": Exit Sub
If cs < -1 Then CalculSol = "Ne se couche pas": Exit Sub
If cs = 0 Then ah = PI / 2 Else ah = Atn(Sqr(1 - cs * cs) / cs)
If cs < 0 Then ah = ah + PI
' Lever du soleil
Pm = h + fh + (ET - ah) / hr
If Pm < 0 Then Pm = Pm + 24
If Pm > 24 Then Pm = Pm - 24
hs = Int(Pm)
Pm = 60 * (Pm - hs)
If Format(Pm, "00") = "60" Then Pm = Pm - 60: hs = hs + 1
lev = Format(hs, "00") & ":" & Format(Pm, "00")
' Coucher du soleil
Pm = h + fh + (ET + ah) / hr
If Pm > 24 Then Pm = Pm - 24
If Pm < 0 Then Pm = Pm + 24
hs = Int(Pm)
Pm = 60 * (Pm - hs)
If Format(Pm, "00") = "60" Then Pm = Pm - 60: hs = hs + 1
couch = Format(hs, "00") & ":" & Format(Pm, "00")
midi = Format(Int(h), "00") & ":" & Format((h - Int(h)) * 60, "00")
CalculSol = "Lever = " & lev & vbCrLf & "Coucher = " & couch & vbCrLf & "midi = " & midi
'Debug.Print "Jour = " & Jo & vbCrLf & "Mois = " & Mo & vbCrLf & CalculSol
End Sub


Bonsoir,
J'avais pas vu ce post, désolé.
il y aurait comme une Equation du temps figée sur une valeur...
Essayez de suivre cette formule, votre compilateur ne connait peut etre pas l'ATN dans :

Code:

ET = Atn(Y / x)
DC = Atn(Z / Sqr(1 - Z * Z))

Bonjour Monsieur Ravet,
J’ai compris d’où venait l’erreur.
Elle résulte d’une initiative (malheureuse) de ma part. Je travaille en standard avec l’option « Explicit » active et j’ai donc défini toutes les variables utilisées. Avec probablement quelques choix erronés.
En supprimant l’option « Explicit » et, bien sûr, les définitions, tous les calculs sont corrects.
Désolé de vous avoir dérangé pour une initiative malheureuse.
Je vous souhaite une excellente journée
GiHem

C'était pourtant une bonne initiative, justement la première à adopter quand on cherche des bugs. En dimensionnant en integer on supprime les décimales, et on supprime le transport de valeurs.