0410 - プログラム倉庫

Function seekx(n As Single, x, b) As Single
Dim m As Single
Dim opx As Single
Dim h As Single
Dim sx  As Single
sx = 0
h = 0
For m = 1 To 41
If x(m, n) > 10 ^ (-5) Then h = h + 1
If x(m, n) > 10 ^ (-5) Then opx = m
Next
If h = 1 Then sx = b(opx) / x(opx, n)
seekx = sx
End Function


Function seekpibot(target As Single, x, b) As Single
Dim m As Single
Dim under As Single
Dim c(1 To 41) As Single
Dim px As Single
For m = 1 To 41
under = x(m, target)
c(m) = 999
If under > 10 ^ (-5) Then c(m) = b(m) / under
Next
px = 999
minc = 999
For m = 1 To 41
If c(m) < minc Then px = m
If c(m) < minc Then minc = c(m)
Next
seekpibot = px
End Function

Function seektarget(x) As Single
Dim n As Single
Dim tx As Single
tx = 999
For n = 1 To 81
If x(0, n) > 0 Then tx = n
Next
seektarget = tx
End Function

Private Sub Command1_Click()
Dim m As Single
Dim n As Single
Dim x(0 To 41, 1 To 81) As Single
Dim b(0 To 41) As Single
Dim target As Single
Dim pibot As Single
Dim z As Single
Dim theta As Single
theta = 1.2
For n = 1 To 10
x(0, n) = 11 - n
x(0, 10 + n) = 11 - n
x(0, 20 + n) = 11 - n
x(0, 30 + n) = 11 - n
Next
For m = 1 To 40
x(m, m) = 1
Next
For m = 1 To 40
x(m, m + 40) = 1
Next
For n = 1 To 10
x(41, n) = 1
Next
For n = 11 To 20
x(41, n) = 1
Next
For n = 21 To 30
x(41, n) = 1
Next
For n = 31 To 40
x(41, n) = 1.1
Next
x(41, 81) = 1
b(0) = 0
For n = 1 To 40
b(n) = 1
Next
b(41) = 21
target = seektarget(x)
Do Until target > 100
pibot = seekpibot(target, x, b)
For m = 0 To 41
z = x(m, target) / x(pibot, target)
If m = pibot Then z = 0
For n = 1 To 81
x(m, n) = x(m, n) - z * x(pibot, n)
Next
b(m) = b(m) - z * b(pibot)
Next
Debug.Print target, pibot, b(0)
target = seektarget(x)
Loop
For n = 1 To 40
Debug.Print n, seekx(n, x, b)
Next

End Sub