?? nihe.txt
字號:
Function StadMain(FileName As Variant)
Dim i As Integer, j As Integer
Dim n As Integer, r As Integer
Dim d As Boolean, k As Boolean
Dim x(51) As Single, y(51) As Single
Dim d1 As Single, d2 As Single
Dim a(51) As Single, c(51) As Single, u(1024) As Single, g(51) As Single, m(51) As Single, s(1024) As Single
Dim min As Single, max As Single, Step As Single
Dim str As Variant
''''''''''''''''''''''''''''''''''''''''''無敵分隔線 ''''''''''''''''''''''''''''''''''''''''''''''
Open FileName For Input As #1
Do While Not EOF(1)
Line Input #1, str
If Len(str) > 10 And Mid(str, 1, 1) = "-" Then
For i = 1 To Len(str)
If Mid(str, i, 1) = "-" Then
j = j + 1
End If
Next i
If j = Len(str) Then
d = True
j = 0
End If
End If
Loop
Close #1
If d = True Then
Open FileName For Input As #1
Do While Not EOF(1)
Line Input #1, str
If str <> "" And k = True Then
x(n) = Left(str, InStr(str, " "))
str = Trim(Right(str, Len(str) - InStr(str, " ")))
y(n) = str
n = n + 1
End If
If Len(str) > 10 And Mid(str, 1, 1) = "-" Then
For i = 1 To Len(str)
If Mid(str, i, 1) = "-" Then
j = j + 1
End If
Next i
If j = Len(str) Then
k = True
End If
End If
Loop
Close #1
Else
Open FileName For Input As #1
Do While Not EOF(1)
Line Input #1, str
If str <> "" Then
If InStr(str, " ") > 0 Then
x(n) = Left(str, InStr(str, " "))
str = Trim(Right(str, Len(str) - InStr(str, " ")))
y(n) = str
n = n + 1
Else
x(n) = Left(str, InStr(str, Chr(9)))
str = Trim(Right(str, Len(str) - InStr(str, Chr(9))))
y(n) = str
n = n + 1
End If
End If
Loop
Close #1
End If
r = 1023
n = n - 1
d1 = 0
d2 = 0
min = x(0)
max = x(n)
Step = Format((max - min) / 1024, "0.00000000")
For j = 1 To r
u(j) = min + Step * j
Next j
Call spl(n, r, d1, d2, x, y, a, c, u, g, m, s)
If Form4.Text2.Text <> "" Then
Open Form4.Text2.Text For Output As 1
Close #1
Open Form4.Text2.Text For Append As 1
For i = 1 To 1023
Print #1, Format(u(i), "0.00000000") & " " & Format(s(i), "0.00000000")
Next i
Close #1
End If
End Function
Function spl(n As Integer, r As Integer, d1 As Single, d2 As Single, x() As Single, y() As Single, a() As Single, c() As Single, u() As Single, g() As Single, m() As Single, s() As Single)
Dim i As Integer, k As Integer
Dim p1(1024) As Single, p2(1024) As Single, p3(1024) As Single, p4(1024) As Single, h(50) As Single
For k = 0 To n - 1
h(k) = x(k + 1) - x(k)
Next k
For k = 1 To n - 1
a(k) = h(k) / (h(k) + h(k - 1))
c(k) = 1 - a(k)
g(k) = 3 * (c(k) * (y(k + 1) - y(k)) / h(k) + a(k) * (y(k) - y(k - 1)) / h(k - 1))
Next k
c(0) = 1
a(n) = 1
g(0) = 3 * (y(1) - y(0)) / h(0) - d1 * h(0) / 2
g(n) = 3 * (y(n) - y(n - 1)) / h(n - 1) + d2 * h(n - 1) / 2
Call zgf(a, c, g, m, n)
For i = 0 To r
k = 1
Do While (1)
If k > n Then
GoTo L1
Else
If u(i) <= x(k - 1) Then
GoTo L1
Else
k = k + 1
End If
End If
Loop
L1:
k = k - 2
If k >= 0 Then
p1(i) = ((h(k) + 2 * (u(i) - x(k))) * (u(i) - x(k + 1)) * (u(i) - x(k + 1)) * y(k)) / h(k) / h(k) / h(k)
p2(i) = ((h(k) - 2 * (u(i) - x(k + 1))) * (u(i) - x(k)) * (u(i) - x(k)) * y(k + 1)) / h(k) / h(k) / h(k)
p3(i) = ((u(i) - x(k)) * (u(i) - x(k + 1)) * (u(i) - x(k + 1)) * m(k)) / h(k) / h(k)
p4(i) = ((u(i) - x(k + 1)) * (u(i) - x(k)) * (u(i) - x(k)) * m(k + 1)) / h(k) / h(k)
s(i) = p1(i) + p2(i) + p3(i) + p4(i)
End If
Next i
End Function
Function zgf(a() As Single, c() As Single, g() As Single, m() As Single, n As Integer)
Dim i As Integer
Dim b(51) As Single
c(0) = c(0) / 2
g(0) = g(0) / 2
For i = 1 To n - 1
b(i) = 2 - a(i) * c(i - 1)
c(i) = c(i) / b(i)
g(i) = (g(i) - a(i) * g(i - 1)) / b(i)
Next i
b(n) = 2 - a(n) * c(n - 1)
m(n) = (g(n) - a(n) * g(n - 1)) / b(n)
For i = n - 1 To 0 Step -1
m(i) = g(i) - c(i) * m(i + 1)
Next i
End Function
?? 快捷鍵說明
復制代碼
Ctrl + C
搜索代碼
Ctrl + F
全屏模式
F11
切換主題
Ctrl + Shift + D
顯示快捷鍵
?
增大字號
Ctrl + =
減小字號
Ctrl + -