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 41
If x(m, n) > e Then h = h + 1
Next
For m = 0 To 41
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 41) 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 41
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 41
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 81
If x(0, n) > e Then nx = n
Next
seekn = nx
End Function
Private Sub Command1_Click()
Dim x(0 To 41, 1 To 81) As Single
Dim b(0 To 41) As Single
Dim c(0 To 21) As Single
Dim le(0 To 21) As Single
Dim n As Single
Dim n1 As Single
Dim n2 As Single
Dim m As Single
Dim opx As Single
Dim th As Single
Dim d1 As Single
Dim d2 As Single
Dim dd As Single
th = 1
For n = 0 To 21
c(n) = 0.4 + 0.01 * n
Next
For n = 0 To 21
le(n) = 1 - c(21 - n) / th
Next
For n = 1 To 20
x(0, n) = Log(c(n + 1)) - Log(c(n))
Next
For n = 21 To 40
x(0, n) = Log(le(n - 20)) - Log(le(n - 21))
Next
b(0) = 0
For m = 1 To 40
x(m, m) = 1
x(m, m + 40) = 1
Next
For m = 1 To 40
b(m) = 1
Next
For n = 1 To 40
x(41, n) = 1
Next
x(41, 81) = 1
b(41) = 20
n = seekn(x)
Debug.Print seekpibot(n, x, b)
opx = seekn(x)
t = 0
Do Until t > 99
pibot = seekpibot(opx, x, b)
For m = 0 To 41
z = x(m, opx) / x(pibot, opx)
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
opx = seekn(x)
If opx > 900 Then t = 100
Debug.Print t, b(0)
t = t + 1
Loop
For n = 1 To 81
Debug.Print n, seekx(n, x, b)
Next
End Sub
最終更新:2009年08月02日 13:00