Lever et coucher du soleil

Télécharger le projet
Commenter

Description

Heures de lever et de coucher du soleil par le calcul, simplifié, des éléments du soleil.

Source / Exemple : 


Public PI As Double
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

'******************************************************************
'** Pour celui qui désirera plus de précision il lui faudra:
'1): calculer la déclinaison et l'équation du temps selon la date vraie, là
'    je détermine le nombre de jours depuis le
'    premier mars, les années bissextiles, ca fait déjà un jour d'erreur.
'2): Ne pas se contenter de constantes pour l'exentricité de l'orbite (e)
'    ni pour l'obliquité (Ob)
'******************************************************************

Declare Sub GetSystemTime Lib "kernel32" (lpSystemTime As HeureSyst)
' Ca, c'est pour déterminer 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
Public Function CalculSol(Jou As Integer, Moi As Integer, Lon As Double, Lat As Double)
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
' 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 Function
If cs < -1 Then CalculSol = "Ne se couche pas": Exit Function
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")
CalculSol = "Lever = " & lev & vbCrLf & "Coucher = " & couch
End Function

Conclusion :


Si y'a des gens qui veulent la précision à la seconde (c'est parfois utile) je pourrai ajouter le code du calcul de l'obliquité, de l'excentricité de l'ecliptique et de l'équation du temps.
Télécharger le projet

Codes Sources

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (VBbigineure)