一维扩散方程.frm

一维

  colorcode = 15 * Rnd
'每个时间间隔"数值解"数据画连成一条线
   For i = 0 To nx - 1  '将结果画窗体中
      Line (i * dx, point(i))-((i + 1) * dx, point(i + 1)), QBColor(colorcode)
   Next i

Else
   DrawWidth = 4 '线宽度

   colorcode = 15 * Rnd
   '每个时间间隔"精确解"数据画连成一条线
   For i = 0 To nx  '将结果画窗体中
    PSet (i * dx, point(i)), QBColor(colorcode)
Next i


End If
End Sub
Sub TRIDAG(A(), B(), C(), R(), U(), N)   '追赶法子程序,求解矩阵
    ReDim GAM(N)
    If B(1) = 0# Then Exit Sub
    BET = B(1)
    U(1) = R(1) / BET
    For j = 2 To N
        GAM(j) = C(j - 1) / BET
        BET = B(j) - A(j) * GAM(j)
        If BET = 0# Then Exit Sub
        U(j) = (R(j) - A(j) * U(j - 1)) / BET
    Next j
    For j = N - 1 To 1 Step -1
        U(j) = U(j) - GAM(j + 1) * U(j + 1)
    Next j
End Sub

'显示和保存数据结果子过程
Sub datashow(point() As Single, nx As Integer, interval_x As Single, filename As String, judge As Integer)
Dim i As Integer, j As Integer, k  As Integer

If judge = 0 Then
Open App.Path + filename For Output As #1

For i = nx To 0 Step -1
Print #1, "x="; Format$(i * interval_x, "#0.##0"),
Print #1, Format$(point(i), "#0.##0")

Next i

Print #1,

Close #1
Text1.Text = App.Path + filename   '显示文件保存路径
RichTextBox1.filename = App.Path + filename '在文本框中显示"数值解"数据
Else
Open App.Path + filename For Output As #1

For i = nx To 0 Step -1
Print #1, "x="; Format$(i * interval_x, "#0.##0"),
Print #1, Format$(point(i), "#0.##0")

Next i

Print #1,

Close #1
Text1.Text = App.Path + filename   '显示文件保存路径
RichTextBox2.filename = App.Path + filename '在文本框中显示"精确解"数据
End If
End Sub
Private Sub Command_Click()
'计算主程序
Dim total_x As Single, interval_x As Single, total_t As Single, interval_t As Single, aB As Single
'total_t是任意时间
'total_x是x的上下界
'interval_t是△t
'interval_x是△x。
Dim nx As Integer, nt As Integer, i As Integer, j As Integer
Dim judge As Integer
Dim filename As String

Dim check As Single '定义检验是否收敛变量
total_x = 1
total_t = Val(Combot.Text)
interval_x = Val(Combodx.Text)
interval_t = Val(Combodt.Text)   '将在文本框输入的参数赋值给相应的量
Dim A(), B(), C(), R(), U()
'A,B,C数组分别存方程左端放矩阵的向量，R数组存放方程右端向量，U存放计算结果
Dim point() As Single, m   'point存放离散点的值,m是系数
Dim boundary As Single '定义边界值变量
boundary = 100   '给边界变量赋值
aB = Val(Combob.Text)
k = 1
If Combodx.Text = "" Or Combodt.Text = "" Or Combot.Text = "" Then
i = MsgBox("未输入参数", vbExclamation Or vbOKCancel Or vbDefaultButton1, _
"参数输入")
Exit Sub
End If
m = aB * interval_t / (2 * interval_x ^ 2)
nx = CInt(total_x / interval_x)
nt = Fix(total_t / interval_t)
If (OptionXF.Value = True) Then
check = (interval_x ^ 2 / 2) / aB
If interval_t > check Then
i = MsgBox("不收敛B*dt/dx^2>1/2", vbExclamation Or vbOKCancel Or vbDefaultButton1, _
"重新输入")
Exit Sub
End If
End If

ReDim point(nx) As Single
ReDim s(nx) As Single
ReDim A(1 To nx - 1), B(1 To nx - 1), C(1 To nx - 1), R(1 To nx - 1), U(1 To nx - 1)


For i = 0 To nx         '输入初始值

point(i) = 0
Next i

point(0) = 100
point(nx) = 100



If (OptionXF.Value = True) Then
'formX.Cls

filename = "\FTCS显格式数值解.txt"
For j = 0 To nt - 1

For i = nx - 1 To 1 Step -1 '利用FTCS格式计算结果

point(i) = point(i) + 2 * m * (point(i + 1) - 2 * point(i) - point(i - 1))

Next i

Next j

