次のようにユーザー定義関数を定義しています。サブルーチンで呼び出そうとすると、「ゼロ」値が返されますが、これは間違いです。
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
助けてくれてありがとう！ローカルウィンドウで、関数が呼び出された後、dx 配列がすべてゼロになることがわかりました。これは (hx, 0, 0) である必要があります。何らかの理由で、dx 配列がすべてゼロに強制されます。理由はわかりません...