[讨论]高斯消去法---这是用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
8 o3 `4 U' f- Si = 1: j = 1
6 D2 k, |) N( Cn = Val(InputBox("请输入矩阵的阶数(即：方程组未知数个数)N", "方程的未知数个数n", 3))
! y9 ~) D$ x+ U' p& }4 ^" \; gReDim Preserve a(1 To n, 1 To n + 1)
! H% o" w( i7 S( Y  D$ LReDim 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
ReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()
For i = 1 To n
For j = 1 To n
. l; {% A8 B3 N- u' Ja2(i, j) = a(i, j)
/ j: ]" t: a0 C# g' t) W% UNext
9 k' e' ^# W( {9 g% TNext '将a()的值全部赋给a2()
# I; u6 K% G, M( I; v: N' cm = 0
. E( [9 j, A/ Y+ z: f. xD = 1
ReDim x(1 To n)
Print "--------------------------------"
Print "您输入的增广矩阵如下："
For i = 1 To n
7 \+ {+ [7 B( Z/ [* gs = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
1 {( U9 l% x% V# SFor j = 1 To n
5 `( i4 x; U* Y9 S9 K! N3 Ba(i, j) = Val(Left(s, InStr(s, " ")))
s = Trim(Right(s, (Len(s) - InStr(s, " "))))
* ^/ Y2 C3 D2 `5 {" J- t* TPrint a(i, j);
0 \  l1 M7 ?6 f1 G$ K7 T- KNext
a(i, n + 1) = Val(s)
; B- U& g5 @  _+ a4 kPrint a(i, n + 1);
( H, @/ w7 a% E2 n( F* A# \Print
  h, w: A/ F" W) _Next

For k = 1 To n - 1 '开始消元
If a(k, k) = 0 Then
: n7 q- O8 Y& x+ T! Q) UMsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
Exit Sub
Else
For i = k + 1 To n
! z, y: d3 _% {# zl(i, k) = a(i, k) / a(k, k)
4 q. D0 \- i4 @5 g. b( @" r/ zFor j = k + 1 To n + 1
a(i, j) = a(i, j) - l(i, k) * a(k, j)
* G# E2 z( t" ?8 L5 a, dNext
8 M- d9 J) T3 c, P. M& GNext
) B% J& ]5 _; m( R0 f: [, v& v/ aD = D * a(k, k)
5 \# m1 k0 r" j8 B, W6 WEnd If
* e6 u8 A9 f! q: f# KNext k '消元结束
If a(n, n) = 0 Then
0 U# B' v4 {! R: p3 ]MsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
Exit Sub
" G6 t$ k4 G5 a' c$ NElse
6 F5 C+ [% O( ND = D * a(n, n)
End If
0 v7 M' G6 e6 _1 ~5 d+ A+ DPrint "--------------------------------"
Print "系数行列式的值是："; D
: X5 C- |( w: [& O" sx(n) = a(n, n + 1) / a(n, n)
For k = n - 1 To 1 Step -1 '开始回代
For j = k + 1 To n
m = m + a(k, j) * x(j)
Next j
8 Z' F4 P! l7 F0 U2 j3 ~x(k) = (a(k, n + 1) - m) / a(k, k)
9 G, \, V, j1 e8 [m = 0
Next k '结束回代
6 H! i9 d2 V$ ^8 i
Print "--------------------------------"
Print "方程组的解如下："

For k = 1 To n
% }% z$ t8 t: B8 D9 L# ?8 wPrint
: j& W2 A; p3 m: vPrint "X(" & k & ") = " & x(k)
Next k
Print "--------------------------------"
Print "其中各行Ax-b="
Print
For i = 1 To n
" n' D1 f$ ~$ I( w) f  Qt = 0
! c, T' ^1 I: |( Q. iFor j = 1 To n
% P5 o/ o7 c0 }; A. Tt = t + a2(i, j) * x(j)
Next j
( u# w9 }3 q1 T+ `+ \t = t - a2(i, n + 1)
  S# `, @3 y& k& RPrint Spc(5); "第" & i & "行："; t
* D$ j8 c9 |9 a$ N: w, p; e2 F1 YPrint
: |! ^% l* ?+ J) RNext i

