   ' Mondaufgang / Monduntergang als Ergnzung zu
   ' Keith Burnets users defined spreadsheet function called
   ' sunevent


Private Function range360(x)
range360 = x - 360 * Int(x / 360)
End Function


Private Sub minimoon(t As Double, RA As Double, dec As Double)

Dim nm As Double

kk = 3.14159265358979 / 180

julianischeDatum = t * 36525 + 2451545

d = julianischeDatum - 2451543.5
   
    nm = range360(125.1228 - 0.0529538083 * d)
    im = 5.1454
    wm = range360(318.0634 + 0.1643573223 * d)
    am = 60.2666  '(Earth radii)
    ecm = 0.0549
    Mm = range360(115.3654 + 13.0649929509 * d) 'M
    
    
    Enull = Mm + (180 / 3.14159265358979) * ecm * Sin(Mm * 3.14159265358979 / 180) * (1 + ecm * Cos(Mm * 3.14159265358979 / 180))
    
    Eeins = Enull - (Enull - (180 / 3.14159265358979) * ecm * Sin(Enull * 3.14159265358979 / 180) - Mm) / (1 - ecm * Cos(Enull * 3.14159265358979 / 180))
    
    Ezwei = Eeins - (Eeins - (180 / 3.14159265358979) * ecm * Sin(Eeins * 3.14159265358979 / 180) - Mm) / (1 - ecm * Cos(Eeins * 3.14159265358979 / 180))
    
    xx = am * (Cos(Ezwei * 3.14159265358979 / 180) - ecm)
    yy = am * Sqr(1 - ecm * ecm) * Sin(Ezwei * 3.14159265358979 / 180)
       
    
    xv = xx
    yv = yy
    
     vv = Atn(yy / xx) * 180 / 3.14159265358979
     If xx < 0 Then
     vv = 180 + vv
     End If
     vv = range360(vv)
         
    
    rr = Sqr(xx * xx + yy * yy)

    vm = vv

    rm = rr
    
    x = rm * (Cos(nm * kk) * Cos((vm + wm) * kk) - Sin(nm * kk) * Sin((vm + wm) * kk) * Cos(im * kk))
    Y = rm * (Sin(nm * kk) * Cos((vm + wm) * kk) + Cos(nm * kk) * Sin((vm + wm) * kk) * Cos(im * kk))
    Z = rm * (Sin(((vm + wm) * kk)) * Sin(im * kk))
 
        

    lon = Atn(Y / x) * 180 / 3.14159265358979
    
    If x < 0 Then
    lon = 180 + lon
     End If
    lon = range360(lon)
    
        
    lat = Atn(Z / Sqr(x * x + Y * Y)) * 180 / 3.14159265358979
       

  
    ws = range360(282.9404 + 0.0000470935 * d)
    Ms = range360(356.047 + 0.9856002585 * d)
    '   perturbations
    '   first calculate arguments below,
    'Ms, Mm             Mean Anomaly of the Sun and the Moon
    'Nm                 Longitude of the Moon's node
    'ws, wm             Argument of perihelion for the Sun and the Moon
    ls = Ms + ws       'Mean Longitude of the Sun  (Ns=0)
    lm = Mm + wm + nm  'Mean longitude of the Moon
    dm = lm - ls        'Mean elongation of the Moon
    F = lm - nm        'Argument of latitude for the Moon
    
       
            rm = rm - 0.58 * Cos((Mm - 2 * dm) * kk)
            rm = rm - 0.46 * Cos((2 * dm) * kk)


          moonr = rm
     
            dlat = -0.173 * Sin(kk * (F - 2 * dm))
            dlat = dlat - 0.055 * Sin(kk * (Mm - F - 2 * dm))
            dlat = dlat - 0.046 * Sin(kk * (Mm + F - 2 * dm))
            dlat = dlat + 0.033 * Sin(kk * (F + 2 * dm))
            dlat = dlat + 0.017 * Sin(kk * (2 * Mm + F))

          moonlat = lat + dlat
       

            dlon = -1.274 * Sin(kk * (Mm - 2 * dm))        '(the Evection)
            dlon = dlon + 0.658 * Sin(kk * (2 * dm))       '(the Variation)
            dlon = dlon - 0.186 * Sin(Ms * kk)           '(the Yearly Equation)
            dlon = dlon - 0.059 * Sin(kk * (2 * Mm - 2 * dm))
            dlon = dlon - 0.057 * Sin(kk * (Mm - 2 * dm + Ms))
            dlon = dlon + 0.053 * Sin(kk * (Mm + 2 * dm))
            dlon = dlon + 0.046 * Sin(kk * (2 * dm - Ms))
            dlon = dlon + 0.041 * Sin(kk * (Mm - Ms))
            dlon = dlon - 0.035 * Sin(kk * dm)           '(the Parallactic Equation)
            dlon = dlon - 0.031 * Sin(kk * (Mm + Ms))
            dlon = dlon - 0.015 * Sin(kk * (2 * F - 2 * dm))
            dlon = dlon + 0.011 * Sin(kk * (Mm - 4 * dm))

            moonlon = lon + dlon


    xmoon = moonr * Cos(moonlon * kk) * Cos(moonlat * kk)
    ymoon = moonr * Sin(moonlon * kk) * Cos(moonlat * kk)
    zmoon = moonr * Sin(moonlat * kk)

    xemoon = xmoon
    yemoon = ymoon * 0.917482061 - zmoon * 0.397777159
    zemoon = ymoon * 0.397777159 + zmoon * 0.917482061

    decmoon = Atn(zemoon / Sqr(xemoon * xemoon + yemoon * yemoon)) * 180 / 3.14159265358979


