Soyez le premier à donner votre avis sur cette source.
Vue 51 714 fois - Téléchargée 11 109 fois
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
Modifié le 30 mars 2019 à 09:26
Mais il y a une variation cyclique de +/- 4 ans, corrigée lors des années bissextiles.
Votre calcul n'en tient pas compte.
Cordialement
16 févr. 2015 à 16:20
4 févr. 2013 à 13:58
Je vais chercher maintenant le lever de la lune
3 févr. 2010 à 12:58
A tout hasard, qqun l'aurai transcrit en vb .net ?
7 sept. 2008 à 04:25
Tres bon code , j'approuve . Il y a seulement une requête:
vu votre tres bon niveau en astronomie, pouvez vous nous poster une application qui donnera l'azimut et L'altitude du soleil en fonction du temps et des coordonnées?
je signal que ce genre d'appli est très demandé.
merci
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.