% c1 ~! F: q5 K4 s2 \End SubPrivate Sub gauss_Click() '高斯消去法
" B1 Z8 J' e5 k6 TDim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single
3 _! J2 k% ~4 J+ Mi = 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)
/ T7 w1 ], Y& M3 ]6 a$ a* f- RDim k As Integer, D As Single, m As Single, x() As Single, t As Single, a2() As Single
ReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()
For i = 1 To n
+ B; H8 z9 q. Z2 ?  [6 YFor j = 1 To n
1 g- D% x  {8 [7 [9 X  _9 c: d) b0 |$ ga2(i, j) = a(i, j)
Next
: N/ w/ [; i8 F/ Q$ M" lNext '将a()的值全部赋给a2()
m = 0
3 j. C4 S( l. e- @" xD = 1
* o0 G: N. [; ^4 ^; X# z) {ReDim x(1 To n)
Print "--------------------------------"
Print "您输入的增广矩阵如下："
For i = 1 To n
% A# u' ~+ K! fs = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
2 j! H) N$ L8 \0 q, s9 V& EFor j = 1 To n
a(i, j) = Val(Left(s, InStr(s, " ")))
s = Trim(Right(s, (Len(s) - InStr(s, " "))))
Print a(i, j);
Next
8 j* x- m. o- m: S* D! d5 I& Ta(i, n + 1) = Val(s)
Print a(i, n + 1);
( A# X! n& E0 I' BPrint
5 s  q  n% {( C  Z/ a- YNext
& S" K/ }# c6 W) q
For k = 1 To n - 1 '开始消元
If a(k, k) = 0 Then
) q" K% v9 z2 r* B' r7 UMsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
Exit Sub
Else
8 v* {. S$ f; x9 G' SFor i = k + 1 To n
5 F5 |& C; l% \8 b; [' O+ {9 Xl(i, k) = a(i, k) / a(k, k)
For j = k + 1 To n + 1
a(i, j) = a(i, j) - l(i, k) * a(k, j)
Next
! E3 @0 d# w$ v1 X+ tNext
D = D * a(k, k)
; j/ ?$ F: K; e* |- O* f+ U) IEnd If
- s: {( \8 F8 [1 K3 w) A( t; qNext k '消元结束
$ ~8 g  g# ]+ p& h9 Z, k  s  ]: aIf a(n, n) = 0 Then
1 R& F: i: t% jMsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
. ?& j; D0 ]- OExit Sub
0 _3 e4 e' g$ u3 u) ?9 {Else
9 w; b# u; _& `( U2 ZD = D * a(n, n)
End If
" q" Z4 h7 a- hPrint "--------------------------------"
Print "系数行列式的值是："; D
x(n) = a(n, n + 1) / a(n, n)
. Y3 |- \$ ^1 b+ ^9 L4 zFor k = n - 1 To 1 Step -1 '开始回代
For j = k + 1 To n
( X  P( s: o) ~- l$ pm = m + a(k, j) * x(j)
Next j
5 B; ]; l% l7 F9 z5 q0 Px(k) = (a(k, n + 1) - m) / a(k, k)
! e5 o9 F( ]# i- H7 V) A" [7 jm = 0
Next k '结束回代
7 n6 Q8 B8 \$ o
Print "--------------------------------"
Print "方程组的解如下："

For k = 1 To n
Print
, D+ r6 e8 I; }$ j! b. d1 YPrint "X(" & k & ") = " & x(k)
5 X# o! ?% C8 c/ [Next k
7 Z$ A- b0 r, k# ~Print "--------------------------------"
  C( X1 R! U( J, _0 h1 f0 ZPrint "其中各行Ax-b="
Print
+ q$ X: }0 C: gFor i = 1 To n
t = 0
& I  [% `! X5 J- D" v  u& w7 q/ Z) zFor j = 1 To n
, D7 t( W- ]& M1 vt = t + a2(i, j) * x(j)
- H/ t. f& g6 t" [  TNext j
t = t - a2(i, n + 1)
" L. D4 y6 S! ?1 d# y  n1 c) R8 lPrint Spc(5); "第" & i & "行："; t
, @8 |8 d8 Z" m7 [) x  iPrint
) q: Y# @4 r- n6 a6 JNext i
2 u/ m% W% G: s1 j( v
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

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