かｎ - プログラム倉庫

Private Sub Command1_Click()
Dim th(1 To 100) As Single
Dim s As Single
Dim m As Single
Dim n As Single
Dim mx As Single
Dim nx As Single
Dim q As Single
Dim c1 As Single
Dim y1 As Single
Dim c2 As Single
Dim y2 As Single
Dim cs(1 To 100) As Single
Dim ys(1 To 100) As Single
Dim u(1 To 99, -1 To 1, -1 To 1) As Single
Dim w(1 To 99, -1 To 1, -1 To 1) As Single
Dim gotoc(1 To 99, -1 To 1, -1 To 1, -5 To 5) As Single
Dim gotoy(1 To 99, -1 To 1, -1 To 1, -5 To 5) As Single
Dim v(1 To 99, -1 To 1, -1 To 1, -5 To 5) As Single
Dim opc(1 To 100) As Single
Dim opy(1 To 100) As Single
Dim opq(1 To 100) As Single
Dim w1 As Single
Dim wp As Single
Dim bp As Single
Dim h As Single
Dim bb As Single
Dim s1 As Single
Dim time As Single
Open "c:/501.txt" For Input As #1
Do Until EOF(1)
Input #1, a1, a2
s = a1
th(s) = a2
Loop
Close #1
Open "c:/502.txt" For Input As #2
Do Until EOF(2)
Input #2, a1, a2, a3
s = a1
cs(s) = a2
ys(s) = a3
Loop
Close #2
h = 10 ^ (-2)
time = 1
Do Until time > 1000
For s = 1 To 99
For m = -1 To 1
For n = -1 To 1
c1 = cs(s) + m * h
y1 = ys(s) + n * h
l1 = y1 / th(s)
pp = 0
If l1 < 0 Then pp = 1
If l1 < 0 Then l1 = 0
If l1 > 0.99 Then pp = 1
If l1 > 0.99 Then l1 = 0.99
If c1 < 0.01 Then pp = 1
If c1 < 0.01 Then c1 = 0.01
u(s, m, n) = -1 / c1 - 1 / (1 - l1)
If pp = 1 Then u(s, m, n) = -999
Next
Next
Next
For s = 1 To 99
For m = -1 To 1
For n = -1 To 1
c1 = cs(s) + m * h
y1 = ys(s) + n * h
l1 = y1 / th(s + 1)
pp = 0
If l1 < 0 Then pp = 1
If l1 < 0 Then l1 = 0
If l1 > 0.99 Then pp = 1
If l1 > 0.99 Then l1 = 0.99
If c1 < 0.01 Then pp = 1
If c1 < 0.01 Then c1 = 0.01
w(s, m, n) = -1 / c1 - 1 / (1 - l1)
If pp = 1 Then w(s, m, n) = -999
Next
Next
Next
For s = 1 To 99
For m = -1 To 1
For n = -1 To 1
For q = -5 To 5
v(s, m, n, q) = -999
Next
Next
Next
Next
s = 1
For m = -1 To 1
For n = -1 To 1
q = n - m
v(s, m, n, q) = u(s, m, n)
Next
Next
For s = 2 To 99
For m = -1 To 1
For n = -1 To 1
For q = -5 To 5
u1 = u(s, m, n)
c1 = cs(s) + m * h
y1 = ys(s) + n * h
qx = q + m - n
t = 0
If qx > 5 Then t = 1000
If qx < -5 Then t = 1000
vs = -999
Do Until t > 100
For mx = -1 To 1
For nx = -1 To 1
pp = 0
w1 = w(s - 1, mx, nx)
If w1 > u1 Then pp = 1
c2 = cs(s - 1) + mx * h
y2 = ys(s - 1) + nx * h
If c2 > c1 Then pp = 1
If y2 > y1 Then pp = 1
If v(s - 1, mx, nx, qx) < -900 Then pp = 1
v1 = u1 + v(s - 1, mx, nx, qx)
If pp = 1 Then v1 = -999
If v1 > vs Then mxs = mx
If v1 > vs Then nxs = nx
If v1 > vs Then vs = v1
Next
Next
t = 1000
Loop
gotoc(s, m, n, q) = mxs
gotoy(s, m, n, q) = nxs
v(s, m, n, q) = vs
Next
Next
Next
Next
s = 100
vs = -999
For m = -1 To 1
For n = -1 To 1
c1 = cs(s) + m * h
y1 = ys(s) + n * h
u1 = -1 / c1 - 1 / (1 - y1 / th(s))
qx = m - n
For mx = -1 To 1
For nx = -1 To 1
pp = 0
w1 = w(s - 1, mx, nx)
If w1 > u1 Then pp = 1
c2 = cs(s - 1) + mx * h
y2 = ys(s - 1) + nx * h
If c2 > c1 Then pp = 1
If y2 > y1 Then pp = 1
If v(s - 1, mx, nx, qx) < -900 Then pp = 1
v1 = u1 + v(s - 1, mx, nx, qx)
If pp = 1 Then v1 = -999
If v1 > vs Then ms = m
If v1 > vs Then ns = n
If v1 > vs Then mxs = mx
If v1 > vs Then nxs = nx
If v1 > vs Then vs = v1
Next
Next
Next
Next
opc(100) = ms
opy(100) = ns
opc(99) = mxs
opy(99) = nxs
opq(99) = ms - ns
For t = 1 To 98
s = 99 - t
opc(s) = gotoc(s + 1, opc(s + 1), opy(s + 1), opq(s + 1))
opy(s) = gotoy(s + 1, opc(s + 1), opy(s + 1), opq(s + 1))
opq(s) = opq(s + 1) + opc(s + 1) - opy(s + 1)
Next
For s = 1 To 100
cs(s) = cs(s) + opc(s) * h
ys(s) = ys(s) + opy(s) * h
Next
e = 0
For s = 1 To 100
e = e + opc(s) ^ 2 + opy(s) ^ 2
Next
If e < 10 Then h = h / 2
If h < 10 ^ (-6) Then time = 10000
Debug.Print time, e, vs
time = time + 1
Loop
For s = 1 To 98
y1 = ys(s + 1) - ys(s)
c1 = cs(s + 1) - cs(s)
pp = 0
If y1 < 10 ^ (-5) Then pp = 1
If y1 < 10 ^ (-5) Then y1 = 1
R = 100 * (1 - c1 / y1)
If pp = 1 Then R = 0
Debug.Print R
Next
End Sub