prog51 - プログラム倉庫

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
For m = 1 To 10
th(m) = 0.95 + 0.01 * m
Next
beta = 0.95
a = 0.33
ks = 0.5 * ((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
For m = 1 To 10
lx(m, n) = 0.5
cx(m, n) = th(m) * k(n) ^ a * lx(m, n) ^ (1 - a)
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)
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)
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
Debug.Print t, e
t = t + 1
Loop
Dim um As Single
Dim px(1 To 10, 1 To 100) As Single
Dim ps(1 To 10, 1 To 100) As Single
Dim pc As Single
Dim i1 As Single
Dim pp As Single
Dim ms As Single
Dim p1 As Single
Dim p2 As Single
Dim p3 As Single
Dim t4 As Single
ms = 10
For n = 1 To 100
For m = 1 To 10
px(m, n) = 1
Next
Next
t4 = 0
Do Until t4 > 100
For n = 10 To 90
For m = 1 To 10
p1 = 1.1 * px(m, n)
p2 = 0.9 * px(m, n)
um = 0
For s = 1 To 10
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
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)
pc = px(s, n2) + (n1 - n2) * (px(s, n3) - px(s, n2))
pp = pc / p1
r1 = th(s) * a * k1 ^ (a - 1) * l1 ^ (1 - a)
i1 = pp * (1 + r1) - 1
um = um + beta * i1 / (c1 * pp)
Next
um = um / 10
z1 = ms * um - p1
t = 0
Do Until t > 100
um = 0
For s = 1 To 10
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
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)
pc = px(s, n2) + (n1 - n2) * (px(s, n3) - px(s, n2))
pp = pc / p2
i1 = pp * (1 + r1) - 1
um = um + beta * i1 / (c1 * pp)
Next
um = um / 10
z2 = ms * um - p2
p3 = p2 - z2 * (p2 - p1) / (z2 - z1)
p1 = p2
p2 = p3
z1 = z2
If z2 ^ 2 < 10 ^ (-5) Then t = 1000
t = t + 1
Loop
ps(m, n) = p2
Next
Next
e = 0
For n = 10 To 90
For m = 1 To 10
e = e + (px(m, n) - ps(m, n)) ^ 2
Next
Next
For n = 10 To 90
For m = 1 To 10
px(m, n) = ps(m, n)
Next
Next
If e < 10 ^ (-5) Then t4 = 1000
Debug.Print t4, e
t4 = t4 + 1
Loop
End Sub