Reputation: 31
I'm defining a user defined function as follows, when I am trying to call it in a subroutine, it returns a "zero" value, which surely is wrong.
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
However, when I was trying to duplicate the same code defining the above function using a subroutine, and providing the same input values, the results are totally OK, as follows:
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
I have checked the data type and it seems there is no mismatch. And also, the function ThermoRel(x, y, P, T) works fine and has a variant data type. I have spent a lot of time and tried every way I can think of but still cannot figure it out, your inputs would be highly appreciated!!!
In order for you to easily debug it, I made a virtual example with the same errors (outputs zero) as follows:
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
Thank you all for the help! I found in the locals window that the dx array becomes all zero after the function is called, which should be (hx, 0, 0). Out of some reason, the dx array is enforced to all zero, I don't know why...
Upvotes: 0
Views: 384
Reputation: 166790
Your problem may be your use of Array()
to populate (eg) x
By using that you're re-defining the bounds:
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
Upvotes: 1