lp06 - プログラム倉庫

Function seekx(n As Single, x, b) As Single
Dim num As Single
Dim nus As Single
Dim sol As Single
Dim m As Single
num = 0
For m = 1 To 201
If x(m, n) > 0 Then num = num + 1
Next
For m = 1 To 201
If x(m, n) > 0 Then nus = m
Next
sol = 0
If num = 1 Then sol = b(nus) / x(nus, n)
seekx = sol
End Function

Function seekpibot(v As Single, x, b) As Single
Dim under As Single
Dim minc As Single
Dim h As Single
Dim c(1 To 201) As Single
For m = 1 To 201
under = x(m, v)
If under = 0 Then under = -1
c(m) = b(m) / under
If under < 0 Then c(m) = 1000
Next
minc = 999
For m = 1 To 201
h = 0
If c(m) < minc Then h = h + 1
If c(m) > 0 Then h = h + 1
If c(m) = 0 Then h = h + 1
If h = 2 Then op = m
If h = 2 Then minc = c(m)
Next
seekpibot = op
End Function

Function seekv(x) As Single
Dim v1 As Single
Dim s As Single
Dim n As Single
v1 = 999
For s = 1 To 402
n = 403 - s
If x(0, n) > 0 Then v1 = n
Next
seekv = v1
End Function

Private Sub Command1_Click()
Dim x(0 To 201, 1 To 402) As Single
Dim b(0 To 203) As Single
Dim m As Single
Dim n As Single
Dim v As Single
Dim pibot As Single
Dim u(0 To 100) As Single
For n = 1 To 100
u(n) = Log(0.01 * n)
Next
u(0) = -20
For n = 1 To 100
x(0, n) = u(n) - u(n - 1)
x(0, 100 + n) = u(n) - u(n - 1)
Next
For m = 1 To 200
x(m, m) = 1
Next
For n = 1 To 200
x(201, n) = 1
Next
For m = 1 To 201
x(m, 201 + m) = 1
Next
For m = 1 To 200
b(m) = 1
Next
b(201) = 100
v = 1
s1 = 0
Do Until s1 > 10000
pibot = seekpibot(v, x, b)
For m = 0 To 201
z = x(m, v) / x(pibot, v)
If m = pibot Then z = 0
For n = 1 To 402
x(m, n) = x(m, n) - z * x(pibot, n)
Next
b(m) = b(m) - z * b(pibot)
Next
v = seekv(x)
If v > 500 Then s1 = 100000
s1 = s1 + 1
Debug.Print s1, b(0)
Loop
For n = 1 To 201
Debug.Print n, seekx(n, x, b)
Next
End Sub