lecpxgaussjordenmainmodule.bas
来自「科学与工程数值计算算法(Visual Basic版) 附赠的光盘包含了本书中全」· BAS 代码 · 共 85 行
BAS
85 行
Attribute VB_Name = "MainModule"
Sub Main()
Dim dblAR(4, 4) As Double, dblAI(4, 4) As Double
Dim dblBR(4, 2) As Double, dblBI(4, 2) As Double
Dim sCpx11 As String, sCpx12 As String, sCpx21 As String, sCpx22 As String
Dim sCpx31 As String, sCpx32 As String, sCpx41 As String, sCpx42 As String
'系数矩阵
dblAR(1, 1) = 1
dblAR(1, 2) = 3
dblAR(1, 3) = 2
dblAR(1, 4) = 13
dblAR(2, 1) = 7
dblAR(2, 2) = 2
dblAR(2, 3) = 1
dblAR(2, 4) = -2
dblAR(3, 1) = 9
dblAR(3, 2) = 15
dblAR(3, 3) = 3
dblAR(3, 4) = -2
dblAR(4, 1) = -2
dblAR(4, 2) = -2
dblAR(4, 3) = 11
dblAR(4, 4) = 5
dblAI(1, 1) = 3
dblAI(1, 2) = -2
dblAI(1, 3) = 1
dblAI(1, 4) = 6
dblAI(2, 1) = -2
dblAI(2, 2) = 7
dblAI(2, 3) = 5
dblAI(2, 4) = 8
dblAI(3, 1) = 9
dblAI(3, 2) = -3
dblAI(3, 3) = 15
dblAI(3, 4) = 1
dblAI(4, 1) = -2
dblAI(4, 2) = -2
dblAI(4, 3) = 7
dblAI(4, 4) = 6
'常数向量
dblBR(1, 1) = 2
dblBR(1, 2) = -2
dblBR(2, 1) = 7
dblBR(2, 2) = 3
dblBR(3, 1) = 3
dblBR(3, 2) = 2
dblBR(4, 1) = 9
dblBR(4, 2) = 1
dblBI(1, 1) = 1
dblBI(1, 2) = 3
dblBI(2, 1) = 2
dblBI(2, 2) = 7
dblBI(3, 1) = -2
dblBI(3, 2) = 9
dblBI(4, 1) = 3
dblBI(4, 2) = 2
'求解
If LECpxGaussJordan(4, 2, dblAR, dblAI, dblBR, dblBI) = True Then
sCpx11 = Round(dblBR(1, 1), 5) & " + " & Round(dblBI(1, 1), 5) & "j"
sCpx12 = Round(dblBR(1, 2), 5) & " + " & Round(dblBI(1, 2), 5) & "j"
sCpx21 = Round(dblBR(2, 1), 5) & " + " & Round(dblBI(2, 1), 5) & "j"
sCpx22 = Round(dblBR(2, 2), 5) & " + " & Round(dblBI(2, 2), 5) & "j"
sCpx31 = Round(dblBR(3, 1), 5) & " + " & Round(dblBI(3, 1), 5) & "j"
sCpx32 = Round(dblBR(3, 2), 5) & " + " & Round(dblBI(3, 2), 5) & "j"
sCpx41 = Round(dblBR(4, 1), 5) & " + " & Round(dblBI(4, 1), 5) & "j"
sCpx42 = Round(dblBR(4, 2), 5) & " + " & Round(dblBI(4, 2), 5) & "j"
MsgBox "求解成功!" & Chr$(13) & Chr$(13) & _
"x11 = " & sCpx11 & Chr$(13) & _
"x21 = " & sCpx21 & Chr$(13) & _
"x31 = " & sCpx31 & Chr$(13) & _
"x41 = " & sCpx41 & Chr$(13) & Chr$(13) & _
" x12 = " & sCpx12 & Chr$(13) & _
" x22 = " & sCpx22 & Chr$(13) & _
" x32 = " & sCpx32 & Chr$(13) & _
" x42 = " & sCpx42
Else
MsgBox "求解失败!"
End If
End Sub
⌨️ 快捷键说明
复制代码Ctrl + C
搜索代码Ctrl + F
全屏模式F11
增大字号Ctrl + =
减小字号Ctrl + -
显示快捷键?