5.11.09

Worksheets(ActiveCell.Worksheet.Name).Select

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

没有评论: