我正在尝试定义一个导数函数来求解微分方程组，但是当我运行调用这个子程序的实际宏时，我不断得到运行时错误5：无效的过程调用或参数。当x不大于1并且使用提供的等式计算Qv时，在If语句中会发生此错误。在进入调试时，所有变量都有值，但它给了我错误，我不明白为什么。有人可以帮忙吗？
Sub Derivs(x As Double, y() As Double, dydx() As Double)
Const g As Double = 32.1740485564
Const Hr As Double = 100
Const h0 As Double = 80
Const fm As Double = 0.024
Const L As Double = 1500
Const dp As Double = 2
Const tc As Double = 5
Const k As Double = 25.7
Const Di As Double = 5
Dim u0 As Double
Dim Qv As Double
Dim Qv0 As Double
Dim hstar As Double
u0 = ((g * h0 / ((1 / 2) * fm * (L / dp))) * ((Hr / h0) - 1)) ^ (1 / 2)
Qv0 = (u0 * 3.14 * Di ^ 2) / 4
hstar = h0 - (Qv0 / k) ^ 2
If x >= 1 Then
Qv = 0
Else
Qv = k * (h0 ^ 0.5) * (1 - x) * (y(1) - hstar / h0) ^ 0.5
End If
dydx(0) = ((tc * g * h0) / (L * u0)) * (((Hr / h0) - y(1)) - ((Hr / h0) - 1) * y(0) * Abs(y(0)))
dydx(1) = ((dp / Di) ^ 2) * (u0 * tc / h0) * y(0) - ((4 * Qv * tc) / (3.14 * h0 * Di ^ 2))
End Sub
调用此子例程的宏是：
Sub RungeKutta()
Dim y(1) As Double
Dim dydx(1) As Double
Dim yout(1) As Double
Dim yerr(1) As Double
Dim x As Double
Dim hdid As Double
Dim yscal(1) As Double
Dim hnext As Double
Dim ystart(1) As Double
Dim NOk As Integer
Dim NBad As Integer
Dim h As Double
Const n As Integer = 2
Dim htry As Double
Const eps As Double = 0.00000001
Dim x1 As Double
Dim x2 As Double
Const nvar As Integer = 2
Dim h1 As Double
Const hmin As Double = 0.001
h = 0.001
x1 = 0
x2 = 10
h1 = 0.01
x = x1
h = Sgn(x2 - x1) * Abs(h1)
NOk = 0
NBad = 0
kount = -1
x = 0
y(0) = 1#
y(1) = 1#
Call Derivs(x, y(), dydx())
Call odeint(ystart(), nvar, x1, x2, eps, h1, hmin, NOk, NBad)
' I have a bunch of coding to input the calculations into a spreadsheet that I am omitting
End Sub
宏中的主程序是：
Sub odeint(ystart() As Double, nvar As Integer, x1 As Double, x2 As Double, eps As Double, h1 As Double, hmin As Double, NOk As Integer, NBad As Integer)
Const MaxStp As Double = 10000
Const Tiny As Double = 10 ^ (-30)
Dim y() As Double
Dim yscal() As Double
Dim dydx() As Double
Dim x As Double
Dim h As Double
Dim hdid As Double
Dim hnext As Double
Const n As Integer = 2
NM1 = n - 1
nvar = 2
ReDim y(NM1)
ReDim dydx(NM1)
ReDim yscal(NM1)
x = x1
h = Sgn(x2 - x1) * Abs(h1)
NOk = 0
NBad = 0
kount = -1
kmax = 500
ReDim xp(kmax)
ReDim yp(NM1, kmax)
dxsav = (x2 - x1) / kmax
For I = 0 To nvar - 1
y(I) = ystart(I)
Next I
If kmax > 0 Then xsav = x - 2 * dxsav
For nstp = 1 To MaxStp
Call Derivs(x, y(), dydx())
For I = 0 To nvar - 1
yscal(I) = Abs(y(I)) + Abs(h * dydx(I)) + Tiny
Next I
If kmax > 0 Then
If Abs(x - xsav) > Abs(dxsav) Then
If kount < kmax - 1 Then
kount = kount + 1
xp(kount) = x
For I = 0 To nvar - 1
yp(I, kount) = y(I)
Next I
xsav = x
End If
End If
End If
If (x + h - x2) * (x + h - x1) > 0 Then h = x2 - x
Call rkqs(y(), dydx(), nvar, x, h, eps, yscal(), hdid, hnext)
If hdid = h Then
NOk = NOk + 1
Else
NBad = NBad + 1
End If
If (x - x2) * (x2 - x1) >= 0 Then
For I = 0 To nvar - 1
ystart(I) = y(I)
Next I
If Not kmax = 0 Then
kount = kount + 1
xp(kount) = x
For I = 0 To nvar - 1
yp(I, kount) = y(I)
Next I
End If
Exit Sub
End If
If Abs(hnext) < hmin Then MsgBox "Stepsize smaller than minimum in odeint!", vbExclamation
h = hnext
Next nstp
MsgBox "Too many steps in odeint", vbExclamation
End Sub
调用此子例程：
Sub rkqs(y() As Double, dydx() As Double, n As Integer, x As Double, htry As Double, eps As Double, yscal() As Double, hdid As Double, hnext As Double)
NM1 = n - 1
Dim ytemp() As Double
Dim yerr() As Double
Dim h As Double
Const Tiny As Double = 10 ^ (-30)
ReDim ytemp(NM1)
ReDim yerr(NM1)
Const Safety As Double = 0.9
Const PGrow As Double = -0.2
Const PShrink As Double = -0.25
Const ErrCon As Double = (5# / Safety) ^ (1# / PGrow)
h = htry
Do
Call rkck(y(), dydx(), n, x, h, ytemp(), yerr())
ErrMax = 0
For I = 0 To NM1
yscal(I) = Abs(y(I)) + Abs(h * dydx(I)) + Tiny
Next I
For I = 0 To n - 1
If Abs(yerr(I) / yscal(I)) > ErrMax Then ErrMax = Abs(yerr(I) / yscal(I))
Next I
ErrMax = ErrMax / eps
If ErrMax > 1 Then
dummy = h
h = Safety * h * (ErrMax ^ PShrink)
If h < 0.1 * dummy Then
h = 0.1 * dummy
End If
xNew = x + h
If xNew = x Then MsgBox "Stepsize underflow in rkqsl", vbExclamation
ContLoop = True
Else
If ErrMax > ErrCon Then
hnext = Safety * h * (ErrMax ^ PGrow)
Else
hnext = 5 * h
End If
hdid = h
x = x + h
For I = 0 To n - 1
y(I) = ytemp(I)
Next I
ContLoop = False
End If
Loop While ContLoop
End Sub
然后调用此子例程：
Sub rkck(y() As Double, dydx() As Double, n As Integer, x As Double, h As Double, yout() As Double, yerr() As Double)
Dim NM1 As Integer
Dim I As Integer
Dim ak2() As Double
Dim ak3() As Double
Dim ak4() As Double
Dim ak5() As Double
Dim ak6() As Double
Dim ytemp() As Double
NM1 = n - 1
ReDim ak2(NM1)
ReDim ak3(NM1)
ReDim ak4(NM1)
ReDim ak5(NM1)
ReDim ak6(NM1)
ReDim ytemp(NM1)
Const A2 As Double = 1# / 5#
Const A3 As Double = 3# / 10#
Const A4 As Double = 3# / 5#
Const A5 As Double = 1#
Const A6 As Double = 7# / 8#
Const B21 As Double = 1# / 5#
Const B31 As Double = 3# / 40#
Const B32 As Double = 9# / 40#
Const B41 As Double = 3# / 10#
Const B42 As Double = -9# / 10#
Const B43 As Double = 6# / 5#
Const B51 As Double = -11# / 54#
Const B52 As Double = 5# / 2#
Const B53 As Double = -70# / 27#
Const B54 As Double = 35# / 27#
Const B61 As Double = 1631# / 55296#
Const B62 As Double = 175# / 512#
Const B63 As Double = 575# / 13824#
Const B64 As Double = 44275# / 110592#
Const B65 As Double = 253# / 4096#
Const C1 As Double = 37# / 378#
Const C3 As Double = 250# / 621#
Const C4 As Double = 125# / 594#
Const C6 As Double = 512# / 1771#
Const DC1 As Double = C1 - 2825# / 27648#
Const DC3 As Double = C3 - 18575# / 48384#
Const DC4 As Double = C4 - 13525# / 55296#
Const DC5 As Double = -277# / 14336#
Const DC6 As Double = C6 - 1# / 4#
'First Step
For I = 0 To n - 1
ytemp(I) = y(I) + B21 * h * dydx(I)
Next I
'Second Step
Call Derivs(x + A2 * h, ytemp(), ak2())
For I = 0 To n - 1
ytemp(I) = y(I) + h * (B31 * dydx(I) + B32 * ak2(I))
Next I
'Third Step
Call Derivs(x + A3 * h, ytemp(), ak3())
For I = 0 To n - 1
ytemp(I) = y(I) + h * (B41 * dydx(I) + B42 * ak2(I) + B43 * ak3(I))
Next I
'Fourth Step
Call Derivs(x + A4 * h, ytemp(), ak4())
For I = 0 To n - 1
ytemp(I) = y(I) + h * (B51 * dydx(I) + B52 * ak2(I) + B53 * ak3(I) + B54 * ak4(I))
Next I
'Fifth Step
Call Derivs(x + A5 * h, ytemp(), ak5())
For I = 0 To n - 1
ytemp(I) = y(I) + h * (B61 * dydx(I) + B62 * ak2(I) + B63 * ak3(I) + B64 * ak4(I) + B65 * ak5(I))
Next I
'Sixth Step
Call Derivs(x + A6 * h, ytemp(), ak6())
For I = 0 To n - 1
yout(I) = y(I) + h * (C1 * dydx(I) + C3 * k3(I) + C4 * ak4(I) + C6 * ak6(I))
Next I
For I = 0 To n - 1
yerr(I) = h * (DC1 * dydx(I) + DC3 * ak3(I) + DC4 * ak4(I) + DC5 * ak5(I) + DC6 * ak6(I))
Next I
End Sub
这是Runge Kutta方法。
所以我从RKCK开始分别调试三个程序中的每一个，然后进入RKQS然后通过为包含所有参数的每个编写测试宏来进入ODEINT，在消息框中输出与每个程序相关的计算值，并调用以下示例方程组：
Sub Derivs1(x As Double, y() As Double, dydx() As Double)
dydx(0) = -2 * x * y(0)
dydx(1) = -3 * y(1) * x ^ 2
End Sub
每个程序都适用于此示例，因此我决定使用实际的问题语句公式测试每个测试宏。 RKCK工作得很好，RKQS也是如此。然后，当我到达ODEINT时，会弹出错误消息。
答案 0 :(得分：2)
运行时错误5是“无效的过程调用”错误。
只要y数组的索引为1，我就无法看到该行如何产生错误。
您需要举一个调用此函数的示例，类似于以下运行，没有任何错误。
Sub test()
Dim dydx(0 To 1) As Double
Dim y(0 To 1) As Double
dydx(0) = 1
dydx(1) = 2
y(0) = 1
y(1) = 2
Derivs 0.5, y, dydx
End Sub
我已经运行了您编辑过的代码，并在
中发生错误Qv = k * (h0 ^ 0.5) * (1 - x) * (y(1) - hstar / h0) ^ 0.5
您的变量值为：
y(1) = 0
hstar = 38.3
h0 = 80
这意味着：
(y(1) - hstar / h0) = -0.478857734838603
正如Jean-FrançoisCorbett所提到的，vba不支持-ve数的平方根，导致运行时错误5。
答案 1 :(得分：0)
你可能正在采取负面的平方根。
当x ^ 0.5为否定时， x将为您提供“无效的过程调用或参数”错误。
尝试在调试模式下单步调试代码以确认这一点。