prog13 - プログラム倉庫

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 100) As Single
Dim cp(1 To 100) 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
beta = 0.95
a = 0.33
ks = ((1 / beta - 1) / a) ^ (1 / (a - 1))
h = 2 * ks / 100
For n = 1 To 100
k(n) = n * h
Next
For n = 1 To 100
cx(n) = k(n) ^ a
Next
t = 0
Do Until t > 100
For n = 10 To 90
k1 = k(n) + k(n) ^ a - cx(n)
r1 = a * k1 ^ (a - 1)
n1 = k1 / h
n2 = Int(n1)
n3 = n2 + 1
c1 = cx(n2) + (n1 - n2) * (cx(n3) - cx(n2))
cp(n) = c1 / (beta * (1 + r1))
Next
e = 0
For n = 1 To 100
e = e + (cx(n) - cp(n)) ^ 2
Next
For n = 1 To 100
cx(n) = cp(n)
Next
If e < 10 ^ (-5) Then t = 1000
t = t + 1
Loop
Dim px(1 To 100) As Single
Dim ps(1 To 100) As Single
Dim ms As Single
Dim g1 As Single
Dim px1 As Single
Dim px2 As Single
Dim px3 As Single
Dim z1 As Single
Dim z2 As Single
ms = 3
For n = 1 To 100
px(n) = 1
Next
s = 0
Do Until s > 10
For n = 10 To 90
k1 = k(n) + k(n) ^ a - cx(n)
r1 = a * k1 ^ (a - 1)
n1 = k1 / h
n2 = Int(n1)
n3 = n2 + 1
c1 = cx(n2) + (n1 - n2) * (cx(n3) - cx(n2))
p1 = px(n2) + (n1 - n2) * (px(n3) - px(n2))
px1 = 1.01 * px(n)
px2 = 0.99 * px(n)
g1 = p1 / px1 - 1
i1 = (1 + r1) * (1 + g1) - 1
p1 = ms * beta * (1 + g1) / (c1 * i1)
z1 = p1 - px1
t = 0
Do Until t > 100
g2 = p1 / px2 - 1
i2 = (1 + r1) * (1 + g2) - 1
p2 = ms * beta * (1 + g2) / (c1 * i2)
z2 = p2 - px2
px3 = px2 - z2 * (px2 - px1) / (z2 - z1)
px1 = px2
px2 = px3
z1 = z2
If z1 ^ 2 < 10 ^ (-5) Then t = 1000
t = t + 1
Loop
ps(n) = px2
Next
e = 0
For n = 10 To 90
e = e + (px(n) - ps(n)) ^ 2
Next
For n = 10 To 90
px(n) = ps(n)
Next
If e < 10 ^ (-3) Then s = 1000
Debug.Print s, e
s = s + 1
Loop
End Sub