Volevo calcolare le fasi lunari con metodo astronomico, questo permette
un calcolo con precisione al minuto, attualmente utilizzo un metodo
utiizzando il numero d'Oro e l' Epatta pero' in questo modo a volte il
calcolo sballa di un giorno.
Per i calcoli astronomici esiste un libro Bibbia
Jean Meeus, Astronomia con il computer. Formule, metodi di calcolo,
esempi numerici. Salvo De Meis (curatore) Milano, Hoepli 1990. (232 pagine)
pero' e' irreperibile se non in lingua inglese. Girovagando ho trovato
un programmatore VB6 che ha implementato gli algoritmi del libro
http://www.it-lang-vb.net/download.asp?file=http://www.it-lang-vb.net/Archivio/Sorgenti/Fasi%20Lunari.zip&ID=685
ho leggermente modificato le funzioni passando invece della data odierna
(Now) una data da me scelta, mi serve fare i calcoli partendo sempre dal
primo del mese e poi non avendo a disposizione la Funzione Round ho
provato, seguendo i post di questa ML, ad implementare io una funzione
Round, pero' i calcoli non sono precisi non riesco a capire se gli
errori sono dovuti ad una difformita' della funzione Round di VB oppure
se chi ha implementato gli algoritmi ha commesso piccoli
errori,guardando l' ora ad esempio della luna nuova e confrontando i
risultati con quelli di questo sito :
http://www.marcomenichelli.it/fasilunari.asp
noto uno sfasamento di alcune ore per cui in taluni casi il giorno
risulta essere sbagliato, anche utilizzando via codice la funzione Calc
ROUND o ROUNDUP non ottengo risultati precisi.
Allego le routine chissa' magari sotto l' ombrellone vi annoiate e ci
provate.
--
Cordiali saluti. Luca
Const PG = 3.14159265358979 'è la classica pi greca
Function data() as Date
Dim Y as Integer, M as Integer, D as Integer
Y = 2008
M = 10
D = 1
data = cDate( D & "/" & M & "/" & Y )
End Function
Function JD(YYY As Integer, MMM As Integer, GGG As Integer) As Double
Dim AAA As Long, BBB As Long
If MMM < 3 Then MMM = MMM + 12: YYY = YYY - 1
AAA = Int(YYY / 100)
BBB = 2 - AAA + Int(AAA / 4)
JD = Int(365.25 * (YYY + 4716)) + Int(30.6 * (MMM + 1)) + GGG + BBB - 1524.5
End Function
Function NDay(JD As Double) As Variant
Dim ParteIntera As Long, ParteDecimale As Double
Dim PPP As Long, AAA As Long, BBB As Long, CCC As Long, DDD As Long, EEE As
Long
Dim SCN As Double, MNT As Double, HRN As Double, GRN As Integer, MSN As
Integer, ANN As Integer
JD = JD + 0.5
ParteIntera = Int(JD)
ParteDecimale = JD - ParteIntera
PPP = Int((ParteIntera - 1867216.25) / 36524.25)
AAA = ParteIntera + 1 + PPP - Int(PPP / 4)
BBB = AAA + 1524
CCC = Int((BBB - 122.1) / 365.25)
DDD = Int(365.25 * CCC)
EEE = Int((BBB - DDD) / 30.6001)
GRN = BBB - DDD - Int(30.6001 * EEE)
HRN = Int(ParteDecimale * 24)
ParteDecimale = ParteDecimale - HRN / 24
MNT = Int(ParteDecimale * 1440)
ParteDecimale = ParteDecimale - MNT / 1440
SCN = Int(ParteDecimale * 86400)
If EEE < 13.5 Then MSN = EEE - 1
If EEE > 13.5 Then MSN = EEE - 13
If MSN > 2.5 Then ANN = CCC - 4716
If MSN < 2.5 Then ANN = CCC - 4715
NDay = Format(GRN, "00") & "." & Format(MSN, "00") & "." & ANN & " ore " &
Format(HRN, "00") & ":" & Format(MNT, "00") & ":" & Format(SCN, "00")
End Function
Function LunaNuovaPrecedente() As Variant
Dim YYY As Double, kk As Double, TT As Double, MS As Double, ML As Double,
FF As Double
YYY = Year(data) + DatePart("y", data - 30) / 365
kk = Round (((YYY - 1900) * 12.3685),0)
TT = kk / 1236.85
MS = 359.2242 + 29.10535608 * kk - 0.0000333 * TT ^ 2 - 0.00000347 * TT ^ 3
Do While Int(MS) > 360
MS = MS - 360
Loop
ML = 306.0253 + 385.81691806 * kk + 0.0107306 * TT ^ 2 + 0.00001236 * TT ^ 3
Do While Int(ML) > 360
ML = ML - 360
Loop
FF = 21.2964 + 390.67050646 * kk - 0.0016528 * TT ^ 2 - 0.00000239 * TT ^ 3
'Precedente Luna Nuova
LunaNuovaPrecedente = 2415020.75933 + 29.53058868 * kk + 0.0001178 * (TT ^
2) - 0.000000155 * (TT ^ 3) _
+ 0.00033 * Sin((166.56 + 132.87 * TT - 0.009173 * (T ^ 2)) * PG / 180) _
+ (0.1734 - (0.000393 * TT)) * Sin(MS * PG / 180) + 0.0021 * Sin(2 * MS *
PG / 180) _
- 0.4068 * Sin(ML * PG / 180) + 0.0161 * Sin(2 * ML * PG / 180) _
- 0.0004 * Sin(3 * ML * PG / 180) + 0.0104 * Sin(2 * FF * PG / 180) _
- 0.0051 * Sin((MS + ML) * PG / 180) - 0.0074 * Sin((MS - ML) * PG / 180) _
+ 0.0004 * Sin((2 * FF + MS) * PG / 180) - 0.0004 * Sin((2 * FF - MS) * PG
/ 180) _
- 0.0006 * Sin((2 * FF + ML) * PG / 180) + 0.001 * Sin((2 * FF - ML) * PG /
180) _
+ 0.0005 * Sin((MS + 2 * ML) * PG / 180)
print NDay(LunaNuovaPrecedente)
End Function
Function PrimoQuartoPrecedente() As Variant
Dim YYY As Double, kk As Double, TT As Double, MS As Double, ML As Double,
FF As Double
YYY = Year(Now) + DatePart("y", Now - 30) / 365
kk = Round((YYY - 1900) * 12.3685) + 0.25
TT = kk / 1236.85
MS = 359.2242 + 29.10535608 * kk - 0.0000333 * TT ^ 2 - 0.00000347 * TT ^ 3
Do While Int(MS) > 360
MS = MS - 360
Loop
ML = 306.0253 + 385.81691806 * kk + 0.0107306 * TT ^ 2 + 0.00001236 * TT ^ 3
Do While Int(ML) > 360
ML = ML - 360
Loop
FF = 21.2964 + 390.67050646 * kk - 0.0016528 * TT ^ 2 - 0.00000239 * TT ^ 3
'Primo Quarto Precedente
PrimoQuartoPrecedente = 2415020.75933 + 29.53058868 * kk + 0.0001178 * (TT
^ 2) - 0.000000155 * (TT ^ 3) _
+ 0.00033 * Sin((166.56 + 132.87 * TT - 0.009173 * (T ^ 2)) * PG / 180) _
+ (0.1721 - 0.0004 * TT) * Sin(MS * PG / 180) + 0.0021 * Sin(2 * MS * PG /
180) _
- 0.628 * Sin(ML * PG / 180) + 0.0089 * Sin(2 * ML * PG / 180) - 0.0004 *
Sin(3 * ML * PG / 180) _
+ 0.0079 * Sin(2 * FF * PG / 180) - 0.0119 * Sin((MS + ML) * PG / 180) _
- 0.0047 * Sin((MS - ML) * PG / 180) + 0.0003 * Sin((2 * FF + MS) * PG /
180) - 0.0004 * Sin((2 * FF - MS) * PG / 180) _
- 0.0006 * Sin((2 * FF + ML) * PG / 180) + 0.0021 * Sin((2 * FF - ML) * PG
/ 180) _
+ 0.0003 * Sin((MS + 2 * ML) * PG / 180) + 0.0004 * Sin((MS - 2 * ML) * PG
/ 180) _
- 0.0003 * ((2 * MS + ML) * PG / 180) _
+ 0.0028 - 0.0004 * Cos(MS * PG / 180) + 0.0003 * Cos(ML * PG / 180) 'per
1° quarto
print NDay(PrimoQuartoPrecedente)
End Function
Function LunaPienaPrecedente() As Variant
Dim YYY As Double, kk As Double, TT As Double, MS As Double, ML As Double,
FF As Double
YYY = Year(Now) + DatePart("y", Now - 30) / 365
kk = Round ((YYY - 1900) * 12.3685) + 0.5
TT = kk / 1236.85
MS = 359.2242 + 29.10535608 * kk - 0.0000333 * TT ^ 2 - 0.00000347 * TT ^ 3
Do While Int(MS) > 360
MS = MS - 360
Loop
ML = 306.0253 + 385.81691806 * kk + 0.0107306 * TT ^ 2 + 0.00001236 * TT ^ 3
Do While Int(ML) > 360
ML = ML - 360
Loop
FF = 21.2964 + 390.67050646 * kk - 0.0016528 * TT ^ 2 - 0.00000239 * TT ^ 3
'Luna Piena Precedente
LunaPienaPrecedente = 2415020.75933 + 29.53058868 * kk + 0.0001178 * (TT ^
2) - 0.000000155 * (TT ^ 3) _
+ 0.00033 * Sin((166.56 + 132.87 * TT - 0.009173 * (T ^ 2)) * PG / 180) _
+ (0.1734 - (0.000393 * TT)) * Sin(MS * PG / 180) + 0.0021 * Sin(2 * MS *
PG / 180) _
- 0.4068 * Sin(ML * PG / 180) + 0.0161 * Sin(2 * ML * PG / 180) _
- 0.0004 * Sin(3 * ML * PG / 180) + 0.0104 * Sin(2 * FF * PG / 180) _
- 0.0051 * Sin((MS + ML) * PG / 180) - 0.0074 * Sin((MS - ML) * PG / 180) _
+ 0.0004 * Sin((2 * FF + MS) * PG / 180) - 0.0004 * Sin((2 * FF - MS) * PG
/ 180) _
- 0.0006 * Sin((2 * FF + ML) * PG / 180) + 0.001 * Sin((2 * FF - ML) * PG /
180) _
+ 0.0005 * Sin((MS + 2 * ML) * PG / 180)
End Function
Function UltimoQuartoPrecedente() As Variant
Dim YYY As Double, kk As Double, TT As Double, MS As Double, ML As Double,
FF As Double
YYY = Year(Now) + DatePart("y", Now - 30) / 365
kk = Round((YYY - 1900) * 12.3685) + 0.75
TT = kk / 1236.85
MS = 359.2242 + 29.10535608 * kk - 0.0000333 * TT ^ 2 - 0.00000347 * TT ^ 3
Do While Int(MS) > 360
MS = MS - 360
Loop
ML = 306.0253 + 385.81691806 * kk + 0.0107306 * TT ^ 2 + 0.00001236 * TT ^ 3
Do While Int(ML) > 360
ML = ML - 360
Loop
FF = 21.2964 + 390.67050646 * kk - 0.0016528 * TT ^ 2 - 0.00000239 * TT ^ 3
'Ultimo Quarto Precedente
UltimoQuartoPrecedente = 2415020.75933 + 29.53058868 * kk + 0.0001178 * (TT
^ 2) - 0.000000155 * (TT ^ 3) _
+ 0.00033 * Sin((166.56 + 132.87 * TT - 0.009173 * (T ^ 2)) * PG / 180) _
+ (0.1721 - 0.0004 * TT) * Sin(MS * PG / 180) + 0.0021 * Sin(2 * MS * PG /
180) _
- 0.628 * Sin(ML * PG / 180) + 0.0089 * Sin(2 * ML * PG / 180) - 0.0004 *
Sin(3 * ML * PG / 180) _
+ 0.0079 * Sin(2 * FF * PG / 180) - 0.0119 * Sin((MS + ML) * PG / 180) _
- 0.0047 * Sin((MS - ML) * PG / 180) + 0.0003 * Sin((2 * FF + MS) * PG /
180) - 0.0004 * Sin((2 * FF - MS) * PG / 180) _
- 0.0006 * Sin((2 * FF + ML) * PG / 180) + 0.0021 * Sin((2 * FF - ML) * PG
/ 180) _
+ 0.0003 * Sin((MS + 2 * ML) * PG / 180) + 0.0004 * Sin((MS - 2 * ML) * PG
/ 180) _
- 0.0003 * ((2 * MS + ML) * PG / 180) _
- 0.0028 + 0.0004 * Cos(MS * PG / 180) - 0.0003 * Cos(ML * PG / 180)
End Function
Function LunaNuova() As Variant
Dim YYY As Double, kk As Double, TT As Double, MS As Double, ML As Double,
FF As Double
YYY = Year(data) + DatePart("y", data) / 365
kk = RoundUp (((YYY - 1900) * 12.3685),0)
TT = kk / 1236.85
MS = 359.2242 + 29.10535608 * kk - 0.0000333 * TT ^ 2 - 0.00000347 * TT ^ 3
Do While Int(MS) > 360
MS = MS - 360
Loop
ML = 306.0253 + 385.81691806 * kk + 0.0107306 * TT ^ 2 + 0.00001236 * TT ^ 3
Do While Int(ML) > 360
ML = ML - 360
Loop
FF = 21.2964 + 390.67050646 * kk - 0.0016528 * TT ^ 2 - 0.00000239 * TT ^ 3
'Luna Nuova del mese
LunaNuova = 2415020.75933 + 29.53058868 * kk + 0.0001178 * (TT ^ 2) -
0.000000155 * (TT ^ 3) _
+ 0.00033 * Sin((166.56 + 132.87 * TT - 0.009173 * (T ^ 2)) * PG / 180) _
+ (0.1734 - (0.000393 * TT)) * Sin(MS * PG / 180) + 0.0021 * Sin(2 * MS *
PG / 180) _
- 0.4068 * Sin(ML * PG / 180) + 0.0161 * Sin(2 * ML * PG / 180) _
- 0.0004 * Sin(3 * ML * PG / 180) + 0.0104 * Sin(2 * FF * PG / 180) _
- 0.0051 * Sin((MS + ML) * PG / 180) - 0.0074 * Sin((MS - ML) * PG / 180) _
+ 0.0004 * Sin((2 * FF + MS) * PG / 180) - 0.0004 * Sin((2 * FF - MS) * PG
/ 180) _
- 0.0006 * Sin((2 * FF + ML) * PG / 180) + 0.001 * Sin((2 * FF - ML) * PG /
180) _
+ 0.0005 * Sin((MS + 2 * ML) * PG / 180)
print NDay(LunaNuova)
End Function
Function PrimoQuarto() As Variant
Dim YYY As Double, kk As Double, TT As Double, MS As Double, ML As Double,
FF As Double
YYY = Year(data) + DatePart("y", data) / 365
kk = Round((((YYY - 1900) * 12.3685) + 0.25),2)
TT = kk / 1236.85
MS = 359.2242 + 29.10535608 * kk - 0.0000333 * TT ^ 2 - 0.00000347 * TT ^ 3
Do While Int(MS) > 360
MS = MS - 360
Loop
ML = 306.0253 + 385.81691806 * kk + 0.0107306 * TT ^ 2 + 0.00001236 * TT ^ 3
Do While Int(ML) > 360
ML = ML - 360
Loop
FF = 21.2964 + 390.67050646 * kk - 0.0016528 * TT ^ 2 - 0.00000239 * TT ^ 3
'Primo Quarto
PrimoQuarto = 2415020.75933 + 29.53058868 * kk + 0.0001178 * (TT ^ 2) -
0.000000155 * (TT ^ 3) _
+ 0.00033 * Sin((166.56 + 132.87 * TT - 0.009173 * (T ^ 2)) * PG / 180) _
+ (0.1721 - 0.0004 * TT) * Sin(MS * PG / 180) + 0.0021 * Sin(2 * MS * PG /
180) _
- 0.628 * Sin(ML * PG / 180) + 0.0089 * Sin(2 * ML * PG / 180) - 0.0004 *
Sin(3 * ML * PG / 180) _
+ 0.0079 * Sin(2 * FF * PG / 180) - 0.0119 * Sin((MS + ML) * PG / 180) _
- 0.0047 * Sin((MS - ML) * PG / 180) + 0.0003 * Sin((2 * FF + MS) * PG /
180) - 0.0004 * Sin((2 * FF - MS) * PG / 180) _
- 0.0006 * Sin((2 * FF + ML) * PG / 180) + 0.0021 * Sin((2 * FF - ML) * PG
/ 180) _
+ 0.0003 * Sin((MS + 2 * ML) * PG / 180) + 0.0004 * Sin((MS - 2 * ML) * PG
/ 180) _
- 0.0003 * ((2 * MS + ML) * PG / 180) _
+ 0.0028 - 0.0004 * Cos(MS * PG / 180) + 0.0003 * Cos(ML * PG / 180)
printNDay(PrimoQuarto)
End Function
Function LunaPiena() As Variant
Dim YYY As Double, kk As Double, TT As Double, MS As Double, ML As Double,
FF As Double
YYY = Year(data) + DatePart("y", data) / 365
kk = Round((((YYY - 1900) * 12.3685) + 0.5),2)
TT = kk / 1236.85
MS = 359.2242 + 29.10535608 * kk - 0.0000333 * TT ^ 2 - 0.00000347 * TT ^ 3
Do While Int(MS) > 360
MS = MS - 360
Loop
ML = 306.0253 + 385.81691806 * kk + 0.0107306 * TT ^ 2 + 0.00001236 * TT ^ 3
Do While Int(ML) > 360
ML = ML - 360
Loop
FF = 21.2964 + 390.67050646 * kk - 0.0016528 * TT ^ 2 - 0.00000239 * TT ^ 3
'Prossima Luna Piena
LunaPiena = 2415020.75933 + 29.53058868 * kk + 0.0001178 * (TT ^ 2) -
0.000000155 * (TT ^ 3) _
+ 0.00033 * Sin((166.56 + 132.87 * TT - 0.009173 * (T ^ 2)) * PG / 180) _
+ (0.1734 - (0.000393 * TT)) * Sin(MS * PG / 180) + 0.0021 * Sin(2 * MS *
PG / 180) _
- 0.4068 * Sin(ML * PG / 180) + 0.0161 * Sin(2 * ML * PG / 180) _
- 0.0004 * Sin(3 * ML * PG / 180) + 0.0104 * Sin(2 * FF * PG / 180) _
- 0.0051 * Sin((MS + ML) * PG / 180) - 0.0074 * Sin((MS - ML) * PG / 180) _
+ 0.0004 * Sin((2 * FF + MS) * PG / 180) - 0.0004 * Sin((2 * FF - MS) * PG
/ 180) _
- 0.0006 * Sin((2 * FF + ML) * PG / 180) + 0.001 * Sin((2 * FF - ML) * PG /
180) _
+ 0.0005 * Sin((MS + 2 * ML) * PG / 180)
print NDay(LunaPiena)
End Function
Function UltimoQuarto() As Variant
Dim YYY As Double, kk As Double, TT As Double, MS As Double, ML As Double,
FF As Double
YYY = Year(data) + DatePart("y", data) / 365
kk = Round((((YYY - 1900) * 12.3685) + 0.75),2)
TT = kk / 1236.85
MS = 359.2242 + 29.10535608 * kk - 0.0000333 * TT ^ 2 - 0.00000347 * TT ^ 3
Do While Int(MS) > 360
MS = MS - 360
Loop
ML = 306.0253 + 385.81691806 * kk + 0.0107306 * TT ^ 2 + 0.00001236 * TT ^ 3
Do While Int(ML) > 360
ML = ML - 360
Loop
FF = 21.2964 + 390.67050646 * kk - 0.0016528 * TT ^ 2 - 0.00000239 * TT ^ 3
'Ultimo Quarto
UltimoQuarto = 2415020.75933 + 29.53058868 * kk + 0.0001178 * (TT ^ 2) -
0.000000155 * (TT ^ 3) _
+ 0.00033 * Sin((166.56 + 132.87 * TT - 0.009173 * (T ^ 2)) * PG / 180) _
+ (0.1721 - 0.0004 * TT) * Sin(MS * PG / 180) + 0.0021 * Sin(2 * MS * PG /
180) _
- 0.628 * Sin(ML * PG / 180) + 0.0089 * Sin(2 * ML * PG / 180) - 0.0004 *
Sin(3 * ML * PG / 180) _
+ 0.0079 * Sin(2 * FF * PG / 180) - 0.0119 * Sin((MS + ML) * PG / 180) _
- 0.0047 * Sin((MS - ML) * PG / 180) + 0.0003 * Sin((2 * FF + MS) * PG /
180) - 0.0004 * Sin((2 * FF - MS) * PG / 180) _
- 0.0006 * Sin((2 * FF + ML) * PG / 180) + 0.0021 * Sin((2 * FF - ML) * PG
/ 180) _
+ 0.0003 * Sin((MS + 2 * ML) * PG / 180) + 0.0004 * Sin((MS - 2 * ML) * PG
/ 180) _
- 0.0003 * ((2 * MS + ML) * PG / 180) _
- 0.0028 + 0.0004 * Cos(MS * PG / 180) - 0.0003 * Cos(ML * PG / 180)
print NDay(UltimoQuarto)
End Function
Function LunaNuovaSuccessiva() As Variant
Dim YYY As Double, kk As Double, TT As Double, MS As Double, ML As Double,
FF As Double
YYY = Year(data) + DatePart("y", data + 30) / 365
kk = RoundUp(((YYY - 1900) * 12.3685),0)
TT = kk / 1236.85
MS = 359.2242 + 29.10535608 * kk - 0.0000333 * TT ^ 2 - 0.00000347 * TT ^ 3
Do While Int(MS) > 360
MS = MS - 360
Loop
ML = 306.0253 + 385.81691806 * kk + 0.0107306 * TT ^ 2 + 0.00001236 * TT ^ 3
Do While Int(ML) > 360
ML = ML - 360
Loop
FF = 21.2964 + 390.67050646 * kk - 0.0016528 * TT ^ 2 - 0.00000239 * TT ^ 3
'Successiva Luna Nuova
LunaNuovaSuccessiva = 2415020.75933 + 29.53058868 * kk + 0.0001178 * (TT ^
2) - 0.000000155 * (TT ^ 3) _
+ 0.00033 * Sin((166.56 + 132.87 * TT - 0.009173 * (T ^ 2)) * PG / 180) _
+ (0.1734 - (0.000393 * TT)) * Sin(MS * PG / 180) + 0.0021 * Sin(2 * MS *
PG / 180) _
- 0.4068 * Sin(ML * PG / 180) + 0.0161 * Sin(2 * ML * PG / 180) _
- 0.0004 * Sin(3 * ML * PG / 180) + 0.0104 * Sin(2 * FF * PG / 180) _
- 0.0051 * Sin((MS + ML) * PG / 180) - 0.0074 * Sin((MS - ML) * PG / 180) _
+ 0.0004 * Sin((2 * FF + MS) * PG / 180) - 0.0004 * Sin((2 * FF - MS) * PG
/ 180) _
- 0.0006 * Sin((2 * FF + ML) * PG / 180) + 0.001 * Sin((2 * FF - ML) * PG /
180) _
+ 0.0005 * Sin((MS + 2 * ML) * PG / 180)
print NDay(LunaNuovaSuccessiva)
End Function
Function PrimoQuartoSuccessivo() As Variant
Dim YYY As Double, kk As Double, TT As Double, MS As Double, ML As Double,
FF As Double
YYY = Year(data) + DatePart("y", data + 30) / 365
kk = Round((((YYY - 1900) * 12.3685) + 0.25),2)
TT = kk / 1236.85
MS = 359.2242 + 29.10535608 * kk - 0.0000333 * TT ^ 2 - 0.00000347 * TT ^ 3
Do While Int(MS) > 360
MS = MS - 360
Loop
ML = 306.0253 + 385.81691806 * kk + 0.0107306 * TT ^ 2 + 0.00001236 * TT ^ 3
Do While Int(ML) > 360
ML = ML - 360
Loop
FF = 21.2964 + 390.67050646 * kk - 0.0016528 * TT ^ 2 - 0.00000239 * TT ^ 3
'Primo Quarto Successivo
PrimoQuartoSuccessivo = 2415020.75933 + 29.53058868 * kk + 0.0001178 * (TT
^ 2) - 0.000000155 * (TT ^ 3) _
+ 0.00033 * Sin((166.56 + 132.87 * TT - 0.009173 * (T ^ 2)) * PG / 180) _
+ (0.1721 - 0.0004 * TT) * Sin(MS * PG / 180) + 0.0021 * Sin(2 * MS * PG /
180) _
- 0.628 * Sin(ML * PG / 180) + 0.0089 * Sin(2 * ML * PG / 180) - 0.0004 *
Sin(3 * ML * PG / 180) _
+ 0.0079 * Sin(2 * FF * PG / 180) - 0.0119 * Sin((MS + ML) * PG / 180) _
- 0.0047 * Sin((MS - ML) * PG / 180) + 0.0003 * Sin((2 * FF + MS) * PG /
180) - 0.0004 * Sin((2 * FF - MS) * PG / 180) _
- 0.0006 * Sin((2 * FF + ML) * PG / 180) + 0.0021 * Sin((2 * FF - ML) * PG
/ 180) _
+ 0.0003 * Sin((MS + 2 * ML) * PG / 180) + 0.0004 * Sin((MS - 2 * ML) * PG
/ 180) _
- 0.0003 * ((2 * MS + ML) * PG / 180) _
+ 0.0028 - 0.0004 * Cos(MS * PG / 180) + 0.0003 * Cos(ML * PG / 180)
print NDay(PrimoQuartoSuccessivo)
End Function
Function LunaPienaSuccessiva() As Variant
Dim YYY As Double, kk As Double, TT As Double, MS As Double, ML As Double,
FF As Double
YYY = Year(data) + DatePart("y", data + 30) / 365
kk = Round((((YYY - 1900) * 12.3685) + 0.5),2)
TT = kk / 1236.85
MS = 359.2242 + 29.10535608 * kk - 0.0000333 * TT ^ 2 - 0.00000347 * TT ^ 3
Do While Int(MS) > 360
MS = MS - 360
Loop
ML = 306.0253 + 385.81691806 * kk + 0.0107306 * TT ^ 2 + 0.00001236 * TT ^ 3
Do While Int(ML) > 360
ML = ML - 360
Loop
FF = 21.2964 + 390.67050646 * kk - 0.0016528 * TT ^ 2 - 0.00000239 * TT ^ 3
'Luna Piena Successiva
LunaPienaSuccessiva = 2415020.75933 + 29.53058868 * kk + 0.0001178 * (TT ^
2) - 0.000000155 * (TT ^ 3) _
+ 0.00033 * Sin((166.56 + 132.87 * TT - 0.009173 * (T ^ 2)) * PG / 180) _
+ (0.1734 - (0.000393 * TT)) * Sin(MS * PG / 180) + 0.0021 * Sin(2 * MS *
PG / 180) _
- 0.4068 * Sin(ML * PG / 180) + 0.0161 * Sin(2 * ML * PG / 180) _
- 0.0004 * Sin(3 * ML * PG / 180) + 0.0104 * Sin(2 * FF * PG / 180) _
- 0.0051 * Sin((MS + ML) * PG / 180) - 0.0074 * Sin((MS - ML) * PG / 180) _
+ 0.0004 * Sin((2 * FF + MS) * PG / 180) - 0.0004 * Sin((2 * FF - MS) * PG
/ 180) _
- 0.0006 * Sin((2 * FF + ML) * PG / 180) + 0.001 * Sin((2 * FF - ML) * PG /
180) _
+ 0.0005 * Sin((MS + 2 * ML) * PG / 180)
print NDay(LunaPienaSuccessiva)
End Function
Function UltimoQuartoSuccessivo() As Variant
Dim YYY As Double, kk As Double, TT As Double, MS As Double, ML As Double,
FF As Double
YYY = Year(data) + DatePart("y", data + 30) / 365
kk = Round((((YYY - 1900) * 12.3685) + 0.75),2)
TT = kk / 1236.85
MS = 359.2242 + 29.10535608 * kk - 0.0000333 * TT ^ 2 - 0.00000347 * TT ^ 3
Do While Int(MS) > 360
MS = MS - 360
Loop
ML = 306.0253 + 385.81691806 * kk + 0.0107306 * TT ^ 2 + 0.00001236 * TT ^ 3
Do While Int(ML) > 360
ML = ML - 360
Loop
FF = 21.2964 + 390.67050646 * kk - 0.0016528 * TT ^ 2 - 0.00000239 * TT ^ 3
'Ultimo Quarto Successivo
UltimoQuartoSuccessivo = 2415020.75933 + 29.53058868 * kk + 0.0001178 * (TT
^ 2) - 0.000000155 * (TT ^ 3) _
+ 0.00033 * Sin((166.56 + 132.87 * TT - 0.009173 * (T ^ 2)) * PG / 180) _
+ (0.1721 - 0.0004 * TT) * Sin(MS * PG / 180) + 0.0021 * Sin(2 * MS * PG /
180) _
- 0.628 * Sin(ML * PG / 180) + 0.0089 * Sin(2 * ML * PG / 180) - 0.0004 *
Sin(3 * ML * PG / 180) _
+ 0.0079 * Sin(2 * FF * PG / 180) - 0.0119 * Sin((MS + ML) * PG / 180) _
- 0.0047 * Sin((MS - ML) * PG / 180) + 0.0003 * Sin((2 * FF + MS) * PG /
180) - 0.0004 * Sin((2 * FF - MS) * PG / 180) _
- 0.0006 * Sin((2 * FF + ML) * PG / 180) + 0.0021 * Sin((2 * FF - ML) * PG
/ 180) _
+ 0.0003 * Sin((MS + 2 * ML) * PG / 180) + 0.0004 * Sin((MS - 2 * ML) * PG
/ 180) _
- 0.0003 * ((2 * MS + ML) * PG / 180) _
- 0.0028 + 0.0004 * Cos(MS * PG / 180) - 0.0003 * Cos(ML * PG / 180)
print NDay(UltimoQuartoSuccessivo)
End Function
'______________________________________________________________________________________________________________________
Function Round( n2r as Double, optional ndec as integer ) as Double
'____________________________________________
Dim initFormat as string, decpart as string
'____________________________________________
initFormat = "####"
select case ndec
case 0
Round = cDbl(Format(n2r, initFormat))
case 1 to 9
decpart = "." & String(ndec, "#")
Round = cDbl(Format(n2r,initFormat & decpart))
End Select
End Function
'______________________________________________________________________________________________________________________
Function RoundUp (Numero As Double, Cifre As Integer) As Double
Dim oFunction
oFunction = CreateUnoService("com.sun.star.sheet.FunctionAccess")
RoundUp = oFunction.callFunction("ROUNDUP", Array(Numero, Cifre))
End Function
---------------------------------------------------------------------
To unsubscribe, e-mail: [EMAIL PROTECTED]
For additional commands, e-mail: [EMAIL PROTECTED]
