0

我正在定义一个用户定义的函数,如下所示,当我试图在子程序中调用它时,它返回一个“零”值,这肯定是错误的。

Function Getpartialderiv_K_x(x As Variant, y As Variant, P As Variant, 
T As Variant, hx As Variant, dx As Variant) As Variant

Dim i As Integer
ReDim dx(1 To UBound(x, 1)) As Variant

'record the original value for x
Dim original_x As Variant
original_x = x

'calc f(x+1)
For i = 1 To UBound(x, 1)
x(i) = original_x(i) + dx(i)
Next i
Dim f1 As Variant
f1 = ThermoRel(x, y, P, T)

'calc f(x-1)
For i = 1 To UBound(x, 1)
x(i) = original_x(i) - dx(i)
Next i
Dim f2 As Variant
f2 = ThermoRel(x, y, P, T)

'calc partial deriv
ReDim pderiv(1 To UBound(x, 1))
'get the results of partial derivatives
For i = 1 To UBound(x, 1)
pderiv(i) = (f1(i) - f2(i)) / (2 * hx)
Next i

Getpartialderiv_K_x = pderiv

End Function

Sub click2()

ReDim x(1 To 3) As Variant
ReDim y(1 To 3) As Variant
x = Array(0.4, 0.3, 0.3)
y = Array(0.3, 0.2, 0.5)
Dim P As Variant
P = 1171.904923  'pressure in the unit of psia
Dim T As Variant
T = 527.67 'fix temperature in the unit of oR
Dim hx As Variant
hx = 0.001
ReDim dx(1 To 3) As Variant
dx = Array(hx, 0, 0)

Dim result As Variant
result = Getpartialderiv_K_x(x, y, P, T, hx, dx)

MsgBox (result(1))

End Sub

但是,当我尝试使用子程序复制定义上述函数的相同代码并提供相同的输入值时,结果完全没问题,如下所示:

Sub click()
Dim i As Integer
ReDim x(1 To 3) As Variant
ReDim y(1 To 3) As Variant
x = Array(0.4, 0.3, 0.3)
y = Array(0.3, 0.2, 0.5)
Dim P As Variant
P = 1171.904923  'pressure in the unit of psia
Dim T As Variant
T = 527.67 'fix temperature in the unit of oR
Dim hx As Variant
hx = 0.001
ReDim dx(1 To 3) As Variant
dx = Array(hx, 0, 0)

Dim original_x As Variant
original_x = x

'calc f(x + 1)
 For i = 1 To 3
 x(i) = original_x(i) + dx(i)
 Next i
 Dim f1 As Variant
 f1 = ThermoRel(x, y, P, T)

 'calc f(x - 1)
 For i = 1 To 3
 x(i) = original_x(i) - dx(i)
 Next i
 Dim f2 As Variant
 f2 = ThermoRel(x, y, P, T)

 ReDim pderiv(1 To 3) As Variant
 For i = 1 To 3
 pderiv(i) = (f1(i) - f2(i)) / (2 * hx)
 Next i

 Msgbox(pderiv(3))

 End Sub

我检查了数据类型,似乎没有不匹配。此外,ThermoRel(x, y, P, T) 函数工作正常,并且具有变体数据类型。我花了很多时间并尝试了我能想到的所有方法,但仍然无法弄清楚,非常感谢您的输入!!!

为了让您轻松调试它,我制作了一个具有相同错误(输出为零)的虚拟示例,如下所示:

Option Explicit
Option Base 1
Function ThermoRel2(x As Variant, y As Variant, P As Variant, T As Variant) As Variant

Dim i As Integer       'component index
Dim Ke As Variant      'equilibrium constant for each component
Ke = Array(0.8789, 1.0389, 0.7903)
ReDim outvec(LBound(x, 1) To UBound(x, 1)) As Variant

For i = LBound(x, 1) To UBound(x, 1)
outvec(i) = y(i) - x(i) * Ke(i)
Next i

ThermoRel2 = outvec

End Function

Function Getpartialderiv_K_x_2(x As Variant, y As Variant, P As Variant, T  As Variant, hx As Variant, dx As Variant) As Variant

Dim i As Integer
ReDim dx(LBound(x, 1) To UBound(x, 1)) As Variant

'record the original value for x
Dim original_x As Variant
original_x = x

'calc f(x+1)
For i = LBound(x, 1) To UBound(x, 1)
x(i) = original_x(i) + dx(i)
Next i
Dim f1 As Variant
f1 = ThermoRel2(x, y, P, T)

'calc f(x-1)
For i = LBound(x, 1) To UBound(x, 1)
x(i) = original_x(i) - dx(i)
Next i
Dim f2 As Variant
f2 = ThermoRel2(x, y, P, T)

'calc partial deriv
ReDim pderiv(LBound(x, 1) To UBound(x, 1))
'get the results of partial derivatives
For i = LBound(x, 1) To UBound(x, 1)
pderiv(i) = (f1(i) - f2(i)) / (2 * hx)
Next i

Getpartialderiv_K_x_2 = pderiv

End Function

Sub dbg()

Dim x As Variant
Dim y As Variant
ReDim x(1 To 3) As Variant
ReDim y(1 To 3) As Variant
x = Array(0.4, 0.3, 0.3)
y = Array(0.3, 0.2, 0.5)
Dim P As Variant
P = 1171.904923  'pressure in the unit of psia
Dim T As Variant
T = 527.67 'fix temperature in the unit of oR
Dim hx As Variant
hx = 0.001
Dim dx As Variant
ReDim dx(1 To 3) As Variant
dx = Array(hx, 0, 0)
Dim result As Variant
result = Getpartialderiv_K_x_2(x, y, P, T, hx, dx)
MsgBox (result(1))
End Sub

谢谢大家的帮助!我在locals窗口中发现调用函数后dx数组全为零,应该是(hx, 0, 0)。出于某种原因,dx 数组被强制为零,我不知道为什么......

4

1 回答 1

1

您的问题可能是您用于Array()填充(例如)x 通过使用您重新定义边界:

Dim x()

ReDim x(1 To 3) As Variant

Debug.Print LBound(x), UBound(x) '<< 1, 3

x = Array(0.4, 0.3, 0.3)

Debug.Print LBound(x), UBound(x) '<< 0, 2
于 2015-07-17T23:42:50.517 回答