プログラム５ ６ - プログラム倉庫

Function countb(bx As Single, bs As Single, h As Single) As Single
Dim zs As Single
Dim z1 As Single
Dim z2 As Single
Dim ct As Single
zs = (bx - bs) / h
z1 = Int(zs)
z2 = z1 + 1
ct = z1
If (zs - z2) ^ 2 < (zs - z1) ^ 2 Then ct = z2
countb = ct
End Function

Private Sub Command1_Click()
Dim m As Single
Dim n1 As Single
Dim n2 As Single
Dim n3 As Single
Dim q As Single
Dim qx As Single
Dim pp As Single
Dim h As Single
Dim u(1 To 9, -1 To 1, -1 To 1, -1 To 1) As Single
Dim b(1 To 9, -1 To 1, -1 To 1, -1 To 1) As Single
Dim fastu(-1 To 1, -1 To 1) As Single
Dim fastb(-1 To 1, -1 To 1) As Single
Dim fastv(-1 To 1, -1 To 1, -100 To 100) As Single
Dim endu(-1 To 1, -1 To 1) As Single
Dim endb(-1 To 1, -1 To 1) As Single
Dim endv(-1 To 1, -1 To 1) As Single
Dim v(1 To 9, -1 To 1, -1 To 1, -1 To 1, -100 To 100) As Single
Dim bx As Single
Dim bs As Single
Open "c:/m2.txt" For Input As #2
Do Until EOF(2)
Input #2, a1, a2, a3, a4, a5, a6
m = a1
n1 = a2
n2 = a3
n3 = a4
u(m, n1, n2, n3) = a5
b(m, n1, n2, n3) = a6
Loop
Close #2
Open "c:/m3.txt" For Input As #3
Do Until EOF(3)
Input #3, a1, a2, a3, a4
n1 = a1
n2 = a2
fastu(n1, n2) = a3
fastb(n1, n2) = a4
Loop
Close #3
Open "c:/m4.txt" For Input As #4
Do Until EOF(4)
Input #4, a1, a2, a3, a4
n1 = a1
n2 = a2
endu(n1, n2) = a3
endb(n1, n2) = a4
Loop
Close #3
For n1 = -1 To 1
For n2 = -1 To 1
For q = -100 To 100
fastv(n1, n2, q) = -999
Next
Next
Next
h = 0.01
For n1 = -1 To 1
For n2 = -1 To 1
bx = fastb(n1, n2)
bs = fastb(0, 0)
q = countb(bx, bs, h)
fastv(n1, n2, q) = fastu(n1, n2)
Next
Next
For m = 1 To 9
For n1 = -1 To 1
For n2 = -1 To 1
For n3 = -1 To 1
For q = -100 To 100
v(m, n1, n2, n3, q) = -999
Next
Next
Next
Next
Next
m = 1
For n1 = -1 To 1
For n2 = -1 To 1
For n3 = -1 To 1
For q = -100 To 100
u1 = u(m, n1, n2, n3)
bx = b(m, n1, n2, n3)
bs = b(m, 0, 0, 0)
qx = q - countb(bx, bs, h)
pp = 0
If qx > 100 Then pp = 1
If qx < -100 Then pp = 1
If pp = 1 Then qx = 0
vs = u1 + fastv(n1, n2, qx)
If pp = 1 Then vs = -999
v(m, n1, n2, n3, q) = vs
Next
Next
Next
Next
For m = 2 To 9
For n1 = -1 To 1
For n2 = -1 To 1
For n3 = -1 To 1
For q = -100 To 100
u1 = u(m, n1, n2, n3)
bx = b(m, n1, n2, n3)
bs = b(m, 0, 0, 0)
qx = q - countb(bx, bs, h)
pp = 0
If qx > 100 Then pp = 1
If qx < -100 Then pp = 1
If pp = 1 Then qx = 0
vs = -999
For nx = -1 To 1
v1 = u1 + v(m - 1, nx, n1, n2, qx)
If v1 > vs Then vs = v1
Next
If pp = 1 Then vs = -999
v(m, n1, n2, n3, q) = vs
Next
Next
Next
Next
Next
For n1 = -1 To 1
For n2 = -1 To 1
endv(n1, n2) = -999
Next
Next
For n1 = -1 To 1
For n2 = -1 To 1
u1 = endu(n1, n2)
bx = endb(n1, n2)
bs = endb(0, 0)
qx = bs - bx
pp = 0
If qx > 100 Then pp = 1
If qx < -100 Then pp = 1
If pp = 1 Then qx = 0
vs = -999
For nx = -1 To 1
v1 = u1 + v(9, nx, n1, n2, qx)
If v1 > vs Then vs = v1
Next
If pp = 1 Then vs = -999
endv(n1, n2) = vs
Debug.Print n1, n2, endv(n1, n2)
Next
Next
End Sub