DewPoint Calculator Routine

From IARC 207 Wiki
Revision as of 11:53, 28 November 2011 by 137.229.92.251 (talk)
(diff) ← Older revision | Latest revision (diff) | Newer revision → (diff)
Jump to navigation Jump to search

This shorty calculates dew point from dry bulb air temperature and relative humidity so daily / monthly averages can be computed.

Sub DewPoint_Calcs()

'' This subroutine runs through a worksheet and calculates dewpoint from relative humidity and air temperature
'' as per the Dingman book appendix.

    Dim inputrow As Long
    Dim outputrow As Long
    Dim inputtempcol As Integer
    Dim inputrhcol As Integer
    Dim outputdpcol As Integer
    Dim inputWS As Integer
    Dim outputWS As Integer
    Dim eastar As Double
    Dim temperature As Double
    Dim Wa As Double
    Dim ea As Double
    Dim dewpoint As Double
    
    inputWS = 1
    inputrow = 4
    inputtempcol = 5
    inputrhcol = 8
    outputWS = inputWS
    outputrow = inputrow
    outputdpcol = 15
    
    Do While Worksheets(inputWS).Cells(inputrow, inputtempcol).Value <> ""
        '' #1 Read in the values
        If Abs(Worksheets(inputWS).Cells(inputrow, inputtempcol).Value) <> 6999 And _
                Abs(Worksheets(inputWS).Cells(inputrow, inputtempcol).Value) <> 7777 And _
                Abs(Worksheets(inputWS).Cells(inputrow, inputtempcol).Value) <> 9999 And _
                Abs(Worksheets(inputWS).Cells(inputrow, inputtempcol).Value) <> 9999.9 Then
            temperature = Worksheets(inputWS).Cells(inputrow, inputtempcol).Value
        Else:
          temperature = 6999
        End If
        If Abs(Worksheets(inputWS).Cells(inputrow, inputrhcol).Value) <> 6999 And _
                Abs(Worksheets(inputWS).Cells(inputrow, inputrhcol).Value) <> 7777 And _
                Abs(Worksheets(inputWS).Cells(inputrow, inputrhcol).Value) <> 9999 And _
                Abs(Worksheets(inputWS).Cells(inputrow, inputrhcol).Value) <> 9999.9 Then
            Wa = Worksheets(inputWS).Cells(inputrow, inputrhcol).Value
        Else:
            Wa = 6999
        End If
        If temperature <> 6999 And Wa <> 6999 Then
            eastar = 0.611 * (Exp((17.3 * temperature) / (temperature + 237.3)))
            ea = eastar * Wa / 100
            dewpoint = (Log(ea) + 0.4926) / (0.0708 - 0.00421 * Log(ea))
        Else:
            dewpoint = 6999
        End If
        Worksheets(outputWS).Cells(outputrow, outputdpcol).Value = dewpoint
        outputrow = outputrow + 1
        inputrow = inputrow + 1
    Loop
    Range("A12").Select
End Sub