ramoon = Atn(yemoon / xemoon) * 180 / 3.14159265358979

If xemoon < 0 Then
    ramoon = 180 + ramoon
     End If
   ramoon = range360(ramoon)

ramoon = ramoon / 15

    
    decmoon2 = decmoon
    
    
    dec = decmoon

    RA = ramoon


End Sub





Private Function SinAltmun(mjd0 As Double, hour As Double, glong As Double, cglat As Double, sglat As Double) As Double

    Dim mjd As Double
    Dim t As Double
    Dim RA As Double
    Dim dec As Double
    Dim tau As Double
    Dim salt As Double
    Dim rads As Double
    rads = 0.0174532925
    mjd = mjd0 + hour / 24#
    t = (mjd - 51544.5) / 36525#
    Call minimoon(t, RA, dec)
    ' hour angle of object
    tau = 15# * (lmst(mjd, glong) - RA)
    ' sin(alt) of object using the conversion formulas
    salt = sglat * sin(rads * dec) + cglat * Cos(rads * dec) * Cos(rads * tau)
    SinAltmun = salt

End Function




Function moonevent(year As Integer, month As Integer, day As Integer, tz As Double, glong As Double, glat As Double, EventType As Integer) As String

    Dim sglong As Double, sglat As Double, cglat As Double, ddate As Double, ym As Double
    Dim yz As Double, above As Integer, utrise As Double, utset As Double
    Dim yp As Double, nz As Integer, rise As Integer, sett As Integer, j As Integer
    Dim hour As Double, z1 As Double, z2 As Double, rads As Double, xe As Double, ye As Double
    Dim AlwaysUp As String, AlwaysDown As String, OutString As String, NoEvent As String
    Dim sinho(5) As Double
    rads = 0.0174532925
    AlwaysUp = "****"
    AlwaysDown = "...."
    NoEvent = "----"
    

    sinho(1) = sin(rads * 0.15)     
    sinho(2) = sin(rads * -6#)        
    sinho(3) = sin(rads * -12#)      
    sinho(4) = sin(rads * -18#)       
    sglat = sin(rads * glat)
    cglat = Cos(rads * glat)
    ddate = mjd(year, month, day) - tz / 24

    j = Abs(EventType)
        nz = 0
        z1 = 0
        z2 = 0
        xe = 0
        ye = 0
        rise = 0
        sett = 0
        above = 0
        hour = 1#
        ym = SinAltmun(ddate, hour - 1#, glong, cglat, sglat) - sinho(j)
        If (ym > 0#) Then above = 1
        
        Do While (hour < 25 And (sett = 0 Or rise = 0))
            yz = SinAltmun(ddate, hour, glong, cglat, sglat) - sinho(j)
            yp = SinAltmun(ddate, hour + 1#, glong, cglat, sglat) - sinho(j)
            Call quad(ym, yz, yp, nz, z1, z2, xe, ye)
            
            If (nz = 1) Then
                If (ym < 0#) Then
                    utrise = hour + z1
                    rise = 1
                Else
                    utset = hour + z1
                    sett = 1
                End If
            End If ' end of nz = 1 case
           
            If (nz = 2) Then
                If (ye < 0#) Then
                    utrise = hour + z2
                    utset = hour + z1
                Else
                    utrise = hour + z1
                    utset = hour + z2
                End If
            rise = 1
            sett = 1
            End If
            
            ym = yp
            hour = hour + 2#

        Loop ' end of while loop
            
        If (rise = 1 Or sett = 1) Then
            If (rise = 1) Then
                If (EventType > 0) Then OutString = hrsmin(utrise)
            Else
                If (EventType > 0) Then OutString = NoEvent
            End If
            If (sett = 1) Then
                If (EventType < 0) Then OutString = hrsmin(utset)
            Else
                If (EventType < 0) Then OutString = NoEvent
            End If
        Else
            If (above = 1) Then
                OutString = AlwaysUp
            Else
                OutString = AlwaysDown
            End If
        End If
        moonevent = OutString
End Function




Function moonrise(ddate As Date, tz As Double, glong As Double, glat As Double) As Double

    Dim EventTime As Double, hour As Double, minfrac As Double
    Dim out As String
    out = moonevent(year(ddate), month(ddate), day(ddate), tz, glong, glat, 1)
    If (out = "...." Or out = "----" Or out = "****") Then
        EventTime = Null
    Else
        hour = Fix(Val(out) / 100)
        minfrac = (Val(out) - 100 * hour) / 60
        hour = hour + minfrac
        hour = hour / 24
        EventTime = hour
    End If
    moonrise = EventTime
End Function



Function moonset(ddate As Date, tz As Double, glong As Double, glat As Double) As Double

    Dim EventTime As Double, hour As Double, minfrac As Double
    Dim out As String
    out = moonevent(year(ddate), month(ddate), day(ddate), tz, glong, glat, -1)
    If (out = "...." Or out = "----" Or out = "****") Then
        EventTime = Null
    Else
        hour = Fix(Val(out) / 100)
        minfrac = (Val(out) - 100 * hour) / 60
        hour = hour + minfrac
        hour = hour / 24
        EventTime = hour
    End If
    moonset = EventTime
End Function








