tougo - プログラム倉庫

Function myeselect(s1 As Single, s2 As Single, th1, th2, n1 As Single, n2 As Single, c, y1, y2) As Single
Dim m As Single
Dim maxu As Single
Dim maxm As Single
Dim u1 As Single
Dim c1 As Single
Dim my As Single
Dim fy As Single
Dim i As Single
Dim j As Single
maxu = -999
For m1 = 0 To 10
c1 = c(m1, 9, n1)
my = y1(m1)
fy = y2(9)
u1 = u(s1, s2, th1, th2, c1, my, fy)
If u1 > maxu Then maxm = m1
If u1 > maxu Then maxu = u1
Next
For m1 = 0 To 10
c1 = c(m1, 10, n2)
my = y1(m1)
fy = y2(10)
u1 = u(s1, s2, th1, th2, c1, my, fy)
If u1 > maxu Then maxm = m1
If u1 > maxu Then maxu = u1
Next
myeselect = maxm
End Function
Function myfselect(s1 As Single, s2 As Single, th1, th2, n1 As Single, n2 As Single, c, y1, y2) As Single
Dim m As Single
Dim maxu As Single
Dim maxm As Single
Dim u1 As Single
Dim c1 As Single
Dim my As Single
Dim fy As Single
Dim i As Single
Dim j As Single
maxu = -999
For m1 = 0 To 10
c1 = c(m1, 0, n1)
my = y1(m1)
fy = y2(0)
u1 = u(s1, s2, th1, th2, c1, my, fy)
If u1 > maxu Then maxm = m1
If u1 > maxu Then maxu = u1
Next
For m1 = 0 To 10
c1 = c(m1, 1, n2)
my = y1(m1)
fy = y2(1)
u1 = u(s1, s2, th1, th2, c1, my, fy)
If u1 > maxu Then maxm = m1
If u1 > maxu Then maxu = u1
Next
myfselect = maxm
End Function


Function fyfselect(s1 As Single, s2 As Single, th1, th2, n1 As Single, n2 As Single, c, y1, y2) As Single
Dim m As Single
Dim maxu As Single
Dim maxm As Single
Dim u1 As Single
Dim c1 As Single
Dim my As Single
Dim fy As Single
Dim i As Single
Dim j As Single
maxu = -999
For m1 = 0 To 10
c1 = c(m1, 0, n1)
my = y1(m1)
fy = y2(0)
u1 = u(s1, s2, th1, th2, c1, my, fy)
If u1 > maxu Then maxm = 0
If u1 > maxu Then maxu = u1
Next
For m1 = 0 To 10
c1 = c(m1, 1, n2)
my = y1(m1)
fy = y2(1)
u1 = u(s1, s2, th1, th2, c1, my, fy)
If u1 > maxu Then maxm = 1
If u1 > maxu Then maxu = u1
Next
fyfselect = maxm
End Function
Function fyeselect(s1 As Single, s2 As Single, th1, th2, n1 As Single, n2 As Single, c, y1, y2) As Single
Dim m As Single
Dim maxu As Single
Dim maxm As Single
Dim u1 As Single
Dim c1 As Single
Dim my As Single
Dim fy As Single
Dim i As Single
Dim j As Single
maxu = -999
For m1 = 0 To 10
c1 = c(m1, 9, n1)
my = y1(m1)
fy = y2(9)
u1 = u(s1, s2, th1, th2, c1, my, fy)
If u1 > maxu Then maxm = 9
If u1 > maxu Then maxu = u1
Next
For m1 = 0 To 10
c1 = c(m1, 10, n2)
my = y1(m1)
fy = y2(10)
u1 = u(s1, s2, th1, th2, c1, my, fy)
If u1 > maxu Then maxm = 10
If u1 > maxu Then maxu = u1
Next
fyeselect = maxm
End Function
Function fprefer(s1 As Single, s2 As Single, th1, th2, c, y1, y2) As Single
Dim m As Single
Dim maxu As Single
Dim maxm As Single
Dim u1 As Single
Dim c1 As Single
Dim my As Single
Dim fy As Single
maxu = -999
For m1 = 0 To 10
For m2 = 0 To 10
c1 = c(m1, m2)
my = y1(m1)
fy = y2(m2)
u1 = u(s1, s2, th1, th2, c1, my, fy)
If u1 > maxu Then maxm = m2
If u1 > maxu Then maxu = u1
Next
Next
fprefer = maxm
End Function
Function fyselect(s1 As Single, s2 As Single, th1, th2, m2 As Single, n1 As Single, n2 As Single, n3 As Single, c, y1, y2) As Single
Dim m As Single
Dim maxu As Single
Dim maxm As Single
Dim u1 As Single
Dim c1 As Single
Dim my As Single
Dim fy As Single
Dim i As Single
Dim j As Single
maxu = -999
For m1 = 0 To 10
c1 = c(m1, m2 - 1, n1)
my = y1(m1)
fy = y2(m2 - 1)
u1 = u(s1, s2, th1, th2, c1, my, fy)
If u1 > maxu Then maxm = m2 - 1
If u1 > maxu Then maxu = u1
Next
For m1 = 0 To 10
c1 = c(m1, m2, n2)
my = y1(m1)
fy = y2(m2)
u1 = u(s1, s2, th1, th2, c1, my, fy)
If u1 > maxu Then maxm = m2
If u1 > maxu Then maxu = u1
Next
For m1 = 0 To 10
c1 = c(m1, m2 + 1, n3)
my = y1(m1)
fy = y2(m2 + 1)
u1 = u(s1, s2, th1, th2, c1, my, fy)
If u1 > maxu Then maxm = m2 + 1
If u1 > maxu Then maxu = u1
Next
fyselect = maxm
End Function

