プログラム ８ - プログラム倉庫

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 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 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
Dim m As Single
Dim th(1 To 10) As Single
For m = 1 To 10
th(m) = 0.95 + 0.01 * m
Next
beta = 0.95
a = 0.33
ls = 0.5
ks = ls * ((1 / beta - 1) / a) ^ (1 / (a - 1))
h = 2 * ks / 100
For n = 1 To 100
k(n) = n * h
For m = 1 To 10
lx(m, n) = ls
cx(m, n) = th(m) * k(n) ^ a * lx(m, n) ^ (1 - a)
Next
Next
t1 = 0
Do Until t1 > 100
For m = 1 To 10
For n = 10 To 90
k1 = k(n) + th(m) * k(n) ^ a * lx(m, n) ^ (1 - a) - cx(m, n)
n1 = k1 / h
n2 = Int(n1)
n3 = n2 + 1
uc = 0
For m1 = 1 To 10
c1 = cx(m1, n2) + (n1 - n2) * (cx(m1, n3) - cx(m1, n2))
l1 = lx(m1, n2) + (n1 - n2) * (lx(m1, n3) - lx(m1, n2))
r1 = th(m1) * a * k1 ^ (a - 1) * l1 ^ (1 - a)
uc = uc + (beta * (1 + r1)) / c1
Next
uc = 0.1 * uc
cp(m, n) = 1 / uc
w1 = (1 - a) * th(m) + k(n) ^ a * lx(m, n) ^ (-a)
lp(m, n) = 1 - cx(m, n) / w1
Next
Next
e = 0
For m = 1 To 10
For n = 10 To 90
e = e + (cx(m, n) - cp(m, n)) ^ 2 + (lx(m, n) - lp(m, n)) ^ 2
Next
Next
For m = 1 To 10
For n = 10 To 90
lx(m, n) = lp(m, n)
cx(m, n) = cp(m, n)
Next
Next
If e < 10 ^ (-5) Then t1 = 1000
t1 = t1 + 1
Loop
Dim ms As Single
Dim px(1 To 10, 1 To 100) As Single
Dim ps(1 To 10, 1 To 100) As Single
Dim p1 As Single
Dim p2 As Single
Dim p3 As Single
Dim z1 As Single
Dim z2 As Single
Dim z3 As Single
Dim pi As Single
Dim pxs As Single
ms = 50
For m = 1 To 10
For n = 1 To 100
px(m, n) = 1
Next
Next
t4 = 0
Do Until t4 > 1000
For m = 1 To 10
For n = 10 To 90
p1 = 1.1 * px(m, n)
p2 = 0.9 * px(m, n)
k1 = k(n) + th(m) * k(n) ^ a * lx(m, n) ^ (1 - a) - cx(m, n)
n1 = k1 / h
n2 = Int(n1)
n3 = n2 + 1
z1 = 0
For m1 = 1 To 10
pxs = px(m1, n2) + (n1 - n2) * (px(m1, n3) - px(m1, n2))
l1 = lx(m1, n2) + (n1 - n2) * (lx(m1, n3) - lx(m1, n2))
r1 = a * k1 ^ (a - 1) * l1 ^ (1 - a)
pi = pxs / p1 - 1
iss = (1 + pi) * (1 + r1) - 1
z1 = z1 + iss * ms / (cx(m, n) * (1 + iss))
Next
z1 = 0.1 * z1
z1 = z1 - p1
t3 = 0
Do Until t3 > 100
z2 = 0
For m1 = 1 To 10
pxs = px(m1, n2) + (n1 - n2) * (px(m1, n3) - px(m1, n2))
l1 = lx(m1, n2) + (n1 - n2) * (lx(m1, n3) - lx(m1, n2))
r1 = a * k1 ^ (a - 1) * l1 ^ (1 - a)
pi = pxs / p2 - 1
iss = (1 + pi) * (1 + r1) - 1
z2 = z2 + iss * ms / (cx(m, n) * (1 + iss))
Next
z2 = 0.1 * z2
z2 = z2 - p2
p3 = p2 - z2 * (p2 - p1) / (z2 - z1)
If z2 ^ 2 < 10 ^ (-5) Then t3 = 10000
p1 = p2
p2 = p3
z1 = z2
t3 = t3 + 1
Loop
ps(m, n) = p2
Next
Next
e = 0
For m = 1 To 10
For n = 10 To 90
e = e + (px(m, n) - ps(m, n)) ^ 2
Next
Next
For m = 1 To 10
For n = 10 To 90
px(m, n) = ps(m, n)
Next
Next
If e < 10 ^ (-5) Then t4 = 1000
t4 = t4 + 1
Debug.Print t4, e
Loop
For n = 10 To 90
Debug.Print px(5, n)
Next
End Sub