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)
没有评论:
发表评论