090118 - プログラム倉庫

Private Sub Command1_Click()
Dim ks As Single
Dim a As Single
Dim beta As Single
Dim r1 As Single
Dim n As Single
Dim cx(1 To 100) As Single
Dim cp(1 To 100) As Single
Dim k(1 To 100) As Single
Dim h As Single
Dim k1 As Single
Dim n1 As Single
Dim n2 As Single
Dim n3 As Single
Dim c1 As Single
Dim e As Single
beta = 0.95
a = 0.33
r1 = 1 / beta - 1
ks = (r1 / a) ^ (1 / (a - 1))
Debug.Print ks
h = 2 * ks / 100
For n = 1 To 100
k(n) = n * h
cx(n) = k(n) ^ a
Next
t1 = 0
Do Until t1 > 100
For n = 10 To 90
k1 = k(n) + k(n) ^ a - cx(n)
n1 = k1 / h
n2 = Int(n1)
n3 = n2 + 1
c1 = cx(n2) + (n1 - n2) * (cx(n3) - cx(n2))
r1 = a * k1 ^ (a - 1)
cp(n) = c1 / (beta * (1 + r1))
Next
e = 0
For n = 10 To 90
e = e + (cx(n) - cp(n)) ^ 2
Next
For n = 10 To 90
cx(n) = cp(n)
Next
If e < 10 ^ (-5) Then t1 = 1000
t1 = t1 + 1
Loop
Dim px(1 To 100) As Single
Dim ps(1 To 100) As Single
Dim pi As Single
Dim ix As Single
Dim p1 As Single
Dim p2 As Single
Dim p3 As Single
Dim ms As Single
ms = 10
For n = 1 To 100
px(n) = 1
Next
t3 = 0
Do Until t3 > 100
For n = 10 To 90
p1 = 0.9 * px(n)
p2 = 1.1 * px(n)
k1 = k(n) + k(n) ^ a - cx(n)
n1 = k1 / h
n2 = Int(n1)
n3 = n2 + 1
pz = px(n2) + (n1 - n2) * (px(n3) - px(n2))
pi = pz / p1 - 1
r1 = a * k1 ^ (a - 1)
ix = (1 + r1) * (1 + pi) - 1
z1 = ms * ix / (cx(n) * (1 + ix)) - p1
t2 = 0
Do Until t2 > 100
pi = pz / p2 - 1
r1 = a * k1 ^ (a - 1)
ix = (1 + r1) * (1 + pi) - 1
z2 = ms * ix / (cx(n) * (1 + ix)) - p2
p3 = p2 - z2 * (p2 - p1) / (z2 - z1)
p1 = p2
p2 = p3
z1 = z2
If z2 ^ 2 < 10 ^ (-5) Then t2 = 1000
Loop
ps(n) = p2
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 ^ (-5) Then t3 = 1000
t3 = t3 + 1
Debug.Print t3, e
Loop
For n = 10 To 90
Debug.Print px(n)
Next
End Sub