'   A series of astronomical functions which may be
'   useful. These are all 'user defined functions'.
'   This means that you can paste them into spreadsheets
'   just like the normal functions - see Insert|function,
'   you can even use the function wizard.

'   The disadvantage
'   of Excel's 'user defined functions' is that they
'   can only return a single value, and the function cannot alter
'   the properties of the worksheet. Arguments you pass to
'   the VBA functions you define are passed 'by value'.

'   However, VBA defaults to 'passing arguments by reference'
'   when a function is called from another VBA function! This
'   can lead to a function giving a different answer when
'   called in the VBA module compared with when called in the
'   spreadsheet. Use the ByVal keyword to tag arguments you
'   change later in functions. See smoon() for an example.

'   define some numerical constants - these are not
'   accessible in the spreadsheet.

Public Const pi As Double = 3.14159265358979
Public Const tpi As Double = 6.28318530717958
Public Const degs  As Double = 57.2957795130823
Public Const rads As Double = 1.74532925199433E-02

'   The trig formulas working in degrees. This just
'   makes the spreadsheet formulas a bit easier to
'   read. DegAtan2() has had the arguments swapped
'   from the Excel order, so the order matches most
'   textbooks

Function DegSin(x As Double) As Double
    DegSin = Sin(rads * x)
End Function

Function DegCos(x As Double) As Double
    DegCos = Cos(rads * x)
End Function

Function DegTan(x As Double) As Double
    DegTan = Tan(rads * x)
End Function

Function DegArcsin(x As Double) As Double
    DegArcsin = degs * Application.Asin(x)
End Function

Function DegArccos(x As Double) As Double
     DegArccos = degs * Application.Acos(x)
End Function

Function DegArctan(x As Double) As Double
    DegArctan = degs * Atn(x)
End Function

Function DegAtan2(Y As Double, x As Double) As Double
'   this returns the angle in the range 0 to 360
'   instead of -180 to 180 - and swaps the arguments
'   This format matches Meeus and Duffett-Smith
    DegAtan2 = degs * Application.Atan2(x, Y)
    If DegAtan2 < 0 Then DegAtan2 = DegAtan2 + 360
End Function

Private Function range2pi(x)
'
'   returns an angle x in the range 0 to two pi rads
'   This function is not available in the spreadsheet
'
range2pi = x - tpi * Int(x / tpi)
End Function

Private Function range360(x)
'
'   returns an angle x in the range 0 to 360
'   used to prevent the huge values of degrees
'   that you get from mean longitude formulas
'
'   this function is private to this module,
'   you won't find it in the Function Wizard,
'   and you can't use it on a spreadsheet.
'   If you want it on the spreadsheet, just remove
'   the 'private' keyword above.
'
range360 = x - 360 * Int(x / 360)
End Function

Function degdecimal(d, m, s)
'   converts from dms format to ddd format
    degdecimal = d + m / 60 + s / 3600
End Function

'
'   calander functions. jday and jcentury work on the Julian day numbers.
'   day2000 and century2000 work on the days to J2000 to reduce the
'   number of significant figures needed
'

Function jday(year As Integer, month As Integer, day As Integer, hour As Integer, _
 min As Integer, sec As Double, Optional greg) As Double
 '  returns julian day number given date in gregorian calender (greg=1)
 '  or julian calendar (greg = 0). If greg ommited, then Gregorian is assumed.
    Dim A As Double
    Dim b As Integer
    A = 10000# * year + 100# * month + day
    If (A < -47120101) Then MsgBox "Warning: date too early for algorithm"
    If (IsMissing(greg)) Then greg = 1
    If (month <= 2) Then
        month = month + 12
        year = year - 1
    End If
    If (greg = 0) Then
        b = -2 + Fix((year + 4716) / 4) - 1179
    Else
        b = Fix(year / 400) - Fix(year / 100) + Fix(year / 4)
    End If
    A = 365# * year + 1720996.5
    jday = A + b + Fix(30.6001 * (month + 1)) + day + (hour + min / 60 + sec / 3600) / 24
End Function

Function jcentury(JD As Double) As Double
'   finds how many julian centuries since J2000 given
'    the julian day number. Not used below, I just add
'   a line into the subroutines which then take days
'   before J2000 as the time argument
    jcentury = (JD - 2451545) / 36525
End Function

Function day2000(year As Integer, month As Integer, day As Integer, hour As Integer, _
 min As Integer, sec As Double, Optional greg) As Double
 '  returns days before J2000.0 given date in gregorian calender (greg=1)
 '  or julian calendar (greg = 0). If you don't provide a value for greg,
 '  then assumed Gregorian calender
    Dim A As Double
    Dim b As Integer
    If (IsMissing(greg)) Then greg = 1
    A = 10000# * year + 100# * month + day
    If (month <= 2) Then
        month = month + 12
        year = year - 1
    End If
    If (greg = 0) Then
        b = -2 + Fix((year + 4716) / 4) - 1179
    Else
        b = Fix(year / 400) - Fix(year / 100) + Fix(year / 4)
    End If
    A = 365# * year - 730548.5
    day2000 = A + b + Fix(30.6001 * (month + 1)) + day + (hour + min / 60 + sec / 3600) / 24
End Function

Function century2000(day2000 As Double) As Double
'   finds how many julian centuries since J2000 given
'   the days before J2000
    century2000 = day2000 / 36525
End Function

'
'   Conversion to and from rectangular and polar coordinates.
'   X,Y,Z form a left handed set of axes, and r is the radius vector
'   of the point from the origin. Theta is the elevation angle of
'   r with the XY plane, and phi is the angle anti-clockwise from the
'   X axis and the projection of r in the X,Y plane.
'
'   in astronomical coordinate systems,
'
'   item    equatorial          ecliptic (helio or geo centric)
'   z       celestial pole      ecliptic pole
'   x,y     equatorial plane    ecliptic
'   theta   declination         latitude
'   phi     right ascension     longitude
'

Function rectangular(r As Double, theta As Double, phi As Double, _
 index As Integer) As Double
 '  takes spherical coordinates in degrees and returns the rectangular
 '  coordinate shown by index, 1 = x, 2 = y, 3 = z
 '
 '  x = r.cos(theta).cos(phi)
 '  y = r.cos(theta).sin(phi)
 '  z = r.sin(theta)
 '
    Dim r_cos_theta As Double
    r_cos_theta = r * DegCos(theta)
    Select Case index
        Case 1
            rectangular = r_cos_theta * DegCos(phi) 'returns x coord
        Case 2
            rectangular = r_cos_theta * DegSin(phi) 'returns y coord
        Case 3
            rectangular = r * DegSin(theta)         'returns z coord
    End Select
End Function

Function rlength(x As Double, Y As Double, Z As Double) As Double
'   returns radius vector given the rectangular coords
    rlength = Sqr(x * x + Y * Y + Z * Z)
End Function

Function spherical(x As Double, Y As Double, Z As Double, index As Integer) As Double
'
'   Takes the rectangular coordinates and returns the shperical
'   coordinate selected by index - 1 = r, 2 = theta, 3 = phi
'
'   r = sqrt(x*x + y*y + z*z)
'   tan(phi) = y/x - use atan2 to get in correct quadrant
'   tan(theta) = z/sqrt(x*x + y*y) - likewise
'
    Dim RHO As Double
    RHO = x * x + Y * Y
        Select Case index
        Case 1
            spherical = Sqr(RHO + Z * Z)    'returns r
        Case 2
            RHO = Sqr(RHO)
            spherical = DegArctan(Z / RHO)    'returns theta
        Case 3
            RHO = Sqr(RHO)
            spherical = DegAtan2(Y, x)      'returns phi
    End Select
End Function

'
'   returns the obliquity of the ecliptic in degrees given the number
'   of julian centuries from J2000
'
'   Most textbooks will give the IAU formula for the obliquity of
'   the ecliptic below;
'
'   obliquity = 23.43929111 - 46.8150"t - 0.00059"t^2 + 0.001813*t^3
'
'   as explained in Meeus or Numerical Recipes, it is more efficient and
'   accurate to use the nested brackets shown in the function. If you
'   multiply the brackets out, they come to the same.
'
Function obliquity(d As Double) As Double
    Dim T As Double
    T = d / 36525   'julian centuries since J2000.0
    obliquity = 23.43929111 - (46.815 + (0.00059 - 0.001813 * T) * T) * T / 3600#
End Function

'
'   functions for converting between equatorial and ecliptic
'   geocentric coordinates, both polar and rectangular coords
'

'
'   Converts geocentric ecliptic coordinates into geocentric equatorial
'   coordinates. Expects rectangular coordinates.
'
Function requatorial(x As Double, Y As Double, Z As Double, d As Double, _
 index As Integer) As Double
    Dim obl As Double
    obl = obliquity(d)
    Select Case index
        Case 1
            requatorial = x
        Case 2
            requatorial = Y * DegCos(obl) - Z * DegSin(obl)
        Case 3
            requatorial = Y * DegSin(obl) + Z * DegCos(obl)
    End Select
End Function
'
'   converts geocentric equatorial coordinates into geocentric ecliptic
'   coordinates. Expects rectangular coordinates.
'
Function recliptic(x As Double, Y As Double, Z As Double, d As Double, _
 index As Integer) As Double
    Dim obl As Double
    obl = obliquity(d)
    Select Case index
        Case 1
            recliptic = x
        Case 2
            recliptic = Y * DegCos(obl) + Z * DegSin(obl)
        Case 3
            recliptic = -Y * DegSin(obl) + Z * DegCos(obl)
    End Select
End Function

'
'   Converts geocentric ecliptic coordinates into geocentric equatorial
'   coordinates. Expects spherical coordinates.
'
Function sequatorial(r As Double, theta As Double, phi As Double, d As Double, _
 index As Integer) As Double
    Dim x As Double, Y As Double, Z As Double
    x = rectangular(r, theta, phi, 1)
    Y = rectangular(r, theta, phi, 2)
    Z = rectangular(r, theta, phi, 3)
    sequatorial = spherical(requatorial(x, Y, Z, d, 1), requatorial(x, Y, Z, d, 2), _
     requatorial(x, Y, Z, d, 3), index)
End Function

'   Converts geocentric equatorial coordinates into geocentric ecliptic
'   coordinates. Expects spherical coordinates.
'
Function secliptic(r As Double, theta As Double, phi As Double, d As Double, _
 index As Integer) As Double
    Dim x As Double, Y As Double, Z As Double
    x = rectangular(r, theta, phi, 1)
    Y = rectangular(r, theta, phi, 2)
    Z = rectangular(r, theta, phi, 3)
    secliptic = spherical(recliptic(x, Y, Z, d, 1), recliptic(x, Y, Z, d, 2), _
    recliptic(x, Y, Z, d, 3), index)
End Function
'
'   precession (approximate formula) from Meeus Algorithms p124
'   d1 is the epoch to precess from, d2 is the epoch to precess
'   to, and index selects ra or dec. The function takes optional
'   arguments dra and ddec to represent the proper motion of a
'   star in seconds of arc per year.
'
'   ra and dec must BOTH be in decimal degrees. This formula is
'   different to the one elsewhere on the Web site!
'
Function precess(d1 As Double, d2 As Double, dec As Double, _
                    RA As Double, index As Integer, _
                    Optional ddec, Optional dra) As Double
Dim m As Double, N As Double, T As Double
If (IsMissing(dra)) Then dra = 0
If (IsMissing(ddec)) Then ddec = 0
T = d1 / 36525          'years since J2000
m = 0.01281233333333 + 0.00000775 * T
N = 0.005567527777778 - 2.361111111111E-06 * T
T = (d2 - d1) / 365.25   'difference in julian _years_, not centuries!
Select Case index
    Case 1      'dec
        precess = dec + (N * DegCos(RA) + ddec / 3600) * T
    Case 2      'ra
        precess = RA + (m + N * DegSin(RA) * DegTan(dec) + dra / 3600) * T
End Select
End Function
'
'   The function below returns the geocentric ecliptic coordinates of the sun
'   to an accuracy corresponding to about 0.01 degree over
'   100 years either side of J2000. Coordinates returned
'   in spherical form. From page C24 of the 1996 Astronomical
'   Alamanac. Comparing accuracy with Planeph, a DOS ephemeris
'   by Chapront, we get;
'
'   Sun error
'                       RA sec    DEC arcsec
'   Max within 3 year     0.6        8.9
'   Min within 3 year    -2.1       -8.2
'   Max within 10 year    0.6       10.9
'   Min within 10 year   -2.6      -12.5
'   Max within 50 year    1.0       16.8
'   Min within 50 year   -2.9      -16.1
'
'   Error = C24 low precision method - Planeph
'
'   Note: Planeph was set to give output referred to mean
'         ecliptic and equinox of date.
'
'   The accuracy of this routine is good enough for sunrise
'   and shadow direction calculations, and for referring
'   low precision planetary and comet positions to the Earth,
'   but is no good for accurate coordinate conversion or
'   for eclipse or occultation use.
'
'   Coordinates are referred to the ecliptic and mean equinox of date
'
Function ssun(d As Double, index As Integer) As Double
    Dim g As Double
    Dim L As Double
    g = range360(357.528 + 0.9856003 * d)
    L = range360(280.461 + 0.9856474 * d)
    Select Case index
        Case 1
            ' radius vector of Sun
            ssun = 1.00014 - 0.01671 * DegCos(g) - 0.00014 * DegCos(2 * g)
        Case 2
            ssun = 0    'ecliptic latitude of Sun is zero to very good accuracy
        Case 3
            'longitude of Sun
            ssun = range360(L + 1.915 * DegSin(g) + 0.02 * DegSin(2 * g))
    End Select
End Function

'   returns the geocentric ecliptic coordinates of the sun
'   to an accuracy corresponding to about 0.01 degree over
'   100 years either side of J2000. Assumes ssun() exists.
'
'   rectangular form is easier for converting positions from helio-
'   centric to geocentric, but beware low accuracy (roughly 0.01 degree)
'   of values
'
Function rsun(d As Double, index As Integer) As Double
    Dim x As Double
    Dim Y As Double
    Dim Z As Double
    rsun = rectangular(ssun(d, 1), ssun(d, 2), ssun(d, 3), index)
End Function
'
'   sun() returns the geocentric ra and dec and radius vector
'   of the moon - calls smoon three times, and sequatorial
'   three times - sequatorial calls rectangular three times
'   each!
'
Function sun(d As Double, index As Integer) As Double
    sun = sequatorial(ssun(d, 1), ssun(d, 2), ssun(d, 3), d, index)
