[讨论]高斯消去法---这是用VB编的

god

Private Sub gauss_Click() '高斯消去法
Dim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single
i = 1: j = 1
n = Val(InputBox("请输入矩阵的阶数(即：方程组未知数个数)N", "方程的未知数个数n", 3))
1 U1 D. U3 q; S9 u, }ReDim Preserve a(1 To n, 1 To n + 1)
ReDim Preserve l(1 To n, 1 To n + 1)
9 ^  A- Z  j6 ?4 w) F& k6 e. l* yDim k As Integer, D As Single, m As Single, x() As Single, t As Single, a2() As Single
8 f8 `8 K8 n* cReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()
For i = 1 To n
For j = 1 To n
a2(i, j) = a(i, j)
3 J6 v+ e+ v- ]$ DNext
Next '将a()的值全部赋给a2()
m = 0
D = 1
ReDim x(1 To n)
" y; a7 \. z5 Z$ z* }% c7 CPrint "--------------------------------"
( c5 d9 O0 N7 J, I& d( F0 _Print "您输入的增广矩阵如下："
. w: [7 |" ]( g* ?: sFor i = 1 To n
s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
For j = 1 To n
a(i, j) = Val(Left(s, InStr(s, " ")))
) h7 X, \2 ~, i) gs = Trim(Right(s, (Len(s) - InStr(s, " "))))
Print a(i, j);
& v4 h7 f. p5 L1 M6 g3 [Next
a(i, n + 1) = Val(s)
" z) q' {1 C) j. h( HPrint a(i, n + 1);
, b- u8 |% a8 s/ l8 B! }Print
Next

For k = 1 To n - 1 '开始消元
2 u# f- c. w# Y  L. f* zIf a(k, k) = 0 Then
MsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
Exit Sub
Else
For i = k + 1 To n
l(i, k) = a(i, k) / a(k, k)
& R/ B4 M/ T# y0 xFor j = k + 1 To n + 1
a(i, j) = a(i, j) - l(i, k) * a(k, j)
2 \9 q+ r5 p" _2 r: @3 ENext
Next
; q9 t% h6 S6 u$ ?( i$ ]' o+ eD = D * a(k, k)
End If
Next k '消元结束
If a(n, n) = 0 Then
MsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
Exit Sub
Else
D = D * a(n, n)
6 j, }! H9 r! DEnd If
Print "--------------------------------"
Print "系数行列式的值是："; D
. A* y- N- c0 k$ h6 X; Jx(n) = a(n, n + 1) / a(n, n)
5 _' ]% d: P" T. M2 K  [For k = n - 1 To 1 Step -1 '开始回代
+ _. N, k* L# \4 {8 AFor j = k + 1 To n
: h) I& @  L. y$ M0 ^$ cm = m + a(k, j) * x(j)
Next j
! H) r0 a( `% {1 e2 Qx(k) = (a(k, n + 1) - m) / a(k, k)
m = 0
9 |$ m# z: {$ I3 |$ N5 {4 hNext k '结束回代

Print "--------------------------------"
9 M! i2 r6 Y2 K5 ~% q7 M6 F4 YPrint "方程组的解如下："
* ~, Z& D/ Y0 s3 j7 q  Y2 E. _
For k = 1 To n
Print
Print "X(" & k & ") = " & x(k)
Next k
Print "--------------------------------"
* \! N+ e0 g# [+ ]) lPrint "其中各行Ax-b="
Print
For i = 1 To n
, c# p- I; B+ {7 a' E- ~t = 0
7 d! o- s# G9 N- {. ?& A% K) Q8 ^8 ~For j = 1 To n
t = t + a2(i, j) * x(j)
% ?+ B3 U. O6 f: ?" nNext j
t = t - a2(i, n + 1)
Print Spc(5); "第" & i & "行："; t
Print
Next i

End SubPrivate Sub gauss_Click() '高斯消去法
Dim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single
i = 1: j = 1
n = Val(InputBox("请输入矩阵的阶数(即：方程组未知数个数)N", "方程的未知数个数n", 3))
ReDim Preserve a(1 To n, 1 To n + 1)
ReDim Preserve l(1 To n, 1 To n + 1)
Dim k As Integer, D As Single, m As Single, x() As Single, t As Single, a2() As Single
9 d7 V9 y$ _; X* t6 _1 eReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()
For i = 1 To n
For j = 1 To n
6 ]; w+ W+ O  I# T8 H' i7 sa2(i, j) = a(i, j)
; F) z: X5 W$ y6 |( E, e* hNext
Next '将a()的值全部赋给a2()
, [6 U; H  S7 j9 _m = 0
D = 1
ReDim x(1 To n)
* [! c2 `( ^* b7 |0 @Print "--------------------------------"
: |7 q) |0 ]  Y' |& I1 h, aPrint "您输入的增广矩阵如下："
For i = 1 To n
* |1 F0 M8 K- B+ R6 U# }# V5 ys = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
2 L: N+ |  X& @+ s4 ]0 cFor j = 1 To n
0 U5 A/ {5 D$ ]' |" b# ha(i, j) = Val(Left(s, InStr(s, " ")))
5 ^  ^# w6 {( \( L: xs = Trim(Right(s, (Len(s) - InStr(s, " "))))
Print a(i, j);
2 b( E/ X) G( k3 p' T# y% MNext
a(i, n + 1) = Val(s)
Print a(i, n + 1);
Print
+ j% k( }% V# U9 e& xNext
7 k1 y# U9 F6 D2 e" y
For k = 1 To n - 1 '开始消元
If a(k, k) = 0 Then
' c9 K* q& F+ {$ s; kMsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
Exit Sub
$ g4 A+ E7 }: o% K9 OElse
8 l) ]9 b3 ]6 D% YFor i = k + 1 To n
l(i, k) = a(i, k) / a(k, k)
. c( s3 v( v* u! pFor j = k + 1 To n + 1
a(i, j) = a(i, j) - l(i, k) * a(k, j)
' k) L0 p$ h; K! d) B9 TNext
  U0 d$ d1 S* E1 m) iNext
D = D * a(k, k)
End If
( a& w7 ]0 a/ L6 P# r/ FNext k '消元结束
If a(n, n) = 0 Then
MsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
4 u2 j& c% V" d" {( \Exit Sub
2 Z2 \7 a# K0 V: OElse
D = D * a(n, n)
End If
Print "--------------------------------"
7 h$ n( g0 U. b5 HPrint "系数行列式的值是："; D
* {2 X- G5 `. x& c7 S* ex(n) = a(n, n + 1) / a(n, n)
For k = n - 1 To 1 Step -1 '开始回代
- b' p! G% I# qFor j = k + 1 To n
m = m + a(k, j) * x(j)
0 h9 m3 a- n% P: H+ f, xNext j
x(k) = (a(k, n + 1) - m) / a(k, k)
m = 0
% w) @4 O$ P) ?$ u5 j9 {. ANext k '结束回代

3 d/ D* j- s& f) M7 k6 aPrint "--------------------------------"
Print "方程组的解如下："
0 A% ]6 S5 [0 v8 w7 W- F
* {) M$ o( B4 I, aFor k = 1 To n
5 `9 x; `( l; M7 o5 C6 rPrint
Print "X(" & k & ") = " & x(k)
Next k
; c1 F) {6 ?  i2 {3 o+ vPrint "--------------------------------"
8 _- k- j! O# ZPrint "其中各行Ax-b="
Print
For i = 1 To n
t = 0
8 u8 O8 {9 A: s) i& mFor j = 1 To n
t = t + a2(i, j) * x(j)
% M3 ^4 \4 g  u: ANext j
7 ?, r6 ]) D' m) V, }" j7 A# Yt = t - a2(i, n + 1)
Print Spc(5); "第" & i & "行："; t
Print
Next i
! ^$ X* F; V0 I0 ?
End Sub

ch123en123

下载学习哦

lq12131010

<p>您的程序我没看&nbsp; 但是我用FORTRAN 90 编过 </p><p>唯一注意的是高斯消法是有局限的 </p><p>1计算量大</p><p>2不能克服病态方程问题。</p><p>不知道您注意没有 </p><p>另我有FORTRAN 90&nbsp;的选主元高斯消去法的程序。</p>

zqyzixin

我也想了解了解！！！先顶一个