Attribute VB_Name = "Module_DistillationCurves"
Option Explicit

Function Interpolate_DistCurve _
    (Value As Variant, YieldInput As Boolean, degF_Data As Object, pctYield_Data As Object) _
As Variant
Attribute Interpolate_DistCurve.VB_Description = "Interpolates distillation curve assuming 'S' shape for yield vs temperature. 'YieldInput' Boolean to tell whether a temperature Value or Yield Value has been input."
'
'   Function to interpolate within distillation curve data to determine temperature or
'   yield.  The yield data is straightened by converting to a Gaussian normal variable
'   (as in the use of probability graph paper) using the NORMSINV & NORMSDIST worksheet
'   functions.
'
'   Written 10/24/2002 (JL Jechura).
'   Modified 10/29/2008 (JL Jechura). Check that the temperature & yield arrays are
'       in monotonic ascending order. If not, return error code. Do this at same time as
'       copying values from objects to arrays.
'

Dim nData As Integer, iRow As Integer, NewValue As Variant, Fraction As Double
Dim TransformedYields() As Variant, degFs() As Variant

'
'   Ensure that the arrays have the same sizes.

    nData = degF_Data.Count
    If (nData <> pctYield_Data.Count) Then
        Interpolate_DistCurve = "#ArrayLengths!"
        Exit Function
    ElseIf (nData <= 1) Then
        Interpolate_DistCurve = "#NumberOfValues!"
        Exit Function
    End If
    
'
'   Ensure that the temperature and yield values are monotonically increasing in value.
    ReDim degFs(1 To nData)
    degFs(1) = degF_Data(1)
    For iRow = 2 To nData
        degFs(iRow) = degF_Data(iRow)
        If (degF_Data(iRow) <= degF_Data(iRow - 1)) Then
            Interpolate_DistCurve = "#OrderTemperature!"
            Exit Function
        End If
    Next iRow
    
    ReDim TransformedYields(1 To nData)
    TransformedYields(1) = WorksheetFunction.NormSInv(pctYield_Data(1) / 100#)
    For iRow = 2 To nData
        TransformedYields(iRow) = WorksheetFunction.NormSInv(pctYield_Data(iRow) / 100#)
        If (TransformedYields(iRow) <= TransformedYields(iRow - 1)) Then
            Interpolate_DistCurve = "#OrderYield!"
            Exit Function
        End If
    Next iRow
    
'
'   Do the interpolation.
'   Find temperature for given yield.
    If (YieldInput) Then
        NewValue = WorksheetFunction.NormSInv(Value / 100#)
        NewValue = LinearInterpolate(NewValue, TransformedYields, degFs)
'
'   Find yield for given temperature.
    Else
        NewValue = LinearInterpolate(Value, degFs, TransformedYields)
        NewValue = WorksheetFunction.NormSDist(NewValue) * 100#
    End If
    
'
'   Set value & return.
    Interpolate_DistCurve = NewValue
    
End Function
    
Private Function LinearInterpolate _
    (X_Value As Variant, Known_Xs() As Variant, Known_Ys() As Variant) _
As Variant
'
'   Function to do linear interpolation within two arrays.
'
'   Written 07/06/2001 (J.L. Jechura).
'   Modified 10/24/2002 (JL Jechura) to split up the Excel specific code from the general
'       array code.
'
Dim iRow As Integer, Fraction As Double

'
'   Determine the row that starts to bracket the answer.
'   Determine the interpolated x_value.

    iRow = Locate(X_Value, Known_Xs)
    Fraction = (X_Value - Known_Xs(iRow)) / (Known_Xs(iRow + 1) - Known_Xs(iRow))
    LinearInterpolate = Known_Ys(iRow) + (Known_Ys(iRow + 1) - Known_Ys(iRow)) * Fraction
    
    End Function

Private Function Locate(X_Value As Variant, Known_Xs() As Variant) As Variant
'
'   Returns the index value in "known_xs" that precedes the given "x_value".  Bisection method
'   used.
'
'   Based on Fortran code in _Numerical Recipes in Fortran 77, 2nd ed._, WH Press, SA Teukolsky, WT Vetterling, & BP Flannery, 1992, pg. 111.
'
'   Written 08/31/2001 (JL Jechura).
'
Dim jFirst As Long, jLast As Long
Dim jLow As Long, jMid As Long, jUpper As Long
Dim bAscend As Boolean

'
' Initialize lower & upper limits.  Initialize logical flag for ascending data.
' Code using VB arrays.
    jFirst = LBound(Known_Xs)
    jLast = UBound(Known_Xs)
    
    jLow = jFirst - 1
    jUpper = jLast + 1
    bAscend = (Known_Xs(jLast) >= Known_Xs(jFirst))
    
    Do While ((jUpper - jLow) > 1)
        jMid = (jUpper + jLow) / 2
        If (bAscend = (X_Value >= Known_Xs(jMid))) Then
            jLow = jMid
        Else
            jUpper = jMid
        End If
    Loop

    Locate = WorksheetFunction.Max(jFirst, WorksheetFunction.Min(jLow, jLast - 1))

End Function