Attribute VB_Name = "Modul1"
Sub calc_et()

Dim ws, ct, ch, cu, cs As String
Dim temp As Double, rf As Double, sos As Double, u10 As Double, u2 As Double
Dim rg As Double, doy As Integer

' Datenquelle
ws = "J2007"
ct = "E"
ch = "M"
cu = "Q"
cs = "S"
cp = "W"
ci = "x"



doy = 1

For Line = 3 To 367
    
    
    
    ' Einlesen der Daten
    
    temp = Worksheets(ws).Range(ct + Trim(Str(Line)))
    rf = Worksheets(ws).Range(ch + Trim(Str(Line)))
    u10 = Worksheets(ws).Range(cu + Trim(Str(Line)))
    sos = Worksheets(ws).Range(cs + Trim(Str(Line)))
    
    ' Umrechnungen in Hilfsgroessen
    u2 = u10 * Log((2 - 0.08) / 0.012) / Log((10 - 0.08) / 0.012) / 3.6 'Windgeschw. in 2m (umgerechnet von 10m) + Umrechnung m/s
    es = 6.11 * Exp(17.62 * temp / (243.12 + temp))
    e = es * rf / 100

    
    ceta = 0.0172 * doy - 1.39
    r0 = 2425 + 1735 * Sin(ceta)
    s0 = 12.3 + Sin(ceta) * 4.3
    rg = r0 / 1.82 * (sos / s0 + 0.35)
    r1stern = 0.77 * rg / (249.8 - 0.242 * temp)
    ra = 0.00000049 * (273.15 + temp) ^ 4 / (249.8 - 0.242 * temp)
    r2stern = ra * (0.1 + 0.9 * sos / s0) * (0.34 - 0.044 * Sqr(e))
    rnstern = r1stern - r2stern
    gamma = 0.65 * (1 + 0.34 * u2)
    
    
    c = 1
    If rf < 50 Then c = 1 + (50 - rf) / 70
    etpturc = (rg + 209) / (temp + 15) * temp * 0.0031 * c
    If temp < 5 Then etpturc = 0.000036 * (25 + temp) * (25 + temp) * (100 - rf)
    If etpturc < 0 Then etpturc = 0
    
    stsd = es * (4284 / (243.12 + temp) ^ 2) 'Steigung der Dampfdruckkurve

    
    etppenman = stsd * rnstern / (stsd + gamma) + 90 * 0.65 / (stsd + gamma) * u2 * es / (temp + 273.15) * (1 - rf / 100)
    If etppenman < 0 Then etppenman = 0
    
    Worksheets(ws).Range(ci + Trim(Str(Line))) = etpturc
    Worksheets(ws).Range(cp + Trim(Str(Line))) = etppenman


    doy = doy + 1
Next Line


End Sub