Function myselect(s1 As Single, s2 As Single, th1, th2, m2 As Single, n1 As Single, n2 As Single, n3 As Single, c, y1, y2) As Single
Dim m As Single
Dim maxu As Single
Dim maxm As Single
Dim u1 As Single
Dim c1 As Single
Dim my As Single
Dim fy As Single
Dim i As Single
Dim j As Single
maxu = -999
For m1 = 0 To 10
c1 = c(m1, m2 - 1, n1)
my = y1(m1)
fy = y2(m2 - 1)
u1 = u(s1, s2, th1, th2, c1, my, fy)
If u1 > maxu Then maxm = m1
If u1 > maxu Then maxu = u1
Next
For m1 = 0 To 10
c1 = c(m1, m2, n2)
my = y1(m1)
fy = y2(m2)
u1 = u(s1, s2, th1, th2, c1, my, fy)
If u1 > maxu Then maxm = m1
If u1 > maxu Then maxu = u1
Next
For m1 = 0 To 10
c1 = c(m1, m2 + 1, n3)
my = y1(m1)
fy = y2(m2 + 1)
u1 = u(s1, s2, th1, th2, c1, my, fy)
If u1 > maxu Then maxm = m1
If u1 > maxu Then maxu = u1
Next
myselect = maxm
End Function

Function mfselect(s1 As Single, s2 As Single, th1, th2, n1 As Single, n2 As Single, c, y1, y2) As Single
Dim m As Single
Dim maxu As Single
Dim maxm As Single
Dim u1 As Single
Dim c1 As Single
Dim my As Single
Dim fy As Single
Dim i As Single
Dim j As Single
maxu = -999
For m2 = 0 To 10
c1 = c(0, m2, n1)
my = y1(0)
fy = y2(m2)
u1 = u(s1, s2, th1, th2, c1, my, fy)
If u1 > maxu Then maxm = 0
If u1 > maxu Then maxu = u1
Next
For m2 = 0 To 10
c1 = c(1, m2, n2)
my = y1(1)
fy = y2(m2)
u1 = u(s1, s2, th1, th2, c1, my, fy)
If u1 > maxu Then maxm = 1
If u1 > maxu Then maxu = u1
Next
mfselect = maxm
End Function
Function meselect(s1 As Single, s2 As Single, th1, th2, n1 As Single, n2 As Single, c, y1, y2) As Single
Dim m As Single
Dim maxu As Single
Dim maxm As Single
Dim u1 As Single
Dim c1 As Single
Dim my As Single
Dim fy As Single
Dim i As Single
Dim j As Single
maxu = -999
For m2 = 0 To 10
c1 = c(9, m2, n1)
my = y1(9)
fy = y2(m2)
u1 = u(s1, s2, th1, th2, c1, my, fy)
If u1 > maxu Then maxm = 9
If u1 > maxu Then maxu = u1
Next
For m2 = 0 To 10
c1 = c(10, m2, n2)
my = y1(10)
fy = y2(m2)
u1 = u(s1, s2, th1, th2, c1, my, fy)
If u1 > maxu Then maxm = 10
If u1 > maxu Then maxu = u1
Next
meselect = maxm
End Function
Function feselect(s1 As Single, s2 As Single, th1, th2, n1 As Single, n2 As Single, c, y1, y2) As Single
Dim m As Single
Dim maxu As Single
Dim maxm As Single
Dim u1 As Single
Dim c1 As Single
Dim my As Single
Dim fy As Single
Dim i As Single
Dim j As Single
maxu = -999
For m2 = 0 To 10
c1 = c(9, m2, n1)
my = y1(9)
fy = y2(m2)
u1 = u(s1, s2, th1, th2, c1, my, fy)
If u1 > maxu Then maxm = m2
If u1 > maxu Then maxu = u1
Next
For m2 = 0 To 10
c1 = c(10, m2, n2)
my = y1(10)
fy = y2(m2)
u1 = u(s1, s2, th1, th2, c1, my, fy)
If u1 > maxu Then maxm = m2
If u1 > maxu Then maxu = u1
Next
feselect = maxm
End Function





