Sub solveV0()
    Dim NRow As Long, i As Long
    Dim beta1 As Double, beta2 As Double, beta As Double
    Dim V As Double, H As Double, h0 As Double, V0 As Double
    Dim f As Double, dfdV0 As Double
   
    Worksheets(ActiveCell.Worksheet.Name).Select
   
    NRow = Cells(2, 10)
    beta1 = Cells(2, 3)
    beta2 = Cells(2, 4)
   
    beta = (beta1 + beta2) ^ (beta1 + beta2) / beta1 ^ beta1 / beta2 ^ beta2
   
    For i = 1 To NRow
        V = Cells(4 + i, 1)
        V = Abs(V)
        H = Cells(4 + i, 2)
        H = Abs(H)
        h0 = Cells(4 + i, 8)
        V0 = Sqr(V ^ 2 + H ^ 2)
        If (H = 0) Then
            V0 = V
        Else
            f = H / (V0 * h0) - beta * (V / V0) ^ beta1 * (1 - V / V0) ^ beta2
            Do While (Abs(f) >= 0.000001)
                dfdV0 = -H / h0 / V0 ^ 2 + beta * beta1 * V ^ beta1 / V0 ^ (beta1 + 1) * (1 - V / V0) ^ beta2 - beta * beta2 * (V / V0) ^ beta1 * (1 - V / V0) ^ (beta2 - 1) * V / V0 ^ 2
                V0 = V0 - f / dfdV0
                f = H / (V0 * h0) - beta * (V / V0) ^ beta1 * (1 - V / V0) ^ beta2
            Loop
           
        End If
        Cells(4 + i, 9) = V0
    Next i
End Sub
5.11.09
订阅:
博文评论 (Atom)
 
没有评论:
发表评论