Uhlig(1997) - プログラム倉庫

Private Sub Command1_Click()
Dim n As Single
Dim h As Single
Dim a As Single
Dim beta As Single
Dim k(1 To 100) As Single
Dim cx(1 To 10, 1 To 100) As Single
Dim cp(1 To 10, 1 To 100) As Single
Dim lx(1 To 10, 1 To 100) As Single
Dim lp(1 To 10, 1 To 100) As Single
Dim th(1 To 10) As Single
Dim ks As Single
Dim r1 As Single
Dim c1 As Single
Dim n1 As Single
Dim n2 As Single
Dim n3 As Single
Dim e As Single
Dim t As Single
Dim uc As Single
Dim ls As Single
Dim de As Single
de = 0.05
For m = 1 To 10
th(m) = 1 + 0.02 * m
Next
beta = 0.95
a = 0.33
ls = (1 - a) / (2 - a)
ks = ls * ((1 / beta + de - 1) / a) ^ (1 / (a - 1))
h = 2 * ks / 100
For n = 1 To 100
k(n) = n * h
Next
For n = 1 To 100
For m = 1 To 10
lx(m, n) = ls
cx(m, n) = th(m) * k(n) ^ a * lx(m, n) ^ (1 - a) - de * k(n)
Next
Next
t = 0
Do Until t > 100
For n = 10 To 90
For m = 1 To 10
uc = 0
For s = 1 To 10
k1 = k(n) + th(m) * k(n) ^ a * lx(m, n) ^ (1 - a) - cx(m, n) - de * k(n)
n1 = k1 / h
n2 = Int(n1)
n3 = n2 + 1
c1 = cx(s, n2) + (n1 - n2) * (cx(s, n3) - cx(s, n2))
l1 = lx(s, n2) + (n1 - n2) * (lx(s, n3) - lx(s, n2))
r1 = th(s) * a * k1 ^ (a - 1) * l1 ^ (1 - a) - de
uc = uc + (beta * (1 + r1)) / c1
Next
uc = uc / 10
cp(m, n) = 1 / uc
w1 = th(m) * (1 - a) * k(n) ^ a * lx(m, n) ^ (-a)
lp(m, n) = 1 - c1 / w1
Next
Next
e = 0
For n = 10 To 90
For m = 1 To 10
e = e + (cx(m, n) - cp(m, n)) ^ 2 + (lx(m, n) - lp(m, n)) ^ 2
Next
Next
For n = 10 To 90
For m = 1 To 10
cx(m, n) = cp(m, n)
lx(m, n) = lp(m, n)
Next
Next
If e < 10 ^ (-5) Then t = 1000
t = t + 1
Loop
k1 = k(50)
For t = 1 To 100
Randomize
m = Int(10 * Rnd()) + 1
n1 = k1 / h
n2 = Int(n1)
n3 = n2 + 1
c1 = cx(m, n2) + (n1 - n2) * (cx(m, n3) - cx(m, n2))
l1 = lx(m, n2) + (n1 - n2) * (lx(m, n3) - lx(m, n2))
k1 = k1 + th(m) * k1 ^ a * l1 ^ (1 - a) - c1 - de * k1
Debug.Print t, c1, l1
Next
End Sub