lp01 01 01 - プログラム倉庫

Function seekpibot(n As Single, x, b) As Single
Dim y(1 To 3) 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 3
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 3
If y(m) < miny Then mx = m
If y(m) < miny Then miny = y(m)
Next
seekpibot = mx
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 3
If x(m, n) > e Then h = h + 1
Next
For m = 0 To 3
If x(m, n) > e Then sx = b(m) / x(m, n)
Next
If h = 1 Then xx = sx
seekx = xx
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 5
If x(0, n) > e Then nx = n
Next
seekn = nx
End Function

Private Sub Command1_Click()
Dim x(0 To 3, 1 To 5) As Single
Dim b(0 To 3) As Single
Dim m As Single
Dim n As Single
Dim pibot As Single
Dim opx As Single
Dim z As Single
Dim t As Single
x(0, 1) = 3
x(0, 2) = 2
x(1, 1) = 3
x(1, 2) = 1
x(2, 1) = 2.5
x(2, 2) = 2
x(3, 1) = 1
x(3, 2) = 2
x(1, 3) = 1
x(2, 4) = 1
x(3, 5) = 1
b(1) = 9
b(2) = 12.5
b(3) = 8
opx = seekn(x)
t = 0
Do Until t > 99
pibot = seekpibot(opx, x, b)
For m = 0 To 3
z = x(m, opx) / x(pibot, opx)
If m = pibot Then z = 0
For n = 1 To 5
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 = 100
Debug.Print t, b(0)
t = t + 1
Loop
For n = 1 To 4
Debug.Print n, seekx(n, x, b)
Next
End Sub