End Function
'
'   The function below implements Paul Schlyter's simplification
'   of van Flandern and Pulkkinen's method for finding the geocentric
'   ecliptic positions of the Moon to an accuracy of about 1 to 4 arcmin.
'
'   I can probably reduce the number of variables, and there must
'   be a quicker way of declaring variables!
'
'   The VBA trig functions have been used throughout for speed,
'   note how the atan function returns values in domain -pi to pi
'
Function smoon(ByVal d As Double, index As Integer) As Double
    Dim nm As Double, im As Double, wm As Double, am As Double, ecm As Double, _
    mm As Double, em As Double, Ms As Double, ws As Double, xv As Double, _
    yv As Double, vm As Double, rm As Double, x As Double, Y As Double, _
    Z As Double, lon As Double, lat As Double, ls As Double, lm As Double, _
    dm As Double, F As Double, dlong As Double, dlat As Double
    '   Paul's routine uses a slightly different definition of
    '   the day number - I adjust for it below. Remember that VBA
    '   defaults to 'pass by reference' so this change in d
    '   will be visible to other functions unless you set d to 'ByVal'
    '   to force it to be passed by value!
    d = d + 1.5
    '   moon elements
    nm = range360(125.1228 - 0.0529538083 * d) * rads
    im = 5.1454 * rads
    wm = range360(318.0634 + 0.1643573223 * d) * rads
    am = 60.2666  '(Earth radii)
    ecm = 0.0549
    mm = range360(115.3654 + 13.0649929509 * d) * rads
    '   position of Moon
    em = mm + ecm * Sin(mm) * (1# + ecm * Cos(mm))
    xv = am * (Cos(em) - ecm)
    yv = am * (Sqr(1# - ecm * ecm) * Sin(em))
    vm = Application.Atan2(xv, yv)
    '   If vm < 0 Then vm = tpi + vm
    rm = Sqr(xv * xv + yv * yv)
    x = rm * (Cos(nm) * Cos(vm + wm) - Sin(nm) * Sin(vm + wm) * Cos(im))
    Y = rm * (Sin(nm) * Cos(vm + wm) + Cos(nm) * Sin(vm + wm) * Cos(im))
    Z = rm * (Sin(vm + wm) * Sin(im))
    '   moons geocentric long and lat
    lon = Application.Atan2(x, Y)
    If lon < 0 Then lon = tpi + lon
    lat = Atn(Z / Sqr(x * x + Y * Y))
    '   mean longitude of sun
    ws = range360(282.9404 + 0.0000470935 * d) * rads
    Ms = range360(356.047 + 0.9856002585 * d) * rads
    '   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
    ' then add the following terms to the longitude
    ' note amplitudes are in degrees, convert at end
    Select Case index
        Case 1  '   distance terms earth radii
            rm = rm - 0.58 * Cos(mm - 2 * dm)
            rm = rm - 0.46 * Cos(2 * dm)
            smoon = rm
        Case 2  '   latitude terms
            dlat = -0.173 * Sin(F - 2 * dm)
            dlat = dlat - 0.055 * Sin(mm - F - 2 * dm)
            dlat = dlat - 0.046 * Sin(mm + F - 2 * dm)
            dlat = dlat + 0.033 * Sin(F + 2 * dm)
            dlat = dlat + 0.017 * Sin(2 * mm + F)
            smoon = lat * degs + dlat
        Case 3  '   longitude terms
            dlon = -1.274 * Sin(mm - 2 * dm)        '(the Evection)
            dlon = dlon + 0.658 * Sin(2 * dm)       '(the Variation)
            dlon = dlon - 0.186 * Sin(Ms)           '(the Yearly Equation)
            dlon = dlon - 0.059 * Sin(2 * mm - 2 * dm)
            dlon = dlon - 0.057 * Sin(mm - 2 * dm + Ms)
            dlon = dlon + 0.053 * Sin(mm + 2 * dm)
            dlon = dlon + 0.046 * Sin(2 * dm - Ms)
            dlon = dlon + 0.041 * Sin(mm - Ms)
            dlon = dlon - 0.035 * Sin(dm)           '(the Parallactic Equation)
            dlon = dlon - 0.031 * Sin(mm + Ms)
            dlon = dlon - 0.015 * Sin(2 * F - 2 * dm)
            dlon = dlon + 0.011 * Sin(mm - 4 * dm)
            smoon = lon * degs + dlon
    End Select
End Function
'
'   rmoon uses smoon to return the geocentric ecliptic rectangular coordinates
'   of the moon to lowish accuracy.
'
'
Function rmoon(d As Double, index As Integer) As Double
    rmoon = rectangular(smoon(d, 1), smoon(d, 2), smoon(d, 3), index)
End Function
'
'   moon() returns the geocentric ra and dec and radius vector
'   of the moon - calls smoon three times, and sequatorial
'   three times - sequatorial calls rectangular three times
'   each!
'
Function moon(d As Double, index As Integer) As Double
Dim nigel As Double
    If index = 4 Then
        nigel = smoon(d, 2)
        moon = d
    Else
        moon = sequatorial(smoon(d, 1), smoon(d, 2), smoon(d, 3), d, index)
    End If
End Function
'
'   Solutions of the kepler equation using a Newton's method approach.
'   See Meeus or Duffett-Smith (calculator)
'
Function kepler(m As Double, ecc As Double, Optional eps)
'   solves the equation e - ecc*sin(e) = m for e given an m
'   returns the value of the 'true anomaly' in rads
'   m  -  the 'mean anomaly' in rads
'   ecc - the eccentricity of the orbit
'   eps - the precision parameter - solution will be
'         within 10^-eps of the true value.
'         don't set eps above 14, as convergence
'         can't be guaranteed. If not specified, then
'         taken as 10^-8 or 10 nano radians!
'
    Dim delta As Double, e As Double, V As Double
    
    e = m               'first guess
    delta = 0.05        'set delta equal to a dummy value
    If (IsMissing(eps)) Then eps = 8                'if no eps then assume 10^-8
    Do While Abs(delta) >= 10 ^ -eps             'converged?
        delta = e - ecc * Sin(e) - m                'new error
        e = e - delta / (1 - ecc * Cos(e))          'corrected guess
    Loop
    V = 2 * Atn(((1 + ecc) / (1 - ecc)) ^ 0.5 * Tan(0.5 * e))
    If V < 0 Then V = V + tpi
    kepler = V
End Function
'
'   The functions below return the heliocentric ecliptic coordinates
'   of the planets to an accuracy of a few minutes of arc. The coordinates
'   are referred to the equinox of J2000.0
'
'   The functions use a simple Kepler ellipse, but with
'   mean elements which change slightly with the time since
'   J2000. See 'Explanatory supplement to the Astronomical
'   Almanac' 1992, page 316, table 5.8.1. Worst case errors
'   over the period 1800 - 2050 AD in arcsec are below;
'
'                    Ra      Dec
'   Mercury          20"      5"
'   Venus            20"      5"
'   Earth            20"      5"
'   Mars             25"     30"
'   Jupiter         300"    100"
'   Saturn          600"    200"
'   Uranus           60"     25"
'   Neptune          40"     20"
'   Pluto            40"     10"
'

'
'   The rplanet() function returns the ecliptic heliocentric coordinates
'   of each of the major planets. You select the planet you want using
'   pnumber, and the coordinate you want with index as usual.
'
Function rplanet(d As Double, pnumber As Integer, index As Integer) As Double
    Dim x As Double, Y As Double, Z As Double, V As Double, m As Double, _
    i As Double, o As Double, p As Double, A As Double, e As Double, _
    L As Double, r As Double
    '
    '   get elements of the planet
    '
    element i, o, p, A, e, L, d, pnumber
    '
    '   position of planet in its orbit
    '
    m = range2pi(L - p)
    V = kepler(m, e, 8)
    r = A * (1 - e * e) / (1 + e * Cos(V))
    '
    '   heliocentric rectangular coordinates of planet
    '
    Select Case index
    Case 1      'x coordinate
        rplanet = r * (Cos(o) * Cos(V + p - o) - Sin(o) * Sin(V + p - o) * Cos(i))
    Case 2      'y coordinate
        rplanet = r * (Sin(o) * Cos(V + p - o) + Cos(o) * Sin(V + p - o) * Cos(i))
    Case 3      'z coordinate
        rplanet = r * (Sin(V + p - o) * Sin(i))
    End Select
End Function
'
'
'   The planet() function returns the equatorial geocentric coordinates
'   of each of the major planets. You select the planet you want using
'   pnumber, and the coordinate you want with index as usual. Code is
'   duplicated from rplanet() to reduce the number of calls to kepler()
'
'
Function planet(d As Double, pnumber As Integer, index As Integer) As Double
    Dim x As Double, Y As Double, Z As Double, V As Double, m As Double, _
    i As Double, o As Double, p As Double, A As Double, e As Double, _
    L As Double, r As Double, xe As Double, ye As Double, ze As Double, _
    s1 As Double, si As Double, so As Double, c1 As Double, ci As Double, _
    co As Double
    '
    '   elements of planet - select from the values
    '
    element i, o, p, A, e, L, d, pnumber
    '
    '   position of planet in its orbit
    '
    m = range2pi(L - p)
    V = kepler(m, e, 8)
    r = A * (1 - e * e) / (1 + e * Cos(V))
    '
    '   heliocentric rectangular coordinates of planet
    '
    s1 = Sin(V + p - o)
    si = Sin(i)
    so = Sin(o)
    c1 = Cos(V + p - o)
    ci = Cos(i)
    co = Cos(o)
    x = r * (co * c1 - so * s1 * ci)
    Y = r * (so * c1 + co * s1 * ci)
    Z = r * (s1 * si)
    '
    '   elements of earth (reusing variables)
    '
    element i, o, p, A, e, L, d, 3
    '
    '   position of earth in its orbit
    '
    m = range2pi(L - p)
    V = kepler(m, e, 8)
    r = A * (1 - e * e) / (1 + e * Cos(V))
    '
    '   heliocentric rectangular coordinates of earth
    '
    s1 = Sin(V + p - o)
    si = Sin(i)
    so = Sin(o)
    c1 = Cos(V + p - o)
    ci = Cos(i)
    co = Cos(o)
    xe = r * (co * c1 - so * s1 * ci)
    ye = r * (so * c1 + co * s1 * ci)
    ze = r * (s1 * si)
    '
    '   convert to geocentric rectangular coordinates
    '
    x = x - xe
    Y = Y - ye
    '   z = z
    '
    '   rotate around x axis from ecliptic to equatorial coords
    '
    ecl = 23.429292 * rads      'value for J2000.0 frame
    xe = x
    ye = Y * Cos(ecl) - Z * Sin(ecl)
    ze = Y * Sin(ecl) + Z * Cos(ecl)
    '
    '   find the RA and DEC from the rectangular equatorial coords
    '
    Select Case index
    Case 3
        ' RA in degrees
        planet = Application.Atan2(xe, ye) * degs
        If planet < 0 Then planet = 360 + planet
    Case 2
        ' DEC in degrees
        planet = Atn(ze / Sqr(xe * xe + ye * ye)) * degs
    Case 1
        ' Radius vector in au
        planet = Sqr(xe * xe + ye * ye + ze * ze)
    End Select
End Function
'
'   The subroutine below replaces the values of i,o,p,a,e,L
'   with the values for the planet selected by pnum. You could
'   always add planet like objects, but watch the value of
'   the inclination i. The method used in planet is only
'   good for orbits 'near' the ecliptic.
'
Sub element(i As Double, o As Double, p As Double, _
            A As Double, e As Double, L As Double, _
            ByVal d As Double, ByVal pnum As Integer)
    Select Case pnum
        Case 1          'mercury
            i = (7.00487 - 0.000000178797 * d) * rads
            o = (48.33167 - 0.0000033942 * d) * rads
            p = (77.45645 + 0.00000436208 * d) * rads
            A = 0.38709893 + 1.80698E-11 * d
            e = 0.20563069 + 0.000000000691855 * d
            L = range2pi(rads * (252.25084 + 4.092338796 * d))
        Case 2          'venus
            i = (3.39471 - 0.0000000217507 * d) * rads
            o = (76.68069 - 0.0000075815 * d) * rads
            p = (131.53298 - 0.000000827439 * d) * rads
            A = 0.72333199 + 2.51882E-11 * d
            e = 0.00677323 - 0.00000000135195 * d
            L = range2pi(rads * (181.97973 + 1.602130474 * d))
        Case 3          'earth
            i = (0.00005 - 0.000000356985 * d) * rads
            o = (-11.26064 - 0.00013863 * d) * rads
            p = (102.94719 + 0.00000911309 * d) * rads
            A = 1.00000011 - 1.36893E-12 * d
            e = 0.01671022 - 0.00000000104148 * d
            L = range2pi(rads * (100.46435 + 0.985609101 * d))
        Case 4          'mars
            i = (1.85061 - 0.000000193703 * d) * rads
            o = (49.57854 - 0.0000077587 * d) * rads
            p = (336.04084 + 0.00001187 * d) * rads
            A = 1.52366231 - 0.000000001977 * d
            e = 0.09341233 - 0.00000000325859 * d
            L = range2pi(rads * (355.45332 + 0.524033035 * d))
        Case 5          'jupiter
            i = (1.3053 - 0.0000000315613 * d) * rads
            o = (100.55615 + 0.00000925675 * d) * rads
            p = (14.75385 + 0.00000638779 * d) * rads
            A = 5.20336301 + 0.0000000166289 * d
            e = 0.04839266 - 0.00000000352635 * d
            L = range2pi(rads * (34.40438 + 0.083086762 * d))
        Case 6          'saturn
            i = (2.48446 + 0.0000000464674 * d) * rads
            o = (113.71504 - 0.0000121 * d) * rads
            p = (92.43194 - 0.0000148216 * d) * rads
            A = 9.53707032 - 0.0000000825544 * d
            e = 0.0541506 - 0.0000000100649 * d
            L = range2pi(rads * (49.94432 + 0.033470629 * d))
        Case 7          'uranus
            i = (0.76986 - 0.0000000158947 * d) * rads
            o = (74.22988 + 0.0000127873 * d) * rads
            p = (170.96424 + 0.0000099822 * d) * rads
            A = 19.19126393 + 0.0000000416222 * d
            e = 0.04716771 - 0.00000000524298 * d
            L = range2pi(rads * (313.23218 + 0.011731294 * d))
        Case 8          'neptune
            i = (1.76917 - 0.0000000276827 * d) * rads
            o = (131.72169 - 0.0000011503 * d) * rads
            p = (44.97135 - 0.00000642201 * d) * rads
            A = 30.06896348 - 0.0000000342768 * d
            e = 0.00858587 + 0.000000000688296 * d
            L = range2pi(rads * (304.88003 + 0.0059810572 * d))
        Case 9          'pluto
            i = (17.14175 + 0.0000000841889 * d) * rads
            o = (110.30347 - 0.0000002839 * d) * rads
            p = (224.06676 - 0.00000100578 * d) * rads
            A = 39.48168677 - 0.0000000210574 * d
            e = 0.24880766 + 0.00000000177002 * d
            L = range2pi(rads * (238.92881 + 3.97557152635181E-03 * d))
    End Select
End Sub




'
'   This module contains a user defined spreadsheet function called
'   sunevent(year, month, day, glong, glat, tz,event) that returns the
'   time of day of sunrise, sunset, or the beginning and end one of
'   three kinds of twilight
'
'   The method used here is adapted from Montenbruck and Pfleger's
'   Astronomy on the Personal Computer, 3rd Ed, section 3.8
'
'   the arguments for the function are as follows...
'   year, month, day - your date in zone time
'   glong - your longitude in degrees, west negative
'   glat - your latitude in degrees, north positive
'   tz - your time zone in decimal hours, west or 'behind' Greenwich negative
'   event - a code integer representing the event you want as follows
'       positive integers mean rising events
'       negative integers mean setting events
'       1 = sunrise                 -1  = sunset
'       2 = begin civil twilight    -2  = end civil twilight
'       3 = begin nautical twi      -3  = end nautical twi
'       4 = begin astro twi         -4  = end astro twi
'
'   the results are returned as a variant with either a time of day
'   in zone time or a string reporting an 'event not occuring' condition
'   event not occuring can be one of the following
'       .....    always below horizon, so no rise or set
'       *****    always above horizon, so no rise or set
'       -----    the particular rise or set event does not occur on that day
'
'   The function will produce meaningful results at all latitudes
'   but there will be a small range of latitudes around 67.43 degrees North or South
'   when the function might indicate a sunrise very close to noon (or a sunset
'   very soon after noon) where in fact the Sun is below the horizon all day
'   this behaviour relates to the approximate Sun position formulas in use
'
'   As always, the sunrise / set times relate to an earth which is smooth
'   and has no large obstructions on the horizon - you might get a close
'   approximation to this at sea but rarely on land. Accuracy more than 1 min
'   of time is not worth striving for - atmospheric refraction alone can
'   alter observed rise times by minutes
'
'   The module also defines a series of 'named funtions' based on sunevent()
'   as follows
'   astrotwilightstarts(date, tz, glong, glat)
'   nauticaltwilightstarts(date, tz, glong, glat)
'   civiltwilightstarts(date, tz, glong, glat)
'   sunrise(date, tz, glong, glat)
'   sunset(date, tz, glong, glat)
'   civiltwilightends(date, tz, glong, glat)
'   nauticaltwilightends(date, tz, glong, glat)
'   astrotwilightends(date, tz, glong, glat)
'
'   these functions  take a date in Excel date format and return times in
'   Excel time format (ie a day fraction) if there is an event on the day
'   If there isn't an event on the day, then you get #VALUE!
'   These functions lend themselves to plotting sunrise and set times on
'   charts - just multiply output in 'number' format by 24 to get the decimal
'   hours for the event
'
Private Function mjd(year As Integer, month As Integer, day As Integer) As Double
'
'   takes the year, month and day as a Gregorian calendar date
'   and returns the modified julian day number
'
    Dim A As Double
    Dim b As Double
    
    If (month <= 2) Then
        month = month + 12
        year = year - 1
        End If
    b = Fix(year / 400) - Fix(year / 100) + Fix(year / 4)
    A = 365# * year - 679004#
    mjd = A + b + Fix(30.6001 * (month + 1)) + day
End Function


Private Function frac(x As Double) As Double
'
'  returns the fractional part of x as used in minimoon and minisun
'
    Dim A As Double
    A = x - Fix(x)
    frac = A
End Function

Private Function range(x As Double) As Double
'
'   returns an angle in degrees in the range 0 to 360
'   used to condition the arguments for the Sun's orbit
'   in function minisun below
'
    Dim A As Double
    Dim b As Double
    b = x / 360
    A = 360 * (b - Fix(b))
    If (A < 0) Then
        A = A + 360
        End If
    range = A
End Function

Private Function hrsmin(T As Double) As String
'
'   takes a time as a decimal number of hours between 0 and 23.9999...
'   and returns a string with the time in hhmm format
'
    Dim hour As Double
    Dim min As Double
    hour = Fix(T)
    min = Fix((T - hour) * 60 + 0.5)
    hrsmin = Format(hour, "00") + Format(min, "00")
End Function


Private Function lmst(mjd As Double, glong As Double) As Double
'
'  Takes the mjd and the longitude (west negative) and then returns
'  the local sidereal time in hours. Im using Meeus formula 11.4
'  instead of messing about with UTo and so on
'
    Dim lst As Double
    Dim T As Double
    Dim d As Double
    d = mjd - 51544.5
    T = d / 36525#
    lst = range(280.46061837 + 360.98564736629 * d + 0.000387933 * T * T - T * T * T / 38710000)
    lmst = lst / 15# + glong / 15
End Function
    
Private Sub minisun(T As Double, RA As Double, dec As Double)
'
'   takes t (julian centuries since J2000.0) and empty variables ra and dec
'   sets ra and dec to the value of the Sun coordinates at t
'
'   positions claimed to be within 1 arc min by Montenbruck and Pfleger
'
   Dim longitude_soleil As Double
Dim longitude_vraie_soleil As Double
Dim longitude_apparente_soleil As Double
Dim anomalie_soleil As Double
Dim anomalie_vraie_soleil As Double
Dim excentricite_orbite_terre As Double
Dim centre_soleil As Double
Dim obliquite_ecliptique As Double
Dim declinaison_soleil As Double
Dim ascension_soleil As Double
     
    
     sjulien = T
     
     
    
     
   jd1 = T * 36525 + 2451545
   
   es = (jd1 - 2415020) / 36525



a1 = 153.23 + 22518.7541 * es
a2 = 216.57 + 45037.5082 * es
a3 = 312.69 + 32964.3577 * es
a4 = 350.74 + 445267.1142 * es - 0.00144 * es * es
a5 = 231.19 + 20.2 * es

b1 = 0.00134 * Cos(a1 * 3.14159265358979 / 180)
b2 = 0.00154 * Cos(a2 * 3.14159265358979 / 180)
b3 = 0.002 * Cos(a3 * 3.14159265358979 / 180)
b4 = 0.00179 * Sin(a4 * 3.14159265358979 / 180)
b5 = 0.00178 * Sin(a5 * 3.14159265358979 / 180)

bges = b1 + b2 + b3 + b4 + b5
     
     
     

    longitude_soleil = 280.46645 + (36000.76983 * sjulien) + (0.0003032 * sjulien ^ 2)
    longitude_soleil = range(longitude_soleil)

    anomalie_soleil = 357.5291 + (35999.0503 * sjulien) - (0.0001559 * sjulien ^ 2) - (0.00000048 * sjulien ^ 3)
    anomalie_soleil = range(anomalie_soleil)

    excentricite_orbite_terre = 0.01670817 - (0.000042037 * sjulien) - (0.0000001236 * sjulien ^ 2)
                       
    centre_soleil = ((1.9146 - (0.004817 * sjulien) - _
                    (0.000014 * sjulien ^ 2)) * Sin((3.1415926535 / 180) * (anomalie_soleil))) + _
                    ((0.019993 - (0.000101 * sjulien)) * Sin((3.1415926535 / 180) * (2 * anomalie_soleil))) + _
                    (0.00029 * Sin((3.1415926535 / 180) * (3 * anomalie_soleil)))
    
    centre_soleil = range(centre_soleil)

        anomalie_vraie_soleil = anomalie_soleil + centre_soleil
    
    anomalie_vraie_soleil = range(anomalie_vraie_soleil)

        longitude_vraie_soleil = longitude_soleil + centre_soleil
    
    longitude_vraie_soleil = range(longitude_vraie_soleil)

        longitude_apparente_soleil = longitude_vraie_soleil - 0.00569 - _
                    0.00478 * Sin((3.1415926535 / 180) * (125.04 - (1934.136 * sjulien))) + bges
    
    longitude_apparente_soleil = range(longitude_apparente_soleil)

        obliquite_ecliptique = 23.43929111 - (0.01300417 * sjulien) - (0.000001639 * sjulien ^ 2) + _
                    (0.0000005036 * sjulien ^ 3)
    
    obliquite_ecliptique = range(obliquite_ecliptique)

        ascension_soleilx = Cos((3.1415926535 / 180) * obliquite_ecliptique) * Sin((3.1415926535 / 180) * longitude_vraie_soleil)
                      
        ascension_soleilY = Cos((3.1415926535 / 180) * longitude_vraie_soleil)
                  
                                  
                          
     
  
  decx = Sin((3.1415926535 / 180) * obliquite_ecliptique) * Sin((3.1415926535 / 180) * (longitude_vraie_soleil))
  
  dec = Atn(decx / Sqr(1 - decx * decx)) * 180 / 3.14159265358979


    
ascension_soleil = Atn(ascension_soleilx / ascension_soleilY) * 180 / 3.14159265358979

If ascension_soleilY < 0 Then
   ascension_soleil = 180 + ascension_soleil
End If
     
RA = range(ascension_soleil) / 15

RA = RA
dec = dec


End Sub


Private Sub quad(ym As Double, yz As Double, yp As Double, nz As Integer, z1 As Double, z2 As Double, xe As Double, ye As Double)
'
'  finds the parabola throuh the three points (-1,ym), (0,yz), (1, yp)
'  and sets the coordinates of the max/min (if any) xe, ye
'  the values of x where the parabola crosses zero (z1, z2)
'  and the nz number of roots (0, 1 or 2) within the interval [-1, 1]
'
    Dim A As Double
    Dim b As Double
    Dim c As Double
    Dim dis As Double
    Dim dx As Double

    nz = 0
    A = 0.5 * (ym + yp) - yz
    b = 0.5 * (yp - ym)
    c = yz
    xe = -b / (2 * A)
    ye = (A * xe + b) * xe + c
    dis = b * b - 4# * A * c
    If (dis > 0) Then
        dx = 0.5 * Sqr(dis) / Abs(A)
        z1 = xe - dx
        z2 = xe + dx
        If (Abs(z1) <= 1#) Then nz = nz + 1
        If (Abs(z2) <= 1#) Then nz = nz + 1
        If (z1 < -1#) Then z1 = z2
        End If
End Sub





Private Function SinAltSun(mjd0 As Double, hour As Double, glong As Double, cglat As Double, sglat As Double) As Double
'
'  this rather mickey mouse function takes a lot of
'  arguments and then returns the sine of the altitude of
'  the object labelled by iobj. iobj = 1 is moon, iobj = 2 is sun
'
    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 minisun(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)
    SinAltSun = salt
End Function

'
'   Worksheet functions below....
'
    
Function sunevent(year As Integer, month As Integer, day As Integer, tz As Double, glong As Double, glat As Double, EventType As Integer) As String
'
'   This is the function that does most of the work
'
    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 = "----"
    
'
'   Set up the array with the 4 values of sinho needed for the 4
'   kinds of sun event
'
    sinho(1) = Sin(rads * -0.833)     'sunset upper limb simple refraction
    sinho(2) = Sin(rads * -6#)        'civil twi
    sinho(3) = Sin(rads * -12#)       'nautical twi
    sinho(4) = Sin(rads * -18#)       'astro twi
    sglat = Sin(rads * glat)
    cglat = Cos(rads * glat)
    ddate = mjd(year, month, day) - tz / 24
'
'   main loop takes each value of sinho in turn and finds the rise/set
'   events associated with that altitude of the Sun
'
    j = Abs(EventType)
        nz = 0
        z1 = 0
        z2 = 0
        xe = 0
        ye = 0
        rise = 0
        sett = 0
        above = 0
        hour = 1#
        ym = SinAltSun(ddate, hour - 1#, glong, cglat, sglat) - sinho(j)
        If (ym > 0#) Then above = 1
        '
        '  the while loop finds the sin(alt) for sets of three consecutive
        '  hours, and then tests for a single zero crossing in the interval
        '  or for two zero crossings in an interval or for a grazing event
        '  The flags rise and sett are set accordingly
        '
        Do While (hour < 25 And (sett = 0 Or rise = 0))
            yz = SinAltSun(ddate, hour, glong, cglat, sglat) - sinho(j)
            yp = SinAltSun(ddate, hour + 1#, glong, cglat, sglat) - sinho(j)
            Call quad(ym, yz, yp, nz, z1, z2, xe, ye)
            ' case when one event is found in the interval
            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
            '
            '   case where two events are found in this interval
            '   (rare but whole reason we are not using simple iteration)
            '
            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
            '
            '   set up the next search interval
            '
            ym = yp
            hour = hour + 2#

        Loop ' end of while loop
            '
            ' now search has completed, we compile the string to pass back
            ' to the user. The string depends on several combinations
            ' of the above flag (always above or always below) and the rise
            ' and sett flags
            '
        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
        sunevent = OutString
End Function

Function sunrise(ddate As Date, tz As Double, glong As Double, glat As Double) As Double
'
'   simple way of calling sunevent() using the Excel date format
'   returns just the sunrise time or NULL if no event
'   I used the day(), month() and year() functions in excel to allow
'   portability to the MAC (different date serial numbers)
'
    Dim EventTime As Double, hour As Double, minfrac As Double
    Dim out As String
    out = sunevent(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
    sunrise = EventTime
End Function

Function sunset(ddate As Date, tz As Double, glong As Double, glat As Double) As Double
'
'   simple way of calling sunevent() using the Excel date format
'   returns just the sunset time or ****, ...., ---- as approptiate in a string
'   I used the day(), month() and year() functions in excel to allow
'   portability to the MAC (different date serial number base)
'
    Dim EventTime As Double, hour As Double, minfrac As Double
    Dim out As String
    out = sunevent(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
    sunset = EventTime
End Function

Function CivilTwilightStarts(ddate As Date, tz As Double, glong As Double, glat As Double) As Double
'
'   simple way of calling sunevent() using the Excel date format
'   returns just the start of civil twilight time or ****, ...., ---- as approptiate
'   I used the day(), month() and year() functions in excel to allow
'   portability to the MAC (different date serial numbers)
'
    Dim EventTime As Double, hour As Double, minfrac As Double
    Dim out As String
    out = sunevent(year(ddate), month(ddate), day(ddate), tz, glong, glat, 2)
    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
    CivilTwilightStarts = EventTime
End Function

Function CivilTwilightEnds(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 = sunevent(year(ddate), month(ddate), day(ddate), tz, glong, glat, -2)
    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
    CivilTwilightEnds = EventTime
    End Function

Function NauticalTwilightStarts(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 = sunevent(year(ddate), month(ddate), day(ddate), tz, glong, glat, 3)
    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
    NauticalTwilightStarts = EventTime
End Function

Function NauticalTwilightEnds(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 = sunevent(year(ddate), month(ddate), day(ddate), tz, glong, glat, -3)
    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
    NauticalTwilightEnds = EventTime
End Function

Function AstroTwilightStarts(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 = sunevent(year(ddate), month(ddate), day(ddate), tz, glong, glat, 4)
    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
    AstroTwilightStarts = EventTime
End Function

Function AstroTwilightEnds(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 = sunevent(year(ddate), month(ddate), day(ddate), tz, glong, glat, -4)
    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
    AstroTwilightEnds = EventTime
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

Function JD(Jahr As Integer, monat As Integer, tag As Integer, stunde As Integer, _
 min As Integer, sec As Double, Zeitzone As Integer) As Double
 '  Umwandlung ins julianische Datum JD
    
    Dim A As Double
    Dim b As Integer
    
    If monat > 2 Then
    monat = monat
    Jahr = Jahr
    End If
    
    If monat <= 2 Then
    monat = monat + 12
    Jahr = Jahr - 1
    End If
    
    A = Fix(Jahr / 100)
    b = 2 - A + Fix(A / 4)
    
    JD = Fix(365.25 * (Jahr + 4716)) + Fix(30.6001 * (monat + 1)) + tag + b + ((stunde + min / 60 + sec / 3600) / 24) - 1524.5
    
    JD = JD - Zeitzone / 24
    
    
End Function
Private Function rang(x As Double) As Double
'
'  Winkelbereich: 0 ... 360

    Dim A As Double
    Dim b As Double
    b = x / 360
    A = 360 * (b - Fix(b))
    If (A < 0) Then
        A = A + 360
        End If
    rang = A
End Function


Function SternzeitLokal(JD As Double, Lnge As Double) As Double

'  lmst = lokale Sternzeit

'  west =  negative

    Dim lst As Double
    Dim T As Double
    Dim d As Double
    Dim mjd As Double
    
  mjd = JD - 2400000.5
  d = mjd - 51544.5
  T = (d / 36525)
  lst = rang(280.46061837 + 360.98564736629 * d + 0.000387933 * T * T - T * T * T / 38710000)
  SternzeitLokal = (lst / 15) + (Lnge / 15)

  SternzeitLokal = SternzeitLokal * 15
  SternzeitLokal = rang(SternzeitLokal)

End Function

Function SternzeitGreenwich(JD As Double) As Double

'  gmst = Greenwich Sternzeit

'  West =  negativ   Ost = positiv

       
 Dim d As Double
    
  
  d = (JD - 2451545) / 36525
  
  gst = rang(280.46061837 + 360.98564736629 * (JD - 2451545) + 0.000387933 * d * d - d * d * d / 38710000)
  
   SternzeitGreenwich = (gst / 15)

   SternzeitGreenwich = SternzeitGreenwich * 15
   SternzeitGreenwich = rang(SternzeitGreenwich)
  
  

End Function
Function SternzeitGreenwichUT(Jahr As Integer, monat As Integer, tag As Integer) As Double

'  gmst = Greenwich Sternzeit 0 Uhr UT

      
   Dim d As Double
 
   Dim A As Double
   Dim b As Double
   Dim JD As Double
    
    If monat > 2 Then
    monat = monat
    Jahr = Jahr
    End If
    
    If monat <= 2 Then
    monat = monat + 12
    Jahr = Jahr - 1
    End If
    
    A = Fix(Jahr / 100)
    b = 2 - A + Fix(A / 4)
    
    JD = Fix(365.25 * (Jahr + 4716)) + Fix(30.6001 * (monat + 1)) + tag + b - 1524.5
    
       
       
  d = (JD - 2451545) / 36525
  
  SternzeitGreenwichUT = rang(100.46061837 + 36000.770053608 * d + 0.000387933 * d * d - d * d * d / 38710000)
  
 SternzeitGreenwichUT = rang(SternzeitGreenwichUT)
 
 

End Function





 Function Winkelzeit(T As Double) As Date

'   Winkelbereich 0 ..360  nach Zeitformat hh:min:sec

    
    T = T / (15 * 24)
    Winkelzeit = T
    
End Function

Function Ekliptik(JD As Double) As Double

   Dim T As Double
    T = (JD - 2451545) / 36525
    T = 23.43929111 - (46.815 / 3600) * T - (0.00059 / 3600) * T * T + (0.001813 / 3600) * T * T * T
 Ekliptik = T
    
End Function



Function Stundenwinkel(GMST As Double, Lnge As Double, RA As Double) As Double

'Stdw = Stundenwinkel H
'Lnge  = positive Zhlung nach Osten

Stundenwinkel = rang(GMST - (360 - Lnge) - RA)
    
End Function

Function hhe(Stdw As Double, Breite As Double, dek As Double) As Double

Dim h As Double
h = Sin(dek * 3.14159265358979 / 180) * Sin(Breite * 3.14159265358979 / 180) + Cos(Breite * 3.14159265358979 / 180) * Cos(dek * 3.14159265358979 / 180) * Cos(Stdw * 3.14159265358979 / 180)
hhe = Application.Asin(h) * 180 / 3.14159265358979
End Function
    
Function AzimutS(Stdw As Double, Breite As Double, dek As Double) As Double
'  Azimutzhlung mit Sd = 0


Dim A As Double
Dim b As Double
Dim c As Double
A = Sin(Stdw * 3.14159265358979 / 180)
b = Cos(Stdw * 3.14159265358979 / 180) * Sin(Breite * 3.14159265358979 / 180) - Tan(dek * 3.14159265358979 / 180) * Cos(Breite * 3.14159265358979 / 180)

c = Application.Atan2(b, A) * 180 / 3.14159265358979

If c < 0 Then c = c + 360 Else
AzimutS = c
End Function
Function AzimutN(Stdw As Double, Breite As Double, dek As Double) As Double
'  Azimutzhlung mit Nord = 0


Dim A As Double
Dim b As Double
Dim c As Double
A = Sin(Stdw * 3.14159265358979 / 180)
b = Cos(Stdw * 3.14159265358979 / 180) * Sin(Breite * 3.14159265358979 / 180) - Tan(dek * 3.14159265358979 / 180) * Cos(Breite * 3.14159265358979 / 180)

c = Application.Atan2(b, A) * 180 / 3.14159265358979 + 180

If c < 0 Then c = c + 360 Else

AzimutN = c

End Function

Function Refraktion(hhe As Double) As Double

'  Refraktion von  -1 bis 90


Dim r As Double
     
     
   
    r = 1 / (Tan((hhe + 7.31 / (hhe + 4.4)) * 3.14159265358979 / 180)) + 0.0013515
    r = r / 60
    
    If hhe < -1 Then r = 0
    
    Refraktion = hhe - r
   

    
End Function

Function RefraktionWahreHhe(hhe As Double) As Double

'  Refraktion von  -1 bis 90


Dim r As Double
     
     
   
    r = (1.02 / (Tan((hhe + 10.3 / (hhe + 5.11)) * 3.14159265358979 / 180)))
    
    r = (r / 60)
    
    If hhe < -1 Then r = 0
    
    RefraktionWahreHhe = hhe + r
   

    
End Function


Function RFWinkelpos(W As Double) As Double
'
'  Winkelbereich: 0 ... 360

    Dim A As Double
    Dim b As Double
    b = W / 360
    A = 360 * (b - Fix(b))
    If (A < 0) Then
        A = A + 360
        End If
    RFWinkelpos = A
End Function

Function RFWinkelneg(W As Double) As Double
'
'  Winkelbereich: 0 ... -360 bzw. 0 .... 360

    Dim A As Double
    Dim b As Double
    Dim c As Double
    
    A = W / 360
    b = Fix(W / 360)
    c = (A - b) * 360
         
    RFWinkelneg = c
    
End Function

Function Weltzeit(Ortszeit As Double, Zeitzone As Double) As Double
'
'  von Ortszeit nach Weltzeit UT

    Dim A As Double
    Dim b As Double
    
    A = Zeitzone / 24
    b = Ortszeit - A
    If b < 0 Then b = 1 + b
    Weltzeit = b
    
    
End Function

Function DatumWeltzeit(Ortszeit As Double, Ortsdatum As Double, Zeitzone As Double) As Double
'
'  von Ortsdatum nach Weltzeit-Datum UT

    Dim A As Double
    Dim b As Double
    
    A = Zeitzone / 24
    b = Ortszeit - A
    
    If b < 0 Then
    b = -1
    End If
    
    If b > 1 Then
    b = 1
    End If
    
    If Abs(b) <> 1 Then
    b = 0
    End If
    
    DatumWeltzeit = Ortsdatum + b
    
    
End Function

Function Ortszeit(Weltzeit As Double, Zeitzone As Double) As Double
'
'  von UT nach Ortszeit

    Dim A As Double
    Dim b As Double
    
    A = Zeitzone / 24
    b = Weltzeit + A
    If b < 0 Then b = 1 + b
    Ortszeit = b
    
    
End Function


Function Ortsdatum(Weltzeit As Double, Weltzeitdatum As Double, Zeitzone As Double) As Double
'
'  von Weltzeitdatum nach Datum UT

     Dim A As Double
    Dim b As Double
    
    A = Zeitzone / 24
    b = Weltzeit + A
    
    If b < 0 Then
    b = -1
    End If
    
    If b > 1 Then
    b = 1
    End If
    
    If Abs(b) <> 1 Then
    b = 0
    End If
    
    Ortsdatum = Weltzeitdatum + b
    
    
End Function

Function ExzentrischeAnomalie(m As Double, e As Double) As Double

'Lsung der Kepler-Gleichung

Dim A As Double


A = m + e * (180 / 3.14159265358979) * Sin(m * 3.14159265358979 / 180) * (1 + e * Cos(m * 3.14159265358979 / 180))
A = A - (A - e * (180 / 3.14159265358979) * Sin(A * 3.14159265358979 / 180) - m) / (1 - e * Cos(A * 3.14159265358979 / 180))
A = A + e * (180 / 3.14159265358979) * Sin(0 * 3.14159265358979 / 180) * (1 + e * Cos(A * 3.14159265358979 / 180))
A = A - (A - e * (180 / 3.14159265358979) * Sin(A * 3.14159265358979 / 180) - m) / (1 - e * Cos(A * 3.14159265358979 / 180))
A = A + e * (180 / 3.14159265358979) * Sin(0 * 3.14159265358979 / 180) * (1 + e * Cos(A * 3.14159265358979 / 180))
A = A - (A - e * (180 / 3.14159265358979) * Sin(A * 3.14159265358979 / 180) - m) / (1 - e * Cos(A * 3.14159265358979 / 180))
A = A + e * (180 / 3.14159265358979) * Sin(0 * 3.14159265358979 / 180) * (1 + e * Cos(A * 3.14159265358979 / 180))
A = A - (A - e * (180 / 3.14159265358979) * Sin(A * 3.14159265358979 / 180) - m) / (1 - e * Cos(A * 3.14159265358979 / 180))
A = A + e * (180 / 3.14159265358979) * Sin(0 * 3.14159265358979 / 180) * (1 + e * Cos(A * 3.14159265358979 / 180))
A = A - (A - e * (180 / 3.14159265358979) * Sin(A * 3.14159265358979 / 180) - m) / (1 - e * Cos(A * 3.14159265358979 / 180))
A = A + e * (180 / 3.14159265358979) * Sin(0 * 3.14159265358979 / 180) * (1 + e * Cos(A * 3.14159265358979 / 180))
A = A - (A - e * (180 / 3.14159265358979) * Sin(A * 3.14159265358979 / 180) - m) / (1 - e * Cos(A * 3.14159265358979 / 180))
A = A + e * (180 / 3.14159265358979) * Sin(0 * 3.14159265358979 / 180) * (1 + e * Cos(A * 3.14159265358979 / 180))
A = A - (A - e * (180 / 3.14159265358979) * Sin(A * 3.14159265358979 / 180) - m) / (1 - e * Cos(A * 3.14159265358979 / 180))
A = A + e * (180 / 3.14159265358979) * Sin(0 * 3.14159265358979 / 180) * (1 + e * Cos(A * 3.14159265358979 / 180))
A = A - (A - e * (180 / 3.14159265358979) * Sin(A * 3.14159265358979 / 180) - m) / (1 - e * Cos(A * 3.14159265358979 / 180))
A = A + e * (180 / 3.14159265358979) * Sin(0 * 3.14159265358979 / 180) * (1 + e * Cos(A * 3.14159265358979 / 180))
A = A - (A - e * (180 / 3.14159265358979) * Sin(A * 3.14159265358979 / 180) - m) / (1 - e * Cos(A * 3.14159265358979 / 180))
A = A + e * (180 / 3.14159265358979) * Sin(0 * 3.14159265358979 / 180) * (1 + e * Cos(A * 3.14159265358979 / 180))
A = A - (A - e * (180 / 3.14159265358979) * Sin(A * 3.14159265358979 / 180) - m) / (1 - e * Cos(A * 3.14159265358979 / 180))
A = A + e * (180 / 3.14159265358979) * Sin(0 * 3.14159265358979 / 180) * (1 + e * Cos(A * 3.14159265358979 / 180))
A = A - (A - e * (180 / 3.14159265358979) * Sin(A * 3.14159265358979 / 180) - m) / (1 - e * Cos(A * 3.14159265358979 / 180))
A = A + e * (180 / 3.14159265358979) * Sin(0 * 3.14159265358979 / 180) * (1 + e * Cos(A * 3.14159265358979 / 180))
A = A - (A - e * (180 / 3.14159265358979) * Sin(A * 3.14159265358979 / 180) - m) / (1 - e * Cos(A * 3.14159265358979 / 180))
A = A + e * (180 / 3.14159265358979) * Sin(0 * 3.14159265358979 / 180) * (1 + e * Cos(A * 3.14159265358979 / 180))
A = A - (A - e * (180 / 3.14159265358979) * Sin(A * 3.14159265358979 / 180) - m) / (1 - e * Cos(A * 3.14159265358979 / 180))
 
A = A / 360
b = Fix(A)
c = A - b
d = 360 * c

If d < 0 Then
d = 360 + d
End If

ExzentrischeAnomalie = d


End Function



Function WahreAnomalie(m As Double, e As Double) As Double

Dim A As Double
Dim i As Double
Dim j As Double
Dim k As Double
Dim L As Double
Dim o As Double
Dim N As Double


A = m + e * (180 / 3.14159265358979) * Sin(m * 3.14159265358979 / 180) * (1 + e * Cos(m * 3.14159265358979 / 180))
A = A - (A - e * (180 / 3.14159265358979) * Sin(A * 3.14159265358979 / 180) - m) / (1 - e * Cos(A * 3.14159265358979 / 180))
A = A + e * (180 / 3.14159265358979) * Sin(0 * 3.14159265358979 / 180) * (1 + e * Cos(A * 3.14159265358979 / 180))
A = A - (A - e * (180 / 3.14159265358979) * Sin(A * 3.14159265358979 / 180) - m) / (1 - e * Cos(A * 3.14159265358979 / 180))
A = A + e * (180 / 3.14159265358979) * Sin(0 * 3.14159265358979 / 180) * (1 + e * Cos(A * 3.14159265358979 / 180))
A = A - (A - e * (180 / 3.14159265358979) * Sin(A * 3.14159265358979 / 180) - m) / (1 - e * Cos(A * 3.14159265358979 / 180))
A = A + e * (180 / 3.14159265358979) * Sin(0 * 3.14159265358979 / 180) * (1 + e * Cos(A * 3.14159265358979 / 180))
A = A - (A - e * (180 / 3.14159265358979) * Sin(A * 3.14159265358979 / 180) - m) / (1 - e * Cos(A * 3.14159265358979 / 180))
A = A + e * (180 / 3.14159265358979) * Sin(0 * 3.14159265358979 / 180) * (1 + e * Cos(A * 3.14159265358979 / 180))
A = A - (A - e * (180 / 3.14159265358979) * Sin(A * 3.14159265358979 / 180) - m) / (1 - e * Cos(A * 3.14159265358979 / 180))
A = A + e * (180 / 3.14159265358979) * Sin(0 * 3.14159265358979 / 180) * (1 + e * Cos(A * 3.14159265358979 / 180))
A = A - (A - e * (180 / 3.14159265358979) * Sin(A * 3.14159265358979 / 180) - m) / (1 - e * Cos(A * 3.14159265358979 / 180))
A = A + e * (180 / 3.14159265358979) * Sin(0 * 3.14159265358979 / 180) * (1 + e * Cos(A * 3.14159265358979 / 180))
A = A - (A - e * (180 / 3.14159265358979) * Sin(A * 3.14159265358979 / 180) - m) / (1 - e * Cos(A * 3.14159265358979 / 180))
A = A + e * (180 / 3.14159265358979) * Sin(0 * 3.14159265358979 / 180) * (1 + e * Cos(A * 3.14159265358979 / 180))
A = A - (A - e * (180 / 3.14159265358979) * Sin(A * 3.14159265358979 / 180) - m) / (1 - e * Cos(A * 3.14159265358979 / 180))
A = A + e * (180 / 3.14159265358979) * Sin(0 * 3.14159265358979 / 180) * (1 + e * Cos(A * 3.14159265358979 / 180))
A = A - (A - e * (180 / 3.14159265358979) * Sin(A * 3.14159265358979 / 180) - m) / (1 - e * Cos(A * 3.14159265358979 / 180))
A = A + e * (180 / 3.14159265358979) * Sin(0 * 3.14159265358979 / 180) * (1 + e * Cos(A * 3.14159265358979 / 180))
A = A - (A - e * (180 / 3.14159265358979) * Sin(A * 3.14159265358979 / 180) - m) / (1 - e * Cos(A * 3.14159265358979 / 180))
A = A + e * (180 / 3.14159265358979) * Sin(0 * 3.14159265358979 / 180) * (1 + e * Cos(A * 3.14159265358979 / 180))
A = A - (A - e * (180 / 3.14159265358979) * Sin(A * 3.14159265358979 / 180) - m) / (1 - e * Cos(A * 3.14159265358979 / 180))
A = A + e * (180 / 3.14159265358979) * Sin(0 * 3.14159265358979 / 180) * (1 + e * Cos(A * 3.14159265358979 / 180))
A = A - (A - e * (180 / 3.14159265358979) * Sin(A * 3.14159265358979 / 180) - m) / (1 - e * Cos(A * 3.14159265358979 / 180))
A = A + e * (180 / 3.14159265358979) * Sin(0 * 3.14159265358979 / 180) * (1 + e * Cos(A * 3.14159265358979 / 180))
A = A - (A - e * (180 / 3.14159265358979) * Sin(A * 3.14159265358979 / 180) - m) / (1 - e * Cos(A * 3.14159265358979 / 180))
 
A = A / 360
b = Fix(A)
c = A - b
d = 360 * c

If d < 0 Then
d = 360 + d
End If


k = Sqr((1 + e) / (1 - e))
L = Tan((d / 2) * 3.14159265358979 / 180)
N = (L * k)


o = Application.Atan2(1, N) * 180 / 3.14159265358979
o = 2 * o
If o < 0 Then

o = 360 + o
End If


WahreAnomalie = o

End Function


Function NutationLnge(JD As Double) As Double

'  Nutation in Lnge

Dim T As Double
Dim L As Double
Dim ll As Double
Dim omega As Double
     
      
    T = (JD - 2451545) / 36525
    omega = 125.04452 - 1934.136261 * T + 0.0020708 * T * T + T * T * T / 450000
    L = 280.4665 + 36000.7698 * T
    ll = 218.3165 + 481267.8813 * T
    
   NutationLnge = -17.2 * Sin(omega * 3.14159265358979 / 180) - 1.32 * Sin(2 * L * 3.14159265358979 / 180) - 0.23 * Sin(2 * ll * 3.14159265358979 / 180) + 0.21 * Sin(2 * omega * 3.14159265358979 / 180)
  NutationLnge = NutationLnge / 3600
    
End Function


Function NutationBreite(JD As Double) As Double

'  Nutation in Lnge

Dim T As Double
Dim L As Double
Dim ll As Double
Dim omega As Double
     
       
    T = (JD - 2451545) / 36525
    omega = 125.04452 - 1934.136261 * T + 0.0020708 * T * T + T * T * T / 450000
    L = 280.4665 + 36000.7698 * T
    ll = 218.3165 + 481267.8813 * T
    
  NutationBreite = 9.2 * Cos(omega * 3.14159265358979 / 180) + 0.57 * Cos(2 * L * 3.14159265358979 / 180) + 0.1 * Cos(2 * ll * 3.14159265358979 / 180) - 0.09 * Cos(2 * omega * 3.14159265358979 / 180)
  NutationBreite = NutationBreite / 3600
    
End Function



Function jdjahr(JD As Double, Zeitzone As Double) As Double

'  Jahr aus JD

Dim Z As Double
Dim A As Double
Dim alpha As Double
Dim b As Double
Dim c As Double
Dim d As Double
Dim e As Double

JD = 0.5 + JD + Zeitzone / 24

Z = Fix(JD)
F = JD - Z

If Z < 2299161 Then
A = Z
End If

If Z >= 2299161 Then
alpha = Fix((Z - 1867216.25) / 36524.25)
A = Z + 1 + alpha - Fix(alpha / 4)
End If

 b = A + 1524
 c = Fix((b - 122.1) / 365.25)
 d = Fix(365.25 * c)
 e = Fix((b - d) / 30.6001)
 
 tag = b - d - Fix(30.6001 * e) + F
 
 If e < 14 Then
 e = e - 1
 End If
 
 If e = 14 Then
 e = e - 13
 End If
 
 If e = 15 Then
 e = e - 13
 End If
 
 monat = e
 
 If monat > 2 Then
 c = c - 4716
 End If
 
 If monat = 2 Then
 c = c - 4715
 End If
 
 If monat = 1 Then
 c = c - 4715
 End If
 
 Jahr = c
 
 jdjahr = c
  
 
  
 
End Function


Function jdmonat(JD As Double, Zeitzone As Double) As Double

'  Monat aus JD

Dim Z As Double
Dim A As Double
Dim alpha As Double
Dim b As Double
Dim c As Double
Dim d As Double
Dim e As Double


JD = 0.5 + JD + Zeitzone / 24

Z = Fix(JD)
F = JD - Z

If Z < 2299161 Then
A = Z
End If

If Z >= 2299161 Then
alpha = Fix((Z - 1867216.25) / 36524.25)
A = Z + 1 + alpha - Fix(alpha / 4)
End If

 b = A + 1524
 c = Fix((b - 122.1) / 365.25)
 d = Fix(365.25 * c)
 e = Fix((b - d) / 30.6001)
 
 tag = b - d - Fix(30.6001 * e) + F
 
 If e < 14 Then
 e = e - 1
 End If
 
 If e = 14 Then
 e = e - 13
 End If
 
 If e = 15 Then
 e = e - 13
 End If
 
 monat = e
 
 If monat > 2 Then
 c = c - 4716
 End If
 
 If monat = 2 Then
 c = c - 4715
 End If
 
 If monat = 1 Then
 c = c - 4715
 End If
 
 Jahr = c
 
 jdmonat = monat
  
  
 
End Function


Function jdtag(JD As Double, Zeitzone As Double) As Double

'  Tag aus JD

Dim Z As Double
Dim A As Double
Dim alpha As Double
Dim b As Double
Dim c As Double
Dim d As Double
Dim e As Double


JD = 0.5 + JD + Zeitzone / 24

Z = Fix(JD)
F = JD - Z

If Z < 2299161 Then
A = Z
End If

If Z >= 2299161 Then
alpha = Fix((Z - 1867216.25) / 36524.25)
A = Z + 1 + alpha - Fix(alpha / 4)
End If

 b = A + 1524
 c = Fix((b - 122.1) / 365.25)
 d = Fix(365.25 * c)
 e = Fix((b - d) / 30.6001)
 
 tag = b - d - Fix(30.6001 * e) + F
 
 If e < 14 Then
 e = e - 1
 End If
 
 If e = 14 Then
 e = e - 13
 End If
 
 If e = 15 Then
 e = e - 13
 End If
 
 monat = e
 
 If monat > 2 Then
 c = c - 4716
 End If
 
 If monat = 2 Then
 c = c - 4715
 End If
 
 If monat = 1 Then
 c = c - 4715
 End If
 
 Jahr = c
 
 jdtag = Fix(tag)
  
  
 
End Function



Function jdzeit(JD As Double, Zeitzone As Double) As Double

'  Zeit aus JD

Dim Z As Double
Dim A As Double
Dim alpha As Double
Dim b As Double
Dim c As Double
Dim d As Double
Dim e As Double


JD = 0.5 + JD + Zeitzone / 24

Z = Fix(JD)
F = JD - Z

If Z < 2299161 Then
A = Z
End If

If Z >= 2299161 Then
alpha = Fix((Z - 1867216.25) / 36524.25)
A = Z + 1 + alpha - Fix(alpha / 4)
End If

 b = A + 1524
 c = Fix((b - 122.1) / 365.25)
 d = Fix(365.25 * c)
 e = Fix((b - d) / 30.6001)
 
 tag = b - d - Fix(30.6001 * e) + F
 
 If e < 14 Then
 e = e - 1
 End If
 
 If e = 14 Then
 e = e - 13
 End If
 
 If e = 15 Then
 e = e - 13
 End If
 
 monat = e
 
 If monat > 2 Then
 c = c - 4716
 End If
 
 If monat = 2 Then
 c = c - 4715
 End If
 
 If monat = 1 Then
 c = c - 4715
 End If
 
 Jahr = c
 
 jdzeit = tag
  
  
 
End Function


Function ZGL(JD As Double) As Double
'
'  Zeitgleichung

    Dim T As Double
    Dim L As Double
    Dim tt As Double
    Dim e As Double
    Dim Y As Double
    Dim ekl As Double
    
    T = (JD - 2451545) / 365250
    tt = (JD - 2451545) / 36525
    L = rang(280.4664567 + 360007.6982779 * T + 0.03032028 * T * T + (T * T * T) / 49931 - (T * T * T * T) / 15299 - (T * T * T * T * T) / 1988000)
    e = 0.016708617 - 0.000042037 * tt - 0.0000001236 * tt * tt
    m = rang(357.5291 + 35999.0503 * tt - 0.0001559 * tt * tt - 0.00000048 * tt * tt * tt)
    ekl = 23.43929111 - (46.815 / 3600) * tt - (0.00059 / 3600) * tt * tt + (0.001813 / 3600) * tt * tt * tt
    Y = (Tan(ekl * 3.14159265358979 / 360)) * (Tan(ekl * 3.14159265358979 / 360))
     ZGL = Y * Sin(2 * L * 3.14159265358979 / 180) - 2 * e * Sin(m * 3.14159265358979 / 180) + 4 * e * Y * Sin(m * 3.14159265358979 / 180) * Cos(2 * L * 3.14159265358979 / 180) - 0.5 * Y * Y * Sin(4 * L * 3.14159265358979 / 180) - 1.25 * e * e * Sin(2 * m * 3.14159265358979 / 180)
    ZGL = 4 * (180 * ZGL / 3.14159265358979)
ZGL = -ZGL
    
End Function

Function PrzessionDEK(startepoche, epoche, dek, RA As Double)
                  
                    
tt = (startepoche - 2451545) / 36525
T = (epoche - 2451545) / 36525

T2 = T * T
T3 = T2 * T
f1 = (2306.2181 + 1.39656 * tt - 0.000139 * tt * tt) * T + (0.30188 - 0.000344 * tt) * T2 + 0.017998 * T3
f2 = (2306.2181 + 1.39656 * tt - 0.000139 * tt * tt) * T + (1.09468 + 0.000066 * tt) * T2 + 0.018203 * T3
f3 = (2004.3109 - 0.8533 * tt - 0.000217 * tt * tt) * T - (0.42665 + 0.000217 * tt) * T2 - 0.041833 * T3
f1 = f1 / 3600
f2 = f2 / 3600
f3 = f3 / 3600
A = Cos(dek * 3.14159265358979 / 180) * Sin((f1 + RA) * 3.14159265358979 / 180)
b = Cos(f3 * 3.14159265358979 / 180) * Cos(dek * 3.14159265358979 / 180) * Cos((f1 + RA) * 3.14159265358979 / 180) - Sin(f3 * 3.14159265358979 / 180) * Sin(dek * 3.14159265358979 / 180)
c = Sin(f3 * 3.14159265358979 / 180) * Cos(dek * 3.14159265358979 / 180) * Cos((f1 + RA) * 3.14159265358979 / 180) + Cos(f3 * 3.14159265358979 / 180) * Sin(dek * 3.14159265358979 / 180)
PrzessionDEK = arcsin(c)
End Function

Function PrzessionRA(startepoche, epoche, dek, RA)

tt = (startepoche - 2451545) / 36525
T = (epoche - 2451545) / 36525
T2 = T * T
T3 = T2 * T
f1 = (2306.2181 + 1.39656 * tt - 0.000139 * tt * tt) * T + (0.30188 - 0.000344 * tt) * T2 + 0.017998 * T3
f2 = (2306.2181 + 1.39656 * tt - 0.000139 * tt * tt) * T + (1.09468 + 0.000066 * tt) * T2 + 0.018203 * T3
f3 = (2004.3109 - 0.8533 * tt - 0.000217 * tt * tt) * T - (0.42665 + 0.000217 * tt) * T2 - 0.041833 * T3
f1 = f1 / 3600
f2 = f2 / 3600
f3 = f3 / 3600
A = Cos(dek * 3.14159265358979 / 180) * Sin((f1 + RA) * 3.14159265358979 / 180)
b = Cos(f3 * 3.14159265358979 / 180) * Cos(dek * 3.14159265358979 / 180) * Cos((f1 + RA) * 3.14159265358979 / 180) - Sin(f3 * 3.14159265358979 / 180) * Sin(dek * 3.14159265358979 / 180)
c = Sin(f3 * 3.14159265358979 / 180) * Cos(dek * 3.14159265358979 / 180) * Cos((f1 + RA) * 3.14159265358979 / 180) + Cos(f3 * 3.14159265358979 / 180) * Sin(dek * 3.14159265358979 / 180)
amz = Arctan2(b, A)
PrzessionRA = range(f2 + amz)
End Function
Function Arctan2(RX, RY)
If RX = 0 Then RX = 0.00001
Arctan2 = Atn(RY / RX) * 180 / 3.14159265358979
If RX < 0 Then Arctan2 = Arctan2 + 180
    b = Arctan2 / 360
    A = 360 * (b - Fix(b))
    If (A < 0) Then
        A = A + 360
        End If
Arctan2 = A
End Function
Function arccos(x)
If x > 1 Then x = 1
If x < -1 Then x = -1
If (-x * x + 1) <= 0 Then x = 0.99999
 arccos = Atn(-x / Sqr(-x * x + 1)) + 2 * Atn(1)
 arccos = arccos * 180 / 3.14159265358979
End Function
Function arcsin(x)
If x > 1 Then x = 1
If x < -1 Then x = -1
If (-x * x + 1) <= 0 Then x = 0.99999
    arcsin = Atn(x / Sqr(-x * x + 1))
    arcsin = arcsin * 180 / 3.14159265358979
End Function



Function WinkelformatDEK(Winkel As Double) As String

If Winkel < 0 Then
vz = "-"
End If


If Winkel >= 0 Then
vz = " "
End If

Winkel = Abs(Winkel)

gg = Fix(Winkel)
m = Winkel - gg
m = 60 * m
gm = Fix(m)
s = m - gm
s = s * 60
gs = Round(s, 2)


WinkelformatDEK = vz & gg & "" & gm & "" & gs & ""
  
  
End Function

Function WinkelformatRA(Winkel As Double) As Variant


Winkel = rang(Winkel)
Winkel = Winkel / 15



gg = Fix(Winkel)
m = Winkel - gg
m = 60 * m
gm = Fix(m)
s = m - gm
s = s * 60
gs = s

 
WinkelformatRA = TimeSerial(gg, gm, gs)
  
  
End Function


Function jddatum(JD As Double, Zeitzone As Double) As Double

'  Tag aus JD

Dim Z As Double
Dim A As Double
Dim alpha As Double
Dim b As Double
Dim c As Double
Dim d As Double
Dim e As Double


JD = 0.5 + JD + Zeitzone / 24

Z = Fix(JD)
F = JD - Z

If Z < 2299161 Then
A = Z
End If

If Z >= 2299161 Then
alpha = Fix((Z - 1867216.25) / 36524.25)
A = Z + 1 + alpha - Fix(alpha / 4)
End If

 b = A + 1524
 c = Fix((b - 122.1) / 365.25)
 d = Fix(365.25 * c)
 e = Fix((b - d) / 30.6001)
 
 tag = b - d - Fix(30.6001 * e) + F
 
 If e < 14 Then
 e = e - 1
 End If
 
 If e = 14 Then
 e = e - 13
 End If
 
 If e = 15 Then
 e = e - 13
 End If
 
 monat = e
 
 If monat > 2 Then
 c = c - 4716
 End If
 
 If monat = 2 Then
 c = c - 4715
 End If
 
 If monat = 1 Then
 c = c - 4715
 End If
 
 Jahr = c
 
 tag = Fix(tag)
 
 jddatum = DateSerial(Jahr, monat, tag)
  
  
 
End Function



Public Function ostern(Jahreszahl As Integer) As Date

Dim k As Integer, m As Integer, s As Integer, A As Integer, d As Integer

Dim tag As Integer, monat As Integer

k = Jahreszahl \ 100
m = 15 + ((3 * k + 3) \ 4) - ((8 * k + 13) \ 25)
s = 2 - ((3 * k + 3) \ 4)
A = Jahreszahl Mod 19
d = (19 * A + m) Mod 30
r = (d \ 29) + ((d \ 28) - (d \ 29)) * (A \ 11)
og = 21 + d - r
sz = 7 - ((Jahreszahl + (Jahreszahl \ 4) + s) Mod 7)
oe = 7 - ((og - sz) Mod 7)
os = og + oe
If os > 31 Then
tag = os - 31
monat = 4
Else
tag = os
monat = 3
End If

ostern = DateSerial(Jahreszahl, monat, tag)

End Function



Function winkelsub(A As Double, b As Double) As Double
  
W = A - b
If W < 0 Then
W = 360 + W
End If

winkelsub = W

End Function



Function zgl2(Z As Double) As String
  
  Dim vz As Double
  
  F = Z
  vz = 1
  
  If Z < 0 Then
  vz = -1
  End If
  
  Z = Fix(Z)
  
  zf = (F - Z) * 60
  
  zf = Abs(Round(zf, 0))
  
zgl2 = "- " & Z & "min " & zf & "sec"

Z = Abs(Z)

zgl2 = Z & "min " & zf & "sec"

If vz < 0 Then
zgl2 = "- " & Z & "min " & zf & "sec"
End If



End Function



Function Extinktion(hhe As Double, Magnitude As Double) As Double
  
  dm = 0.2 / Cos((90 - hhe) * 3.14159265358979 / 180)
  If hhe > 85 Then
  dm = 0
  End If
   
Extinktion = Magnitude + dm

End Function


Function HhenparallaxeMond(Abstand As Double, GeozentrHhe As Double, GeogrBreite As Double) As Double




Dim p As Double
     
   plax = Application.Asin(6378.14 / Abstand) * 180 / 3.14159265358979
   p = 0.9983271 + 0.0016764 * Cos(2 * GeogrBreite * 3.14159265358979 / 180) - 0.0000035 * Cos(4 * GeogrBreite * 3.14159265358979 / 180)
   par = p * Sin((plax) * 3.14159265358979 / 180) * Cos(GeozentrHhe * 3.14159265358979 / 180)
   par = Application.Asin(par) * 180 / 3.14159265358979
     
   
   HhenparallaxeMond = GeozentrHhe - par

    
End Function




Function ekliplamda(RA As Double, dek As Double, eklip As Double) As Double


A = RA
e = eklip
d = dek
 
sina = Sin(A * 3.14159265358979 / 180)
cose = Cos(e * 3.14159265358979 / 180)
tand = Tan(d * 3.14159265358979 / 180)
sine = Sin(e * 3.14159265358979 / 180)
cosa = Cos(A * 3.14159265358979 / 180)
sind = Sin(d * 3.14159265358979 / 180)
cosd = Cos(d * 3.14159265358979 / 180)

sinbeta = sind * cose - cosd * sine * sina

x = (sina * cose + tand * sine)
Y = cosa

lamda = Application.Atan2(Y, x) * 180 / 3.14159265358979

beta = Application.Asin(sinbeta) * 180 / 3.14159265358979

If lamda < 0 Then
lamda = lamda + 360
End If

ekliplamda = lamda

 
End Function


Function eklipbeta(RA As Double, dek As Double, eklip As Double) As Double


A = RA
e = eklip
d = dek
 
sina = Sin(A * 3.14159265358979 / 180)
cose = Cos(e * 3.14159265358979 / 180)
tand = Tan(d * 3.14159265358979 / 180)
sine = Sin(e * 3.14159265358979 / 180)
cosa = Cos(A * 3.14159265358979 / 180)
sind = Sin(d * 3.14159265358979 / 180)
cosd = Cos(d * 3.14159265358979 / 180)

sinbeta = sind * cose - cosd * sine * sina

x = (sina * cose + tand * sine)
Y = cosa

lamda = Application.Atan2(Y, x) * 180 / 3.14159265358979

beta = Application.Asin(sinbeta) * 180 / 3.14159265358979

If lamda < 0 Then
lamda = lamda + 360
End If

eklipbeta = beta
 
End Function




Function EklipRektaszension(lamda As Double, beta As Double, eklip As Double) As Double


L = lamda
e = eklip
b = beta

sinl = Sin(L * 3.14159265358979 / 180)
cose = Cos(e * 3.14159265358979 / 180)
tanb = Tan(b * 3.14159265358979 / 180)
sine = Sin(e * 3.14159265358979 / 180)
cosl = Cos(L * 3.14159265358979 / 180)
sinb = Sin(b * 3.14159265358979 / 180)
cosb = Cos(b * 3.14159265358979 / 180)

sindek = sinb * cose + cosb * sine * sinl


x = (sinl * cose - tanb * sine)
Y = cosl

RA = Application.Atan2(Y, x) * 180 / 3.14159265358979

de = Application.Asin(sindek) * 180 / 3.14159265358979

If RA < 0 Then
RA = RA + 360
End If

EklipRektaszension = RA

End Function


Function EklipDeklination(lamda As Double, beta As Double, eklip As Double) As Double


L = lamda
e = eklip
b = beta

sinl = Sin(L * 3.14159265358979 / 180)
cose = Cos(e * 3.14159265358979 / 180)
tanb = Tan(b * 3.14159265358979 / 180)
sine = Sin(e * 3.14159265358979 / 180)
cosl = Cos(L * 3.14159265358979 / 180)
sinb = Sin(b * 3.14159265358979 / 180)
cosb = Cos(b * 3.14159265358979 / 180)

sindek = sinb * cose + cosb * sine * sinl


x = (sinl * cose - tanb * sine)
Y = cosl

RA = Application.Atan2(Y, x) * 180 / 3.14159265358979

de = Application.Asin(sindek) * 180 / 3.14159265358979

If RA < 0 Then
RA = RA + 360
End If

EklipDeklination = de

End Function










Function HoriDeklination(Azimut As Double, hhe As Double, Breite As Double, lokSternzeit As Double) As Double

Dim A As Double

A = rang(180 + Azimut)
h = hhe
b = Breite

sina = Sin(A * 3.14159265358979 / 180)
cosa = Cos(A * 3.14159265358979 / 180)
th = Tan(h * 3.14159265358979 / 180)
sinb = Sin(b * 3.14159265358979 / 180)
cosb = Cos(b * 3.14159265358979 / 180)
sh = Sin(h * 3.14159265358979 / 180)
ch = Cos(h * 3.14159265358979 / 180)

sindek = sinb * sh - cosb * ch * cosa



hdek = Application.Asin(sindek) * 180 / 3.14159265358979


HoriDeklination = hdek


End Function




Function HoriRektaszension(Azimut As Double, hhe As Double, Breite As Double, lokSternzeit As Double) As Double

Dim A As Double

A = rang(180 + Azimut)
h = hhe
b = Breite

sina = Sin(A * 3.14159265358979 / 180)
cosa = Cos(A * 3.14159265358979 / 180)
th = Tan(h * 3.14159265358979 / 180)
sinb = Sin(b * 3.14159265358979 / 180)
cosb = Cos(b * 3.14159265358979 / 180)
sh = Sin(h * 3.14159265358979 / 180)
ch = Cos(h * 3.14159265358979 / 180)


x = sina
Y = cosa * sinb + th * cosb
StwH = Application.Atan2(Y, x) * 180 / 3.14159265358979

If StwH < 0 Then
StwH = StwH + 360
End If


hra = rang(lokSternzeit - StwH)

 HoriRektaszension = hra / (15 * 24)

End Function




Function zirkumpolar(Deklination As Double, Breite As Double) As String

Dim zp As String

d = Deklination
b = Breite

abe = d * b
abz = Abs(d + b)

bbe = abe
bbz = Abs(b - d)

zp = "normal"

If abe > 0 And abz > 90 Then
zp = "zirkumpolar"
End If

If bbe < 0 And bbz > 90 Then
zp = "unter Horizont"
End If

zirkumpolar = zp


End Function



Function Aufgang(Rektaszension As Double, Deklination As Double, SternzeitGWN As Double, Lnge As Double, Breite As Double, Zeitzone As Double, Refraktion As Double) As Double

Dim zp As String
Dim zirkumpolar As String


RA = Rektaszension
dek = Deklination
szgwn = SternzeitGWN
L = -1 * Lnge
b = Breite
r = Refraktion
zz = Zeitzone

ha = (RA + L - szgwn) / 360

If ha < 0 Then
ha = ha + 1
End If


If ha > 1 Then
ha = ha - 1
End If

ha = ha

hc = (Sin(r * 3.14159265358979 / 180) - Sin(b * 3.14159265358979 / 180) * Sin(dek * 3.14159265358979 / 180)) / (Cos(b * 3.14159265358979 / 180) * Cos(dek * 3.14159265358979 / 180))

If Abs(hc) >= 1 Then
zag = "no"
GoTo 100
End If

h = Application.Acos(hc) * 180 / 3.14159265358979

HH = h / 360


tagbogen = 2 * HH / 24

utag = (ha - HH) * 24
utdg = ha * 24
utug = (ha + HH) * 24
ozag = zz + utag
ozdg = zz + utdg
ozug = zz + utug


zag = ozag
zdg = ozdg
zug = ozug

If zag < 0 Then
zag = zag + 24
End If

If zag > 24 Then
zag = zag - 24
End If


If zdg < 0 Then
zdg = zdg + 24
End If

If zdg > 24 Then
zdg = zdg - 24
End If


If zug < 0 Then
zug = zug + 24
End If

If zug > 24 Then
zug = zug - 24
End If


zag = zag / 24
zdg = zdg / 24
zug = zug / 24



100:


d = dek
b = b
deta = 0

abe = d * b
abz = Abs(d + b)

bbe = abe
bbz = Abs(b - d)

If abe > 0 And abz > 90 Then
zag = "zirkumpolar"
deta = 1
End If

If bbe < 0 And bbz > 90 Then
zag = "unter Horizont"
deta = 1
End If

zirkumpolar = zp

deta = deta




Aufgang = zag



End Function




Function Durchgang(RektaszensionA As Double, DeklinationA As Double, SternzeitGWN As Double, Lnge As Double, Breite As Double, Zeitzone As Double, Refraktion As Double)

Dim zp As String
Dim zirkumpolar As String


RA = RektaszensionA
dek = DeklinationA
szgwn = SternzeitGWN
L = -1 * Lnge
b = Breite
r = Refraktion
zz = Zeitzone

ha = (RA + L - szgwn) / 360

If ha < 0 Then
ha = ha + 1
End If


If ha > 1 Then
ha = ha - 1
End If

ha = ha

hc = (Sin(r * 3.14159265358979 / 180) - Sin(b * 3.14159265358979 / 180) * Sin(dek * 3.14159265358979 / 180)) / (Cos(b * 3.14159265358979 / 180) * Cos(dek * 3.14159265358979 / 180))

If Abs(hc) >= 1 Then
zdg = "no"
GoTo 100
End If

h = Application.Acos(hc) * 180 / 3.14159265358979

HH = h / 360


tagbogen = 2 * HH / 24

utag = (ha - HH) * 24
utdg = ha * 24
utug = (ha + HH) * 24
ozag = zz + utag
ozdg = zz + utdg
ozug = zz + utug


zag = ozag
zdg = ozdg
zug = ozug

If zag < 0 Then
zag = zag + 24
End If

If zag > 24 Then
zag = zag - 24
End If


If zdg < 0 Then
zdg = zdg + 24
End If

If zdg > 24 Then
zdg = zdg - 24
End If


If zug < 0 Then
zug = zug + 24
End If

If zug > 24 Then
zug = zug - 24
End If


zag = zag / 24
zdg = zdg / 24
zug = zug / 24



100:


d = dek
b = b
deta = 0

abe = d * b
abz = Abs(d + b)

bbe = abe
bbz = Abs(b - d)

If abe > 0 And abz > 90 Then
zdg = "zirkumpolar"
deta = 1
End If

If bbe < 0 And bbz > 90 Then
zdg = "unter Horizont"
deta = 1
End If

zirkumpolar = zp

deta = deta





Durchgang = zdg



End Function



Function Untergang(Rektaszension As Double, Deklination As Double, SternzeitGWN As Double, Lnge As Double, Breite As Double, Zeitzone As Double, Refraktion As Double)

Dim zp As String
Dim zirkumpolar As String


RA = Rektaszension
dek = Deklination
szgwn = SternzeitGWN
L = -1 * Lnge
b = Breite
r = Refraktion
zz = Zeitzone

ha = (RA + L - szgwn) / 360

If ha < 0 Then
ha = ha + 1
End If


If ha > 1 Then
ha = ha - 1
End If

ha = ha

hc = (Sin(r * 3.14159265358979 / 180) - Sin(b * 3.14159265358979 / 180) * Sin(dek * 3.14159265358979 / 180)) / (Cos(b * 3.14159265358979 / 180) * Cos(dek * 3.14159265358979 / 180))

If Abs(hc) >= 1 Then
zug = "no"
GoTo 100
End If

h = Application.Acos(hc) * 180 / 3.14159265358979

HH = h / 360


tagbogen = 2 * HH / 24

utag = (ha - HH) * 24
utdg = ha * 24
utug = (ha + HH) * 24
ozag = zz + utag
ozdg = zz + utdg
ozug = zz + utug


zag = ozag
zdg = ozdg
zug = ozug

If zag < 0 Then
zag = zag + 24
End If

If zag > 24 Then
zag = zag - 24
End If


If zdg < 0 Then
zdg = zdg + 24
End If

If zdg > 24 Then
zdg = zdg - 24
End If


If zug < 0 Then
zug = zug + 24
End If

If zug > 24 Then
zug = zug - 24
End If


zag = zag / 24
zdg = zdg / 24
zug = zug / 24



100:


d = dek
b = b
deta = 0

abe = d * b
abz = Abs(d + b)

bbe = abe
bbz = Abs(b - d)

If abe > 0 And abz > 90 Then
zug = "zirkumpolar"
deta = 1
End If

If bbe < 0 And bbz > 90 Then
zug = "unter Horizont"
deta = 1
End If

zirkumpolar = zp

deta = deta


Untergang = zug


End Function





Function jdUT(Jahr As Integer, monat As Integer, tag As Integer) As Double


     
   Dim d As Double
   Dim A As Double
   Dim b As Double
   Dim JD As Double
    
    If monat > 2 Then
    monat = monat
    Jahr = Jahr
    End If
    
    If monat <= 2 Then
    monat = monat + 12
    Jahr = Jahr - 1
    End If
    
    A = Fix(Jahr / 100)
    b = 2 - A + Fix(A / 4)
    
    jdUT = Fix(365.25 * (Jahr + 4716)) + Fix(30.6001 * (monat + 1)) + tag + b - 1524.5
    
       

End Function


Function Interpolation3(a1 As Double, a2 As Double, a3 As Double, N As Double) As Double

A = a2 - a1
b = a3 - a2
c = a1 + a3 - 2 * a2

Interpolation3 = a2 + (N / 2) * (A + b + N * c)
 
End Function


Function nm(RektaszensionA As Double, SternzeitGWN As Double, Lnge As Double) As Double


RA = RektaszensionA
szgwn = SternzeitGWN
L = -1 * Lnge



nm = (RA + L - szgwn) / 360

If nm < 0 Then
nm = nm + 1
End If


If nm > 1 Then
nm = nm - 1
End If

nm = nm

End Function



Function ParabelNullstelle(ym As Double, yz As Double, yp As Double)

        
    A = 0.5 * (ym + yp) - yz
    b = 0.5 * (yp - ym)
    c = yz
    
    dis = b * b - 4 * A * c
    Z = "no"
    If (dis > 0) Then
     z1 = (-1 * b + Sqr(dis)) / (2 * A)
     z2 = (-1 * b - Sqr(dis)) / (2 * A)
   End If
   
   If Abs(z1) <= 1 Then
   Z = z1
   End If
   
   If Abs(z2) <= 1 Then
   Z = z2
   End If
   
   ParabelNullstelle = Z
   
   
   End Function
   
   
   Function Parabelmax(ym As Double, yz As Double, yp As Double)

        
    A = 0.5 * (ym + yp) - yz
    b = 0.5 * (yp - ym)
    c = yz
    
    xm = -1 * b / (2 * A)
    
  Parabelmax = xm
   
   
   End Function
   
   Function DurchgangSonne(Jahr As Double, monat As Double, tag As Double, Lnge As Double, Zeitzone As Double) As Double


     
   Dim d As Double
   Dim A As Double
   Dim b As Double
   Dim zd As Double
    
    If monat > 2 Then
    monat = monat
    Jahr = Jahr
    End If
    
    If monat <= 2 Then
    monat = monat + 12
    Jahr = Jahr - 1
    End If
    
    A = Fix(Jahr / 100)
    b = 2 - A + Fix(A / 4)
    
    zd = Fix(365.25 * (Jahr + 4716)) + Fix(30.6001 * (monat + 1)) + tag + b - 1524.5 + 0.5
    
       
       
  
  
 DurchgangSonne = (12 + ZGL(zd) / 60) / 24 + (Zeitzone / 24) - (Lnge * 4) / (60 * 24)
 
 If DurchgangSonne > 1 Then
 DurchgangSonne = DurchgangSonne - 1
 End If
 
 If DurchgangSonne < 0 Then
 DurchgangSonne = DurchgangSonne + 1
 End If
 
DurchgangSonne = DurchgangSonne
 
End Function
   
   
   
Function kw(d As Date) As Integer
    T = DateSerial(year(d + (8 - Weekday(d)) Mod 7 - 3), 1, 1)
    kw = (d - T - 3 + (Weekday(T) + 1) Mod 7) \ 7 + 1
End Function


Function Schaltjahr(Jahreszahl)
   If (Jahreszahl Mod 4) = 0 And (Jahreszahl Mod 100) <> 0 Or _
     ((Jahreszahl Mod 400) = 0) Then
      Schaltjahr = "Schaltjahr"
   Else
      Schaltjahr = "kein Schaltjahr"
   End If

Schaltjahr = Schaltjahr
End Function


Function Sommerzeit(Jahreszahl As Integer) As Date
Dim ti As Integer
Dim dzu As Integer


For ti = 31 To 25 Step -1

 szu = DateSerial(Jahreszahl, 3, ti)
 dzu = Weekday(szu)
 
 If dzu = 1 Then GoTo 100
 
 Next
 
100:
 
Sommerzeit = szu

  
  
End Function



Function Winterzeit(Jahreszahl As Integer) As Date
Dim ti As Integer
Dim dzu As Integer


For ti = 31 To 25 Step -1

 szu = DateSerial(Jahreszahl, 10, ti)
 dzu = Weekday(szu)
 
 If dzu = 1 Then GoTo 100
 
 Next
 
100:
 
Winterzeit = szu

  
  
End Function

  
Function quaParallaxeMond(Abstand As Double) As Double
              
  quaParallaxeMond = Application.Asin(6378.14 / Abstand) * 180 / 3.14159265358979
 
End Function

Function quaParallaxePlanet(Abstand As Double) As Double
              
  quaParallaxePlanet = Application.Asin((8.794 / 3600) / Abstand) * 180 / 3.14159265358979
 
End Function



Function GeozDeklination(geoBreite As Double) As Double


gb = (692.73 / 3600) * Sin(2 * geoBreite * 3.14159265358979 / 180) - (1.16 / 3600) * Sin(4 * geoBreite * 3.14159265358979 / 180)
              
GeozDeklination = geoBreite - gb
 
End Function


Function GeogrBreite(dek As Double) As Double

            
  GeogrBreite = dek + 0.1924 * Sin(2 * dek * 3.14159265358979 / 180)
 
End Function



Function TopoDek(Parallaxe As Double, geozStdw As Double, GeogrBreite As Double, HStandort As Double, dek As Double) As Double

Dim u As Double
Dim pcb As Double
Dim psb As Double
Dim drax As Double
Dim dray As Double


pp = Parallaxe
h = geozStdw
b = GeogrBreite
dek = dek
hs = HStandort

u = 0.99664719 * Tan(b * 3.14159265358979 / 180)

u = Application.Atan2(1, u) * 180 / 3.14159265358979


pcb = Cos(u * 3.14159265358979 / 180) + (hs / 6378140) * Cos(b * 3.14159265358979 / 180)
psb = 0.99664719 * Sin(u * 3.14159265358979 / 180) + (hs / 6378140) * Sin(b * 3.14159265358979 / 180)


drax = -1 * pcb * Sin(pp * 3.14159265358979 / 180) * Sin(h * 3.14159265358979 / 180)
dray = Cos(dek * 3.14159265358979 / 180) - pcb * Sin(pp * 3.14159265358979 / 180) * Cos(h * 3.14159265358979 / 180)

dra = Application.Atan2(dray, drax) * 180 / 3.14159265358979
            
  xdek = (Sin(dek * 3.14159265358979 / 180) - psb * Sin(pp * 3.14159265358979 / 180)) * Cos(dra * 3.14159265358979 / 180)
  ydek = Cos(dek * 3.14159265358979 / 180) - pcb * Sin(pp * 3.14159265358979 / 180) * Cos(h * 3.14159265358979 / 180)
 
 
 

TopoDek = Application.Atan2(ydek, xdek) * 180 / 3.14159265358979

 
End Function


Function TopoRA(Parallaxe As Double, geozStdw As Double, GeogrBreite As Double, HStandort As Double, dek As Double, RA As Double) As Double

Dim u As Double
Dim pcb As Double
Dim psb As Double
Dim drax As Double
Dim dray As Double


pp = Parallaxe
h = geozStdw
b = GeogrBreite
dek = dek
hs = HStandort

u = 0.99664719 * Tan(b * 3.14159265358979 / 180)

u = Application.Atan2(1, u) * 180 / 3.14159265358979


pcb = Cos(u * 3.14159265358979 / 180) + (hs / 6378140) * Cos(b * 3.14159265358979 / 180)
psb = 0.99664719 * Sin(u * 3.14159265358979 / 180) + (hs / 6378140) * Sin(b * 3.14159265358979 / 180)


drax = -1 * pcb * Sin(pp * 3.14159265358979 / 180) * Sin(h * 3.14159265358979 / 180)
dray = Cos(dek * 3.14159265358979 / 180) - pcb * Sin(pp * 3.14159265358979 / 180) * Cos(h * 3.14159265358979 / 180)

dra = Application.Atan2(dray, drax) * 180 / 3.14159265358979
            
  
 
 
 

TopoRA = dra + RA

TopoRA = rang(TopoRA)

 
End Function


Public Function DEKSonne(JD As Double)



    
    
Dim NutationBreite As Double
Dim NutationLnge As Double
Dim Ekliptik As Double
Dim dtjd As Double
Dim Lsonne As Double

jdx = JD
Jahr = ((jdx + 1524 - 122.1) / 365.25) - 4715.5
Jahr = Fix(Jahr)
u = (Jahr - 1900) / 100
dtjd = (-2.44 + 87.24 * u + 815.2 * u ^ 2 - 2637.8 * u ^ 3 - 18756.33 * u ^ 4 + 124906.15 * u ^ 5 - 303191.19 * u ^ 6 + 372919.88 * u ^ 7 - 232424.66 * u ^ 8 + 58353.42 * u ^ 9)
If Jahr > 1998 Then
dtjd = Jahr * 0.6 - 1135.4
End If
dtjd = Round(dtjd, 0)
dtjd = dtjd / (86400#)

jdx = jdx + dtjd
T = (jdx - 2451545) / 36525
tjh = (jdx - 2451545) / 36525


Ekliptik = 23.43929111 - (46.815 / 3600) * T - (0.00059 / 3600) * T * T + (0.001813 / 3600) * T * T * T

omega = 125.04452 - 1934.136261 * T + 0.0020708 * T * T + T * T * T / 450000
    om1 = 280.4665 + 36000.7698 * T
    om2 = 218.3165 + 481267.8813 * T
    
   NutationLnge = -17.2 * Sin(omega * 3.14159265358979 / 180) - 1.32 * Sin(2 * om1 * 3.14159265358979 / 180) - 0.23 * Sin(2 * om2 * 3.14159265358979 / 180) + 0.21 * Sin(2 * omega * 3.14159265358979 / 180)
  
NutationLnge = NutationLnge / 3600

    
    NL = 280.4665 + 36000.7698 * T
    NLL = 218.3165 + 481267.8813 * T
    
  NutationBreite = 9.2 * Cos(omega * 3.14159265358979 / 180) + 0.57 * Cos(2 * NL * 3.14159265358979 / 180) + 0.1 * Cos(2 * NLL * 3.14159265358979 / 180) - 0.09 * Cos(2 * omega * 3.14159265358979 / 180)
  NutationBreite = NutationBreite / 3600

Ekliptik = Ekliptik + NutationBreite

'Radius Sonne

T = (jdx - (0.0057755183) - 2451545) / 365250



r1 = 100013989 * Cos(0 + 0 * T)
r2 = 1670700 * Cos(3.0984635 + 6283.07585 * T)
r3 = 13956 * Cos(3.05525 + 12566.1517 * T)
r4 = 3084 * Cos(5.1985 + 77713.7715 * T)
r5 = 1628 * Cos(1.1739 + 5753.3849 * T)
r6 = 1576 * Cos(2.8469 + 7860.4194 * T)
r7 = 925 * Cos(5.453 + 11506.77 * T)
r8 = 542 * Cos(4.564 + 3930.21 * T)
r9 = 472 * Cos(3.661 + 5884.927 * T)
r10 = 346 * Cos(0.964 + 5507.553 * T)
r11 = 329 * Cos(5.9 + 5223.694 * T)
r12 = 307 * Cos(0.299 + 5573143 * T)
r13 = 243 * Cos(4.273 + 11790.629 * T)
r14 = 212 * Cos(5.847 + 1577.344 * T)
r15 = 186 * Cos(5.022 + 10977.079 * T)
r16 = 175 * Cos(3.012 + 18849.228 * T)
r17 = 110 * Cos(5.055 + 5486.778 * T)
r18 = 98 * Cos(0.89 + 6069.78 * T)
r19 = 86 * Cos(5.69 + 15720.84 * T)
r20 = 86 * Cos(1.27 + 161000.69 * T)
r21 = 65 * Cos(0.27 + 17260.15 * T)
r22 = 63 * Cos(0.92 + 529.69 * T)
r23 = 57 * Cos(2.01 + 83996 * T)
r24 = 56 * Cos(5.24 + 71430.7 * T)
r25 = 49 * Cos(3.25 + 2544.31 * T)
r26 = 47 * Cos(2.58 + 775.52 * T)
r27 = 45 * Cos(5.54 + 9437.76 * T)
r28 = 43 * Cos(6.01 + 6275.96 * T)
r29 = 39 * Cos(5.36 + 4694 * T)
r30 = 38 * Cos(2.39 + 8827.39 * T)
r31 = 37 * Cos(0.83 + 19651.05 * T)
r32 = 37 * Cos(4.9 + 12139.55 * T)
r33 = 36 * Cos(1.67 + 12036.46 * T)
r34 = 35 * Cos(1.84 + 2942.46 * T)
r35 = 33 * Cos(0.24 + 7084.9 * T)
r36 = 32 * Cos(0.18 + 5088.63 * T)
r37 = 32 * Cos(1.78 + 398.15 * T)
r38 = 28 * Cos(1.21 + 6286.6 * T)
r39 = 28 * Cos(1.9 + 6279.55 * T)
r40 = 26 * Cos(4.59 + 10447.39 * T)
r41 = 56 * Cos(5.24 + 71430.7 * T)
r42 = 49 * Cos(3.25 + 2544.31 * T)
r43 = 47 * Cos(2.58 + 775.52 * T)
r44 = 45 * Cos(5.54 + 9437.76 * T)
r45 = 43 * Cos(6.01 + 6275.96 * T)
r46 = 39 * Cos(5.36 + 4694 * T)
r47 = 38 * Cos(2.39 + 8827.39 * T)
r48 = 37 * Cos(0.83 + 19651.05 * T)
r49 = 37 * Cos(4.9 + 12139.55 * T)
r50 = 36 * Cos(1.67 + 12036.46 * T)
r51 = 35 * Cos(1.84 + 2942.46 * T)
r52 = 33 * Cos(0.24 + 7084.9 * T)
r53 = 32 * Cos(0.18 + 5088.63 * T)
r54 = 32 * Cos(1.78 + 398.15 * T)
r55 = 28 * Cos(1.21 + 6286.6 * T)
r56 = 28 * Cos(1.9 + 6279.55 * T)
r57 = 26 * Cos(4.59 + 10447.39 * T)

rges1 = r1 + r2 + r3 + r4 + r5 + r6 + r7 + r8 + r9 + r10
rges2 = r11 + r12 + r13 + r14 + r15 + r16 + r17 + r18 + r19 + r20
rges3 = r21 + r22 + r23 + r24 + r25 + r26 + r27 + r28 + r29 + r30
rges4 = r31 + r32 + r33 + r34 + r35 + r36 + r37 + r38 + r39 + r40
rges5 = r41 + r42 + r43 + r44 + r45 + r46 + r47 + r48 + r49 + r50
rges6 = r51 + r52 + r53 + r54 + r55 + r56 + r57

rges = rges1 + rges2 + rges3 + rges4 + rges5 + rges6

rr1 = 103019 * Cos(1.10749 + 6283.2075 * T)
rr2 = 1721 * Cos(1.0644 + 12566.1517 * T)
rr3 = 702 * Cos(3.142 + 0 * T)
rr4 = 32 * Cos(1.02 + 18849.23 * T)
rr5 = 31 * Cos(2.84 + 5507.55 * T)
rr6 = 25 * Cos(1.32 + 5223.69 * T)
rr7 = 18 * Cos(1.42 + 1577.34 * T)
rr8 = 10 * Cos(5.91 + 10977.08 * T)
rr9 = 9 * Cos(1.42 + 6275.96 * T)
rr10 = 9 * Cos(0.27 + 5486.78 * T)

rrges = rr1 + rr2 + rr3 + rr4 + rr5 + rr6 + rr7 + rr8 + rr9 + rr10

rrr1 = 4359 * Cos(5.7846 + 6283.0758 * T)
rrr2 = 124 * Cos(5.579 + 12566.152 * T)
rrr3 = 12 * Cos(3.14 + 0 * T)
rrr4 = 9 * Cos(3.63 + 77713.17 * T)
rrr5 = 6 * Cos(1.87 + 5573.14 * T)
rrr6 = 3 * Cos(5.47 + 18849.23 * T)

rrrges = rrr1 + rrr2 + rrr3 + rrr4 + rrr5 + rrr6

rrrr1 = 145 * Cos(4.273 + 6283.076 * T)
rrrr2 = 7 * Cos(3.92 + 12566.15 * T)
rrrrges = rrrr1 + rrrr2
rrrrr1 = 4 * Cos(2.56 + 6283.08 * T)

rson = (rges + rrges * T + rrrges * T ^ 2 + rrrrges * T ^ 3 + rrrrr1 * T ^ 4) / 10 ^ 8


'Aberration

aber = -(20.4898 / 3600) / rson

T = (jdx - (2 * rson * 0.0057755183) - 2451545) / 365250

'Breite

b01 = 280 * Cos(3.199 + 84334.662 * T)
b02 = 102 * Cos(5.422 + 5507.553 * T)
b03 = 80 * Cos(3.88 + 5223.69 * T)
b04 = 44 * Cos(3.7 + 2352.87 * T)
b05 = 32 * Cos(4 + 1577.34 * T)

b0ges = b01 + b02 + b03 + b04 + b05


b11 = 9 * Cos(3.9 + 5507.6 * T)
b12 = 6 * Cos(1.73 + 5223.69 * T)

b1ges = b11 + b12

bsonne = -((b0ges + T * b1ges) / 10 ^ 8) * (180 / 3.14159265358979)




'Lnge


l1 = 175347046 * Cos(0 + 0 * T)
l2 = 3341656 * Cos(4.6692568 + 6283.07585 * T)
l3 = 34894 * Cos(4.6261 + 12566.1517 * T)
l4 = 3497 * Cos(2.7441 + 5753.3849 * T)
l5 = 3418 * Cos(2.8289 + 3.5231 * T)
l6 = 3136 * Cos(3.6277 + 77713.7715 * T)
l7 = 2676 * Cos(4.4181 + 7860.4194 * T)
l8 = 2343 * Cos(6.1353 + 3930.2097 * T)
l9 = 1324 * Cos(0.7425 + 11506.7698 * T)
l10 = 1273 * Cos(2.0371 + 529.691 * T)
l11 = 1199 * Cos(1.1096 + 1577.3435 * T)
l12 = 990 * Cos(5.233 + 5884.927 * T)
l13 = 902 * Cos(2.045 + 26.298 * T)
l14 = 857 * Cos(3.508 + 398.149 * T)
l15 = 780 * Cos(1.179 + 5223.694 * T)
l16 = 753 * Cos(2.533 + 5507.553 * T)
l17 = 505 * Cos(4.583 + 18849.228 * T)
l18 = 492 * Cos(4.205 + 775.523 * T)
l19 = 357 * Cos(2.92 + 0.067 * T)
l20 = 317 * Cos(5.849 + 11790.629 * T)
l21 = 284 * Cos(1.899 + 796.298 * T)
l22 = 271 * Cos(0.315 + 10977.079 * T)
l23 = 243 * Cos(0.345 + 5486.778 * T)
l24 = 206 * Cos(4.806 + 2544.314 * T)
l25 = 205 * Cos(1.869 + 5573.143 * T)
l26 = 202 * Cos(2.458 + 6069.777 * T)
l27 = 156 * Cos(0.833 + 213.299 * T)
l28 = 132 * Cos(3.411 + 2942.463 * T)
l29 = 126 * Cos(1.083 + 20.775 * T)
l30 = 115 * Cos(0.645 + 0.98 * T)
l31 = 103 * Cos(0.636 + 4694.003 * T)
l32 = 102 * Cos(0.976 + 15720.839 * T)
l33 = 102 * Cos(4.267 + 7.114 * T)
l34 = 99 * Cos(6.21 + 2146.17 * T)
l35 = 98 * Cos(0.86 + 155.4 * T)
l36 = 86 * Cos(5.98 + 161000.7 * T)
l37 = 85 * Cos(1.3 + 6275.96 * T)
l38 = 85 * Cos(3.67 + 71430.7 * T)
l39 = 80 * Cos(1.81 + 17260.15 * T)
l40 = 79 * Cos(3.04 + 12036.46 * T)
l41 = 75 * Cos(1.76 + 5088.63 * T)
l42 = 74 * Cos(3.5 + 3154.69 * T)
l43 = 74 * Cos(4.68 + 801.82 * T)
l44 = 70 * Cos(0.83 + 9437.76 * T)
l45 = 62 * Cos(3.98 + 8827.39 * T)
l46 = 61 * Cos(1.82 + 7084.9 * T)
l47 = 57 * Cos(2.78 + 6286.6 * T)
l48 = 56 * Cos(4.39 + 14143.5 * T)
l49 = 56 * Cos(3.47 + 6279.55 * T)
l50 = 52 * Cos(0.19 + 12139.55 * T)
l51 = 52 * Cos(1.33 + 1748.02 * T)
l52 = 51 * Cos(0.28 + 5856.48 * T)
l53 = 49 * Cos(0.49 + 119.45 * T)
l54 = 41 * Cos(5.37 + 8429.24 * T)
l55 = 41 * Cos(2.4 + 19651.05 * T)
l56 = 39 * Cos(6.17 + 10447.39 * T)
l57 = 37 * Cos(6.04 + 10213.29 * T)
l58 = 37 * Cos(2.57 + 1059.38 * T)
l59 = 36 * Cos(1.71 + 2352.87 * T)
l60 = 36 * Cos(1.78 + 6812.77 * T)
l61 = 33 * Cos(0.59 + 17789.85 * T)
l62 = 30 * Cos(0.44 + 83996.85 * T)
l63 = 30 * Cos(2.74 + 1349.87 * T)
l64 = 25 * Cos(3.16 + 4690.48 * T)


l0ges1 = l1 + l2 + l3 + l4 + l5 + l6 + l7 + l8 + l9 + l10
l0ges2 = l11 + l12 + l13 + l14 + l15 + l16 + l17 + l18 + l19 + l20
l0ges3 = l21 + l22 + l23 + l24 + l25 + l26 + l27 + l28 + l29 + l30
l0ges4 = l31 + l32 + l33 + l34 + l35 + l36 + l37 + l38 + l39 + l40
l0ges5 = l41 + l42 + l43 + l44 + l45 + l46 + l47 + l48 + l49 + l50
l0ges6 = l51 + l52 + l53 + l54 + l55 + l56 + l57 + l58 + l59 + l60
l0ges7 = l61 + l62 + l63 + l64

l0ges = l0ges1 + l0ges2 + l0ges3 + l0ges4 + l0ges5 + l0ges6 + l0ges7



l111 = 628331966747# * Cos(0 + 0 * T)
l112 = 206059 * Cos(2.678235 + 6283.07585 * T)
l113 = 4303 * Cos(2.6351 + 12566.1517 * T)
l114 = 425 * Cos(1.59 + 3.523 * T)
l115 = 119 * Cos(5.796 + 26.298 * T)
l116 = 109 * Cos(2.966 + 1577.344 * T)
l117 = 93 * Cos(2.59 + 18849.23 * T)
l118 = 72 * Cos(1.14 + 529.69 * T)
l119 = 68 * Cos(1.87 + 398.15 * T)
l120 = 67 * Cos(4.41 + 5507.55 * T)
l121 = 59 * Cos(2.89 + 5223.69 * T)
l122 = 56 * Cos(2.17 + 155.42 * T)
l123 = 45 * Cos(0.4 + 796.3 * T)
l124 = 36 * Cos(0.47 + 775.52 * T)
l125 = 29 * Cos(2.65 + 7.11 * T)
l126 = 19 * Cos(1.85 + 5486.78 * T)
l127 = 19 * Cos(4.97 + 213.3 * T)
l128 = 17 * Cos(2.99 + 6275.96 * T)
l129 = 16 * Cos(0.03 + 2544.31 * T)
l130 = 16 * Cos(1.43 + 2146.17 * T)
l131 = 15 * Cos(1.21 + 10977.08 * T)
l132 = 12 * Cos(2.83 + 1748.02 * T)
l133 = 12 * Cos(3.26 + 5088.63 * T)
l134 = 12 * Cos(5.27 + 1194.45 * T)
l135 = 12 * Cos(2.08 + 4694 * T)
l136 = 11 * Cos(0.77 + 553 * T)
l137 = 10 * Cos(1.3 + 6286.6 * T)
l138 = 10 * Cos(4.24 + 1349.87 * T)
l139 = 9 * Cos(2.7 + 242.73 * T)
l140 = 9 * Cos(5.64 + 951.72 * T)
l141 = 8 * Cos(5.3 + 2352.87 * T)
l142 = 6 * Cos(2.65 + 9437.76 * T)
l143 = 6 * Cos(4.67 + 4690.48 * T)


l1ges1 = l111 + l112 + l113 + l114 + l115 + l116 + l117 + l118 + l119
l1ges2 = l120 + l121 + l122 + l123 + l124 + l125 + l126 + l127 + l128 + l129
l1ges3 = l130 + l131 + l132 + l133 + l134 + l135 + l136 + l137 + l138 + l139
l1ges4 = l140 + l141 + l142 + l143


l1ges = l1ges1 + l1ges2 + l1ges3 + l1ges4


l211 = 52919 * Cos(0 + 0 * T)
l212 = 8720 * Cos(1.0721 + 6283.0758 * T)
l213 = 309 * Cos(0.876 + 12566.152 * T)
l214 = 27 * Cos(0.05 + 3.52 * T)
l215 = 16 * Cos(5.19 + 26.3 * T)
l216 = 16 * Cos(3.68 + 155.42 * T)
l217 = 10 * Cos(0.76 + 18849.23 * T)
l218 = 9 * Cos(2.06 + 77713.77 * T)
l219 = 7 * Cos(0.83 + 775.52 * T)
l220 = 5 * Cos(4.66 + 1577.34 * T)
l221 = 4 * Cos(1.03 + 7.11 * T)
l222 = 4 * Cos(3.44 + 5573.14 * T)
l223 = 3 * Cos(5.14 + 796.3 * T)
l224 = 3 * Cos(6.05 + 5507.55 * T)
l225 = 3 * Cos(1.19 + 242.73 * T)
l226 = 3 * Cos(6.12 + 529.73 * T)
l227 = 3 * Cos(0.31 + 398.15 * T)
l228 = 3 * Cos(2.28 + 553.7 * T)
l229 = 2 * Cos(4.38 + 5223.69 * T)
l230 = 2 * Cos(3.75 + 0.98 * T)

l2ges1 = l211 + l212 + l213 + l214 + l215 + l216 + l217 + l218 + l219
l2ges2 = l220 + l221 + l222 + l223 + l224 + l225 + l226 + l227 + l228 + l229 + l230

l2ges = l2ges1 + l2ges2



l311 = 289 * Cos(5.844 + 6283.076 * T)
l312 = 35 * Cos(0 + 0 * T)
l313 = 17 * Cos(5.49 + 12566.15 * T)
l314 = 3 * Cos(5.2 + 155.42 * T)
l315 = 1 * Cos(4.72 + 3.52 * T)
l316 = 1 * Cos(5.3 + 18849.23 * T)
l318 = 1 * Cos(5.97 + 242.73 * T)

l3ges = l311 + l312 + l313 + l314 + l315 + l316 + l317 + l318

l411 = 114 * Cos(3.142 + 0 * T)
l412 = 8 * Cos(4.13 + 6283.08 * T)
l413 = 1 * Cos(3.84 + 12566.15 * T)

l4ges = l411 + l412 + l413


l5ges = 1 * Cos(3.14 + 0 * T)


Lsonne = ((l0ges + T * l1ges + T * T * l2ges + T * T * T * l3ges + T * T * T * T * l4ges + T * T * T * T * T * l5ges) / 10 ^ 8) * (180 / 3.14159265358979)

bkor = Lsonne - 1.397 * tjh - 0.00031 * tjh * tjh
bkor = (0.03916 / 3600) * (Cos((3.1415926535 / 180) * bkor) - Sin((3.1415926535 / 180) * bkor))


Lsonne = Lsonne + 180 - aber + NutationLnge - 0.000025092
Lsonne = range(Lsonne)

bsonne = bsonne + bkor

decx = Sin((3.1415926535 / 180) * bsonne) * Cos((3.1415926535 / 180) * Ekliptik) + Cos((3.1415926535 / 180) * bsonne) * Sin((3.1415926535 / 180) * Ekliptik) * Sin((3.1415926535 / 180) * Lsonne)

  
DEKSonne = Atn(decx / Sqr(1 - decx * decx)) * 180 / 3.14159265358979

DEKSonne = DEKSonne




   

End Function

Public Function rasonne(JD As Double)


 Dim NutationBreite As Double
Dim NutationLnge As Double
Dim Ekliptik As Double
Dim dtjd As Double
Dim Lsonne As Double

jdx = JD
Jahr = ((jdx + 1524 - 122.1) / 365.25) - 4715.5
Jahr = Fix(Jahr)
u = (Jahr - 1900) / 100
dtjd = (-2.44 + 87.24 * u + 815.2 * u ^ 2 - 2637.8 * u ^ 3 - 18756.33 * u ^ 4 + 124906.15 * u ^ 5 - 303191.19 * u ^ 6 + 372919.88 * u ^ 7 - 232424.66 * u ^ 8 + 58353.42 * u ^ 9)
If Jahr > 1998 Then
dtjd = Jahr * 0.6 - 1135.4
End If
dtjd = Round(dtjd, 0)
dtjd = dtjd / (86400#)

jdx = jdx + dtjd
T = (jdx - 2451545) / 36525
tjh = (jdx - 2451545) / 36525


Ekliptik = 23.43929111 - (46.815 / 3600) * T - (0.00059 / 3600) * T * T + (0.001813 / 3600) * T * T * T

omega = 125.04452 - 1934.136261 * T + 0.0020708 * T * T + T * T * T / 450000
    om1 = 280.4665 + 36000.7698 * T
    om2 = 218.3165 + 481267.8813 * T
    
   NutationLnge = -17.2 * Sin(omega * 3.14159265358979 / 180) - 1.32 * Sin(2 * om1 * 3.14159265358979 / 180) - 0.23 * Sin(2 * om2 * 3.14159265358979 / 180) + 0.21 * Sin(2 * omega * 3.14159265358979 / 180)
  
NutationLnge = NutationLnge / 3600

    
    NL = 280.4665 + 36000.7698 * T
    NLL = 218.3165 + 481267.8813 * T
    
  NutationBreite = 9.2 * Cos(omega * 3.14159265358979 / 180) + 0.57 * Cos(2 * NL * 3.14159265358979 / 180) + 0.1 * Cos(2 * NLL * 3.14159265358979 / 180) - 0.09 * Cos(2 * omega * 3.14159265358979 / 180)
  NutationBreite = NutationBreite / 3600

Ekliptik = Ekliptik + NutationBreite

'Radius Sonne

T = (jdx - (0.0057755183) - 2451545) / 365250



r1 = 100013989 * Cos(0 + 0 * T)
r2 = 1670700 * Cos(3.0984635 + 6283.07585 * T)
r3 = 13956 * Cos(3.05525 + 12566.1517 * T)
r4 = 3084 * Cos(5.1985 + 77713.7715 * T)
r5 = 1628 * Cos(1.1739 + 5753.3849 * T)
r6 = 1576 * Cos(2.8469 + 7860.4194 * T)
r7 = 925 * Cos(5.453 + 11506.77 * T)
r8 = 542 * Cos(4.564 + 3930.21 * T)
r9 = 472 * Cos(3.661 + 5884.927 * T)
r10 = 346 * Cos(0.964 + 5507.553 * T)
r11 = 329 * Cos(5.9 + 5223.694 * T)
r12 = 307 * Cos(0.299 + 5573143 * T)
r13 = 243 * Cos(4.273 + 11790.629 * T)
r14 = 212 * Cos(5.847 + 1577.344 * T)
r15 = 186 * Cos(5.022 + 10977.079 * T)
r16 = 175 * Cos(3.012 + 18849.228 * T)
r17 = 110 * Cos(5.055 + 5486.778 * T)
r18 = 98 * Cos(0.89 + 6069.78 * T)
r19 = 86 * Cos(5.69 + 15720.84 * T)
r20 = 86 * Cos(1.27 + 161000.69 * T)
r21 = 65 * Cos(0.27 + 17260.15 * T)
r22 = 63 * Cos(0.92 + 529.69 * T)
r23 = 57 * Cos(2.01 + 83996 * T)
r24 = 56 * Cos(5.24 + 71430.7 * T)
r25 = 49 * Cos(3.25 + 2544.31 * T)
r26 = 47 * Cos(2.58 + 775.52 * T)
r27 = 45 * Cos(5.54 + 9437.76 * T)
r28 = 43 * Cos(6.01 + 6275.96 * T)
r29 = 39 * Cos(5.36 + 4694 * T)
r30 = 38 * Cos(2.39 + 8827.39 * T)
r31 = 37 * Cos(0.83 + 19651.05 * T)
r32 = 37 * Cos(4.9 + 12139.55 * T)
r33 = 36 * Cos(1.67 + 12036.46 * T)
r34 = 35 * Cos(1.84 + 2942.46 * T)
r35 = 33 * Cos(0.24 + 7084.9 * T)
r36 = 32 * Cos(0.18 + 5088.63 * T)
r37 = 32 * Cos(1.78 + 398.15 * T)
r38 = 28 * Cos(1.21 + 6286.6 * T)
r39 = 28 * Cos(1.9 + 6279.55 * T)
r40 = 26 * Cos(4.59 + 10447.39 * T)
r41 = 56 * Cos(5.24 + 71430.7 * T)
r42 = 49 * Cos(3.25 + 2544.31 * T)
r43 = 47 * Cos(2.58 + 775.52 * T)
r44 = 45 * Cos(5.54 + 9437.76 * T)
r45 = 43 * Cos(6.01 + 6275.96 * T)
r46 = 39 * Cos(5.36 + 4694 * T)
r47 = 38 * Cos(2.39 + 8827.39 * T)
r48 = 37 * Cos(0.83 + 19651.05 * T)
r49 = 37 * Cos(4.9 + 12139.55 * T)
r50 = 36 * Cos(1.67 + 12036.46 * T)
r51 = 35 * Cos(1.84 + 2942.46 * T)
r52 = 33 * Cos(0.24 + 7084.9 * T)
r53 = 32 * Cos(0.18 + 5088.63 * T)
r54 = 32 * Cos(1.78 + 398.15 * T)
r55 = 28 * Cos(1.21 + 6286.6 * T)
r56 = 28 * Cos(1.9 + 6279.55 * T)
r57 = 26 * Cos(4.59 + 10447.39 * T)

rges1 = r1 + r2 + r3 + r4 + r5 + r6 + r7 + r8 + r9 + r10
rges2 = r11 + r12 + r13 + r14 + r15 + r16 + r17 + r18 + r19 + r20
rges3 = r21 + r22 + r23 + r24 + r25 + r26 + r27 + r28 + r29 + r30
rges4 = r31 + r32 + r33 + r34 + r35 + r36 + r37 + r38 + r39 + r40
rges5 = r41 + r42 + r43 + r44 + r45 + r46 + r47 + r48 + r49 + r50
rges6 = r51 + r52 + r53 + r54 + r55 + r56 + r57

rges = rges1 + rges2 + rges3 + rges4 + rges5 + rges6

rr1 = 103019 * Cos(1.10749 + 6283.2075 * T)
rr2 = 1721 * Cos(1.0644 + 12566.1517 * T)
rr3 = 702 * Cos(3.142 + 0 * T)
rr4 = 32 * Cos(1.02 + 18849.23 * T)
rr5 = 31 * Cos(2.84 + 5507.55 * T)
rr6 = 25 * Cos(1.32 + 5223.69 * T)
rr7 = 18 * Cos(1.42 + 1577.34 * T)
rr8 = 10 * Cos(5.91 + 10977.08 * T)
rr9 = 9 * Cos(1.42 + 6275.96 * T)
rr10 = 9 * Cos(0.27 + 5486.78 * T)

rrges = rr1 + rr2 + rr3 + rr4 + rr5 + rr6 + rr7 + rr8 + rr9 + rr10

rrr1 = 4359 * Cos(5.7846 + 6283.0758 * T)
rrr2 = 124 * Cos(5.579 + 12566.152 * T)
rrr3 = 12 * Cos(3.14 + 0 * T)
rrr4 = 9 * Cos(3.63 + 77713.17 * T)
rrr5 = 6 * Cos(1.87 + 5573.14 * T)
rrr6 = 3 * Cos(5.47 + 18849.23 * T)

rrrges = rrr1 + rrr2 + rrr3 + rrr4 + rrr5 + rrr6

rrrr1 = 145 * Cos(4.273 + 6283.076 * T)
rrrr2 = 7 * Cos(3.92 + 12566.15 * T)
rrrrges = rrrr1 + rrrr2
rrrrr1 = 4 * Cos(2.56 + 6283.08 * T)

rson = (rges + rrges * T + rrrges * T ^ 2 + rrrrges * T ^ 3 + rrrrr1 * T ^ 4) / 10 ^ 8


'Aberration

aber = -(20.4898 / 3600) / rson


T = (jdx - (2 * rson * 0.0057755183) - 2451545) / 365250

'Breite


b01 = 280 * Cos(3.199 + 84334.662 * T)
b02 = 102 * Cos(5.422 + 5507.553 * T)
b03 = 80 * Cos(3.88 + 5223.69 * T)
b04 = 44 * Cos(3.7 + 2352.87 * T)
b05 = 32 * Cos(4 + 1577.34 * T)

b0ges = b01 + b02 + b03 + b04 + b05


b11 = 9 * Cos(3.9 + 5507.6 * T)
b12 = 6 * Cos(1.73 + 5223.69 * T)

b1ges = b11 + b12

bsonne = -((b0ges + T * b1ges) / 10 ^ 8) * (180 / 3.14159265358979)




'Lnge


l1 = 175347046 * Cos(0 + 0 * T)
l2 = 3341656 * Cos(4.6692568 + 6283.07585 * T)
l3 = 34894 * Cos(4.6261 + 12566.1517 * T)
l4 = 3497 * Cos(2.7441 + 5753.3849 * T)
l5 = 3418 * Cos(2.8289 + 3.5231 * T)
l6 = 3136 * Cos(3.6277 + 77713.7715 * T)
l7 = 2676 * Cos(4.4181 + 7860.4194 * T)
l8 = 2343 * Cos(6.1353 + 3930.2097 * T)
l9 = 1324 * Cos(0.7425 + 11506.7698 * T)
l10 = 1273 * Cos(2.0371 + 529.691 * T)
l11 = 1199 * Cos(1.1096 + 1577.3435 * T)
l12 = 990 * Cos(5.233 + 5884.927 * T)
l13 = 902 * Cos(2.045 + 26.298 * T)
l14 = 857 * Cos(3.508 + 398.149 * T)
l15 = 780 * Cos(1.179 + 5223.694 * T)
l16 = 753 * Cos(2.533 + 5507.553 * T)
l17 = 505 * Cos(4.583 + 18849.228 * T)
l18 = 492 * Cos(4.205 + 775.523 * T)
l19 = 357 * Cos(2.92 + 0.067 * T)
l20 = 317 * Cos(5.849 + 11790.629 * T)
l21 = 284 * Cos(1.899 + 796.298 * T)
l22 = 271 * Cos(0.315 + 10977.079 * T)
l23 = 243 * Cos(0.345 + 5486.778 * T)
l24 = 206 * Cos(4.806 + 2544.314 * T)
l25 = 205 * Cos(1.869 + 5573.143 * T)
l26 = 202 * Cos(2.458 + 6069.777 * T)
l27 = 156 * Cos(0.833 + 213.299 * T)
l28 = 132 * Cos(3.411 + 2942.463 * T)
l29 = 126 * Cos(1.083 + 20.775 * T)
l30 = 115 * Cos(0.645 + 0.98 * T)
l31 = 103 * Cos(0.636 + 4694.003 * T)
l32 = 102 * Cos(0.976 + 15720.839 * T)
l33 = 102 * Cos(4.267 + 7.114 * T)
l34 = 99 * Cos(6.21 + 2146.17 * T)
l35 = 98 * Cos(0.86 + 155.4 * T)
l36 = 86 * Cos(5.98 + 161000.7 * T)
l37 = 85 * Cos(1.3 + 6275.96 * T)
l38 = 85 * Cos(3.67 + 71430.7 * T)
l39 = 80 * Cos(1.81 + 17260.15 * T)
l40 = 79 * Cos(3.04 + 12036.46 * T)
l41 = 75 * Cos(1.76 + 5088.63 * T)
l42 = 74 * Cos(3.5 + 3154.69 * T)
l43 = 74 * Cos(4.68 + 801.82 * T)
l44 = 70 * Cos(0.83 + 9437.76 * T)
l45 = 62 * Cos(3.98 + 8827.39 * T)
l46 = 61 * Cos(1.82 + 7084.9 * T)
l47 = 57 * Cos(2.78 + 6286.6 * T)
l48 = 56 * Cos(4.39 + 14143.5 * T)
l49 = 56 * Cos(3.47 + 6279.55 * T)
l50 = 52 * Cos(0.19 + 12139.55 * T)
l51 = 52 * Cos(1.33 + 1748.02 * T)
l52 = 51 * Cos(0.28 + 5856.48 * T)
l53 = 49 * Cos(0.49 + 119.45 * T)
l54 = 41 * Cos(5.37 + 8429.24 * T)
l55 = 41 * Cos(2.4 + 19651.05 * T)
l56 = 39 * Cos(6.17 + 10447.39 * T)
l57 = 37 * Cos(6.04 + 10213.29 * T)
l58 = 37 * Cos(2.57 + 1059.38 * T)
l59 = 36 * Cos(1.71 + 2352.87 * T)
l60 = 36 * Cos(1.78 + 6812.77 * T)
l61 = 33 * Cos(0.59 + 17789.85 * T)
l62 = 30 * Cos(0.44 + 83996.85 * T)
l63 = 30 * Cos(2.74 + 1349.87 * T)
l64 = 25 * Cos(3.16 + 4690.48 * T)


l0ges1 = l1 + l2 + l3 + l4 + l5 + l6 + l7 + l8 + l9 + l10
l0ges2 = l11 + l12 + l13 + l14 + l15 + l16 + l17 + l18 + l19 + l20
l0ges3 = l21 + l22 + l23 + l24 + l25 + l26 + l27 + l28 + l29 + l30
l0ges4 = l31 + l32 + l33 + l34 + l35 + l36 + l37 + l38 + l39 + l40
l0ges5 = l41 + l42 + l43 + l44 + l45 + l46 + l47 + l48 + l49 + l50
l0ges6 = l51 + l52 + l53 + l54 + l55 + l56 + l57 + l58 + l59 + l60
l0ges7 = l61 + l62 + l63 + l64

l0ges = l0ges1 + l0ges2 + l0ges3 + l0ges4 + l0ges5 + l0ges6 + l0ges7



l111 = 628331966747# * Cos(0 + 0 * T)
l112 = 206059 * Cos(2.678235 + 6283.07585 * T)
l113 = 4303 * Cos(2.6351 + 12566.1517 * T)
l114 = 425 * Cos(1.59 + 3.523 * T)
l115 = 119 * Cos(5.796 + 26.298 * T)
l116 = 109 * Cos(2.966 + 1577.344 * T)
l117 = 93 * Cos(2.59 + 18849.23 * T)
l118 = 72 * Cos(1.14 + 529.69 * T)
l119 = 68 * Cos(1.87 + 398.15 * T)
l120 = 67 * Cos(4.41 + 5507.55 * T)
l121 = 59 * Cos(2.89 + 5223.69 * T)
l122 = 56 * Cos(2.17 + 155.42 * T)
l123 = 45 * Cos(0.4 + 796.3 * T)
l124 = 36 * Cos(0.47 + 775.52 * T)
l125 = 29 * Cos(2.65 + 7.11 * T)
l126 = 19 * Cos(1.85 + 5486.78 * T)
l127 = 19 * Cos(4.97 + 213.3 * T)
l128 = 17 * Cos(2.99 + 6275.96 * T)
l129 = 16 * Cos(0.03 + 2544.31 * T)
l130 = 16 * Cos(1.43 + 2146.17 * T)
l131 = 15 * Cos(1.21 + 10977.08 * T)
l132 = 12 * Cos(2.83 + 1748.02 * T)
l133 = 12 * Cos(3.26 + 5088.63 * T)
l134 = 12 * Cos(5.27 + 1194.45 * T)
l135 = 12 * Cos(2.08 + 4694 * T)
l136 = 11 * Cos(0.77 + 553 * T)
l137 = 10 * Cos(1.3 + 6286.6 * T)
l138 = 10 * Cos(4.24 + 1349.87 * T)
l139 = 9 * Cos(2.7 + 242.73 * T)
l140 = 9 * Cos(5.64 + 951.72 * T)
l141 = 8 * Cos(5.3 + 2352.87 * T)
l142 = 6 * Cos(2.65 + 9437.76 * T)
l143 = 6 * Cos(4.67 + 4690.48 * T)


l1ges1 = l111 + l112 + l113 + l114 + l115 + l116 + l117 + l118 + l119
l1ges2 = l120 + l121 + l122 + l123 + l124 + l125 + l126 + l127 + l128 + l129
l1ges3 = l130 + l131 + l132 + l133 + l134 + l135 + l136 + l137 + l138 + l139
l1ges4 = l140 + l141 + l142 + l143


l1ges = l1ges1 + l1ges2 + l1ges3 + l1ges4


l211 = 52919 * Cos(0 + 0 * T)
l212 = 8720 * Cos(1.0721 + 6283.0758 * T)
l213 = 309 * Cos(0.876 + 12566.152 * T)
l214 = 27 * Cos(0.05 + 3.52 * T)
l215 = 16 * Cos(5.19 + 26.3 * T)
l216 = 16 * Cos(3.68 + 155.42 * T)
l217 = 10 * Cos(0.76 + 18849.23 * T)
l218 = 9 * Cos(2.06 + 77713.77 * T)
l219 = 7 * Cos(0.83 + 775.52 * T)
l220 = 5 * Cos(4.66 + 1577.34 * T)
l221 = 4 * Cos(1.03 + 7.11 * T)
l222 = 4 * Cos(3.44 + 5573.14 * T)
l223 = 3 * Cos(5.14 + 796.3 * T)
l224 = 3 * Cos(6.05 + 5507.55 * T)
l225 = 3 * Cos(1.19 + 242.73 * T)
l226 = 3 * Cos(6.12 + 529.73 * T)
l227 = 3 * Cos(0.31 + 398.15 * T)
l228 = 3 * Cos(2.28 + 553.7 * T)
l229 = 2 * Cos(4.38 + 5223.69 * T)
l230 = 2 * Cos(3.75 + 0.98 * T)





l2ges1 = l211 + l212 + l213 + l214 + l215 + l216 + l217 + l218 + l219
l2ges2 = l220 + l221 + l222 + l223 + l224 + l225 + l226 + l227 + l228 + l229 + l230

l2ges = l2ges1 + l2ges2



l311 = 289 * Cos(5.844 + 6283.076 * T)
l312 = 35 * Cos(0 + 0 * T)
l313 = 17 * Cos(5.49 + 12566.15 * T)
l314 = 3 * Cos(5.2 + 155.42 * T)
l315 = 1 * Cos(4.72 + 3.52 * T)
l316 = 1 * Cos(5.3 + 18849.23 * T)
l318 = 1 * Cos(5.97 + 242.73 * T)

l3ges = l311 + l312 + l313 + l314 + l315 + l316 + l317 + l318

l411 = 114 * Cos(3.142 + 0 * T)
l412 = 8 * Cos(4.13 + 6283.08 * T)
l413 = 1 * Cos(3.84 + 12566.15 * T)

l4ges = l411 + l412 + l413


l5ges = 1 * Cos(3.14 + 0 * T)


lsun = ((l0ges + T * l1ges + T * T * l2ges + T * T * T * l3ges + T * T * T * T * l4ges + T * T * T * T * T * l5ges) / 10 ^ 8) * (180 / 3.14159265358979)

bkor = lsun - 1.397 * tjh - 0.00031 * tjh * tjh
bkor = (0.03916 / 3600) * (Cos((3.1415926535 / 180) * bkor) - Sin((3.1415926535 / 180) * bkor))


lsun = range(lsun + 180 - aber + NutationLnge - 0.000025092)

bsonne = bsonne + bkor


decx = Sin((3.1415926535 / 180) * bsonne) * Cos((3.1415926535 / 180) * Ekliptik) + Cos((3.1415926535 / 180) * bsonne) * Sin((3.1415926535 / 180) * Ekliptik) * Sin((3.1415926535 / 180) * lson)

  
dek = Atn(decx / Sqr(1 - decx * decx)) * 180 / 3.14159265358979



rax = Sin((3.1415926535 / 180) * lsun) * Cos((3.1415926535 / 180) * Ekliptik) - Tan((3.1415926535 / 180) * bsonne) * Sin((3.1415926535 / 180) * Ekliptik)

ray = Cos((3.1415926535 / 180) * lsun)

rasun = Atn(rax / ray) * 180 / 3.14159265358979

If ray < 0 Then
   rasun = 180 + rasun
End If
     
If rasun < 0 Then
rasun = 360 + rasun
End If

If rasun > 360 Then
rasun = rasun - 360
End If


rasonne = rasun


End Function


Function moz(T As Date, L As Double, zeitgl As Double, zeitzo As Double)


L = -1 * L
L = (L / 15) / 24

   
    stunde = hour(T)
    min = Minute(T)
    sec = Second(T)

utl = stunde + min / 60 + sec / 3600
utl = (utl / 24) - zeitzo / 24

moz = utl - L


If moz > 1 Then
moz = moz - 1

End If

If moz < 0 Then
moz = moz + 1

End If

moz = moz


End Function
Function woz(zeitgl As Double, zeitmoz As Double) As Date

woz = zeitmoz - zeitgl / (24 * 60)

If woz > 1 Then
woz = woz - 1

End If

If woz < 0 Then
woz = woz + 1

End If

woz = woz

End Function



Function GeogrLnge(RA As Double, GMST As Double) As Double


       
  GeogrLnge = rang(RA - GMST)
  

End Function





Function rsonne(JD As Double) As Double

T = (JD + 1 / (60 * 24) - 2451545) / 365250

r1 = 100013989 * Cos(0 + 0 * T)
r2 = 1670700 * Cos(3.0984635 + 6283.07585 * T)
r3 = 13956 * Cos(3.05525 + 12566.1517 * T)
r4 = 3084 * Cos(5.1985 + 77713.7715 * T)
r5 = 1628 * Cos(1.1739 + 5753.3849 * T)
r6 = 1576 * Cos(2.8469 + 7860.4194 * T)
r7 = 925 * Cos(5.453 + 11506.77 * T)
r8 = 542 * Cos(4.564 + 3930.21 * T)
r9 = 472 * Cos(3.661 + 5884.927 * T)
r10 = 346 * Cos(0.964 + 5507.553 * T)
r11 = 329 * Cos(5.9 + 5223.694 * T)
r12 = 307 * Cos(0.299 + 5573143 * T)
r13 = 243 * Cos(4.273 + 11790.629 * T)
r14 = 212 * Cos(5.847 + 1577.344 * T)
r15 = 186 * Cos(5.022 + 10977.079 * T)
r16 = 175 * Cos(3.012 + 18849.228 * T)
r17 = 110 * Cos(5.055 + 5486.778 * T)
r18 = 98 * Cos(0.89 + 6069.78 * T)
r19 = 86 * Cos(5.69 + 15720.84 * T)
r20 = 86 * Cos(1.27 + 161000.69 * T)
r21 = 65 * Cos(0.27 + 17260.15 * T)
r22 = 63 * Cos(0.92 + 529.69 * T)
r23 = 57 * Cos(2.01 + 83996 * T)
r24 = 56 * Cos(5.24 + 71430.7 * T)
r25 = 49 * Cos(3.25 + 2544.31 * T)
r26 = 47 * Cos(2.58 + 775.52 * T)
r27 = 45 * Cos(5.54 + 9437.76 * T)
r28 = 43 * Cos(6.01 + 6275.96 * T)
r29 = 39 * Cos(5.36 + 4694 * T)
r30 = 38 * Cos(2.39 + 8827.39 * T)
r31 = 37 * Cos(0.83 + 19651.05 * T)
r32 = 37 * Cos(4.9 + 12139.55 * T)
r33 = 36 * Cos(1.67 + 12036.46 * T)
r34 = 35 * Cos(1.84 + 2942.46 * T)
r35 = 33 * Cos(0.24 + 7084.9 * T)
r36 = 32 * Cos(0.18 + 5088.63 * T)
r37 = 32 * Cos(1.78 + 398.15 * T)
r38 = 28 * Cos(1.21 + 6286.6 * T)
r39 = 28 * Cos(1.9 + 6279.55 * T)
r40 = 26 * Cos(4.59 + 10447.39 * T)
r41 = 56 * Cos(5.24 + 71430.7 * T)
r42 = 49 * Cos(3.25 + 2544.31 * T)
r43 = 47 * Cos(2.58 + 775.52 * T)
r44 = 45 * Cos(5.54 + 9437.76 * T)
r45 = 43 * Cos(6.01 + 6275.96 * T)
r46 = 39 * Cos(5.36 + 4694 * T)
r47 = 38 * Cos(2.39 + 8827.39 * T)
r48 = 37 * Cos(0.83 + 19651.05 * T)
r49 = 37 * Cos(4.9 + 12139.55 * T)
r50 = 36 * Cos(1.67 + 12036.46 * T)
r51 = 35 * Cos(1.84 + 2942.46 * T)
r52 = 33 * Cos(0.24 + 7084.9 * T)
r53 = 32 * Cos(0.18 + 5088.63 * T)
r54 = 32 * Cos(1.78 + 398.15 * T)
r55 = 28 * Cos(1.21 + 6286.6 * T)
r56 = 28 * Cos(1.9 + 6279.55 * T)
r57 = 26 * Cos(4.59 + 10447.39 * T)


rges1 = r1 + r2 + r3 + r4 + r5 + r6 + r7 + r8 + r9 + r10
rges2 = r11 + r12 + r13 + r14 + r15 + r16 + r17 + r18 + r19 + r20
rges3 = r21 + r22 + r23 + r24 + r25 + r26 + r27 + r28 + r29 + r30
rges4 = r31 + r32 + r33 + r34 + r35 + r36 + r37 + r38 + r39 + r40
rges5 = r41 + r42 + r43 + r44 + r45 + r46 + r47 + r48 + r49 + r50
rges6 = r51 + r52 + r53 + r54 + r55 + r56 + r57

rges = rges1 + rges2 + rges3 + rges4 + rges5 + rges6



rr1 = 103019 * Cos(1.10749 + 6283.2075 * T)
rr2 = 1721 * Cos(1.0644 + 12566.1517 * T)
rr3 = 702 * Cos(3.142 + 0 * T)
rr4 = 32 * Cos(1.02 + 18849.23 * T)
rr5 = 31 * Cos(2.84 + 5507.55 * T)
rr6 = 25 * Cos(1.32 + 5223.69 * T)
rr7 = 18 * Cos(1.42 + 1577.34 * T)
rr8 = 10 * Cos(5.91 + 10977.08 * T)
rr9 = 9 * Cos(1.42 + 6275.96 * T)
rr10 = 9 * Cos(0.27 + 5486.78 * T)

rrges = rr1 + rr2 + rr3 + rr4 + rr5 + rr6 + rr7 + rr8 + rr9 + rr10


rrr1 = 4359 * Cos(5.7846 + 6283.0758 * T)
rrr2 = 124 * Cos(5.579 + 12566.152 * T)
rrr3 = 12 * Cos(3.14 + 0 * T)
rrr4 = 9 * Cos(3.63 + 77713.17 * T)
rrr5 = 6 * Cos(1.87 + 5573.14 * T)
rrr6 = 3 * Cos(5.47 + 18849.23 * T)


rrrges = rrr1 + rrr2 + rrr3 + rrr4 + rrr5 + rrr6


rrrr1 = 145 * Cos(4.273 + 6283.076 * T)
rrrr2 = 7 * Cos(3.92 + 12566.15 * T)

rrrrges = rrrr1 + rrrr2

rrrrr1 = 4 * Cos(2.56 + 6283.08 * T)



rsonne = (rges + rrges * T + rrrges * T ^ 2 + rrrrges * T ^ 3 + rrrrr1 * T ^ 4) / 10 ^ 8






End Function




Function dgmond(Jahr As Integer, monat As Integer, tag As Integer, Lnge As Double, Zeitzone As Integer) As Double


    Dim nm As Double, im As Double, wm As Double, am As Double, ecm As Double, _
    mm As Double, em As Double, Ms As Double, ws As Double, xv As Double, _
    yv As Double, vm As Double, rm As Double, x As Double, Y As Double, _
    Z As Double, lon As Double, lat As Double, ls As Double, lm As Double, _
    dm As Double, F As Double, dlong As Double, dlat As Double, AzimutN As Double, jdnull As Double, JD As Double


Breite = 35

If monat > 2 Then
    monat = monat
    Jahr = Jahr
    End If
    
    If monat <= 2 Then
    monat = monat + 12
    Jahr = Jahr - 1
    End If
    
    aaaaa = Fix(Jahr / 100)
    bbbbb = 2 - aaaaa + Fix(aaaaa / 4)
    
    jdnull = Fix(365.25 * (Jahr + 4716)) + Fix(30.6001 * (monat + 1)) + tag + bbbbb - 1524.5
    jdnull = jdnull - Zeitzone / 24


JD = jdnull


nn = 0
For ii = 0 To 4320 Step 1
aaaaaa = ii / 4320

JD = jdnull + aaaaaa




kk = 3.14159265358979 / 180
d = JD - 2451543.5
jdx = JD


  
    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)

  
    
    dec = decmoon

    RA = ramoon
    
     
    
    
  
  dz = (jdx - 2451545) / 36525
  
  gst = range360(280.46061837 + 360.98564736629 * (jdx - 2451545) + 0.000387933 * dz * dz - dz * dz * dz / 38710000)
  
   
      
    If Lnge < 0 Then
Lnge = 360 + Lnge
End If

Stdw = range360(gst - (360 - Lnge) - RA)
   
    
aaa = Sin(Stdw * 3.14159265358979 / 180)
bbb = Cos(Stdw * 3.14159265358979 / 180) * Sin(Breite * 3.14159265358979 / 180) - Tan(dec * 3.14159265358979 / 180) * Cos(Breite * 3.14159265358979 / 180)

cccc = Application.Atan2(bbb, aaa) * 180 / 3.14159265358979 + 180

If ccc < 0 Then ccc = ccc + 360 Else

AzimutN = cccc

dgmond = AzimutN
 
    
 If dgmond >= 179.3 And dgmond <= 180.3 Then
nn = 1
aaaaaa = aaaaaa

GoTo 100

End If

DoEvents

Next
    
100:

nn = nn

    
 dgmond = aaaaaa * 24 / 24
 If nn = 0 Then
 dgmond = "-"
 End If
 
 
  dgmond = dgmond
  
  
  
  
  
  If nn = 1 Then
  jddg = aaaaaa + jdnull + 1 / (24 * 60)
  JD = jddg
  End If
  
  
  
  
  
  
  
 kk = 3.14159265358979 / 180
d = JD - 2451543.5
jdx = JD


  
    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)

  
    
    dec = decmoon

    RA = ramoon
    
     
    
    
  
  dz = (jdx - 2451545) / 36525
  
  gst = range360(280.46061837 + 360.98564736629 * (jdx - 2451545) + 0.000387933 * dz * dz - dz * dz * dz / 38710000)
  
   
      
    If Lnge < 0 Then
Lnge = 360 + Lnge
End If

Stdw = range360(gst - (360 - Lnge) - RA)
   
    
aaa = Sin(Stdw * 3.14159265358979 / 180)
bbb = Cos(Stdw * 3.14159265358979 / 180) * Sin(Breite * 3.14159265358979 / 180) - Tan(dec * 3.14159265358979 / 180) * Cos(Breite * 3.14159265358979 / 180)

cccc = Application.Atan2(bbb, aaa) * 180 / 3.14159265358979 + 180

If ccc < 0 Then ccc = ccc + 360 Else

AzimutN2 = cccc
  
  
  
azidifmin = AzimutN2 - AzimutN
graddif = 1 / azidifmin

azidif = 180 - AzimutN
  
zeitadi = graddif * azidif
  
 zeitadi = zeitadi / (24 * 60)
 
 
  dgmond = dgmond + zeitadi
  
  
  
  zeit = dgmond
  
  
  
  stunde = Fix(zeit * 24)
  min = Fix(60 * (zeit * 24 - stunde))
  
  sekv = stunde * 3600 + min * 60
  seki = zeit * 24 * 3600
  sekr = seki - sekv
  
  zeit = 0
  
  If sekr >= 30 Then
  zeit = 0.00069444
  End If
  
  
  zeitm = dgmond * 24 * 60 + zeit * 60 * 24
  zeitm = Fix(zeitm)
  zeitdg = zeitm / (24 * 60)
   
  
    
 
  dgmond = zeitdg
  
  
  If dgmond < 0 Or nn = 0 Then
  dgmond = "-"
  End If
    
  
  

    
End Function







Function frhling(Jahr As Integer) As Double





jr = (Jahr - 2000) / 1000

jdef = 2451623.80984 + 365242.37404 * jr + 0.05169 * jr ^ 2 - 0.00411 * jr ^ 3 - 0.00057 * jr ^ 4

jdes = 2451716.56767 + 365241.62603 * jr + 0.00325 * jr * jr + 0.00888 * jr ^ 3 - 0.0003 * jr ^ 4

jdeh = 2451810.21715 + 365242.01767 * jr - 0.11575 * jr ^ 2 + 0.00337 * jr ^ 3 + 0.00078 * jr ^ 4

jdew = 2451900.05952 + 365242.74049 * jr - 0.06223 * jr ^ 2 - 0.00823 * jr ^ 3 + 0.00032 * jr ^ 4

tf = (jdef - 2451545) / 36525
ts = (jdes - 2451545) / 36525
th = (jdeh - 2451545) / 36525
tw = (jdew - 2451545) / 36525

wf = 35999.373 * tf - 2.47
ws = 35999.373 * ts - 2.47
wh = 35999.373 * th - 2.47
ww = 35999.373 * tw - 2.47

lf = 1 + 0.0334 * Cos(wf * 3.14159265358979 / 180) + 0.0007 * Cos(2 * wf * 3.14159265358979 / 180)

ls = 1 + 0.0334 * Cos(ws * 3.14159265358979 / 180) + 0.0007 * Cos(2 * ws * 3.14159265358979 / 180)

lh = 1 + 0.0334 * Cos(wh * 3.14159265358979 / 180) + 0.0007 * Cos(2 * wh * 3.14159265358979 / 180)

lw = 1 + 0.0334 * Cos(ww * 3.14159265358979 / 180) + 0.0007 * Cos(2 * ww * 3.14159265358979 / 180)



sf1 = 485 * Cos((324.96 + 1934.136 * tf) * 3.14159265358979 / 180) + 203 * Cos((337.23 + 32964.467 * tf) * 3.14159265358979 / 180) + 199 * Cos((342.08 + 20.186 * tf) * 3.14159265358979 / 180) + 182 * Cos((27.85 + 445267.112 * tf) * 3.14159265358979 / 180) + 156 * Cos((73.14 + 45036.886 * tf) * 3.14159265358979 / 180) + 136 * Cos((171.52 + 22518.443 * tf) * 3.14159265358979 / 180) + 77 * Cos((222.54 + 65928.934 * tf) * 3.14159265358979 / 180) + 74 * Cos((296.72 + 3034.906 * tf) * 3.14159265358979 / 180) + 70 * Cos((243.58 + 9037.513 * tf) * 3.14159265358979 / 180) + 58 * Cos((119.81 + 33718.147 * tf) * 3.14159265358979 / 180) + 52 * Cos((297.17 + 150.678 * tf) * 3.14159265358979 / 180) + 50 * Cos((21.02 + 2281.226) * 3.14159265358979 / 180)

sf2 = 45 * Cos((247.54 + 29929.562 * tf) * 3.14159265358979 / 180) + 44 * Cos((325.15 + 31555.956 * tf) * 3.14159265358979 / 180) + 29 * Cos((60.93 + 4443.417 * tf) * 3.14159265358979 / 180) + 18 * Cos((155.12 + 67555.328 * tf) * 3.14159265358979 / 180) + 17 * Cos((288.79 + 4562.452 * tf) * 3.14159265358979 / 180) + 16 * Cos((198.04 + 62894.029 * tf) * 3.14159265358979 / 180) + 14 * Cos((199.76 + 31436.921 * tf) * 3.14159265358979 / 180) + 12 * Cos((95.39 + 14577.848 * tf) * 3.14159265358979 / 180) + 12 * Cos((287.11 + 31931.756 * tf) * 3.14159265358979 / 180) + 12 * Cos((320.81 + 34777.259 * tf) * 3.14159265358979 / 180) + 9 * Cos((227.73 + 1222.114 * tf) * 3.14159265358979 / 180) + 8 * Cos((15.45 + 16859.074 * tf) * 3.14159265358979 / 180)

sf = sf1 + sf2


ss1 = 485 * Cos((324.96 + 1934.136 * ts) * 3.14159265358979 / 180) + 203 * Cos((337.23 + 32964.467 * ts) * 3.14159265358979 / 180) + 199 * Cos((342.08 + 20.186 * ts) * 3.14159265358979 / 180) + 182 * Cos((27.85 + 445267.112 * ts) * 3.14159265358979 / 180) + 156 * Cos((73.14 + 45036.886 * ts) * 3.14159265358979 / 180) + 136 * Cos((171.52 + 22518.443 * ts) * 3.14159265358979 / 180) + 77 * Cos((222.54 + 65928.934 * ts) * 3.14159265358979 / 180) + 74 * Cos((296.72 + 3034.906 * ts) * 3.14159265358979 / 180) + 70 * Cos((243.58 + 9037.513 * ts) * 3.14159265358979 / 180) + 58 * Cos((119.81 + 33718.147 * ts) * 3.14159265358979 / 180) + 52 * Cos((297.17 + 150.678 * ts) * 3.14159265358979 / 180) + 50 * Cos((21.02 + 2281.226) * 3.14159265358979 / 180)

ss2 = 45 * Cos((247.54 + 29929.562 * ts) * 3.14159265358979 / 180) + 44 * Cos((325.15 + 31555.956 * ts) * 3.14159265358979 / 180) + 29 * Cos((60.93 + 4443.417 * ts) * 3.14159265358979 / 180) + 18 * Cos((155.12 + 67555.328 * ts) * 3.14159265358979 / 180) + 17 * Cos((288.79 + 4562.452 * ts) * 3.14159265358979 / 180) + 16 * Cos((198.04 + 62894.029 * ts) * 3.14159265358979 / 180) + 14 * Cos((199.76 + 31436.921 * ts) * 3.14159265358979 / 180) + 12 * Cos((95.39 + 14577.848 * ts) * 3.14159265358979 / 180) + 12 * Cos((287.11 + 31931.756 * ts) * 3.14159265358979 / 180) + 12 * Cos((320.81 + 34777.259 * ts) * 3.14159265358979 / 180) + 9 * Cos((227.73 + 1222.114 * ts) * 3.14159265358979 / 180) + 8 * Cos((15.45 + 16859.074 * ts) * 3.14159265358979 / 180)

ss = ss1 + ss2


sh1 = 485 * Cos((324.96 + 1934.136 * th) * 3.14159265358979 / 180) + 203 * Cos((337.23 + 32964.467 * th) * 3.14159265358979 / 180) + 199 * Cos((342.08 + 20.186 * th) * 3.14159265358979 / 180) + 182 * Cos((27.85 + 445267.112 * th) * 3.14159265358979 / 180) + 156 * Cos((73.14 + 45036.886 * th) * 3.14159265358979 / 180) + 136 * Cos((171.52 + 22518.443 * th) * 3.14159265358979 / 180) + 77 * Cos((222.54 + 65928.934 * th) * 3.14159265358979 / 180) + 74 * Cos((296.72 + 3034.906 * th) * 3.14159265358979 / 180) + 70 * Cos((243.58 + 9037.513 * th) * 3.14159265358979 / 180) + 58 * Cos((119.81 + 33718.147 * th) * 3.14159265358979 / 180) + 52 * Cos((297.17 + 150.678 * th) * 3.14159265358979 / 180) + 50 * Cos((21.02 + 2281.226) * 3.14159265358979 / 180)

sh2 = 45 * Cos((247.54 + 29929.562 * th) * 3.14159265358979 / 180) + 44 * Cos((325.15 + 31555.956 * th) * 3.14159265358979 / 180) + 29 * Cos((60.93 + 4443.417 * th) * 3.14159265358979 / 180) + 18 * Cos((155.12 + 67555.328 * th) * 3.14159265358979 / 180) + 17 * Cos((288.79 + 4562.452 * th) * 3.14159265358979 / 180) + 16 * Cos((198.04 + 62894.029 * th) * 3.14159265358979 / 180) + 14 * Cos((199.76 + 31436.921 * th) * 3.14159265358979 / 180) + 12 * Cos((95.39 + 14577.848 * th) * 3.14159265358979 / 180) + 12 * Cos((287.11 + 31931.756 * th) * 3.14159265358979 / 180) + 12 * Cos((320.81 + 34777.259 * th) * 3.14159265358979 / 180) + 9 * Cos((227.73 + 1222.114 * th) * 3.14159265358979 / 180) + 8 * Cos((15.45 + 16859.074 * th) * 3.14159265358979 / 180)

sh = sh1 + sh2


sw1 = 485 * Cos((324.96 + 1934.136 * tw) * 3.14159265358979 / 180) + 203 * Cos((337.23 + 32964.467 * tw) * 3.14159265358979 / 180) + 199 * Cos((342.08 + 20.186 * tw) * 3.14159265358979 / 180) + 182 * Cos((27.85 + 445267.112 * tw) * 3.14159265358979 / 180) + 156 * Cos((73.14 + 45036.886 * tw) * 3.14159265358979 / 180) + 136 * Cos((171.52 + 22518.443 * tw) * 3.14159265358979 / 180) + 77 * Cos((222.54 + 65928.934 * tw) * 3.14159265358979 / 180) + 74 * Cos((296.72 + 3034.906 * tw) * 3.14159265358979 / 180) + 70 * Cos((243.58 + 9037.513 * tw) * 3.14159265358979 / 180) + 58 * Cos((119.81 + 33718.147 * tw) * 3.14159265358979 / 180) + 52 * Cos((297.17 + 150.678 * tw) * 3.14159265358979 / 180) + 50 * Cos((21.02 + 2281.226) * 3.14159265358979 / 180)

sw2 = 45 * Cos((247.54 + 29929.562 * tw) * 3.14159265358979 / 180) + 44 * Cos((325.15 + 31555.956 * tw) * 3.14159265358979 / 180) + 29 * Cos((60.93 + 4443.417 * tw) * 3.14159265358979 / 180) + 18 * Cos((155.12 + 67555.328 * tw) * 3.14159265358979 / 180) + 17 * Cos((288.79 + 4562.452 * tw) * 3.14159265358979 / 180) + 16 * Cos((198.04 + 62894.029 * tw) * 3.14159265358979 / 180) + 14 * Cos((199.76 + 31436.921 * tw) * 3.14159265358979 / 180) + 12 * Cos((95.39 + 14577.848 * tw) * 3.14159265358979 / 180) + 12 * Cos((287.11 + 31931.756 * tw) * 3.14159265358979 / 180) + 12 * Cos((320.81 + 34777.259 * tw) * 3.14159265358979 / 180) + 9 * Cos((227.73 + 1222.114 * tw) * 3.14159265358979 / 180) + 8 * Cos((15.45 + 16859.074 * tw) * 3.14159265358979 / 180)

sw = sw1 + sw2





jdef = jdef + 0.00001 * sf / lf - 1 / (60 * 24)

jdes = jdes + 0.00001 * ss / ls - 1 / (60 * 24)

jdeh = jdeh + 0.00001 * sh / lh - 1 / (60 * 24)

jdew = jdew + 0.00001 * sw / lw - 1 / (60 * 24)


frhling = jdef




End Function



Function sommer(Jahr As Integer) As Double





jr = (Jahr - 2000) / 1000

jdef = 2451623.80984 + 365242.37404 * jr + 0.05169 * jr ^ 2 - 0.00411 * jr ^ 3 - 0.00057 * jr ^ 4

jdes = 2451716.56767 + 365241.62603 * jr + 0.00325 * jr * jr + 0.00888 * jr ^ 3 - 0.0003 * jr ^ 4

jdeh = 2451810.21715 + 365242.01767 * jr - 0.11575 * jr ^ 2 + 0.00337 * jr ^ 3 + 0.00078 * jr ^ 4

 jdew = 2451900.05952 + 365242.74049 * jr - 0.06223 * jr ^ 2 - 0.00823 * jr ^ 3 + 0.00032 * jr ^ 4

tf = (jdef - 2451545) / 36525
ts = (jdes - 2451545) / 36525
th = (jdeh - 2451545) / 36525
tw = (jdew - 2451545) / 36525

wf = 35999.373 * tf - 2.47
ws = 35999.373 * ts - 2.47
wh = 35999.373 * th - 2.47
ww = 35999.373 * tw - 2.47

lf = 1 + 0.0334 * Cos(wf * 3.14159265358979 / 180) + 0.0007 * Cos(2 * wf * 3.14159265358979 / 180)

ls = 1 + 0.0334 * Cos(ws * 3.14159265358979 / 180) + 0.0007 * Cos(2 * ws * 3.14159265358979 / 180)

lh = 1 + 0.0334 * Cos(wh * 3.14159265358979 / 180) + 0.0007 * Cos(2 * wh * 3.14159265358979 / 180)

lw = 1 + 0.0334 * Cos(ww * 3.14159265358979 / 180) + 0.0007 * Cos(2 * ww * 3.14159265358979 / 180)



sf1 = 485 * Cos((324.96 + 1934.136 * tf) * 3.14159265358979 / 180) + 203 * Cos((337.23 + 32964.467 * tf) * 3.14159265358979 / 180) + 199 * Cos((342.08 + 20.186 * tf) * 3.14159265358979 / 180) + 182 * Cos((27.85 + 445267.112 * tf) * 3.14159265358979 / 180) + 156 * Cos((73.14 + 45036.886 * tf) * 3.14159265358979 / 180) + 136 * Cos((171.52 + 22518.443 * tf) * 3.14159265358979 / 180) + 77 * Cos((222.54 + 65928.934 * tf) * 3.14159265358979 / 180) + 74 * Cos((296.72 + 3034.906 * tf) * 3.14159265358979 / 180) + 70 * Cos((243.58 + 9037.513 * tf) * 3.14159265358979 / 180) + 58 * Cos((119.81 + 33718.147 * tf) * 3.14159265358979 / 180) + 52 * Cos((297.17 + 150.678 * tf) * 3.14159265358979 / 180) + 50 * Cos((21.02 + 2281.226) * 3.14159265358979 / 180)

sf2 = 45 * Cos((247.54 + 29929.562 * tf) * 3.14159265358979 / 180) + 44 * Cos((325.15 + 31555.956 * tf) * 3.14159265358979 / 180) + 29 * Cos((60.93 + 4443.417 * tf) * 3.14159265358979 / 180) + 18 * Cos((155.12 + 67555.328 * tf) * 3.14159265358979 / 180) + 17 * Cos((288.79 + 4562.452 * tf) * 3.14159265358979 / 180) + 16 * Cos((198.04 + 62894.029 * tf) * 3.14159265358979 / 180) + 14 * Cos((199.76 + 31436.921 * tf) * 3.14159265358979 / 180) + 12 * Cos((95.39 + 14577.848 * tf) * 3.14159265358979 / 180) + 12 * Cos((287.11 + 31931.756 * tf) * 3.14159265358979 / 180) + 12 * Cos((320.81 + 34777.259 * tf) * 3.14159265358979 / 180) + 9 * Cos((227.73 + 1222.114 * tf) * 3.14159265358979 / 180) + 8 * Cos((15.45 + 16859.074 * tf) * 3.14159265358979 / 180)

sf = sf1 + sf2


ss1 = 485 * Cos((324.96 + 1934.136 * ts) * 3.14159265358979 / 180) + 203 * Cos((337.23 + 32964.467 * ts) * 3.14159265358979 / 180) + 199 * Cos((342.08 + 20.186 * ts) * 3.14159265358979 / 180) + 182 * Cos((27.85 + 445267.112 * ts) * 3.14159265358979 / 180) + 156 * Cos((73.14 + 45036.886 * ts) * 3.14159265358979 / 180) + 136 * Cos((171.52 + 22518.443 * ts) * 3.14159265358979 / 180) + 77 * Cos((222.54 + 65928.934 * ts) * 3.14159265358979 / 180) + 74 * Cos((296.72 + 3034.906 * ts) * 3.14159265358979 / 180) + 70 * Cos((243.58 + 9037.513 * ts) * 3.14159265358979 / 180) + 58 * Cos((119.81 + 33718.147 * ts) * 3.14159265358979 / 180) + 52 * Cos((297.17 + 150.678 * ts) * 3.14159265358979 / 180) + 50 * Cos((21.02 + 2281.226) * 3.14159265358979 / 180)

ss2 = 45 * Cos((247.54 + 29929.562 * ts) * 3.14159265358979 / 180) + 44 * Cos((325.15 + 31555.956 * ts) * 3.14159265358979 / 180) + 29 * Cos((60.93 + 4443.417 * ts) * 3.14159265358979 / 180) + 18 * Cos((155.12 + 67555.328 * ts) * 3.14159265358979 / 180) + 17 * Cos((288.79 + 4562.452 * ts) * 3.14159265358979 / 180) + 16 * Cos((198.04 + 62894.029 * ts) * 3.14159265358979 / 180) + 14 * Cos((199.76 + 31436.921 * ts) * 3.14159265358979 / 180) + 12 * Cos((95.39 + 14577.848 * ts) * 3.14159265358979 / 180) + 12 * Cos((287.11 + 31931.756 * ts) * 3.14159265358979 / 180) + 12 * Cos((320.81 + 34777.259 * ts) * 3.14159265358979 / 180) + 9 * Cos((227.73 + 1222.114 * ts) * 3.14159265358979 / 180) + 8 * Cos((15.45 + 16859.074 * ts) * 3.14159265358979 / 180)

ss = ss1 + ss2


sh1 = 485 * Cos((324.96 + 1934.136 * th) * 3.14159265358979 / 180) + 203 * Cos((337.23 + 32964.467 * th) * 3.14159265358979 / 180) + 199 * Cos((342.08 + 20.186 * th) * 3.14159265358979 / 180) + 182 * Cos((27.85 + 445267.112 * th) * 3.14159265358979 / 180) + 156 * Cos((73.14 + 45036.886 * th) * 3.14159265358979 / 180) + 136 * Cos((171.52 + 22518.443 * th) * 3.14159265358979 / 180) + 77 * Cos((222.54 + 65928.934 * th) * 3.14159265358979 / 180) + 74 * Cos((296.72 + 3034.906 * th) * 3.14159265358979 / 180) + 70 * Cos((243.58 + 9037.513 * th) * 3.14159265358979 / 180) + 58 * Cos((119.81 + 33718.147 * th) * 3.14159265358979 / 180) + 52 * Cos((297.17 + 150.678 * th) * 3.14159265358979 / 180) + 50 * Cos((21.02 + 2281.226) * 3.14159265358979 / 180)

sh2 = 45 * Cos((247.54 + 29929.562 * th) * 3.14159265358979 / 180) + 44 * Cos((325.15 + 31555.956 * th) * 3.14159265358979 / 180) + 29 * Cos((60.93 + 4443.417 * th) * 3.14159265358979 / 180) + 18 * Cos((155.12 + 67555.328 * th) * 3.14159265358979 / 180) + 17 * Cos((288.79 + 4562.452 * th) * 3.14159265358979 / 180) + 16 * Cos((198.04 + 62894.029 * th) * 3.14159265358979 / 180) + 14 * Cos((199.76 + 31436.921 * th) * 3.14159265358979 / 180) + 12 * Cos((95.39 + 14577.848 * th) * 3.14159265358979 / 180) + 12 * Cos((287.11 + 31931.756 * th) * 3.14159265358979 / 180) + 12 * Cos((320.81 + 34777.259 * th) * 3.14159265358979 / 180) + 9 * Cos((227.73 + 1222.114 * th) * 3.14159265358979 / 180) + 8 * Cos((15.45 + 16859.074 * th) * 3.14159265358979 / 180)

sh = sh1 + sh2


sw1 = 485 * Cos((324.96 + 1934.136 * tw) * 3.14159265358979 / 180) + 203 * Cos((337.23 + 32964.467 * tw) * 3.14159265358979 / 180) + 199 * Cos((342.08 + 20.186 * tw) * 3.14159265358979 / 180) + 182 * Cos((27.85 + 445267.112 * tw) * 3.14159265358979 / 180) + 156 * Cos((73.14 + 45036.886 * tw) * 3.14159265358979 / 180) + 136 * Cos((171.52 + 22518.443 * tw) * 3.14159265358979 / 180) + 77 * Cos((222.54 + 65928.934 * tw) * 3.14159265358979 / 180) + 74 * Cos((296.72 + 3034.906 * tw) * 3.14159265358979 / 180) + 70 * Cos((243.58 + 9037.513 * tw) * 3.14159265358979 / 180) + 58 * Cos((119.81 + 33718.147 * tw) * 3.14159265358979 / 180) + 52 * Cos((297.17 + 150.678 * tw) * 3.14159265358979 / 180) + 50 * Cos((21.02 + 2281.226) * 3.14159265358979 / 180)

sw2 = 45 * Cos((247.54 + 29929.562 * tw) * 3.14159265358979 / 180) + 44 * Cos((325.15 + 31555.956 * tw) * 3.14159265358979 / 180) + 29 * Cos((60.93 + 4443.417 * tw) * 3.14159265358979 / 180) + 18 * Cos((155.12 + 67555.328 * tw) * 3.14159265358979 / 180) + 17 * Cos((288.79 + 4562.452 * tw) * 3.14159265358979 / 180) + 16 * Cos((198.04 + 62894.029 * tw) * 3.14159265358979 / 180) + 14 * Cos((199.76 + 31436.921 * tw) * 3.14159265358979 / 180) + 12 * Cos((95.39 + 14577.848 * tw) * 3.14159265358979 / 180) + 12 * Cos((287.11 + 31931.756 * tw) * 3.14159265358979 / 180) + 12 * Cos((320.81 + 34777.259 * tw) * 3.14159265358979 / 180) + 9 * Cos((227.73 + 1222.114 * tw) * 3.14159265358979 / 180) + 8 * Cos((15.45 + 16859.074 * tw) * 3.14159265358979 / 180)

sw = sw1 + sw2






jdef = jdef + 0.00001 * sf / lf - 1 / (60 * 24)

jdes = jdes + 0.00001 * ss / ls - 1 / (60 * 24)

jdeh = jdeh + 0.00001 * sh / lh - 1 / (60 * 24)

jdew = jdew + 0.00001 * sw / lw - 1 / (60 * 24)


sommer = jdes




End Function


Function herbst(Jahr As Integer) As Double





jr = (Jahr - 2000) / 1000

jdef = 2451623.80984 + 365242.37404 * jr + 0.05169 * jr ^ 2 - 0.00411 * jr ^ 3 - 0.00057 * jr ^ 4

jdes = 2451716.56767 + 365241.62603 * jr + 0.00325 * jr * jr + 0.00888 * jr ^ 3 - 0.0003 * jr ^ 4

jdeh = 2451810.21715 + 365242.01767 * jr - 0.11575 * jr ^ 2 + 0.00337 * jr ^ 3 + 0.00078 * jr ^ 4

 jdew = 2451900.05952 + 365242.74049 * jr - 0.06223 * jr ^ 2 - 0.00823 * jr ^ 3 + 0.00032 * jr ^ 4

tf = (jdef - 2451545) / 36525
ts = (jdes - 2451545) / 36525
th = (jdeh - 2451545) / 36525
tw = (jdew - 2451545) / 36525

wf = 35999.373 * tf - 2.47
ws = 35999.373 * ts - 2.47
wh = 35999.373 * th - 2.47
ww = 35999.373 * tw - 2.47

lf = 1 + 0.0334 * Cos(wf * 3.14159265358979 / 180) + 0.0007 * Cos(2 * wf * 3.14159265358979 / 180)

ls = 1 + 0.0334 * Cos(ws * 3.14159265358979 / 180) + 0.0007 * Cos(2 * ws * 3.14159265358979 / 180)

lh = 1 + 0.0334 * Cos(wh * 3.14159265358979 / 180) + 0.0007 * Cos(2 * wh * 3.14159265358979 / 180)

lw = 1 + 0.0334 * Cos(ww * 3.14159265358979 / 180) + 0.0007 * Cos(2 * ww * 3.14159265358979 / 180)



sf1 = 485 * Cos((324.96 + 1934.136 * tf) * 3.14159265358979 / 180) + 203 * Cos((337.23 + 32964.467 * tf) * 3.14159265358979 / 180) + 199 * Cos((342.08 + 20.186 * tf) * 3.14159265358979 / 180) + 182 * Cos((27.85 + 445267.112 * tf) * 3.14159265358979 / 180) + 156 * Cos((73.14 + 45036.886 * tf) * 3.14159265358979 / 180) + 136 * Cos((171.52 + 22518.443 * tf) * 3.14159265358979 / 180) + 77 * Cos((222.54 + 65928.934 * tf) * 3.14159265358979 / 180) + 74 * Cos((296.72 + 3034.906 * tf) * 3.14159265358979 / 180) + 70 * Cos((243.58 + 9037.513 * tf) * 3.14159265358979 / 180) + 58 * Cos((119.81 + 33718.147 * tf) * 3.14159265358979 / 180) + 52 * Cos((297.17 + 150.678 * tf) * 3.14159265358979 / 180) + 50 * Cos((21.02 + 2281.226) * 3.14159265358979 / 180)

sf2 = 45 * Cos((247.54 + 29929.562 * tf) * 3.14159265358979 / 180) + 44 * Cos((325.15 + 31555.956 * tf) * 3.14159265358979 / 180) + 29 * Cos((60.93 + 4443.417 * tf) * 3.14159265358979 / 180) + 18 * Cos((155.12 + 67555.328 * tf) * 3.14159265358979 / 180) + 17 * Cos((288.79 + 4562.452 * tf) * 3.14159265358979 / 180) + 16 * Cos((198.04 + 62894.029 * tf) * 3.14159265358979 / 180) + 14 * Cos((199.76 + 31436.921 * tf) * 3.14159265358979 / 180) + 12 * Cos((95.39 + 14577.848 * tf) * 3.14159265358979 / 180) + 12 * Cos((287.11 + 31931.756 * tf) * 3.14159265358979 / 180) + 12 * Cos((320.81 + 34777.259 * tf) * 3.14159265358979 / 180) + 9 * Cos((227.73 + 1222.114 * tf) * 3.14159265358979 / 180) + 8 * Cos((15.45 + 16859.074 * tf) * 3.14159265358979 / 180)

sf = sf1 + sf2


ss1 = 485 * Cos((324.96 + 1934.136 * ts) * 3.14159265358979 / 180) + 203 * Cos((337.23 + 32964.467 * ts) * 3.14159265358979 / 180) + 199 * Cos((342.08 + 20.186 * ts) * 3.14159265358979 / 180) + 182 * Cos((27.85 + 445267.112 * ts) * 3.14159265358979 / 180) + 156 * Cos((73.14 + 45036.886 * ts) * 3.14159265358979 / 180) + 136 * Cos((171.52 + 22518.443 * ts) * 3.14159265358979 / 180) + 77 * Cos((222.54 + 65928.934 * ts) * 3.14159265358979 / 180) + 74 * Cos((296.72 + 3034.906 * ts) * 3.14159265358979 / 180) + 70 * Cos((243.58 + 9037.513 * ts) * 3.14159265358979 / 180) + 58 * Cos((119.81 + 33718.147 * ts) * 3.14159265358979 / 180) + 52 * Cos((297.17 + 150.678 * ts) * 3.14159265358979 / 180) + 50 * Cos((21.02 + 2281.226) * 3.14159265358979 / 180)

ss2 = 45 * Cos((247.54 + 29929.562 * ts) * 3.14159265358979 / 180) + 44 * Cos((325.15 + 31555.956 * ts) * 3.14159265358979 / 180) + 29 * Cos((60.93 + 4443.417 * ts) * 3.14159265358979 / 180) + 18 * Cos((155.12 + 67555.328 * ts) * 3.14159265358979 / 180) + 17 * Cos((288.79 + 4562.452 * ts) * 3.14159265358979 / 180) + 16 * Cos((198.04 + 62894.029 * ts) * 3.14159265358979 / 180) + 14 * Cos((199.76 + 31436.921 * ts) * 3.14159265358979 / 180) + 12 * Cos((95.39 + 14577.848 * ts) * 3.14159265358979 / 180) + 12 * Cos((287.11 + 31931.756 * ts) * 3.14159265358979 / 180) + 12 * Cos((320.81 + 34777.259 * ts) * 3.14159265358979 / 180) + 9 * Cos((227.73 + 1222.114 * ts) * 3.14159265358979 / 180) + 8 * Cos((15.45 + 16859.074 * ts) * 3.14159265358979 / 180)

ss = ss1 + ss2


sh1 = 485 * Cos((324.96 + 1934.136 * th) * 3.14159265358979 / 180) + 203 * Cos((337.23 + 32964.467 * th) * 3.14159265358979 / 180) + 199 * Cos((342.08 + 20.186 * th) * 3.14159265358979 / 180) + 182 * Cos((27.85 + 445267.112 * th) * 3.14159265358979 / 180) + 156 * Cos((73.14 + 45036.886 * th) * 3.14159265358979 / 180) + 136 * Cos((171.52 + 22518.443 * th) * 3.14159265358979 / 180) + 77 * Cos((222.54 + 65928.934 * th) * 3.14159265358979 / 180) + 74 * Cos((296.72 + 3034.906 * th) * 3.14159265358979 / 180) + 70 * Cos((243.58 + 9037.513 * th) * 3.14159265358979 / 180) + 58 * Cos((119.81 + 33718.147 * th) * 3.14159265358979 / 180) + 52 * Cos((297.17 + 150.678 * th) * 3.14159265358979 / 180) + 50 * Cos((21.02 + 2281.226) * 3.14159265358979 / 180)

sh2 = 45 * Cos((247.54 + 29929.562 * th) * 3.14159265358979 / 180) + 44 * Cos((325.15 + 31555.956 * th) * 3.14159265358979 / 180) + 29 * Cos((60.93 + 4443.417 * th) * 3.14159265358979 / 180) + 18 * Cos((155.12 + 67555.328 * th) * 3.14159265358979 / 180) + 17 * Cos((288.79 + 4562.452 * th) * 3.14159265358979 / 180) + 16 * Cos((198.04 + 62894.029 * th) * 3.14159265358979 / 180) + 14 * Cos((199.76 + 31436.921 * th) * 3.14159265358979 / 180) + 12 * Cos((95.39 + 14577.848 * th) * 3.14159265358979 / 180) + 12 * Cos((287.11 + 31931.756 * th) * 3.14159265358979 / 180) + 12 * Cos((320.81 + 34777.259 * th) * 3.14159265358979 / 180) + 9 * Cos((227.73 + 1222.114 * th) * 3.14159265358979 / 180) + 8 * Cos((15.45 + 16859.074 * th) * 3.14159265358979 / 180)

sh = sh1 + sh2


sw1 = 485 * Cos((324.96 + 1934.136 * tw) * 3.14159265358979 / 180) + 203 * Cos((337.23 + 32964.467 * tw) * 3.14159265358979 / 180) + 199 * Cos((342.08 + 20.186 * tw) * 3.14159265358979 / 180) + 182 * Cos((27.85 + 445267.112 * tw) * 3.14159265358979 / 180) + 156 * Cos((73.14 + 45036.886 * tw) * 3.14159265358979 / 180) + 136 * Cos((171.52 + 22518.443 * tw) * 3.14159265358979 / 180) + 77 * Cos((222.54 + 65928.934 * tw) * 3.14159265358979 / 180) + 74 * Cos((296.72 + 3034.906 * tw) * 3.14159265358979 / 180) + 70 * Cos((243.58 + 9037.513 * tw) * 3.14159265358979 / 180) + 58 * Cos((119.81 + 33718.147 * tw) * 3.14159265358979 / 180) + 52 * Cos((297.17 + 150.678 * tw) * 3.14159265358979 / 180) + 50 * Cos((21.02 + 2281.226) * 3.14159265358979 / 180)

sw2 = 45 * Cos((247.54 + 29929.562 * tw) * 3.14159265358979 / 180) + 44 * Cos((325.15 + 31555.956 * tw) * 3.14159265358979 / 180) + 29 * Cos((60.93 + 4443.417 * tw) * 3.14159265358979 / 180) + 18 * Cos((155.12 + 67555.328 * tw) * 3.14159265358979 / 180) + 17 * Cos((288.79 + 4562.452 * tw) * 3.14159265358979 / 180) + 16 * Cos((198.04 + 62894.029 * tw) * 3.14159265358979 / 180) + 14 * Cos((199.76 + 31436.921 * tw) * 3.14159265358979 / 180) + 12 * Cos((95.39 + 14577.848 * tw) * 3.14159265358979 / 180) + 12 * Cos((287.11 + 31931.756 * tw) * 3.14159265358979 / 180) + 12 * Cos((320.81 + 34777.259 * tw) * 3.14159265358979 / 180) + 9 * Cos((227.73 + 1222.114 * tw) * 3.14159265358979 / 180) + 8 * Cos((15.45 + 16859.074 * tw) * 3.14159265358979 / 180)

sw = sw1 + sw2





jdef = jdef + 0.00001 * sf / lf - 1 / (60 * 24)

jdes = jdes + 0.00001 * ss / ls - 1 / (60 * 24)

jdeh = jdeh + 0.00001 * sh / lh - 1 / (60 * 24)

jdew = jdew + 0.00001 * sw / lw - 1 / (60 * 24)


herbst = jdeh




End Function



Function winter(Jahr As Integer) As Double





jr = (Jahr - 2000) / 1000

jdef = 2451623.80984 + 365242.37404 * jr + 0.05169 * jr ^ 2 - 0.00411 * jr ^ 3 - 0.00057 * jr ^ 4

jdes = 2451716.56767 + 365241.62603 * jr + 0.00325 * jr * jr + 0.00888 * jr ^ 3 - 0.0003 * jr ^ 4

jdeh = 2451810.21715 + 365242.01767 * jr - 0.11575 * jr ^ 2 + 0.00337 * jr ^ 3 + 0.00078 * jr ^ 4

 jdew = 2451900.05952 + 365242.74049 * jr - 0.06223 * jr ^ 2 - 0.00823 * jr ^ 3 + 0.00032 * jr ^ 4

tf = (jdef - 2451545) / 36525
ts = (jdes - 2451545) / 36525
th = (jdeh - 2451545) / 36525
tw = (jdew - 2451545) / 36525

wf = 35999.373 * tf - 2.47
ws = 35999.373 * ts - 2.47
wh = 35999.373 * th - 2.47
ww = 35999.373 * tw - 2.47

lf = 1 + 0.0334 * Cos(wf * 3.14159265358979 / 180) + 0.0007 * Cos(2 * wf * 3.14159265358979 / 180)

ls = 1 + 0.0334 * Cos(ws * 3.14159265358979 / 180) + 0.0007 * Cos(2 * ws * 3.14159265358979 / 180)

lh = 1 + 0.0334 * Cos(wh * 3.14159265358979 / 180) + 0.0007 * Cos(2 * wh * 3.14159265358979 / 180)

lw = 1 + 0.0334 * Cos(ww * 3.14159265358979 / 180) + 0.0007 * Cos(2 * ww * 3.14159265358979 / 180)



sf1 = 485 * Cos((324.96 + 1934.136 * tf) * 3.14159265358979 / 180) + 203 * Cos((337.23 + 32964.467 * tf) * 3.14159265358979 / 180) + 199 * Cos((342.08 + 20.186 * tf) * 3.14159265358979 / 180) + 182 * Cos((27.85 + 445267.112 * tf) * 3.14159265358979 / 180) + 156 * Cos((73.14 + 45036.886 * tf) * 3.14159265358979 / 180) + 136 * Cos((171.52 + 22518.443 * tf) * 3.14159265358979 / 180) + 77 * Cos((222.54 + 65928.934 * tf) * 3.14159265358979 / 180) + 74 * Cos((296.72 + 3034.906 * tf) * 3.14159265358979 / 180) + 70 * Cos((243.58 + 9037.513 * tf) * 3.14159265358979 / 180) + 58 * Cos((119.81 + 33718.147 * tf) * 3.14159265358979 / 180) + 52 * Cos((297.17 + 150.678 * tf) * 3.14159265358979 / 180) + 50 * Cos((21.02 + 2281.226) * 3.14159265358979 / 180)

sf2 = 45 * Cos((247.54 + 29929.562 * tf) * 3.14159265358979 / 180) + 44 * Cos((325.15 + 31555.956 * tf) * 3.14159265358979 / 180) + 29 * Cos((60.93 + 4443.417 * tf) * 3.14159265358979 / 180) + 18 * Cos((155.12 + 67555.328 * tf) * 3.14159265358979 / 180) + 17 * Cos((288.79 + 4562.452 * tf) * 3.14159265358979 / 180) + 16 * Cos((198.04 + 62894.029 * tf) * 3.14159265358979 / 180) + 14 * Cos((199.76 + 31436.921 * tf) * 3.14159265358979 / 180) + 12 * Cos((95.39 + 14577.848 * tf) * 3.14159265358979 / 180) + 12 * Cos((287.11 + 31931.756 * tf) * 3.14159265358979 / 180) + 12 * Cos((320.81 + 34777.259 * tf) * 3.14159265358979 / 180) + 9 * Cos((227.73 + 1222.114 * tf) * 3.14159265358979 / 180) + 8 * Cos((15.45 + 16859.074 * tf) * 3.14159265358979 / 180)

sf = sf1 + sf2


ss1 = 485 * Cos((324.96 + 1934.136 * ts) * 3.14159265358979 / 180) + 203 * Cos((337.23 + 32964.467 * ts) * 3.14159265358979 / 180) + 199 * Cos((342.08 + 20.186 * ts) * 3.14159265358979 / 180) + 182 * Cos((27.85 + 445267.112 * ts) * 3.14159265358979 / 180) + 156 * Cos((73.14 + 45036.886 * ts) * 3.14159265358979 / 180) + 136 * Cos((171.52 + 22518.443 * ts) * 3.14159265358979 / 180) + 77 * Cos((222.54 + 65928.934 * ts) * 3.14159265358979 / 180) + 74 * Cos((296.72 + 3034.906 * ts) * 3.14159265358979 / 180) + 70 * Cos((243.58 + 9037.513 * ts) * 3.14159265358979 / 180) + 58 * Cos((119.81 + 33718.147 * ts) * 3.14159265358979 / 180) + 52 * Cos((297.17 + 150.678 * ts) * 3.14159265358979 / 180) + 50 * Cos((21.02 + 2281.226) * 3.14159265358979 / 180)

ss2 = 45 * Cos((247.54 + 29929.562 * ts) * 3.14159265358979 / 180) + 44 * Cos((325.15 + 31555.956 * ts) * 3.14159265358979 / 180) + 29 * Cos((60.93 + 4443.417 * ts) * 3.14159265358979 / 180) + 18 * Cos((155.12 + 67555.328 * ts) * 3.14159265358979 / 180) + 17 * Cos((288.79 + 4562.452 * ts) * 3.14159265358979 / 180) + 16 * Cos((198.04 + 62894.029 * ts) * 3.14159265358979 / 180) + 14 * Cos((199.76 + 31436.921 * ts) * 3.14159265358979 / 180) + 12 * Cos((95.39 + 14577.848 * ts) * 3.14159265358979 / 180) + 12 * Cos((287.11 + 31931.756 * ts) * 3.14159265358979 / 180) + 12 * Cos((320.81 + 34777.259 * ts) * 3.14159265358979 / 180) + 9 * Cos((227.73 + 1222.114 * ts) * 3.14159265358979 / 180) + 8 * Cos((15.45 + 16859.074 * ts) * 3.14159265358979 / 180)

ss = ss1 + ss2


sh1 = 485 * Cos((324.96 + 1934.136 * th) * 3.14159265358979 / 180) + 203 * Cos((337.23 + 32964.467 * th) * 3.14159265358979 / 180) + 199 * Cos((342.08 + 20.186 * th) * 3.14159265358979 / 180) + 182 * Cos((27.85 + 445267.112 * th) * 3.14159265358979 / 180) + 156 * Cos((73.14 + 45036.886 * th) * 3.14159265358979 / 180) + 136 * Cos((171.52 + 22518.443 * th) * 3.14159265358979 / 180) + 77 * Cos((222.54 + 65928.934 * th) * 3.14159265358979 / 180) + 74 * Cos((296.72 + 3034.906 * th) * 3.14159265358979 / 180) + 70 * Cos((243.58 + 9037.513 * th) * 3.14159265358979 / 180) + 58 * Cos((119.81 + 33718.147 * th) * 3.14159265358979 / 180) + 52 * Cos((297.17 + 150.678 * th) * 3.14159265358979 / 180) + 50 * Cos((21.02 + 2281.226) * 3.14159265358979 / 180)

sh2 = 45 * Cos((247.54 + 29929.562 * th) * 3.14159265358979 / 180) + 44 * Cos((325.15 + 31555.956 * th) * 3.14159265358979 / 180) + 29 * Cos((60.93 + 4443.417 * th) * 3.14159265358979 / 180) + 18 * Cos((155.12 + 67555.328 * th) * 3.14159265358979 / 180) + 17 * Cos((288.79 + 4562.452 * th) * 3.14159265358979 / 180) + 16 * Cos((198.04 + 62894.029 * th) * 3.14159265358979 / 180) + 14 * Cos((199.76 + 31436.921 * th) * 3.14159265358979 / 180) + 12 * Cos((95.39 + 14577.848 * th) * 3.14159265358979 / 180) + 12 * Cos((287.11 + 31931.756 * th) * 3.14159265358979 / 180) + 12 * Cos((320.81 + 34777.259 * th) * 3.14159265358979 / 180) + 9 * Cos((227.73 + 1222.114 * th) * 3.14159265358979 / 180) + 8 * Cos((15.45 + 16859.074 * th) * 3.14159265358979 / 180)

sh = sh1 + sh2


sw1 = 485 * Cos((324.96 + 1934.136 * tw) * 3.14159265358979 / 180) + 203 * Cos((337.23 + 32964.467 * tw) * 3.14159265358979 / 180) + 199 * Cos((342.08 + 20.186 * tw) * 3.14159265358979 / 180) + 182 * Cos((27.85 + 445267.112 * tw) * 3.14159265358979 / 180) + 156 * Cos((73.14 + 45036.886 * tw) * 3.14159265358979 / 180) + 136 * Cos((171.52 + 22518.443 * tw) * 3.14159265358979 / 180) + 77 * Cos((222.54 + 65928.934 * tw) * 3.14159265358979 / 180) + 74 * Cos((296.72 + 3034.906 * tw) * 3.14159265358979 / 180) + 70 * Cos((243.58 + 9037.513 * tw) * 3.14159265358979 / 180) + 58 * Cos((119.81 + 33718.147 * tw) * 3.14159265358979 / 180) + 52 * Cos((297.17 + 150.678 * tw) * 3.14159265358979 / 180) + 50 * Cos((21.02 + 2281.226) * 3.14159265358979 / 180)

sw2 = 45 * Cos((247.54 + 29929.562 * tw) * 3.14159265358979 / 180) + 44 * Cos((325.15 + 31555.956 * tw) * 3.14159265358979 / 180) + 29 * Cos((60.93 + 4443.417 * tw) * 3.14159265358979 / 180) + 18 * Cos((155.12 + 67555.328 * tw) * 3.14159265358979 / 180) + 17 * Cos((288.79 + 4562.452 * tw) * 3.14159265358979 / 180) + 16 * Cos((198.04 + 62894.029 * tw) * 3.14159265358979 / 180) + 14 * Cos((199.76 + 31436.921 * tw) * 3.14159265358979 / 180) + 12 * Cos((95.39 + 14577.848 * tw) * 3.14159265358979 / 180) + 12 * Cos((287.11 + 31931.756 * tw) * 3.14159265358979 / 180) + 12 * Cos((320.81 + 34777.259 * tw) * 3.14159265358979 / 180) + 9 * Cos((227.73 + 1222.114 * tw) * 3.14159265358979 / 180) + 8 * Cos((15.45 + 16859.074 * tw) * 3.14159265358979 / 180)

sw = sw1 + sw2





jdef = jdef + 0.00001 * sf / lf - 1 / (60 * 24)

jdes = jdes + 0.00001 * ss / ls - 1 / (60 * 24)

jdeh = jdeh + 0.00001 * sh / lh - 1 / (60 * 24)

jdew = jdew + 0.00001 * sw / lw - 1 / (60 * 24)


winter = jdew




End Function



Function neumond(Jahr As Integer, monat As Integer, tag As Integer, kw As Integer) As Double



jz = Jahr
jzm = monat
jzd = tag

jzjahr = jz + (jzm / 13) + (jzd / (31 * 13))

k = (jzjahr - 2000) * 12.3685
If k - Int(k) > 0.5 Then
    k = Int(k) + 1
Else
    k = Int(k)
End If


kwert = k + kw



k = kwert - 1


tk = k / 1236.85


m = 2.5534 + 29.10535669 * k - 0.0000218 * tk ^ 2 - 0.00000011 * tk ^ 3
Ms = 201.5643 + 385.816935 * k + 0.1017438 * tk ^ 2 + 0.00001239 * tk ^ 3 - 0.000000058 * tk ^ 4
F = 160.7108 + 390.670502 * k - 0.0016341 * tk ^ 2 - 0.00000227 * tk ^ 3
om = 124.7746 - 1.5637558 * k + tk ^ 2 * 0.0020691 + 0.00000215 * tk ^ 3
e = 1 - 0.002516 * tk - 0.0000074 * tk ^ 2
e2 = e * e

a1 = 299.77 + 0.107408 * k - 0.009173 * tk
a2 = 251.88 + 0.016321 * k
a3 = 251.83 + 26.651886 * k
a4 = 349.42 + 36.412478 * k
a5 = 84.66 + 18.206239 * k
a6 = 141.74 + 53.303771 * k
a7 = 207.14 + 2.453732 * k
a8 = 154.84 + 7.30686 * k
a9 = 34.52 + 27.261239 * k
a10 = 207.19 + 0.121824 * k
a11 = 291.34 + 1.844379 * k
a12 = 161.72 + 24.198154 * k
a13 = 239.56 + 25.513 * k
a14 = 331.55 + 3.592518 * k


a1 = 0.000325 * Sin(a1 * 3.14159265358979 / 180)
a2 = 0.000165 * Sin(a2 * 3.14159265358979 / 180)
a3 = 0.000164 * Sin(a3 * 3.14159265358979 / 180)
a4 = 0.000126 * Sin(a4 * 3.14159265358979 / 180)
a5 = 0.00011 * Sin(a5 * 3.14159265358979 / 180)
a6 = 0.000062 * Sin(a6 * 3.14159265358979 / 180)
a7 = 0.00006 * Sin(a7 * 3.14159265358979 / 180)
a8 = 0.000056 * Sin(a8 * 3.14159265358979 / 180)
a9 = 0.000047 * Sin(a9 * 3.14159265358979 / 180)
a10 = 0.000042 * Sin(a10 * 3.14159265358979 / 180)
a11 = 0.00004 * Sin(a11 * 3.14159265358979 / 180)
a12 = 0.000037 * Sin(a12 * 3.14159265358979 / 180)
a13 = 0.000035 * Sin(a13 * 3.14159265358979 / 180)
a14 = 0.000023 * Sin(a14 * 3.14159265358979 / 180)


ages = a1 + a2 + a3 + a4 + a5 + a6 + a7 + a8 + a9 + a10 + a11 + a12 + a13 + a14

'Neumond

sn1 = -0.4072 * Sin((Ms) * 3.14159265358979 / 180)
sn2 = 0.17241 * Sin((m) * 3.14159265358979 / 180) * e
sn3 = 0.01608 * Sin((2 * Ms) * 3.14159265358979 / 180)
sn4 = 0.01039 * Sin((2 * F) * 3.14159265358979 / 180)
sn5 = 0.00739 * Sin((Ms - m) * 3.14159265358979 / 180) * e
sn6 = -0.00514 * Sin((Ms + m) * 3.14159265358979 / 180) * e
sn7 = 0.00208 * Sin((2 * m) * 3.14159265358979 / 180) * e2
sn8 = -0.00111 * Sin((Ms - 2 * F) * 3.14159265358979 / 180)
sn9 = -0.00057 * Sin((Ms + 2 * F) * 3.14159265358979 / 180)
sn10 = 0.00056 * Sin((2 * Ms + m) * 3.14159265358979 / 180) * e
sn11 = -0.00042 * Sin((3 * Ms) * 3.14159265358979 / 180)
sn12 = 0.00042 * Sin((m + 2 * F) * 3.14159265358979 / 180) * e
sn13 = 0.00038 * Sin((m - 2 * F) * 3.14159265358979 / 180) * e
sn14 = -0.00024 * Sin((2 * Ms - m) * 3.14159265358979 / 180) * e
sn15 = -0.00017 * Sin((om) * 3.14159265358979 / 180)
sn16 = -0.00007 * Sin((2 * m + Ms) * 3.14159265358979 / 180)
sn17 = 0.00004 * Sin((2 * Ms - F) * 3.14159265358979 / 180)
sn18 = 0.00004 * Sin((3 * m) * 3.14159265358979 / 180)
sn19 = 0.00003 * Sin((Ms + m - 2 * F) * 3.14159265358979 / 180)
sn20 = 0.00003 * Sin((m + Ms + 2 * F) * 3.14159265358979 / 180)
sn21 = -0.00003 * Sin((Ms + m + 2 * F) * 3.14159265358979 / 180)
sn22 = 0.00003 * Sin((Ms - m + 2 * F) * 3.14159265358979 / 180)
sn23 = -0.00002 * Sin((Ms - m - 2 * F) * 3.14159265358979 / 180)
sn24 = -0.00002 * Sin((3 * Ms + m) * 3.14159265358979 / 180)
sn25 = 0.00002 * Sin((4 * m) * 3.14159265358979 / 180)




sn = sn1 + sn2 + sn3 + sn4 + sn5 + sn6 + sn7 + sn8 + sn9 + sn10 + sn11 + sn12 + sn13 + sn14 + sn15 + sn16 + sn17 + sn18 + sn19 + sn20 + sn21 + sn22 + sn23 + sn24 + sn25


jdeneumond = 2451550.09765 + 29.530588853 * k + 0.0001337 * tk * tk - 0.00000015 * tk ^ 3 + 0.00000000073 * tk ^ 4 + sn + ages - 1 / (60 * 24)

neumond = jdeneumond


End Function








Function vollmond(Jahr As Integer, monat As Integer, tag As Integer, kw As Integer) As Double



jz = Jahr
jzm = monat
jzd = tag

jzjahr = jz + (jzm / 13) + (jzd / (31 * 13))

k = (jzjahr - 2000) * 12.3685
If k - Int(k) > 0.5 Then
    k = Int(k) + 1
Else
    k = Int(k)
End If


kwert = k + kw




k = kwert - 1.5

tk = k / 1236.85


m = 2.5534 + 29.10535669 * k - 0.0000218 * tk ^ 2 - 0.00000011 * tk ^ 3
Ms = 201.5643 + 385.816935 * k + 0.1017438 * tk ^ 2 + 0.00001239 * tk ^ 3 - 0.000000058 * tk ^ 4
F = 160.7108 + 390.670502 * k - 0.0016341 * tk ^ 2 - 0.00000227 * tk ^ 3
om = 124.7746 - 1.5637558 * k + tk ^ 2 * 0.0020691 + 0.00000215 * tk ^ 3
e = 1 - 0.002516 * tk - 0.0000074 * tk ^ 2
e2 = e * e

a1 = 299.77 + 0.107408 * k - 0.009173 * tk
a2 = 251.88 + 0.016321 * k
a3 = 251.83 + 26.651886 * k
a4 = 349.42 + 36.412478 * k
a5 = 84.66 + 18.206239 * k
a6 = 141.74 + 53.303771 * k
a7 = 207.14 + 2.453732 * k
a8 = 154.84 + 7.30686 * k
a9 = 34.52 + 27.261239 * k
a10 = 207.19 + 0.121824 * k
a11 = 291.34 + 1.844379 * k
a12 = 161.72 + 24.198154 * k
a13 = 239.56 + 25.513 * k
a14 = 331.55 + 3.592518 * k


a1 = 0.000325 * Sin(a1 * 3.14159265358979 / 180)
a2 = 0.000165 * Sin(a2 * 3.14159265358979 / 180)
a3 = 0.000164 * Sin(a3 * 3.14159265358979 / 180)
a4 = 0.000126 * Sin(a4 * 3.14159265358979 / 180)
a5 = 0.00011 * Sin(a5 * 3.14159265358979 / 180)
a6 = 0.000062 * Sin(a6 * 3.14159265358979 / 180)
a7 = 0.00006 * Sin(a7 * 3.14159265358979 / 180)
a8 = 0.000056 * Sin(a8 * 3.14159265358979 / 180)
a9 = 0.000047 * Sin(a9 * 3.14159265358979 / 180)
a10 = 0.000042 * Sin(a10 * 3.14159265358979 / 180)
a11 = 0.00004 * Sin(a11 * 3.14159265358979 / 180)
a12 = 0.000037 * Sin(a12 * 3.14159265358979 / 180)
a13 = 0.000035 * Sin(a13 * 3.14159265358979 / 180)
a14 = 0.000023 * Sin(a14 * 3.14159265358979 / 180)


ages = a1 + a2 + a3 + a4 + a5 + a6 + a7 + a8 + a9 + a10 + a11 + a12 + a13 + a14


'Vollmond

sv1 = -0.40614 * Sin((Ms) * 3.14159265358979 / 180)
sv2 = 0.17302 * Sin((m) * 3.14159265358979 / 180) * e
sv3 = 0.01614 * Sin((2 * Ms) * 3.14159265358979 / 180)
sv4 = 0.01043 * Sin((2 * F) * 3.14159265358979 / 180)
sv5 = 0.00734 * Sin((Ms - m) * 3.14159265358979 / 180) * e
sv6 = -0.00515 * Sin((m + Ms) * 3.14159265358979 / 180) * e
sv7 = 0.00209 * Sin((2 * m) * 3.14159265358979 / 180) * e2
sv8 = -0.00111 * Sin((Ms - 2 * F) * 3.14159265358979 / 180)
sv9 = -0.00057 * Sin((Ms + 2 * F) * 3.14159265358979 / 180)
sv10 = 0.00056 * Sin((2 * Ms + m) * 3.14159265358979 / 180) * e
sv11 = -0.00042 * Sin((3 * m) * 3.14159265358979 / 180)
sv12 = 0.00042 * Sin((m + 2 * F) * 3.14159265358979 / 180) * e
sv13 = 0.00038 * Sin((m - 2 * F) * 3.14159265358979 / 180) * e
sv14 = -0.00024 * Sin((2 * Ms - m) * 3.14159265358979 / 180) * e
sv15 = -0.00017 * Sin((om) * 3.14159265358979 / 180)
sv16 = -0.00007 * Sin((Ms + 2 * m) * 3.14159265358979 / 180)
sv17 = 0.00004 * Sin((2 * Ms - 2 * F) * 3.14159265358979 / 180)
sv18 = 0.00004 * Sin((3 * m) * 3.14159265358979 / 180)
sv19 = 0.00003 * Sin((m + Ms - 2 * F) * 3.14159265358979 / 180)
sv20 = 0.00003 * Sin((2 * Ms + 2 * F) * 3.14159265358979 / 180)
sv21 = -0.00003 * Sin((Ms + m + 2 * F) * 3.14159265358979 / 180)
sv22 = 0.00003 * Sin((Ms - m + 2 * F) * 3.14159265358979 / 180)
sv23 = -0.00002 * Sin((Ms - m - 2 * F) * 3.14159265358979 / 180)
sv24 = -0.00002 * Sin((m + 3 * Ms) * 3.14159265358979 / 180)
sv25 = 0.00002 * Sin((4 * Ms) * 3.14159265358979 / 180)


sv = sv1 + sv2 + sv3 + sv4 + sv5 + sv6 + sv7 + sv8 + sv9 + sv10 + sv11 + sv12 + sv13 + sv14 + sv15 + sv16 + sv17 + sv18 + sv19 + sv20 + sv21 + sv22 + sv23 + sv24 + sv25


jdevollmond = 2451550.09765 + 29.530588853 * k + 0.0001337 * tk * tk - 0.00000015 * tk ^ 3 + 0.00000000073 * tk ^ 4 + sv + ages - 1 / (60 * 24)


vollmond = jdevollmond



End Function


Function phase(Jahr As Integer, monat As Integer, tag As Integer, stunde As Integer, _
 min As Integer, sec As Double, Zeitzone As Integer) As Double

    Dim A As Double
    Dim b As Integer
    
    If monat > 2 Then
    monat = monat
    Jahr = Jahr
    End If
    
    If monat <= 2 Then
    monat = monat + 12
    Jahr = Jahr - 1
    End If
    
    A = Fix(Jahr / 100)
    b = 2 - A + Fix(A / 4)
    
    jdp = Fix(365.25 * (Jahr + 4716)) + Fix(30.6001 * (monat + 1)) + tag + b + ((stunde + min / 60 + sec / 3600) / 24) - 1524.5
    
    jdp = jdp - Zeitzone / 24

tzd = (jdp - 2451545) / 36525

'D
elm = rang(297.8502042 + 445267.1115168 * tzd - (0.00163 * tzd * tzd) + tzd ^ 3 / 545868 - tzd ^ 4 / 113065000)
'M
ams = rang(357.5291092 + 35999.0502909 * tzd - 0.0001536 * tzd * tzd + tzd ^ 3 / 24490000)
'M
aml = rang(134.9634114 + 477198.8676313 * tzd - 0.008997 * tzd * tzd + tzd ^ 3 / 69699 - tzd ^ 4 / 14712000)

asd = 180 - elm - _
                    (6.289 * Sin((3.1415926535 / 180) * ((aml)))) + _
                    (2.1 * Sin((3.1415926535 / 180) * ((ams)))) - _
                    (1.274 * Sin((3.1415926535 / 180) * (((2 * elm) - _
                            aml)))) - _
                    (0.658 * Sin((3.1415926535 / 180) * ((2 * elm)))) - _
                    (0.214 * Sin((3.1415926535 / 180) * ((2 * aml)))) - _
                    (0.11 * Sin((3.1415926535 / 180) * ((elm))))
                    
phi1 = (1 + Cos((3.1415926535 / 180) * (asd))) / 2


phase = phi1



End Function

 Function tendenz(Jahr As Integer, monat As Integer, tag As Integer, stunde As Integer, _
 min As Integer, sec As Double, Zeitzone As Integer) As String

    Dim A As Double
    Dim b As Integer
    
    If monat > 2 Then
    monat = monat
    Jahr = Jahr
    End If
    
    If monat <= 2 Then
    monat = monat + 12
    Jahr = Jahr - 1
    End If
    
    A = Fix(Jahr / 100)
    b = 2 - A + Fix(A / 4)
    
    jdp = Fix(365.25 * (Jahr + 4716)) + Fix(30.6001 * (monat + 1)) + tag + b + ((stunde + min / 60 + sec / 3600) / 24) - 1524.5
    
    jdp = jdp - Zeitzone / 24

tzd = (jdp - 2451545) / 36525

'D
elm = rang(297.8502042 + 445267.1115168 * tzd - (0.00163 * tzd * tzd) + tzd ^ 3 / 545868 - tzd ^ 4 / 113065000)
'M
ams = rang(357.5291092 + 35999.0502909 * tzd - 0.0001536 * tzd * tzd + tzd ^ 3 / 24490000)
'M
aml = rang(134.9634114 + 477198.8676313 * tzd - 0.008997 * tzd * tzd + tzd ^ 3 / 69699 - tzd ^ 4 / 14712000)

asd = 180 - elm - _
                    (6.289 * Sin((3.1415926535 / 180) * ((aml)))) + _
                    (2.1 * Sin((3.1415926535 / 180) * ((ams)))) - _
                    (1.274 * Sin((3.1415926535 / 180) * (((2 * elm) - _
                            aml)))) - _
                    (0.658 * Sin((3.1415926535 / 180) * ((2 * elm)))) - _
                    (0.214 * Sin((3.1415926535 / 180) * ((2 * aml)))) - _
                    (0.11 * Sin((3.1415926535 / 180) * ((elm))))
                    
phi1 = (1 + Cos((3.1415926535 / 180) * (asd))) / 2




tzd = (jdp + (0.5 / 24) - 2451545) / 36525

'D
elm = rang(297.8502042 + 445267.1115168 * tzd - (0.00163 * tzd * tzd) + tzd ^ 3 / 545868 - tzd ^ 4 / 113065000)
'M
ams = rang(357.5291092 + 35999.0502909 * tzd - 0.0001536 * tzd * tzd + tzd ^ 3 / 24490000)
'M
aml = rang(134.9634114 + 477198.8676313 * tzd - 0.008997 * tzd * tzd + tzd ^ 3 / 69699 - tzd ^ 4 / 14712000)

asd = 180 - elm - _
                    (6.289 * Sin((3.1415926535 / 180) * ((aml)))) + _
                    (2.1 * Sin((3.1415926535 / 180) * ((ams)))) - _
                    (1.274 * Sin((3.1415926535 / 180) * (((2 * elm) - _
                            aml)))) - _
                    (0.658 * Sin((3.1415926535 / 180) * ((2 * elm)))) - _
                    (0.214 * Sin((3.1415926535 / 180) * ((2 * aml)))) - _
                    (0.11 * Sin((3.1415926535 / 180) * ((elm))))
                    
phi2 = (1 + Cos((3.1415926535 / 180) * (asd))) / 2


If (phi2 - phi1) >= 0 Then
tendenz = "zunehmend"

Else
tendenz = "abnehmend"

End If





End Function


Function dt(Jahr As Integer, k As Integer) As Double


u = (Jahr - 1900) / 100

dt = (-2.44 + 87.24 * u + 815.2 * u ^ 2 - 2637.8 * u ^ 3 - 18756.33 * u ^ 4 + 124906.15 * u ^ 5 - 303191.19 * u ^ 6 + 372919.88 * u ^ 7 - 232424.66 * u ^ 8 + 58353.42 * u ^ 9)

If Jahr > 1998 Then
dt = Jahr * 0.6 - 1135.4
End If
 
 dt = Round(dt, 0) + k
   
End Function


Function dtjd(Jahr As Double, k As Double) As Variant



u = (Jahr - 1900) / 100

dtjd = (-2.44 + 87.24 * u + 815.2 * u ^ 2 - 2637.8 * u ^ 3 - 18756.33 * u ^ 4 + 124906.15 * u ^ 5 - 303191.19 * u ^ 6 + 372919.88 * u ^ 7 - 232424.66 * u ^ 8 + 58353.42 * u ^ 9)

If Jahr > 1998 Then
dtjd = Jahr * 0.6 - 1135.4
End If
 
dtjd = Round(dtjd, 0) + k
dtjd = dtjd / (86400#)
 
End Function




Function rmond(JD As Double) As Double

 
T = (JD + 1 / (60 * 24) - 2451545) / 36525
    

L = 218.3164591 + (481267.88134236 * T) - (0.0013268 * T ^ 2) + ((T ^ 3) / 538841) - ((T ^ 4) / 65194000)

d = 297.8502042 + (445267.1115168 * T) - (0.00163 * T ^ 2) + ((T ^ 3) / 545868) - ((T ^ 4) / 113065)

m = 357.5291092 + (35999.0502909 * T) - (0.0001536 * T ^ 2) + ((T ^ 3) / 24490000)

mm = 134.9634114 + (477198.8676313 * T) + (0.008997 * T ^ 2) + ((T ^ 3) / 69699) - ((T ^ 4) / 14712000)


F = 93.2720993 + (483202.0175273 * T) - (0.0034029 * T ^ 2) - ((T ^ 3) / 3526000) + ((T ^ 4) / 863310000)


a1 = -20905355 * Cos((0 * d + 0 * m + 1 * mm + 0 * F) * 3.14159265358979 / 180)
a2 = -3699111 * Cos((2 * d + 0 * m - 1 * mm + 0 * F) * 3.14159265358979 / 180)
a3 = -2955968 * Cos((2 * d + 0 * m + 0 * mm + 0 * F) * 3.14159265358979 / 180)
a4 = -569925 * Cos((0 * d + 0 * m + 2 * mm + 0 * F) * 3.14159265358979 / 180)
a5 = 48888 * Cos((0 * d + 1 * m + 0 * mm + 0 * F) * 3.14159265358979 / 180)
a6 = -3149 * Cos((0 * d + 0 * m + 0 * mm + 2 * F) * 3.14159265358979 / 180)
a7 = 246158 * Cos((2 * d + 0 * m - 2 * mm + 0 * F) * 3.14159265358979 / 180)
a8 = -152138 * Cos((2 * d - 1 * m - 1 * mm + 0 * F) * 3.14159265358979 / 180)
a9 = -170733 * Cos((2 * d + 0 * m + 1 * mm + 0 * F) * 3.14159265358979 / 180)
a10 = -204586 * Cos((2 * d - 1 * m + 0 * mm + 0 * F) * 3.14159265358979 / 180)
a11 = -129620 * Cos((0 * d + 1 * m - 1 * mm + 0 * F) * 3.14159265358979 / 180)
a12 = 108743 * Cos((1 * d + 0 * m + 0 * mm + 0 * F) * 3.14159265358979 / 180)
a13 = 104755 * Cos((0 * d + 1 * m + 1 * mm + 0 * F) * 3.14159265358979 / 180)
a14 = 10321 * Cos((2 * d + 0 * m + 0 * mm - 2 * F) * 3.14159265358979 / 180)
a15 = 0
a16 = 79661 * Cos((0 * d + 0 * m + 1 * mm - 2 * F) * 3.14159265358979 / 180)
a17 = -34782 * Cos((4 * d + 0 * m - 1 * mm + 0 * F) * 3.14159265358979 / 180)
a18 = -23210 * Cos((0 * d + 0 * m + 3 * mm + 0 * F) * 3.14159265358979 / 180)
a19 = -21636 * Cos((4 * d + 0 * m - 2 * mm + 0 * F) * 3.14159265358979 / 180)
a20 = 24208 * Cos((2 * d + 1 * m - 1 * mm + 0 * F) * 3.14159265358979 / 180)
a21 = 30824 * Cos((2 * d + 1 * m + 0 * mm + 0 * F) * 3.14159265358979 / 180)
a22 = -8379 * Cos((1 * d + 0 * m - 1 * mm + 0 * F) * 3.14159265358979 / 180)
a23 = -16675 * Cos((1 * d + 1 * m + 0 * mm + 0 * F) * 3.14159265358979 / 180)
a24 = -12831 * Cos((2 * d - 1 * m + 1 * mm + 0 * F) * 3.14159265358979 / 180)
a25 = -10445 * Cos((2 * d + 0 * m + 2 * mm + 0 * F) * 3.14159265358979 / 180)
a26 = -11650 * Cos((4 * d + 0 * m + 0 * mm + 0 * F) * 3.14159265358979 / 180)
a27 = 14403 * Cos((2 * d + 0 * m - 3 * mm + 0 * F) * 3.14159265358979 / 180)
a28 = -7003 * Cos((0 * d + 1 * m - 2 * mm + 0 * F) * 3.14159265358979 / 180)
a29 = 0
a30 = 10056 * Cos((2 * d - 1 * m - 2 * mm + 0 * F) * 3.14159265358979 / 180)
a31 = 6322 * Cos((1 * d + 0 * m + 1 * mm + 0 * F) * 3.14159265358979 / 180)
a32 = -9884 * Cos((2 * d - 2 * m - 0 * mm + 0 * F) * 3.14159265358979 / 180)
a33 = 5751 * Cos((0 * d + 1 * m + 2 * mm + 0 * F) * 3.14159265358979 / 180)
a34 = -4950 * Cos((2 * d - 2 * m - 1 * mm + 0 * F) * 3.14159265358979 / 180)
a35 = 4130 * Cos((2 * d + 0 * m + 1 * mm - 2 * F) * 3.14159265358979 / 180)
a36 = -3958 * Cos((4 * d - 1 * m - 1 * mm + 0 * F) * 3.14159265358979 / 180)
a37 = 3258 * Cos((3 * d + 0 * m - 1 * mm + 0 * F) * 3.14159265358979 / 180)
a38 = 2616 * Cos((2 * d + 1 * m + 1 * mm + 0 * F) * 3.14159265358979 / 180)
a39 = -1897 * Cos((4 * d - 1 * m - 2 * mm + 0 * F) * 3.14159265358979 / 180)
a40 = -2117 * Cos((0 * d + 2 * m - 1 * mm + 0 * F) * 3.14159265358979 / 180)
a41 = 2354 * Cos((2 * d + 2 * m - 1 * mm + 0 * F) * 3.14159265358979 / 180)
a42 = -1423 * Cos((4 * d + 0 * m + 1 * mm + 0 * F) * 3.14159265358979 / 180)
a43 = -1117 * Cos((0 * d + 0 * m + 4 * mm + 0 * F) * 3.14159265358979 / 180)
a44 = -1571 * Cos((4 * d - 1 * m - 0 * mm + 0 * F) * 3.14159265358979 / 180)
a45 = -1739 * Cos((1 * d + 0 * m - 2 * mm + 0 * F) * 3.14159265358979 / 180)
a46 = -4421 * Cos((0 * d + 0 * m + 2 * mm - 2 * F) * 3.14159265358979 / 180)
a47 = 1165 * Cos((0 * d + 2 * m + 1 * mm + 0 * F) * 3.14159265358979 / 180)
a48 = 8752 * Cos((2 * d + 0 * m - 1 * mm - 2 * F) * 3.14159265358979 / 180)




az = a1 + a2 + a3 + a4 + a5 + a6 + a7 + a8 + a9 + a10 + a11 + a12 + a13 + a14 + a15 + a16 + a17 + a18 + a19 + a20 + a21 + a22 + a23 + a24 + a25 + a26 + a27 + a28 + a29 + a30
az = az + a31 + a32 + a33 + a34 + a35 + a36 + a37 + a38 + a39 + a40 + a41 + a42 + a43 + a44 + a45 + a46 + a47 + a48


rmond = 385000.56 + (az / 1000)

rmond = Round(rmond, 0)



End Function




Function aphel(Jahr As Double) As Double

 j = Jahr

kj = 0.99997 * (j - 2000.01)

kj = Round(kj, 0) + 0.5

AA = 328.41 + 132.788585 * kj
AB = 316.13 + 584.903153 * kj
AC = 346.2 + 450.380738 * kj
ad = 136.95 + 659.306737 * kj
ae = 249.52 + 329.653368 * kj


AA = Sin(AA * 3.14159265358979 / 180)
AB = Sin(AB * 3.14159265358979 / 180)
AC = Sin(AC * 3.14159265358979 / 180)
ad = Sin(ad * 3.14159265358979 / 180)
ae = Sin(ae * 3.14159265358979 / 180)



AA = -1.352 * AA
AB = 0.061 * AB
AC = 0.062 * AC
ad = 0.029 * ad
ae = 0.031 * ae

az = AA + AB + AC + ad + ae


aphel = 2451547.507 + 365.2596358 * kj + 0.0000000158 * kj * kj + az



    

End Function
Function perihel(Jahr As Double) As Double

 j = Jahr

kj = 0.99997 * (j - 2000.01)

kj = Round(kj, 0)

AA = 328.41 + 132.788585 * kj
AB = 316.13 + 584.903153 * kj
AC = 346.2 + 450.380738 * kj
ad = 136.95 + 659.306737 * kj
ae = 249.52 + 329.653368 * kj


AA = Sin(AA * 3.14159265358979 / 180)
AB = Sin(AB * 3.14159265358979 / 180)
AC = Sin(AC * 3.14159265358979 / 180)
ad = Sin(ad * 3.14159265358979 / 180)
ae = Sin(ae * 3.14159265358979 / 180)



AA = 1.278 * AA
AB = -0.055 * AB
AC = -0.091 * AC
ad = -0.056 * ad
ae = -0.045 * ae

az = AA + AB + AC + ad + ae


perihel = 2451547.507 + 365.2596358 * kj + 0.0000000158 * kj * kj + az
    
    

End Function



Function dekmond(JD As Double) As Double
Dim NutationBreite As Double
Dim NutationLnge As Double
Dim Ekliptik As Double
Dim ramond As Double
Dim dtjd  As Double


jdx = JD

Jahr = ((JD + 1524 - 122.1) / 365.25) - 4715.5
Jahr = Fix(Jahr)
u = (Jahr - 1900) / 100
dtjd = (-2.44 + 87.24 * u + 815.2 * u ^ 2 - 2637.8 * u ^ 3 - 18756.33 * u ^ 4 + 124906.15 * u ^ 5 - 303191.19 * u ^ 6 + 372919.88 * u ^ 7 - 232424.66 * u ^ 8 + 58353.42 * u ^ 9)

If Jahr > 1998 Then
dtjd = Jahr * 0.6 - 1135.4
End If
 
dtjd = Round(dtjd, 0)
dtjd = dtjd / (86400#)

jdx = dtjd + jdx

T = (jdx - 2451545) / 36525

Ekliptik = 23.43929111 - (46.815 / 3600) * T - (0.00059 / 3600) * T * T + (0.001813 / 3600) * T * T * T

omega = 125.04452 - 1934.136261 * T + 0.0020708 * T * T + T * T * T / 450000
    om1 = 280.4665 + 36000.7698 * T
    om2 = 218.3165 + 481267.8813 * T
    
   NutationLnge = -17.2 * Sin(omega * 3.14159265358979 / 180) - 1.32 * Sin(2 * om1 * 3.14159265358979 / 180) - 0.23 * Sin(2 * om2 * 3.14159265358979 / 180) + 0.21 * Sin(2 * omega * 3.14159265358979 / 180)
  
NutationLnge = NutationLnge / 3600


 NL = 280.4665 + 36000.7698 * T
    NLL = 218.3165 + 481267.8813 * T
    
  NutationBreite = 9.2 * Cos(omega * 3.14159265358979 / 180) + 0.57 * Cos(2 * NL * 3.14159265358979 / 180) + 0.1 * Cos(2 * NLL * 3.14159265358979 / 180) - 0.09 * Cos(2 * omega * 3.14159265358979 / 180)
  NutationBreite = NutationBreite / 3600



L = 218.3164591 + (481267.88134236 * T) - (0.0013268 * T ^ 2) + (T ^ 3 / 538841) - (T ^ 4 / 65194000)

d = 297.8502042 + (445267.1115168 * T) - (0.00163 * T ^ 2) + (T ^ 3 / 545868) - (T ^ 4 / 113065)

m = 357.5291092 + (35999.0502909 * T) - (0.0001536 * T ^ 2) + (T ^ 3 / 24490000)

mm = 134.9634114 + (477198.8676313 * T) + (0.008997 * T ^ 2) + (T ^ 3 / 69699) - (T ^ 4 / 14712000)


F = 93.2720993 + (483202.0175273 * T) - (0.0034029 * T ^ 2) - (T ^ 3 / 3526000) + (T ^ 4 / 863310000)

AA = 119.75 + 131.849 * T

AB = 53.09 + 479264.29 * T

AC = 313.45 + 481266.484 * T

e = 1 - (0.002516 * T) - (0.0000074 * T ^ 2)
EE = e * e

b1 = 5128122 * Sin((0 * d + 0 * m + 0 * mm + 1 * F) * 3.14159265358979 / 180)
b2 = 280602 * Sin((0 * d + 0 * m + 1 * mm + 1 * F) * 3.14159265358979 / 180)
b3 = 277693 * Sin((0 * d + 0 * m + 1 * mm + -1 * F) * 3.14159265358979 / 180)
b4 = 173237 * Sin((2 * d + 0 * m + 0 * mm + -1 * F) * 3.14159265358979 / 180)
b5 = 55413 * Sin((2 * d + 0 * m + -1 * mm + 1 * F) * 3.14159265358979 / 180)
b6 = 46271 * Sin((2 * d + 0 * m + -1 * mm + -1 * F) * 3.14159265358979 / 180)
b7 = 32573 * Sin((2 * d + 0 * m + 0 * mm + 1 * F) * 3.14159265358979 / 180)
b8 = 17198 * Sin((0 * d + 0 * m + 2 * mm + 1 * F) * 3.14159265358979 / 180)
b9 = 9266 * Sin((2 * d + 0 * m + 1 * mm + -1 * F) * 3.14159265358979 / 180)
b10 = 8822 * Sin((0 * d + 0 * m + 2 * mm + -1 * F) * 3.14159265358979 / 180)
b11 = e * 8216 * Sin((2 * d - 1 * m + 0 * mm + -1 * F) * 3.14159265358979 / 180)
b12 = 4324 * Sin((2 * d + 0 * m - 2 * mm + -1 * F) * 3.14159265358979 / 180)
b13 = 4200 * Sin((2 * d + 0 * m + 1 * mm + 1 * F) * 3.14159265358979 / 180)
b14 = e * (-3359) * Sin((2 * d + 1 * m + 0 * mm + -1 * F) * 3.14159265358979 / 180)
b15 = e * 2463 * Sin((2 * d - 1 * m - 1 * mm + 1 * F) * 3.14159265358979 / 180)
b16 = e * 2211 * Sin((2 * d - 1 * m + 0 * mm + 1 * F) * 3.14159265358979 / 180)
b17 = e * 2065 * Sin((2 * d - 1 * m - 1 * mm + -1 * F) * 3.14159265358979 / 180)
b18 = -1870 * e * Sin((0 * d + 1 * m - 1 * mm + -1 * F) * 3.14159265358979 / 180)
b19 = 1828 * Sin((4 * d + 0 * m - 1 * mm + -1 * F) * 3.14159265358979 / 180)
b20 = -1794 * e * Sin((0 * d + 1 * m + 0 * mm + 1 * F) * 3.14159265358979 / 180)
b21 = -1749 * Sin((0 * d + 0 * m + 0 * mm + 3 * F) * 3.14159265358979 / 180)
b22 = -1565 * e * Sin((0 * d + 1 * m + -1 * mm + 1 * F) * 3.14159265358979 / 180)
b23 = -1491 * Sin((1 * d + 0 * m + 0 * mm + 1 * F) * 3.14159265358979 / 180)
b24 = -1475 * e * Sin((0 * d + 1 * m + 1 * mm + 1 * F) * 3.14159265358979 / 180)
b25 = -1410 * e * Sin((0 * d + 1 * m + 1 * mm + -1 * F) * 3.14159265358979 / 180)
b26 = -1344 * e * Sin((0 * d + 1 * m + 0 * mm + -1 * F) * 3.14159265358979 / 180)
b27 = -1335 * Sin((1 * d + 0 * m + 0 * mm + -1 * F) * 3.14159265358979 / 180)
b28 = 1107 * Sin((0 * d + 0 * m + 3 * mm + 1 * F) * 3.14159265358979 / 180)
b29 = 1021 * Sin((4 * d + 0 * m + 0 * mm + -1 * F) * 3.14159265358979 / 180)
b30 = 833 * Sin((4 * d + 0 * m - 1 * mm + 1 * F) * 3.14159265358979 / 180)
b31 = 777 * Sin((0 * d + 0 * m + 1 * mm + -3 * F) * 3.14159265358979 / 180)
b32 = 671 * Sin((4 * d + 0 * m - 2 * mm + 1 * F) * 3.14159265358979 / 180)
b33 = 607 * Sin((2 * d + 0 * m + 0 * mm + -3 * F) * 3.14159265358979 / 180)
b34 = 596 * Sin((2 * d + 0 * m + 2 * mm + -1 * F) * 3.14159265358979 / 180)
b35 = 491 * e * Sin((2 * d + -1 * m + 1 * mm + -1 * F) * 3.14159265358979 / 180)
b36 = -451 * Sin((2 * d + 0 * m - 2 * mm + 1 * F) * 3.14159265358979 / 180)
b37 = 439 * Sin((0 * d + 0 * m + 3 * mm + -1 * F) * 3.14159265358979 / 180)
b38 = 422 * Sin((2 * d + 0 * m + 2 * mm + 1 * F) * 3.14159265358979 / 180)
b39 = 421 * Sin((2 * d + 0 * m - 3 * mm + -1 * F) * 3.14159265358979 / 180)
b40 = -366 * e * Sin((2 * d + 1 * m - 1 * mm + 1 * F) * 3.14159265358979 / 180)
b41 = -351 * e * Sin((2 * d + 1 * m + 0 * mm + 1 * F) * 3.14159265358979 / 180)
b42 = 331 * Sin((4 * d + 0 * m + 0 * mm + 1 * F) * 3.14159265358979 / 180)
b43 = 315 * e * Sin((2 * d + -1 * m + 1 * mm + 1 * F) * 3.14159265358979 / 180)
b44 = 302 * EE * Sin((2 * d + -2 * m + 0 * mm + -1 * F) * 3.14159265358979 / 180)
b45 = -283 * Sin((0 * d + 0 * m + 1 * mm + 3 * F) * 3.14159265358979 / 180)
b46 = -229 * Sin((2 * d + 1 * m + 1 * mm + -1 * F) * 3.14159265358979 / 180)
b47 = 223 * Sin((1 * d + 1 * m + 0 * mm + -1 * F) * 3.14159265358979 / 180)
b48 = 223 * Sin((1 * d + 1 * m + 0 * mm + 1 * F) * 3.14159265358979 / 180)
b49 = -220 * Sin((0 * d + 1 * m - 2 * mm + -1 * F) * 3.14159265358979 / 180)
b50 = -220 * Sin((2 * d + 1 * m - 1 * mm + -1 * F) * 3.14159265358979 / 180)
b51 = -185 * Sin((1 * d + 0 * m + 1 * mm + 1 * F) * 3.14159265358979 / 180)
b52 = 181 * e * Sin((2 * d + -1 * m - 2 * mm + -1 * F) * 3.14159265358979 / 180)
b53 = -177 * e * Sin((0 * d + 1 * m + 2 * mm + 1 * F) * 3.14159265358979 / 180)
b54 = 176 * Sin((4 * d + 0 * m - 2 * mm + -1 * F) * 3.14159265358979 / 180)
b55 = 166 * e * Sin((4 * d - 1 * m - 1 * mm + -1 * F) * 3.14159265358979 / 180)
b56 = -164 * Sin((1 * d + 0 * m + 1 * mm + -1 * F) * 3.14159265358979 / 180)
b57 = 132 * Sin((4 * d + 0 * m + 1 * mm + -1 * F) * 3.14159265358979 / 180)
b58 = -119 * Sin((1 * d + 0 * m - 1 * mm + -1 * F) * 3.14159265358979 / 180)
b59 = 115 * e * Sin((4 * d + -1 * m + 0 * mm + -1 * F) * 3.14159265358979 / 180)
b60 = 107 * EE * Sin((2 * d + -2 * m + 0 * mm + 1 * F) * 3.14159265358979 / 180)


bges1 = b1 + b2 + b3 + b4 + b5 + b6 + b7 + b8 + b9 + b10
bges2 = b11 + b12 + b13 + b14 + b15 + b16 + b17 + b18 + b19 + b20
bges3 = b21 + b22 + b23 + b24 + b25 + b26 + b27 + b28 + b29 + b30
bges4 = b31 + b32 + b33 + b34 + b35 + b36 + b37 + b38 + b39 + b40
bges5 = b41 + b42 + b43 + b44 + b45 + b46 + b47 + b48 + b49 + b50
bges6 = b51 + b52 + b53 + b54 + b55 + b56 + b57 + b58 + b59 + b60

bl1 = -2235 * Sin((L) * 3.14159265358979 / 180)
bl2 = 382 * Sin((AC) * 3.14159265358979 / 180)
bl3 = 175 * Sin((AA - F) * 3.14159265358979 / 180)
bl4 = 175 * Sin((AA + F) * 3.14159265358979 / 180)
bl5 = 127 * Sin((L - mm) * 3.14159265358979 / 180)
bl6 = -115 * Sin((L + mm) * 3.14159265358979 / 180)



bl = bl1 + bl2 + bl3 + bl4 + bl5 + bl6



bges = bges1 + bges2 + bges3 + bges4 + bges5 + bges6 + bl







l1 = 6288774 * Sin((0 * d + 0 * m + 1 * mm + 0 * F) * 3.14159265358979 / 180)
l2 = 1274027 * Sin((2 * d + 0 * m - 1 * mm + 0 * F) * 3.14159265358979 / 180)
l3 = 658314 * Sin((2 * d + 0 * m + 0 * mm + 0 * F) * 3.14159265358979 / 180)
l4 = 213618 * Sin((0 * d + 0 * m + 2 * mm + 0 * F) * 3.14159265358979 / 180)
l5 = -185116 * e * Sin((0 * d + 1 * m + 0 * mm + 0 * F) * 3.14159265358979 / 180)
l6 = -114332 * Sin((0 * d + 0 * m + 0 * mm + 2 * F) * 3.14159265358979 / 180)
l7 = 58793 * Sin((2 * d + 0 * m - 2 * mm + 0 * F) * 3.14159265358979 / 180)
l8 = 57066 * e * Sin((2 * d - 1 * m - 1 * mm + 0 * F) * 3.14159265358979 / 180)
l9 = 53322 * Sin((2 * d + 0 * m + 1 * mm + 0 * F) * 3.14159265358979 / 180)
l10 = 45758 * e * Sin((2 * d - 1 * m + 0 * mm + 0 * F) * 3.14159265358979 / 180)
l11 = -40923 * e * Sin((0 * d + 1 * m - 1 * mm + 0 * F) * 3.14159265358979 / 180)
l12 = -34720 * Sin((1 * d + 0 * m + 0 * mm + 0 * F) * 3.14159265358979 / 180)
l13 = -30383 * e * Sin((0 * d + 1 * m + 1 * mm + 0 * F) * 3.14159265358979 / 180)
l14 = 15327 * Sin((2 * d + 0 * m + 0 * mm + -2 * F) * 3.14159265358979 / 180)
l15 = -12528 * Sin((0 * d + 0 * m + 1 * mm + 2 * F) * 3.14159265358979 / 180)
l16 = 10980 * Sin((0 * d + 0 * m + 1 * mm + -2 * F) * 3.14159265358979 / 180)
l17 = 10675 * Sin((4 * d + 0 * m - 1 * mm + 0 * F) * 3.14159265358979 / 180)
l18 = 10034 * Sin((0 * d + 0 * m + 3 * mm + 0 * F) * 3.14159265358979 / 180)
l19 = 8548 * Sin((4 * d + 0 * m - 2 * mm + 0 * F) * 3.14159265358979 / 180)
l20 = -7888 * e * Sin((2 * d + 1 * m - 1 * mm + 0 * F) * 3.14159265358979 / 180)
l21 = -6766 * e * Sin((2 * d + 1 * m + 0 * mm + 0 * F) * 3.14159265358979 / 180)
l22 = -5163 * Sin((1 * d + 0 * m - 1 * mm + 0 * F) * 3.14159265358979 / 180)
l23 = 4987 * e * Sin((1 * d + 1 * m + 0 * mm + 0 * F) * 3.14159265358979 / 180)
l24 = 4036 * e * Sin((2 * d - 1 * m + 1 * mm + 0 * F) * 3.14159265358979 / 180)
l25 = 3994 * Sin((2 * d + 0 * m + 2 * mm + 0 * F) * 3.14159265358979 / 180)
l26 = 3861 * Sin((4 * d + 0 * m + 0 * mm + 0 * F) * 3.14159265358979 / 180)
l27 = 3665 * Sin((2 * d + 0 * m - 3 * mm + 0 * F) * 3.14159265358979 / 180)
l28 = -2689 * Sin((0 * d + 1 * m - 2 * mm + 0 * F) * 3.14159265358979 / 180)
l29 = -2602 * Sin((2 * d + 0 * m - 1 * mm + 2 * F) * 3.14159265358979 / 180)
l30 = 2390 * e * Sin((2 * d - 1 * m - 2 * mm + 0 * F) * 3.14159265358979 / 180)
l31 = -2348 * Sin((1 * d + 0 * m + 1 * mm + 0 * F) * 3.14159265358979 / 180)
l32 = 2236 * EE * Sin((2 * d - 2 * m + 0 * mm + 0 * F) * 3.14159265358979 / 180)
l33 = -2120 * e * Sin((0 * d + 1 * m + 2 * mm + 0 * F) * 3.14159265358979 / 180)
l34 = -2069 * EE * Sin((0 * d + 2 * m + 0 * mm + 0 * F) * 3.14159265358979 / 180)
l35 = 2048 * EE * Sin((2 * d - 2 * m - 1 * mm + 0 * F) * 3.14159265358979 / 180)
l36 = -1773 * Sin((2 * d + 0 * m + 1 * mm + -2 * F) * 3.14159265358979 / 180)
l37 = -1595 * Sin((2 * d + 0 * m + 0 * mm + 2 * F) * 3.14159265358979 / 180)
l38 = 1215 * e * Sin((4 * d - 1 * m - 1 * mm + 0 * F) * 3.14159265358979 / 180)
l39 = -1110 * Sin((0 * d + 0 * m + 2 * mm + 2 * F) * 3.14159265358979 / 180)
l40 = -892 * Sin((3 * d + 0 * m + -1 * mm + 0 * F) * 3.14159265358979 / 180)
l41 = -810 * Sin((2 * d + 1 * m + 1 * mm + 0 * F) * 3.14159265358979 / 180)
l42 = 759 * e * Sin((4 * d - 1 * m - 2 * mm + 0 * F) * 3.14159265358979 / 180)
l43 = -713 * EE * Sin((0 * d + 2 * m - 1 * mm + 0 * F) * 3.14159265358979 / 180)
l44 = -700 * EE * Sin((2 * d + 2 * m - 1 * mm + 0 * F) * 3.14159265358979 / 180)
l45 = 691 * e * Sin((2 * d + 1 * m - 2 * mm + 0 * F) * 3.14159265358979 / 180)
l46 = 596 * e * Sin((2 * d - 1 * m + 0 * mm + -2 * F) * 3.14159265358979 / 180)
l47 = 549 * Sin((4 * d + 0 * m + 1 * mm + 0 * F) * 3.14159265358979 / 180)
l48 = 537 * Sin((0 * d + 0 * m + 4 * mm + 0 * F) * 3.14159265358979 / 180)
l49 = 520 * e * Sin((4 * d - 1 * m + 0 * mm + 0 * F) * 3.14159265358979 / 180)
l50 = -487 * Sin((1 * d + 0 * m - 2 * mm + 0 * F) * 3.14159265358979 / 180)
l51 = -399 * e * Sin((2 * d + 1 * m + 0 * mm + -2 * F) * 3.14159265358979 / 180)
l52 = -381 * Sin((0 * d + 0 * m + 2 * mm + -2 * F) * 3.14159265358979 / 180)
l53 = 351 * e * Sin((1 * d + 1 * m + 1 * mm + 0 * F) * 3.14159265358979 / 180)
l54 = -340 * Sin((3 * d + 0 * m - 2 * mm + 0 * F) * 3.14159265358979 / 180)
l55 = 330 * Sin((4 * d + 0 * m - 3 * mm + 0 * F) * 3.14159265358979 / 180)
l56 = 327 * e * Sin((2 * d - 1 * m + 2 * mm + 0 * F) * 3.14159265358979 / 180)
l57 = -323 * EE * Sin((0 * d + 2 * m + 1 * mm + 0 * F) * 3.14159265358979 / 180)
l58 = 299 * e * Sin((1 * d + 1 * m - 1 * mm + 0 * F) * 3.14159265358979 / 180)
l59 = 294 * Sin((2 * d + 0 * m + 3 * mm + 0 * F) * 3.14159265358979 / 180)
l60 = 0 * Sin((2 * d + 0 * m - 1 * mm + -2 * F) * 3.14159265358979 / 180)



lges1 = l1 + l2 + l3 + l4 + l5 + l6 + l7 + l8 + l9 + l10
lges2 = l11 + l12 + l13 + l14 + l15 + l16 + l17 + l18 + l19 + l20
lges3 = l21 + l22 + l23 + l24 + l25 + l26 + l27 + l28 + l29 + l30
lges4 = l31 + l32 + l33 + l34 + l35 + l36 + l37 + l38 + l39 + l40
lges5 = l41 + l42 + l43 + l44 + l45 + l46 + l47 + l48 + l49 + l50
lges6 = l51 + l52 + l53 + l54 + l55 + l56 + l57 + l58 + l59 + l60


sl1 = 3958 * Sin((AA) * 3.14159265358979 / 180)
sl2 = 1962 * Sin((L - F) * 3.14159265358979 / 180)
sl3 = 318 * Sin((AB) * 3.14159265358979 / 180)

SL = sl1 + sl2 + sl3


lges = lges1 + lges2 + lges3 + lges4 + lges5 + lges6 + SL




betam = NutationBreite + (bges / 1000000)

lamdam = NutationLnge + L + lges / 1000000



Ekliptik = Ekliptik

rax = Sin((lamdam) * 3.14159265358979 / 180) * Cos((Ekliptik) * 3.14159265358979 / 180) - Tan((betam) * 3.14159265358979 / 180) * Sin((Ekliptik) * 3.14159265358979 / 180)

ray = Cos((lamdam) * 3.14159265358979 / 180)

ramond = Application.Atan2(ray, rax) * 180 / 3.14159265358979

If ramond < 0 Then
ramond = 360 + ramond
End If


 ramond = ramond

dekw = Sin((betam) * 3.14159265358979 / 180) * Cos((Ekliptik) * 3.14159265358979 / 180) + Cos((betam) * 3.14159265358979 / 180) * Sin((Ekliptik) * 3.14159265358979 / 180) * Sin((lamdam) * 3.14159265358979 / 180)

dekx = dekw
deky = Sqr(1 - dekx * dekx)

dekmond = Application.Atan2(deky, dekx) * 180 / 3.14159265358979




'Ergebnisse:

dekmond = dekmond
ramond = ramond
lamdamond = lamdam
betamond = betam


dekmond = dekmond

End Function

Function ramond(JD As Double) As Double
Dim NutationBreite As Double
Dim NutationLnge As Double
Dim Ekliptik As Double
Dim dekmond As Double
Dim dtjd  As Double


jdx = JD

Jahr = ((JD + 1524 - 122.1) / 365.25) - 4715.5
Jahr = Fix(Jahr)
u = (Jahr - 1900) / 100
dtjd = (-2.44 + 87.24 * u + 815.2 * u ^ 2 - 2637.8 * u ^ 3 - 18756.33 * u ^ 4 + 124906.15 * u ^ 5 - 303191.19 * u ^ 6 + 372919.88 * u ^ 7 - 232424.66 * u ^ 8 + 58353.42 * u ^ 9)

If Jahr > 1998 Then
dtjd = Jahr * 0.6 - 1135.4
End If
 
dtjd = Round(dtjd, 0)
dtjd = dtjd / (86400#)

jdx = dtjd + jdx

T = (jdx - 2451545) / 36525



Ekliptik = 23.43929111 - (46.815 / 3600) * T - (0.00059 / 3600) * T * T + (0.001813 / 3600) * T * T * T

omega = 125.04452 - 1934.136261 * T + 0.0020708 * T * T + T * T * T / 450000
    om1 = 280.4665 + 36000.7698 * T
    om2 = 218.3165 + 481267.8813 * T
    
   NutationLnge = -17.2 * Sin(omega * 3.14159265358979 / 180) - 1.32 * Sin(2 * om1 * 3.14159265358979 / 180) - 0.23 * Sin(2 * om2 * 3.14159265358979 / 180) + 0.21 * Sin(2 * omega * 3.14159265358979 / 180)
  
NutationLnge = NutationLnge / 3600



  NL = 280.4665 + 36000.7698 * T
    NLL = 218.3165 + 481267.8813 * T
    
  NutationBreite = 9.2 * Cos(omega * 3.14159265358979 / 180) + 0.57 * Cos(2 * NL * 3.14159265358979 / 180) + 0.1 * Cos(2 * NLL * 3.14159265358979 / 180) - 0.09 * Cos(2 * omega * 3.14159265358979 / 180)
  NutationBreite = NutationBreite / 3600



L = 218.3164591 + (481267.88134236 * T) - (0.0013268 * T ^ 2) + (T ^ 3 / 538841) - (T ^ 4 / 65194000)

d = 297.8502042 + (445267.1115168 * T) - (0.00163 * T ^ 2) + (T ^ 3 / 545868) - (T ^ 4 / 113065)

m = 357.5291092 + (35999.0502909 * T) - (0.0001536 * T ^ 2) + (T ^ 3 / 24490000)

mm = 134.9634114 + (477198.8676313 * T) + (0.008997 * T ^ 2) + (T ^ 3 / 69699) - (T ^ 4 / 14712000)


F = 93.2720993 + (483202.0175273 * T) - (0.0034029 * T ^ 2) - (T ^ 3 / 3526000) + (T ^ 4 / 863310000)

AA = 119.75 + 131.849 * T

AB = 53.09 + 479264.29 * T

AC = 313.45 + 481266.484 * T

e = 1 - (0.002516 * T) - (0.0000074 * T ^ 2)
EE = e * e

b1 = 5128122 * Sin((0 * d + 0 * m + 0 * mm + 1 * F) * 3.14159265358979 / 180)
b2 = 280602 * Sin((0 * d + 0 * m + 1 * mm + 1 * F) * 3.14159265358979 / 180)
b3 = 277693 * Sin((0 * d + 0 * m + 1 * mm + -1 * F) * 3.14159265358979 / 180)
b4 = 173237 * Sin((2 * d + 0 * m + 0 * mm + -1 * F) * 3.14159265358979 / 180)
b5 = 55413 * Sin((2 * d + 0 * m + -1 * mm + 1 * F) * 3.14159265358979 / 180)
b6 = 46271 * Sin((2 * d + 0 * m + -1 * mm + -1 * F) * 3.14159265358979 / 180)
b7 = 32573 * Sin((2 * d + 0 * m + 0 * mm + 1 * F) * 3.14159265358979 / 180)
b8 = 17198 * Sin((0 * d + 0 * m + 2 * mm + 1 * F) * 3.14159265358979 / 180)
b9 = 9266 * Sin((2 * d + 0 * m + 1 * mm + -1 * F) * 3.14159265358979 / 180)
b10 = 8822 * Sin((0 * d + 0 * m + 2 * mm + -1 * F) * 3.14159265358979 / 180)
b11 = e * 8216 * Sin((2 * d - 1 * m + 0 * mm + -1 * F) * 3.14159265358979 / 180)
b12 = 4324 * Sin((2 * d + 0 * m - 2 * mm + -1 * F) * 3.14159265358979 / 180)
b13 = 4200 * Sin((2 * d + 0 * m + 1 * mm + 1 * F) * 3.14159265358979 / 180)
b14 = e * (-3359) * Sin((2 * d + 1 * m + 0 * mm + -1 * F) * 3.14159265358979 / 180)
b15 = e * 2463 * Sin((2 * d - 1 * m - 1 * mm + 1 * F) * 3.14159265358979 / 180)
b16 = e * 2211 * Sin((2 * d - 1 * m + 0 * mm + 1 * F) * 3.14159265358979 / 180)
b17 = e * 2065 * Sin((2 * d - 1 * m - 1 * mm + -1 * F) * 3.14159265358979 / 180)
b18 = -1870 * e * Sin((0 * d + 1 * m - 1 * mm + -1 * F) * 3.14159265358979 / 180)
b19 = 1828 * Sin((4 * d + 0 * m - 1 * mm + -1 * F) * 3.14159265358979 / 180)
b20 = -1794 * e * Sin((0 * d + 1 * m + 0 * mm + 1 * F) * 3.14159265358979 / 180)
b21 = -1749 * Sin((0 * d + 0 * m + 0 * mm + 3 * F) * 3.14159265358979 / 180)
b22 = -1565 * e * Sin((0 * d + 1 * m + -1 * mm + 1 * F) * 3.14159265358979 / 180)
b23 = -1491 * Sin((1 * d + 0 * m + 0 * mm + 1 * F) * 3.14159265358979 / 180)
b24 = -1475 * e * Sin((0 * d + 1 * m + 1 * mm + 1 * F) * 3.14159265358979 / 180)
b25 = -1410 * e * Sin((0 * d + 1 * m + 1 * mm + -1 * F) * 3.14159265358979 / 180)
b26 = -1344 * e * Sin((0 * d + 1 * m + 0 * mm + -1 * F) * 3.14159265358979 / 180)
b27 = -1335 * Sin((1 * d + 0 * m + 0 * mm + -1 * F) * 3.14159265358979 / 180)
b28 = 1107 * Sin((0 * d + 0 * m + 3 * mm + 1 * F) * 3.14159265358979 / 180)
b29 = 1021 * Sin((4 * d + 0 * m + 0 * mm + -1 * F) * 3.14159265358979 / 180)
b30 = 833 * Sin((4 * d + 0 * m - 1 * mm + 1 * F) * 3.14159265358979 / 180)
b31 = 777 * Sin((0 * d + 0 * m + 1 * mm + -3 * F) * 3.14159265358979 / 180)
b32 = 671 * Sin((4 * d + 0 * m - 2 * mm + 1 * F) * 3.14159265358979 / 180)
b33 = 607 * Sin((2 * d + 0 * m + 0 * mm + -3 * F) * 3.14159265358979 / 180)
b34 = 596 * Sin((2 * d + 0 * m + 2 * mm + -1 * F) * 3.14159265358979 / 180)
b35 = 491 * e * Sin((2 * d + -1 * m + 1 * mm + -1 * F) * 3.14159265358979 / 180)
b36 = -451 * Sin((2 * d + 0 * m - 2 * mm + 1 * F) * 3.14159265358979 / 180)
b37 = 439 * Sin((0 * d + 0 * m + 3 * mm + -1 * F) * 3.14159265358979 / 180)
b38 = 422 * Sin((2 * d + 0 * m + 2 * mm + 1 * F) * 3.14159265358979 / 180)
b39 = 421 * Sin((2 * d + 0 * m - 3 * mm + -1 * F) * 3.14159265358979 / 180)
b40 = -366 * e * Sin((2 * d + 1 * m - 1 * mm + 1 * F) * 3.14159265358979 / 180)
b41 = -351 * e * Sin((2 * d + 1 * m + 0 * mm + 1 * F) * 3.14159265358979 / 180)
b42 = 331 * Sin((4 * d + 0 * m + 0 * mm + 1 * F) * 3.14159265358979 / 180)
b43 = 315 * e * Sin((2 * d + -1 * m + 1 * mm + 1 * F) * 3.14159265358979 / 180)
b44 = 302 * EE * Sin((2 * d + -2 * m + 0 * mm + -1 * F) * 3.14159265358979 / 180)
b45 = -283 * Sin((0 * d + 0 * m + 1 * mm + 3 * F) * 3.14159265358979 / 180)
b46 = -229 * Sin((2 * d + 1 * m + 1 * mm + -1 * F) * 3.14159265358979 / 180)
b47 = 223 * Sin((1 * d + 1 * m + 0 * mm + -1 * F) * 3.14159265358979 / 180)
b48 = 223 * Sin((1 * d + 1 * m + 0 * mm + 1 * F) * 3.14159265358979 / 180)
b49 = -220 * Sin((0 * d + 1 * m - 2 * mm + -1 * F) * 3.14159265358979 / 180)
b50 = -220 * Sin((2 * d + 1 * m - 1 * mm + -1 * F) * 3.14159265358979 / 180)
b51 = -185 * Sin((1 * d + 0 * m + 1 * mm + 1 * F) * 3.14159265358979 / 180)
b52 = 181 * e * Sin((2 * d + -1 * m - 2 * mm + -1 * F) * 3.14159265358979 / 180)
b53 = -177 * e * Sin((0 * d + 1 * m + 2 * mm + 1 * F) * 3.14159265358979 / 180)
b54 = 176 * Sin((4 * d + 0 * m - 2 * mm + -1 * F) * 3.14159265358979 / 180)
b55 = 166 * e * Sin((4 * d - 1 * m - 1 * mm + -1 * F) * 3.14159265358979 / 180)
b56 = -164 * Sin((1 * d + 0 * m + 1 * mm + -1 * F) * 3.14159265358979 / 180)
b57 = 132 * Sin((4 * d + 0 * m + 1 * mm + -1 * F) * 3.14159265358979 / 180)
b58 = -119 * Sin((1 * d + 0 * m - 1 * mm + -1 * F) * 3.14159265358979 / 180)
b59 = 115 * e * Sin((4 * d + -1 * m + 0 * mm + -1 * F) * 3.14159265358979 / 180)
b60 = 107 * EE * Sin((2 * d + -2 * m + 0 * mm + 1 * F) * 3.14159265358979 / 180)


bges1 = b1 + b2 + b3 + b4 + b5 + b6 + b7 + b8 + b9 + b10
bges2 = b11 + b12 + b13 + b14 + b15 + b16 + b17 + b18 + b19 + b20
bges3 = b21 + b22 + b23 + b24 + b25 + b26 + b27 + b28 + b29 + b30
bges4 = b31 + b32 + b33 + b34 + b35 + b36 + b37 + b38 + b39 + b40
bges5 = b41 + b42 + b43 + b44 + b45 + b46 + b47 + b48 + b49 + b50
bges6 = b51 + b52 + b53 + b54 + b55 + b56 + b57 + b58 + b59 + b60

bl1 = -2235 * Sin((L) * 3.14159265358979 / 180)
bl2 = 382 * Sin((AC) * 3.14159265358979 / 180)
bl3 = 175 * Sin((AA - F) * 3.14159265358979 / 180)
bl4 = 175 * Sin((AA + F) * 3.14159265358979 / 180)
bl5 = 127 * Sin((L - mm) * 3.14159265358979 / 180)
bl6 = -115 * Sin((L + mm) * 3.14159265358979 / 180)



bl = bl1 + bl2 + bl3 + bl4 + bl5 + bl6



bges = bges1 + bges2 + bges3 + bges4 + bges5 + bges6 + bl







l1 = 6288774 * Sin((0 * d + 0 * m + 1 * mm + 0 * F) * 3.14159265358979 / 180)
l2 = 1274027 * Sin((2 * d + 0 * m - 1 * mm + 0 * F) * 3.14159265358979 / 180)
l3 = 658314 * Sin((2 * d + 0 * m + 0 * mm + 0 * F) * 3.14159265358979 / 180)
l4 = 213618 * Sin((0 * d + 0 * m + 2 * mm + 0 * F) * 3.14159265358979 / 180)
l5 = -185116 * e * Sin((0 * d + 1 * m + 0 * mm + 0 * F) * 3.14159265358979 / 180)
l6 = -114332 * Sin((0 * d + 0 * m + 0 * mm + 2 * F) * 3.14159265358979 / 180)
l7 = 58793 * Sin((2 * d + 0 * m - 2 * mm + 0 * F) * 3.14159265358979 / 180)
l8 = 57066 * e * Sin((2 * d - 1 * m - 1 * mm + 0 * F) * 3.14159265358979 / 180)
l9 = 53322 * Sin((2 * d + 0 * m + 1 * mm + 0 * F) * 3.14159265358979 / 180)
l10 = 45758 * e * Sin((2 * d - 1 * m + 0 * mm + 0 * F) * 3.14159265358979 / 180)
l11 = -40923 * e * Sin((0 * d + 1 * m - 1 * mm + 0 * F) * 3.14159265358979 / 180)
l12 = -34720 * Sin((1 * d + 0 * m + 0 * mm + 0 * F) * 3.14159265358979 / 180)
l13 = -30383 * e * Sin((0 * d + 1 * m + 1 * mm + 0 * F) * 3.14159265358979 / 180)
l14 = 15327 * Sin((2 * d + 0 * m + 0 * mm + -2 * F) * 3.14159265358979 / 180)
l15 = -12528 * Sin((0 * d + 0 * m + 1 * mm + 2 * F) * 3.14159265358979 / 180)
l16 = 10980 * Sin((0 * d + 0 * m + 1 * mm + -2 * F) * 3.14159265358979 / 180)
l17 = 10675 * Sin((4 * d + 0 * m - 1 * mm + 0 * F) * 3.14159265358979 / 180)
l18 = 10034 * Sin((0 * d + 0 * m + 3 * mm + 0 * F) * 3.14159265358979 / 180)
l19 = 8548 * Sin((4 * d + 0 * m - 2 * mm + 0 * F) * 3.14159265358979 / 180)
l20 = -7888 * e * Sin((2 * d + 1 * m - 1 * mm + 0 * F) * 3.14159265358979 / 180)
l21 = -6766 * e * Sin((2 * d + 1 * m + 0 * mm + 0 * F) * 3.14159265358979 / 180)
l22 = -5163 * Sin((1 * d + 0 * m - 1 * mm + 0 * F) * 3.14159265358979 / 180)
l23 = 4987 * e * Sin((1 * d + 1 * m + 0 * mm + 0 * F) * 3.14159265358979 / 180)
l24 = 4036 * e * Sin((2 * d - 1 * m + 1 * mm + 0 * F) * 3.14159265358979 / 180)
l25 = 3994 * Sin((2 * d + 0 * m + 2 * mm + 0 * F) * 3.14159265358979 / 180)
l26 = 3861 * Sin((4 * d + 0 * m + 0 * mm + 0 * F) * 3.14159265358979 / 180)
l27 = 3665 * Sin((2 * d + 0 * m - 3 * mm + 0 * F) * 3.14159265358979 / 180)
l28 = -2689 * Sin((0 * d + 1 * m - 2 * mm + 0 * F) * 3.14159265358979 / 180)
l29 = -2602 * Sin((2 * d + 0 * m - 1 * mm + 2 * F) * 3.14159265358979 / 180)
l30 = 2390 * e * Sin((2 * d - 1 * m - 2 * mm + 0 * F) * 3.14159265358979 / 180)
l31 = -2348 * Sin((1 * d + 0 * m + 1 * mm + 0 * F) * 3.14159265358979 / 180)
l32 = 2236 * EE * Sin((2 * d - 2 * m + 0 * mm + 0 * F) * 3.14159265358979 / 180)
l33 = -2120 * e * Sin((0 * d + 1 * m + 2 * mm + 0 * F) * 3.14159265358979 / 180)
l34 = -2069 * EE * Sin((0 * d + 2 * m + 0 * mm + 0 * F) * 3.14159265358979 / 180)
l35 = 2048 * EE * Sin((2 * d - 2 * m - 1 * mm + 0 * F) * 3.14159265358979 / 180)
l36 = -1773 * Sin((2 * d + 0 * m + 1 * mm + -2 * F) * 3.14159265358979 / 180)
l37 = -1595 * Sin((2 * d + 0 * m + 0 * mm + 2 * F) * 3.14159265358979 / 180)
l38 = 1215 * e * Sin((4 * d - 1 * m - 1 * mm + 0 * F) * 3.14159265358979 / 180)
l39 = -1110 * Sin((0 * d + 0 * m + 2 * mm + 2 * F) * 3.14159265358979 / 180)
l40 = -892 * Sin((3 * d + 0 * m + -1 * mm + 0 * F) * 3.14159265358979 / 180)
l41 = -810 * Sin((2 * d + 1 * m + 1 * mm + 0 * F) * 3.14159265358979 / 180)
l42 = 759 * e * Sin((4 * d - 1 * m - 2 * mm + 0 * F) * 3.14159265358979 / 180)
l43 = -713 * EE * Sin((0 * d + 2 * m - 1 * mm + 0 * F) * 3.14159265358979 / 180)
l44 = -700 * EE * Sin((2 * d + 2 * m - 1 * mm + 0 * F) * 3.14159265358979 / 180)
l45 = 691 * e * Sin((2 * d + 1 * m - 2 * mm + 0 * F) * 3.14159265358979 / 180)
l46 = 596 * e * Sin((2 * d - 1 * m + 0 * mm + -2 * F) * 3.14159265358979 / 180)
l47 = 549 * Sin((4 * d + 0 * m + 1 * mm + 0 * F) * 3.14159265358979 / 180)
l48 = 537 * Sin((0 * d + 0 * m + 4 * mm + 0 * F) * 3.14159265358979 / 180)
l49 = 520 * e * Sin((4 * d - 1 * m + 0 * mm + 0 * F) * 3.14159265358979 / 180)
l50 = -487 * Sin((1 * d + 0 * m - 2 * mm + 0 * F) * 3.14159265358979 / 180)
l51 = -399 * e * Sin((2 * d + 1 * m + 0 * mm + -2 * F) * 3.14159265358979 / 180)
l52 = -381 * Sin((0 * d + 0 * m + 2 * mm + -2 * F) * 3.14159265358979 / 180)
l53 = 351 * e * Sin((1 * d + 1 * m + 1 * mm + 0 * F) * 3.14159265358979 / 180)
l54 = -340 * Sin((3 * d + 0 * m - 2 * mm + 0 * F) * 3.14159265358979 / 180)
l55 = 330 * Sin((4 * d + 0 * m - 3 * mm + 0 * F) * 3.14159265358979 / 180)
l56 = 327 * e * Sin((2 * d - 1 * m + 2 * mm + 0 * F) * 3.14159265358979 / 180)
l57 = -323 * EE * Sin((0 * d + 2 * m + 1 * mm + 0 * F) * 3.14159265358979 / 180)
l58 = 299 * e * Sin((1 * d + 1 * m - 1 * mm + 0 * F) * 3.14159265358979 / 180)
l59 = 294 * Sin((2 * d + 0 * m + 3 * mm + 0 * F) * 3.14159265358979 / 180)
l60 = 0 * Sin((2 * d + 0 * m - 1 * mm + -2 * F) * 3.14159265358979 / 180)



lges1 = l1 + l2 + l3 + l4 + l5 + l6 + l7 + l8 + l9 + l10
lges2 = l11 + l12 + l13 + l14 + l15 + l16 + l17 + l18 + l19 + l20
lges3 = l21 + l22 + l23 + l24 + l25 + l26 + l27 + l28 + l29 + l30
lges4 = l31 + l32 + l33 + l34 + l35 + l36 + l37 + l38 + l39 + l40
lges5 = l41 + l42 + l43 + l44 + l45 + l46 + l47 + l48 + l49 + l50
lges6 = l51 + l52 + l53 + l54 + l55 + l56 + l57 + l58 + l59 + l60


sl1 = 3958 * Sin((AA) * 3.14159265358979 / 180)
sl2 = 1962 * Sin((L - F) * 3.14159265358979 / 180)
sl3 = 318 * Sin((AB) * 3.14159265358979 / 180)

SL = sl1 + sl2 + sl3


lges = lges1 + lges2 + lges3 + lges4 + lges5 + lges6 + SL




betam = NutationBreite + (bges / 1000000)

lamdam = NutationLnge + L + lges / 1000000



Ekliptik = Ekliptik

rax = Sin((lamdam) * 3.14159265358979 / 180) * Cos((Ekliptik) * 3.14159265358979 / 180) - Tan((betam) * 3.14159265358979 / 180) * Sin((Ekliptik) * 3.14159265358979 / 180)

ray = Cos((lamdam) * 3.14159265358979 / 180)

ramond = Application.Atan2(ray, rax) * 180 / 3.14159265358979

If ramond < 0 Then
ramond = 360 + ramond
End If



 ramond = ramond

dekw = Sin((betam) * 3.14159265358979 / 180) * Cos((Ekliptik) * 3.14159265358979 / 180) + Cos((betam) * 3.14159265358979 / 180) * Sin((Ekliptik) * 3.14159265358979 / 180) * Sin((lamdam) * 3.14159265358979 / 180)

dekx = dekw
deky = Sqr(1 - dekx * dekx)

dekmond = Application.Atan2(deky, dekx) * 180 / 3.14159265358979




'Ergebnisse:

dekmond = dekmond
ramond = ramond
lamdamond = lamdam
betamond = betam


ramond = ramond

End Function


Public Function Kompass(Azimut)
  
  Dim A  As Double
  Dim Z  As String
  Dim N  As Double
      

  A = Val(Azimut)
      

  N = Int(17 * A / 360)
      
  Select Case N
  Case 0
       Z = "N"
       
  Case 1
       Z = "NNO"
       
  Case 2
       Z = "NO"
       
  Case 3
       Z = " ONO"
       
  Case 4
       Z = "O"
       
  Case 5
       Z = "OSO"
       
  Case 6
       Z = " SO"
       
  Case 7
       Z = " SSO"
       
  Case 8
       Z = "S"
       
  Case 9
       Z = "SSW"
  
  Case 10
       Z = "SW"
       
  Case 11
       Z = "WSW"
       
  Case 12
       Z = "W"
       
  Case 13
       Z = "WNW"
       
  Case 14
       Z = "NW"
       
  Case 15
       Z = "NNW"
       
  Case 16
       Z = "N"
         
  End Select
     
Kompass = Z
  
  End Function





Public Function Ekliptik2(JDE)


T = (JDE - 2451545) / 3652500


  obl = 84381.448 - 4680.93 * T: p = T * T
  obl = obl - 1.55 * p: p = p * T
  obl = obl + 1999.25 * p: p = p * T
  obl = obl - 51.38 * p: p = p * T
  obl = obl - 249.67 * p: p = p * T
  obl = obl - 39.05 * p: p = p * T
  obl = obl + 7.12 * p: p = p * T
  obl = obl + 27.87 * p: p = p * T
  obl = obl + 5.79 * p: p = p * T
  obl = obl + 2.45 * p
  
  obl = obl / 3600

T = (JDE - 2451545#) / 36525
   

  V = 297.85036 + 445267.11148 * T - 0.0019142 * T2 + T3 / 189474
  V = V * Atn(1) / 45
  

  W = 357.52772 + 35999.05034 * T - 0.0001603 * T2 - T3 / 300000
  W = W * Atn(1) / 45
  

  x = 134.96298 + 477198.867398 * T + 0.0086972 * T2 + T3 / 56250
  x = x * Atn(1) / 45
  

  Y = 93.27191 + 483202.017538 * T - 0.0036825 * T2 + T3 / 327270
  Y = Y * Atn(1) / 45
  
  Z = 125.04452 - 1934.136261 * T + 0.0020708 * T2 + T3 / 450000
  Z = Z * Atn(1) / 45
  

  Q = Cos(Z) * (92025 + 8.9 * T)
  Q = Q + Cos(2 * (Y - V + Z)) * (5736 - 3.1 * T)
  Q = Q + Cos(2 * (Y + Z)) * (977 - 0.5 * T)
  Q = Q + Cos(2 * Z) * (0.5 * T - 895)
  Q = Q + Cos(W) * (54 - 0.1 * T)
  Q = Q - 7 * Cos(x)
  Q = Q + Cos(W + 2 * (Y - V + Z)) * (224 - 0.6 * T)
  Q = Q + 200 * Cos(2 * Y + Z)
  Q = Q + Cos(x + 2 * (Y + Z)) * (129 - 0.1 * T)
  Q = Q + Cos(2 * (Y - V + Z) - W) * (0.3 * T - 95)
  Q = Q - 70 * Cos(2 * (Y - V) + Z)
  Q = Q - 53 * Cos(2 * (Y + Z) - x)
  Q = Q - 33 * Cos(x + Z)
  Q = Q + 26 * Cos(2 * (V + Y + Z) - x)
  Q = Q + 32 * Cos(Z - x)
  Q = Q + 27 * Cos(x + 2 * Y + Z)
  Q = Q - 24 * Cos(2 * (Y - x) + Z)
  Q = Q + 16 * Cos(2 * (V + Y + Z))
  Q = Q + 13 * Cos(2 * (x + Y + Z))
  Q = Q - 12 * Cos(x + 2 * (Y - V + Z))
  Q = Q - 10 * Cos(2 * Y + Z - x)
  Q = Q - 8 * Cos(2 * V - x + Z)
  Q = Q + 7 * Cos(2 * (W - V + Y + Z))
  Q = Q + 9 * Cos(W + Z)
  Q = Q + 7 * Cos(x + Z - 2 * V)
  Q = Q + 6 * Cos(Z - W)
  Q = Q + 5 * Cos(2 * (V + Y) - x + Z)
  Q = Q + 3 * Cos(x + 2 * (Y + V + Z))
  Q = Q - 3 * Cos(W + 2 * (Y + Z))
  Q = Q + 3 * Cos(2 * (Y + Z) - W)
  Q = Q + 3 * Cos(2 * (V + Y) + Z)
  Q = Q - 3 * Cos(2 * (x + Y + Z - V))
  Q = Q - 3 * Cos(x + 2 * (Y - V) + Z)
  Q = Q + 3 * Cos(2 * (V - x) + Z)
  Q = Q + 3 * Cos(2 * V + Z)
  Q = Q + 3 * Cos(2 * (Y - V) + Z - W)
  Q = Q + 3 * Cos(Z - 2 * V)
  Q = Q + 3 * Cos(2 * (x + Y) + Z)

Ekliptik2 = obl + Q / 36000000

  End Function

Public Function Nutl(JDE)


  Dim T  As Double
  Dim T2 As Double
  Dim T3 As Double
  
  Dim Q As Double
  
  Dim V As Double
  Dim W As Double
  Dim x As Double
  Dim Y As Double
  

  Dim Z As Double
  
  T = (JDE - 2451545#) / 36525
   

  V = 297.85036 + 445267.11148 * T - 0.0019142 * T2 + T3 / 189474
  V = V * Atn(1) / 45
  

  W = 357.52772 + 35999.05034 * T - 0.0001603 * T2 - T3 / 300000
  W = W * Atn(1) / 45
  

  x = 134.96298 + 477198.867398 * T + 0.0086972 * T2 + T3 / 56250
  x = x * Atn(1) / 45

  Y = 93.27191 + 483202.017538 * T - 0.0036825 * T2 + T3 / 327270
  Y = Y * Atn(1) / 45
  

  Z = 125.04452 - 1934.136261 * T + 0.0020708 * T2 + T3 / 450000
  Z = Z * Atn(1) / 45
  

  Q = Sin(Z) * (-174.2 * T - 171996)
  Q = Q + Sin(2 * (Y + Z - V)) * (-1.6 * T - 13187)
  Q = Q + Sin(2 * (Y + Z)) * (-2274 - 0.2 * T)
  Q = Q + Sin(2 * Z) * (0.2 * T + 2062)
  Q = Q + Sin(W) * (1426 - 3.4 * T)
  Q = Q + Sin(x) * (0.1 * T + 712)
  Q = Q + Sin(2 * (Y + Z - V) + W) * (1.2 * T - 517)
  Q = Q + Sin(2 * Y + Z) * (-0.4 * T - 386)
  Q = Q - 301 * Sin(2 * (Y + Z) + x)
  Q = Q + Sin(2 * (Y + Z - V) - W) * (217 - 0.5 * T)
  Q = Q - 158 * Sin(x - 2 * V)
  Q = Q + Sin(2 * (Y - V) + Z) * (129 + 0.1 * T)
  Q = Q + 123 * Sin(2 * (Y + Z) - x)
  Q = Q + 63 * Sin(2 * V)
  Q = Q + Sin(x + Z) * (0.1 * T + 63)
  Q = Q - 59 * Sin(2 * (V + Y + Z) - x)
  Q = Q + Sin(Z - x) * (-0.1 * T - 58)
  Q = Q - 51 * Sin(2 * Y + x + Z)
  Q = Q + 48 * Sin(2 * (x - V))
  Q = Q + 46 * Sin(2 * (Y - x) + Z)
  Q = Q - 38 * Sin(2 * (V + Y + Z))
  Q = Q - 31 * Sin(2 * (x + Y + Z))
  Q = Q + 29 * Sin(2 * x)
  Q = Q + 29 * Sin(2 * (Y + Z - V) + x)
  Q = Q + 26 * Sin(2 * Y)
  Q = Q - 22 * Sin(2 * (Y - V))
  Q = Q + 21 * Sin(2 * Y + Z - x)
  Q = Q + Sin(2 * W) * (17 - 0.1 * T)
  Q = Q + 16 * Sin(2 * V - x + Z)
  Q = Q + Sin(2 * (W + Y + Z - V)) * (0.1 * T - 16)
  Q = Q - 15 * Sin(W + Z)
  Q = Q - 13 * Sin(x + Z - 2 * V)
  Q = Q - 12 * Sin(Z - W)
  Q = Q + 11 * Sin(2 * (x - Y))
  Q = Q - 10 * Sin(2 * (Y + V) + Z - x)
  Q = Q - 8 * Sin(2 * (Y + V + Z) + x)
  Q = Q + 7 * Sin(2 * (Y + Z) + W)
  Q = Q - 7 * Sin(x - 2 * V + W)
  Q = Q - 7 * Sin(2 * (Y + Z) - W)
  Q = Q - 7 * Sin(2 * V + 2 * Y + Z)
  Q = Q + 6 * Sin(2 * V + x)
  Q = Q + 6 * Sin(2 * (x + Y + Z - V))
  Q = Q + 6 * Sin(2 * (Y - V) + x + Z)
  Q = Q - 6 * Sin(2 * (V - x) + Z)
  Q = Q - 6 * Sin(2 * V + Z)
  Q = Q + 5 * Sin(x - W)
  Q = Q - 5 * Sin(2 * (Y - V) + Z - W)
  Q = Q - 5 * Sin(Z - 2 * V)
  Q = Q - 5 * Sin(2 * (x + Y) + Z)
  Q = Q + 4 * Sin(2 * (x - V) + Z)
  Q = Q + 4 * Sin(2 * (Y - V) + W + Z)
  Q = Q + 4 * Sin(x - 2 * Y)
  Q = Q - 4 * Sin(x - V)
  Q = Q - 4 * Sin(W - 2 * V)
  Q = Q - 4 * Sin(V)
  Q = Q + 3 * Sin(2 * Y + x)
  Q = Q - 3 * Sin(2 * (Y + Z - x))
  Q = Q - 3 * Sin(x - V - W)
  Q = Q - 3 * Sin(W + x)
  Q = Q - 3 * Sin(2 * (Y + Z) + x - W)
  Q = Q - 3 * Sin(2 * (V + Y + Z) - W - x)
  Q = Q - 3 * Sin(2 * (Y + Z) + 3 * x)
  Q = Q - 3 * Sin(2 * (V + Y + Z) - W)


  Nutl = Q / 36000000

  End Function


 Public Function Nutb(JDE)

  Dim JD As String
  Dim T  As Double
  Dim T2 As Double
  Dim T3 As Double
  Dim Q  As Double
  Dim V  As Double
  Dim W  As Double
  Dim x  As Double
  Dim Y  As Double
  

  Dim Z  As Double
    
  T = (JDE - 2451545#) / 36525
   

  V = 297.85036 + 445267.11148 * T - 0.0019142 * T2 + T3 / 189474
  V = V * Atn(1) / 45
  

  W = 357.52772 + 35999.05034 * T - 0.0001603 * T2 - T3 / 300000
  W = W * Atn(1) / 45
  

  x = 134.96298 + 477198.867398 * T + 0.0086972 * T2 + T3 / 56250
  x = x * Atn(1) / 45
  

  Y = 93.27191 + 483202.017538 * T - 0.0036825 * T2 + T3 / 327270
  Y = Y * Atn(1) / 45
  

  Z = 125.04452 - 1934.136261 * T + 0.0020708 * T2 + T3 / 450000
  Z = Z * Atn(1) / 45
  

  Q = Cos(Z) * (92025 + 8.9 * T)
  Q = Q + Cos(2 * (Y - V + Z)) * (5736 - 3.1 * T)
  Q = Q + Cos(2 * (Y + Z)) * (977 - 0.5 * T)
  Q = Q + Cos(2 * Z) * (0.5 * T - 895)
  Q = Q + Cos(W) * (54 - 0.1 * T)
  Q = Q - 7 * Cos(x)
  Q = Q + Cos(W + 2 * (Y - V + Z)) * (224 - 0.6 * T)
  Q = Q + 200 * Cos(2 * Y + Z)
  Q = Q + Cos(x + 2 * (Y + Z)) * (129 - 0.1 * T)
  Q = Q + Cos(2 * (Y - V + Z) - W) * (0.3 * T - 95)
  Q = Q - 70 * Cos(2 * (Y - V) + Z)
  Q = Q - 53 * Cos(2 * (Y + Z) - x)
  Q = Q - 33 * Cos(x + Z)
  Q = Q + 26 * Cos(2 * (V + Y + Z) - x)
  Q = Q + 32 * Cos(Z - x)
  Q = Q + 27 * Cos(x + 2 * Y + Z)
  Q = Q - 24 * Cos(2 * (Y - x) + Z)
  Q = Q + 16 * Cos(2 * (V + Y + Z))
  Q = Q + 13 * Cos(2 * (x + Y + Z))
  Q = Q - 12 * Cos(x + 2 * (Y - V + Z))
  Q = Q - 10 * Cos(2 * Y + Z - x)
  Q = Q - 8 * Cos(2 * V - x + Z)
  Q = Q + 7 * Cos(2 * (W - V + Y + Z))
  Q = Q + 9 * Cos(W + Z)
  Q = Q + 7 * Cos(x + Z - 2 * V)
  Q = Q + 6 * Cos(Z - W)
  Q = Q + 5 * Cos(2 * (V + Y) - x + Z)
  Q = Q + 3 * Cos(x + 2 * (Y + V + Z))
  Q = Q - 3 * Cos(W + 2 * (Y + Z))
  Q = Q + 3 * Cos(2 * (Y + Z) - W)
  Q = Q + 3 * Cos(2 * (V + Y) + Z)
  Q = Q - 3 * Cos(2 * (x + Y + Z - V))
  Q = Q - 3 * Cos(x + 2 * (Y - V) + Z)
  Q = Q + 3 * Cos(2 * (V - x) + Z)
  Q = Q + 3 * Cos(2 * V + Z)
  Q = Q + 3 * Cos(2 * (Y - V) + Z - W)
  Q = Q + 3 * Cos(Z - 2 * V)
  Q = Q + 3 * Cos(2 * (x + Y) + Z)


 Nutb = Q / 36000000

  End Function

'Satberechnung

Function Epochzeit(epoch As Double)

ept = Fix(epoch)
eptj = Fix(ept / 1000)

Jahr = 2000 + eptj
tag = ept - eptj * 1000
datum = DateSerial(Jahr, 1, 1) + tag - 1
UT = epoch - ept
  
Epochzeit = UT
   
   End Function
   
Function Epochdatum(epoch As Double) As Date

ept = Fix(epoch)
eptj = Fix(ept / 1000)

Jahr = 2000 + eptj
tag = ept - eptj * 1000
datum = DateSerial(Jahr, 1, 1) + tag - 1
  
Epochdatum = datum
   
   End Function
Function gha(mm As Double)

s = (mm / 13750.98708) * (mm / 13750.98708)
gha = (398601.2 / s) ^ (1 / 3)
   
   End Function

Function draan(mm As Double, i As Double, e As Double)

erdradius = 6378.14
s = (mm / 13750.98708) * (mm / 13750.98708)
A = (398601.2 / s) ^ (1 / 3)
  
draan = (-9.98 / ((A / erdradius) ^ 3.5 * (1 - e) * (1 - e))) * Cos(i * 3.14159265358979 / 180)
  
  
End Function



Function dap(mm As Double, i As Double, e As Double)

erdradius = 6378.14
s = (mm / 13750.98708) * (mm / 13750.98708)
A = (398601.2 / s) ^ (1 / 3)
  
dap = (5 / ((A / erdradius) ^ 3.5 * (1 - e) * (1 - e))) * (5 * Cos(i * 3.14159265358979 / 180) * Cos(i * 3.14159265358979 / 180) - 1)
  
  
End Function


