ｌｌ３ - プログラム倉庫

Function seekc1(y) As Single
Dim c1 As Single
c1 = 0
For n = 1 To 20
c1 = c1 + y(n)
Next
seekc1 = 0.4 + 0.01 * c1
End Function
Function seekl1(y) As Single
Dim l1 As Single
l1 = 0
For n = 21 To 40
l1 = l1 + y(n)
Next
seekl1 = 0.4 + 0.01 * l1
End Function
Function seekc2(y) As Single
Dim c1 As Single
c1 = 0
For n = 41 To 60
c1 = c1 + y(n)
Next
seekc2 = 0.4 + 0.01 * c1
End Function
Function seekl2(y) As Single
Dim l1 As Single
l1 = 0
For n = 61 To 80
l1 = l1 + y(n)
Next
seekl2 = 0.4 + 0.01 * l1
End Function
Function seekx(n As Single, x, b) As Single
Dim nx As Single
Dim e As Single
Dim h As Single
Dim sx As Single
Dim xx As Single
X1 = 0
e = 10 ^ (-5)
xx = 0
h = 0
For m = 0 To 81
If x(m, n) > e Then h = h + 1
Next
For m = 0 To 81
If x(m, n) > e Then sx = b(m) / x(m, n)
Next
If h = 1 Then xx = sx
seekx = xx
End Function
Function seekpibot(n As Single, x, b) As Single
Dim y(1 To 81) As Single
Dim m As Single
Dim e As Single
Dim p As Single
Dim miny As Single
Dim mx As Single
e = 10 ^ (-5)
For m = 1 To 81
p = 0
under = x(m, n)
If x(m, n) < e Then p = 1
If p = 1 Then under = 1
y(m) = b(m) / under
If p = 1 Then y(m) = 999
Next
miny = 900
mx = 999
For m = 1 To 81
If y(m) < miny Then mx = m
If y(m) < miny Then miny = y(m)
Next
seekpibot = mx
End Function
Function seekn(x) As Single
Dim n As Single
Dim nx As Single
Dim e As Single
e = 10 ^ (-5)
nx = 999
For n = 1 To 161
If x(0, n) > e Then nx = n
Next
seekn = nx
End Function

Private Sub Command1_Click()
Dim x(0 To 81, 1 To 161) As Single
Dim b(0 To 81) As Single
Dim y(1 To 80) As Single
Dim n As Single
Dim n1 As Single
Dim n2 As Single
Dim m As Single
Dim opx As Single
Dim th1 As Single
Dim th2 As Single
th1 = 1
th2 = 1.1
For n = 1 To 20
n1 = 0.39 + 0.01 * n
n2 = n1 + 0.01
x(0, n) = Log(n2) - Log(n1)
x(0, n + 20) = Log(n2) - Log(n1)
x(0, n + 40) = Log(n2) - Log(n1)
x(0, n + 60) = Log(n2) - Log(n1)
Next
b(0) = 0
For m = 1 To 80
x(m, m) = 1
x(m, m + 80) = 1
Next
For m = 1 To 80
b(m) = 1
Next
For n = 1 To 20
x(81, n) = 1
Next
For n = 21 To 40
x(81, n) = th1
Next
For n = 41 To 60
x(81, n) = 1
Next
For n = 61 To 80
x(81, n) = th2
Next
x(81, 81) = 1
b(81) = th1 * 60 + th2 * 60 - 80
n = seekn(x)
opx = seekn(x)
t = 0
Do Until t > 1000
pibot = seekpibot(opx, x, b)
For m = 0 To 81
z = x(m, opx) / x(pibot, opx)
If m = pibot Then z = 0
For n = 1 To 161
x(m, n) = x(m, n) - z * x(pibot, n)
Next
b(m) = b(m) - z * b(pibot)
Next
opx = seekn(x)
If opx > 900 Then t = 10000
Debug.Print t, b(0)
t = t + 1
Loop
For n = 1 To 80
y(n) = seekx(n, x, b)
Next
Debug.Print seekc1(y)
Debug.Print seekl1(y)
Debug.Print seekc2(y)
Debug.Print seekl2(y)
End Sub