ElseIf (OptionCN.Value = True) Then
filename = "\Crank-Nicalson格式.txt"


For j = 0 To nt - 1
R(1) = m * (point(2) - 2 * point(1) + point(0)) + point(1) + m * boundary
R(nx - 1) = m * (point(nx) - 2 * point(nx - 1) + point(nx - 2)) + point(nx - 1) + m * boundary
For i = 2 To nx - 2        '给方程组右端向量R赋值
R(i) = m * (point(i + 1) - 2 * point(i) + point(i - 1)) + point(i)
Next i

For i = 2 To nx - 1
A(i) = -m          '给矩阵的第一条斜对角赋值
Next i
For i = 1 To nx - 1
B(i) = 1 + 2 * m     '给矩阵的对角线赋值
Next i
For i = 1 To nx - 2
C(i) = -m               '给矩阵的第三条斜对角赋值
Next i
Call TRIDAG(A(), B(), C(), R(), U(), (nx - 1))   '调用追赶法子过程计算下一时刻的温度值
point(0) = 100: point(nx) = 100     '在t>0时边界值变成100，即钢棒两端的温度恒为100
For i = 1 To nx - 1
point(i) = U(i)   '将计算的结果赋给point数组
Next i

Next j
              '关闭文件
judge = 0                 '设置绘图标志





ElseIf (OptionYF.Value = True) Then
'formX.Cls
filename = "\.FTCS隐格式.txt"

For j = 0 To nt - 1
R(1) = point(1) + 2 * m * boundary
R(nx - 1) = point(nx - 1) + 2 * m * boundary
For i = 2 To nx - 2        '给方程组右端向量R赋值
R(i) = point(i)
Next i

For i = 2 To nx - 1
A(i) = -2 * m        '给矩阵的第一条斜对角赋值
Next i
For i = 1 To nx - 1
B(i) = 1 + 4 * m    '给矩阵的对角线赋值
Next i
For i = 1 To nx - 2
C(i) = -2 * m             '给矩阵的第三条斜对角赋值
Next i
Call TRIDAG(A(), B(), C(), R(), U(), (nx - 1))   '调用追赶法子过程计算下一时刻的温度值
point(0) = 100: point(nx) = 100     '在t>0时边界值变成100，即钢棒两端的温度恒为100
For i = 1 To nx - 1
point(i) = U(i)   '将计算的结果赋给point数组
Next i

Next j
              '关闭文件
judge = 0                 '设置绘图标志




Else
i = MsgBox("请选择格式", vbExclamation Or vbOKCancel Or vbDefaultButton1, _
"格式选择")  '若用户未选格式提示用户选择
Exit Sub
End If
judge = 0
Call MathPlot(point(), nx, interval_x, judge)   '引用画图子过程
Call datashow(point(), nx, interval_x, filename, judge)  '引用打印显示子过程
End Sub
Private Sub Command1_Click()
formY.Hide
Form2.Show
End Sub

Private Sub Command2_Click()
formY.Cls
End Sub

Private Sub Command3_Click()

Const pi = 3.1415926

Dim A As Double, Q As Double, m As Integer, i As Integer, j As Integer, total_t As Single, B As Single, x As Single, nx As Integer, nt As Integer
'A是精确解的系数，m是累加项个数，x是自变量
Dim boundary As Single   '定义边界值变量
Dim point() As Single, dx As Single, dt As Single   '将精确解的结果放入数组中
Dim judge As Integer   '用作画图判断
Dim filename As String
total_x = 1   '钢棒的总长是1
total_t = Val(Combot.Text)
dx = Val(Combodx.Text)
dt = Val(Combodt.Text)
B = Val(Combob.Text)
If Combodx.Text = "" Or Combodt.Text = "" Or Combot.Text = "" Then
i = MsgBox("未输入参数", vbExclamation Or vbOKCancel Or vbDefaultButton1, _
"参数输入")  '若用户未填入参数提示用户
Exit Sub
End If
'Text_alpha.Text = Format$(alpha, "0.#0######")
filename = "\FTCS格式精确解.txt"
nx = Fix(total_x / dx)
nt = Fix(total_t / dt)
boundary = 100   '给边界变量赋值
ReDim point(nx)


For i = 0 To nx
x = i * dx
Q = 100
For m = 1 To 5000
A = (-400 * Sin(((2 * m - 1) * pi) * x) / ((2 * m - 1) * pi))
Q = Q + A * Exp(-((2 * m - 1) * pi) ^ 2 * B * total_t)
Next m
point(i) = Q

Next i

judge = 1
Call MathPlot(point(), nx, dx, judge)
Call datashow(point(), nx, dx, filename, judge)  '引用打印显示子过程
End Sub