Function ffselect(s1 As Single, s2 As Single, th1, th2, n1 As Single, n2 As Single, c, y1, y2) As Single
Dim m As Single
Dim maxu As Single
Dim maxm As Single
Dim u1 As Single
Dim c1 As Single
Dim my As Single
Dim fy As Single
Dim i As Single
Dim j As Single
maxu = -999
For m2 = 0 To 10
c1 = c(0, m2, n1)
my = y1(0)
fy = y2(m2)
u1 = u(s1, s2, th1, th2, c1, my, fy)
If u1 > maxu Then maxm = m2
If u1 > maxu Then maxu = u1
Next
For m2 = 0 To 10
c1 = c(1, m2, n2)
my = y1(1)
fy = y2(m2)
u1 = u(s1, s2, th1, th2, c1, my, fy)
If u1 > maxu Then maxm = m2
If u1 > maxu Then maxu = u1
Next
ffselect = maxm
End Function

Function u(s1 As Single, s2 As Single, th1, th2, cp As Single, yp1 As Single, yp2 As Single) As Single
Dim lx As Single
Dim cx As Single
Dim px As Single
l1 = yp1 / th1(s1)
l2 = yp2 / th2(s2)
cx = cp
px = 0
If cx < 0.01 Then px = 1
If l1 > 0.99 Then px = 1
If l2 > 0.99 Then px = 1
If l1 < 0 Then px = 1
If l2 < 0 Then px = 1
If px = 1 Then cx = 0.5
If px = 1 Then l1 = 0.5
If px = 1 Then l2 = 0.5
ux = Log(cx) + Log(1 - l1) + Log(1 - l2)
If px = 1 Then ux = -999
u = ux
End Function


Function fselect(s1 As Single, s2 As Single, th1, th2, m1 As Single, n1 As Single, n2 As Single, n3 As Single, c, y1, y2) As Single
Dim m As Single
Dim maxu As Single
Dim maxm As Single
Dim u1 As Single
Dim c1 As Single
Dim my As Single
Dim fy As Single
Dim i As Single
Dim j As Single
maxu = -999
For m2 = 0 To 10
c1 = c(m1 - 1, m2, n1)
my = y1(m1 - 1)
fy = y2(m2)
u1 = u(s1, s2, th1, th2, c1, my, fy)
If u1 > maxu Then maxm = m2
If u1 > maxu Then maxu = u1
Next
For m2 = 0 To 10
c1 = c(m1, m2, n2)
my = y1(m1)
fy = y2(m2)
u1 = u(s1, s2, th1, th2, c1, my, fy)
If u1 > maxu Then maxm = m2
If u1 > maxu Then maxu = u1
Next
For m2 = 0 To 10
c1 = c(m1, m2, n3)
my = y1(m1 + 1)
fy = y2(m2)
u1 = u(s1, s2, th1, th2, c1, my, fy)
If u1 > maxu Then maxm = m2
If u1 > maxu Then maxu = u1
Next
fselect = maxm
End Function
Function mselect(s1 As Single, s2 As Single, th1, th2, m1 As Single, n1 As Single, n2 As Single, n3 As Single, c, y1, y2) As Single
Dim m As Single
Dim maxu As Single
Dim maxm As Single
Dim u1 As Single
Dim c1 As Single
Dim my As Single
Dim fy As Single
Dim i As Single
Dim j As Single
maxu = -999
For m2 = 0 To 10
c1 = c(m1 - 1, m2, n1)
my = y1(m1 - 1)
fy = y2(m2)
u1 = u(s1, s2, th1, th2, c1, my, fy)
If u1 > maxu Then maxm = m1 - 1
If u1 > maxu Then maxu = u1
Next
For m2 = 0 To 10
c1 = c(m1, m2, n2)
my = y1(m1)
fy = y2(m2)
u1 = u(s1, s2, th1, th2, c1, my, fy)
If u1 > maxu Then maxm = m1
If u1 > maxu Then maxu = u1
Next
For m2 = 0 To 10
c1 = c(m1, m2, n3)
my = y1(m1 + 1)
fy = y2(m2)
u1 = u(s1, s2, th1, th2, c1, my, fy)
If u1 > maxu Then maxm = m1 + 1
If u1 > maxu Then maxu = u1
Next
mselect = maxm
End Function
Function mprefer(s1 As Single, s2 As Single, th1, th2, c, y1, y2) As Single
Dim m As Single
Dim maxu As Single
Dim maxm As Single
Dim u1 As Single
Dim c1 As Single
Dim my As Single
Dim fy As Single
maxu = -999
For m1 = 0 To 10
For m2 = 0 To 10
c1 = c(m1, m2)
my = y1(m1)
fy = y2(m2)
u1 = u(s1, s2, th1, th2, c1, my, fy)
If u1 > maxu Then maxm = m1
If u1 > maxu Then maxu = u1
Next
Next
mprefer = maxm
End Function
Private Sub Command1_Click()
Dim m1 As Single
Dim m2 As Single
Dim s1 As Single
Dim s2 As Single
Dim cp1 As Single
Dim yp1 As Single
Dim yp2 As Single
Dim c(0 To 10, 0 To 10, -1 To 1) As Single
Dim cs(0 To 10, 0 To 10) As Single
Dim th1(1 To 10) As Single
Dim th2(1 To 10) As Single
Dim y1(0 To 10) As Single
Dim y2(0 To 10) As Single
Dim mgr(1 To 10, 1 To 10) As Single
Dim fgr(1 To 10, 1 To 10) As Single
Dim gu(1 To 9, -1 To 1, -1 To 1, -1 To 1) As Single
Dim gb(1 To 9, -1 To 1, -1 To 1, -1 To 1) As Single
Dim endu(-1 To 1, -1 To 1) As Single
Dim fastb(-1 To 1, -1 To 1) As Single
Dim endb(-1 To 1, -1 To 1) As Single
Dim fastu(-1 To 1, -1 To 1) As Single
Dim mgroup(0 To 10, 1 To 100) As Single
Dim fgroup(0 To 10, 1 To 100) As Single
Dim ngroup(0 To 10) As Single
Dim v(0 To 9, -1 To 1, -1 To 1, -50 To 50) As Single
Dim goton(0 To 9, -1 To 1, -1 To 1, -50 To 50) As Single
Dim gotoq(0 To 9, -1 To 1, -1 To 1, -50 To 50) As Single
Dim endv(-1 To 1, -1 To 1, -50 To 50) As Single
Dim endq(-1 To 1, -1 To 1, -50 To 50) As Single
Dim op(0 To 10) As Single
Dim oq(0 To 10) As Single
Dim i As Single
Dim j As Single
Dim h As Single
Dim n1 As Single
Dim n2 As Single
Dim n3 As Single
Open "c:/lupin.txt" For Input As #2
Do Until EOF(2)
Input #2, a1, a2, a3
m1 = a1
m2 = a2
cs(m1, m2) = a3
Loop
Close #2
For s = 1 To 10
th1(s) = 0.2 * s
th2(s) = 0.1 * s
Next
For m = 0 To 10
y1(m) = 0.105 * m
y2(m) = 0.05 * m
Next
t3 = 0
Do Until t3 > 5
h = 0.001
t1 = 0
Do Until t1 > 10
For m2 = 0 To 10
For s1 = 1 To 10
For s2 = 1 To 10
mgr(s1, s2) = mprefer(s1, s2, th1, th2, cs, y1, y2)
fgr(s1, s2) = fprefer(s1, s2, th1, th2, cs, y1, y2)
Next
Next
Next
For m1 = 0 To 10
n = 0
For s1 = 1 To 10
For s2 = 1 To 10
If mgr(s1, s2) = m1 Then n = n + 1
If mgr(s1, s2) = m1 Then mgroup(m1, n) = s1
If mgr(s1, s2) = m1 Then fgroup(m1, n) = s2
Next
Next
ngroup(m1) = n
Next
For m1 = 0 To 10
For m2 = 0 To 10
For n = -1 To 1
c(m1, m2, n) = cs(m1, m2) + n * h
Next
Next
Next
For m1 = 1 To 9
For n1 = -1 To 1
For n2 = -1 To 1
For n3 = -1 To 1
nu = ngroup(m1)
us = 0
bs = 0
For s = 1 To nu
s1 = mgroup(m1, s)
s2 = fgroup(m1, s)
i = mselect(s1, s2, th1, th2, m1, n1, n2, n3, c, y1, y2)
j = fselect(s1, s2, th1, th2, m1, n1, n2, n3, c, y1, y2)
nx = n2
If i = m1 - 1 Then nx = n1
If i = m1 + 1 Then nx = n3
cp1 = c(i, j, nx)
yp1 = y1(i)
yp2 = y2(j)
u1 = u(s1, s2, th1, th2, cp1, yp1, yp2)
us = us + u1
bs = bs + yp1 + yp2 - cp1
Next
gu(m1, n1, n2, n3) = us
gb(m1, n1, n2, n3) = bs
Next
Next
Next
Next
For n1 = -1 To 1
For n2 = -1 To 1
nu = ngroup(0)
us = 0
bs = 0
For s = 1 To nu
s1 = mgroup(0, s)
s2 = fgroup(0, s)
i = mfselect(s1, s2, th1, th2, n1, n2, c, y1, y2)
j = ffselect(s1, s2, th1, th2, n1, n2, c, y1, y2)
nx = n1
If i = 1 Then nx = n2
cp1 = c(i, j, nx)
yp1 = y1(i)
yp2 = y2(j)
u1 = u(s1, s2, th1, th2, cp1, yp1, yp2)
us = us + u1
bs = bs + yp1 + yp2 - cp1
Next
fastu(n1, n2) = us
fastb(n1, n2) = bs
Next
Next
For n1 = -1 To 1
For n2 = -1 To 1
nu = ngroup(10)
us = 0
bs = 0
For s = 1 To nu
s1 = mgroup(10, s)
s2 = fgroup(10, s)
i = meselect(s1, s2, th1, th2, n1, n2, c, y1, y2)
j = feselect(s1, s2, th1, th2, n1, n2, c, y1, y2)
nx = n2
If i = 9 Then nx = n1
cp1 = c(i, j, nx)
yp1 = y1(i)
yp2 = y2(j)
u1 = u(s1, s2, th1, th2, cp1, yp1, yp2)
us = us + u1
bs = bs + yp1 + yp2 - cp1
Next
endu(n1, n2) = us
endb(n1, n2) = bs
Next
Next
For n1 = -1 To 1
For n2 = -1 To 1
For q = -50 To 50
v(0, n1, n2, q) = -999
Next
Next
Next
For n1 = -1 To 1
For n2 = -1 To 1
q0 = fastb(0, 0)
q1 = fastb(n1, n2)
q = Int((q1 - q0) / h)
pp = 0
If q > 50 Then pp = 1
If q < -50 Then pp = 1
If pp = 1 Then q = 0
v(0, n1, n2, q) = fastu(n1, n2)
If pp = 1 Then v(0, n1, n2, q) = -999
Next
Next
For m1 = 1 To 9
For n1 = -1 To 1
For n2 = -1 To 1
For q = -50 To 50
vs = -999
For nx = -1 To 1
u1 = gu(m1, nx, n1, n2)
q0 = gb(m1, 0, 0, 0)
q1 = gb(m1, nx, n1, n2)
qq = Int((q1 - q0) / h)
qx = q - qq
pp = 0
If qx > 50 Then pp = 1
If qx < -50 Then pp = 1
If pp = 1 Then qx = 0
v1 = u1 + v(m1 - 1, nx, n1, qx)
If pp = 1 Then v1 = -999
If v1 > vs Then nxs = nx
If v1 > vs Then qxs = qx
If v1 > vs Then vs = v1
Next
v(m1, n1, n2, q) = vs
goton(m1, n1, n2, q) = nxs
gotoq(m1, n1, n2, q) = qxs
Next
Next
Next
Next
For n1 = -1 To 1
For n2 = -1 To 1
For q = -50 To 50
u1 = endu(n1, n2)
q0 = endb(0, 0)
q1 = endb(n1, n2)
qq = Int((q1 - q0) / h)
qx = q - qq
pp = 0
If qx > 50 Then pp = 1
If qx < -50 Then pp = 1
If pp = 1 Then qx = 0
v1 = u1 + v(9, n1, n2, qx)
If pp = 1 Then v1 = -999
endv(n1, n2, q) = v1
endq(n1, n2, q) = qx
Next
Next
Next
maxv = -999
For n1 = -1 To 1
For n2 = -1 To 1
For q = 0 To 50
If endv(n1, n2, q) > maxv Then nx1 = n1
If endv(n1, n2, q) > maxv Then nx2 = n2
If endv(n1, n2, q) > maxv Then qx = q
If endv(n1, n2, q) > maxv Then maxv = endv(n1, n2, q)
Next
Next
Next
op(9) = nx1
op(10) = nx2
oq(10) = qx
oq(9) = endq(op(9), op(10), oq(10))
For j = 1 To 9
m1 = 9 - j
op(m1) = goton(m1 + 1, op(m1 + 1), op(m1 + 2), oq(m1 + 1))
oq(m1) = gotoq(m1 + 1, op(m1 + 1), op(m1 + 2), oq(m1 + 1))
Next
For m1 = 0 To 10
For m2 = 0 To 10
cs(m1, m2) = c(m1, m2, op(m1))
Next
Next
e = 0
For m1 = 0 To 9
e = e + op(m1) ^ 2
Next
If e < 2 Then h = h / 2
If h < 10 ^ (-5) Then t1 = 1000
Debug.Print t1, e, maxv
t1 = t1 + 1
Loop
h = 0.001
t2 = 0
Do Until t2 > 10
For s1 = 1 To 10
For s2 = 1 To 10
mgr(s1, s2) = mprefer(s1, s2, th1, th2, cs, y1, y2)
fgr(s1, s2) = fprefer(s1, s2, th1, th2, cs, y1, y2)
Next
Next
For m2 = 0 To 10
n = 0
For s1 = 1 To 10
For s2 = 1 To 10
If fgr(s1, s2) = m2 Then n = n + 1
If fgr(s1, s2) = m2 Then mgroup(m2, n) = s1
If fgr(s1, s2) = m2 Then fgroup(m2, n) = s2
Next
Next
ngroup(m2) = n
Next
For m1 = 0 To 10
For m2 = 0 To 10
For n = -1 To 1
c(m1, m2, n) = cs(m1, m2) + n * h
Next
Next
Next
For m2 = 1 To 9
For n1 = -1 To 1
For n2 = -1 To 1
For n3 = -1 To 1
nu = ngroup(m2)
us = 0
bs = 0
For s = 1 To nu
s1 = mgroup(m2, s)
s2 = fgroup(m2, s)
i = myselect(s1, s2, th1, th2, m2, n1, n2, n3, c, y1, y2)
j = fyselect(s1, s2, th1, th2, m2, n1, n2, n3, c, y1, y2)
nx = n2
If j = m2 - 1 Then nx = n1
If j = m2 + 1 Then nx = n3
cp1 = c(i, j, nx)
yp1 = y1(i)
yp2 = y2(j)
u1 = u(s1, s2, th1, th2, cp1, yp1, yp2)
us = us + u1
bs = bs + yp1 + yp2 - cp1
Next
gu(m2, n1, n2, n3) = us
gb(m2, n1, n2, n3) = bs
Next
Next
Next
Next
For n1 = -1 To 1
For n2 = -1 To 1
nu = ngroup(0)
us = 0
bs = 0
For s = 1 To nu
s1 = mgroup(0, s)
s2 = fgroup(0, s)
i = myfselect(s1, s2, th1, th2, n1, n2, c, y1, y2)
j = fyfselect(s1, s2, th1, th2, n1, n2, c, y1, y2)
nx = n1
If j = 1 Then nx = n2
cp1 = c(i, j, nx)
yp1 = y1(i)
yp2 = y2(j)
u1 = u(s1, s2, th1, th2, cp1, yp1, yp2)
us = us + u1
bs = bs + yp1 + yp2 - cp1
Next
fastu(n1, n2) = us
fastb(n1, n2) = bs
Next
Next
For n1 = -1 To 1
For n2 = -1 To 1
nu = ngroup(10)
us = 0
bs = 0
For s = 1 To nu
s1 = mgroup(10, s)
s2 = fgroup(10, s)
i = myeselect(s1, s2, th1, th2, n1, n2, c, y1, y2)
j = fyeselect(s1, s2, th1, th2, n1, n2, c, y1, y2)
nx = n2
If j = 9 Then nx = n1
cp1 = c(i, j, nx)
yp1 = y1(i)
yp2 = y2(j)
u1 = u(s1, s2, th1, th2, cp1, yp1, yp2)
us = us + u1
bs = bs + yp1 + yp2 - cp1
Next
endu(n1, n2) = us
endb(n1, n2) = bs
Next
Next
For n1 = -1 To 1
For n2 = -1 To 1
For q = -50 To 50
v(0, n1, n2, q) = -999
Next
Next
Next
For n1 = -1 To 1
For n2 = -1 To 1
q0 = fastb(0, 0)
q1 = fastb(n1, n2)
q = Int((q1 - q0) / h)
pp = 0
If q > 50 Then pp = 1
If q < -50 Then pp = 1
If pp = 1 Then q = 0
v(0, n1, n2, q) = fastu(n1, n2)
If pp = 1 Then v(0, n1, n2, q) = -999
Next
Next
For m2 = 1 To 9
For n1 = -1 To 1
For n2 = -1 To 1
For q = -50 To 50
vs = -999
For nx = -1 To 1
u1 = gu(m2, nx, n1, n2)
q0 = gb(m2, 0, 0, 0)
q1 = gb(m2, nx, n1, n2)
qq = Int((q1 - q0) / h)
qx = q - qq
pp = 0
If qx > 50 Then pp = 1
If qx < -50 Then pp = 1
If pp = 1 Then qx = 0
v1 = u1 + v(m2 - 1, nx, n1, qx)
If pp = 1 Then v1 = -999
If v1 > vs Then nxs = nx
If v1 > vs Then qxs = qx
If v1 > vs Then vs = v1
Next
v(m2, n1, n2, q) = vs
goton(m2, n1, n2, q) = nxs
gotoq(m2, n1, n2, q) = qxs
Next
Next
Next
Next
For n1 = -1 To 1
For n2 = -1 To 1
For q = -50 To 50
u1 = endu(n1, n2)
q0 = endb(0, 0)
q1 = endb(n1, n2)
qq = Int((q1 - q0) / h)
qx = q - qq
pp = 0
If qx > 50 Then pp = 1
If qx < -50 Then pp = 1
If pp = 1 Then qx = 0
v1 = u1 + v(9, n1, n2, qx)
If pp = 1 Then v1 = -999
endv(n1, n2, q) = v1
endq(n1, n2, q) = qx
Next
Next
Next
maxv = -999
For n1 = -1 To 1
For n2 = -1 To 1
For q = 0 To 50
If endv(n1, n2, q) > maxv Then nx1 = n1
If endv(n1, n2, q) > maxv Then nx2 = n2
If endv(n1, n2, q) > maxv Then qx = q
If endv(n1, n2, q) > maxv Then maxv = endv(n1, n2, q)
Next
Next
Next
op(9) = nx1
op(10) = nx2
oq(10) = qx
oq(9) = endq(op(9), op(10), oq(10))
For j = 1 To 9
m2 = 9 - j
op(m2) = goton(m2 + 1, op(m2 + 1), op(m2 + 2), oq(m2 + 1))
oq(m2) = gotoq(m2 + 1, op(m2 + 1), op(m2 + 2), oq(m2 + 1))
Next
For m1 = 0 To 10
For m2 = 0 To 10
cs(m1, m2) = c(m1, m2, op(m2))
Next
Next
e = 0
For m2 = 0 To 9
e = e + op(m2) ^ 2
Next
If e < 3 Then h = h / 2
If h < 10 ^ (-5) Then t2 = 1000
Debug.Print t2, e, maxv
t2 = t2 + 1
Loop
t3 = t3 + 1
Loop
End Sub