[讨论]高斯消去法---这是用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
1 L6 `: ?2 N! e3 S+ O" l( xn = Val(InputBox("请输入矩阵的阶数(即：方程组未知数个数)N", "方程的未知数个数n", 3))
+ t3 K, I( U5 m8 ^1 ]5 d) ~6 A# y9 J1 rReDim Preserve a(1 To n, 1 To n + 1)
- i7 ]. C2 k# e- g, {0 [+ cReDim 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
7 w/ F  U" t7 p: W8 a4 DReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()
For i = 1 To n
" K1 n6 c! L9 `7 bFor j = 1 To n
! F' G7 s) a  Y- o! j# la2(i, j) = a(i, j)
, ]; s" i. X: K2 A( b( gNext
Next '将a()的值全部赋给a2()
) s( m# {# {* [+ k7 C0 hm = 0
D = 1
& q8 `+ v& g/ Z7 N+ f' v. M2 ^ReDim x(1 To n)
Print "--------------------------------"
Print "您输入的增广矩阵如下："
For i = 1 To n
s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
- t, S. E' ~$ s/ R8 [# v3 KFor j = 1 To n
a(i, j) = Val(Left(s, InStr(s, " ")))
7 o7 Y( ^: _; L- js = Trim(Right(s, (Len(s) - InStr(s, " "))))
$ d/ r$ h6 o3 v3 r4 DPrint a(i, j);
Next
a(i, n + 1) = Val(s)
' O+ Z2 s; }& Q" i8 w4 `  W* oPrint a(i, n + 1);
Print
Next

For k = 1 To n - 1 '开始消元
% i. v+ l- I) d9 [( l( kIf a(k, k) = 0 Then
5 G* G6 o7 D+ H% w$ F# H% oMsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
% C: R1 Q  K* D# qExit Sub
8 ?  D/ j* `& n4 a- V; \: @Else
For i = k + 1 To n
0 Q0 B- G* U, f& u7 x( J$ D2 Z7 o6 dl(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)
# c, `  W1 L! D. {4 W$ mNext
1 B: [. F7 s5 A8 Y5 m$ VNext
3 I( c) @$ Z' KD = D * a(k, k)
End If
Next k '消元结束
( }! b0 i0 }* i: OIf a(n, n) = 0 Then
MsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
Exit Sub
Else
2 u8 Z3 M+ R0 a# p" ^6 g( }. qD = D * a(n, n)
1 {/ o+ ]% Q% Y1 A9 HEnd If
Print "--------------------------------"
Print "系数行列式的值是："; D
' C, A& d& c. p, d6 `  Xx(n) = a(n, n + 1) / a(n, n)
For k = n - 1 To 1 Step -1 '开始回代
( P/ c. v, T5 ?9 ]: S, kFor j = k + 1 To n
+ O- e) b' i0 p) A  x7 E9 Rm = m + a(k, j) * x(j)
Next j
# m* l& A0 G; }5 O; k9 M& _: wx(k) = (a(k, n + 1) - m) / a(k, k)
6 [7 m3 k4 `& X  wm = 0
Next k '结束回代
+ X& M8 e3 d$ H
5 ?4 D# }$ D' J3 _Print "--------------------------------"
1 b+ V% Z5 ]* I# Z& q" \Print "方程组的解如下："

For k = 1 To n
Print
Print "X(" & k & ") = " & x(k)
7 ?! L. ?( w9 ~  `Next k
Print "--------------------------------"
+ a7 U+ @0 \5 a5 J4 }/ wPrint "其中各行Ax-b="
Print
, _3 R6 _$ x) L8 b* w9 ]6 ?For i = 1 To n
t = 0
For j = 1 To n
t = t + a2(i, j) * x(j)
Next j
, A8 S: I! L5 Z: x$ i  m2 F0 [7 Mt = t - a2(i, n + 1)
Print Spc(5); "第" & i & "行："; t
6 B! g, W: d) N* r- C( z& S/ QPrint
9 k6 y% d6 f. I, b7 E8 }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
/ |3 I5 L9 j8 p+ Zi = 1: j = 1
n = Val(InputBox("请输入矩阵的阶数(即：方程组未知数个数)N", "方程的未知数个数n", 3))
" X/ Z+ O& s0 bReDim Preserve a(1 To n, 1 To n + 1)
, {* Z* ^# a& U# p5 {; J! |ReDim Preserve l(1 To n, 1 To n + 1)
3 T0 h- Z* A: B) C' nDim 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()
  p8 k( p6 S1 m& ~+ sFor i = 1 To n
For j = 1 To n
4 c+ f  e  c8 O$ Z2 Ra2(i, j) = a(i, j)
Next
Next '将a()的值全部赋给a2()
# U) p4 z. y2 m" tm = 0
2 [# }0 q0 u9 [/ _: BD = 1
7 @. t) l) ~- n9 I7 S! {/ y" {ReDim x(1 To n)
Print "--------------------------------"
, b" @) G2 _+ C& p% oPrint "您输入的增广矩阵如下："
( _7 [% u" J2 z$ m+ z' j6 F7 lFor i = 1 To n
. R4 T* ?, a- T0 w& Ws = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
For j = 1 To n
2 H/ n8 p' C9 Va(i, j) = Val(Left(s, InStr(s, " ")))
s = Trim(Right(s, (Len(s) - InStr(s, " "))))
- r6 C) F: q6 r) @Print a(i, j);
6 ?; }7 U& f/ U4 L0 [/ n% S5 tNext
a(i, n + 1) = Val(s)
4 }# I. y2 O# \5 F& J, W; m* [Print a(i, n + 1);
Print
9 A5 }6 t& s" ^- n$ A! ^Next

For k = 1 To n - 1 '开始消元
If a(k, k) = 0 Then
MsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
! U& t" J7 d1 @, b2 L9 X& hExit Sub
Else
( m1 s: l* d; `" n% B' v! RFor i = k + 1 To n
. L& y; d3 p5 B: K+ k# o- v' d$ {l(i, k) = a(i, k) / a(k, k)
+ B. |4 |% T' X- {+ R$ SFor j = k + 1 To n + 1
7 u5 _" B3 J- O: H1 xa(i, j) = a(i, j) - l(i, k) * a(k, j)
" p( t$ u( f+ k, |; i8 d1 y. YNext
Next
D = D * a(k, k)
End If
8 h: G6 r! q2 e1 j, ANext k '消元结束
- M* u$ x$ N' b. t. mIf a(n, n) = 0 Then
MsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
Exit Sub
. X- v5 X0 v9 s3 m- i2 wElse
! F1 \; E  T& R' q$ p. ~D = D * a(n, n)
End If
Print "--------------------------------"
Print "系数行列式的值是："; D
. Q' b2 \% z+ ?7 A4 Ox(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
x(k) = (a(k, n + 1) - m) / a(k, k)
m = 0
& r) F/ i+ q+ e  SNext k '结束回代

Print "--------------------------------"
! t! F. C# H3 f8 O0 P  }4 jPrint "方程组的解如下："

For k = 1 To n
" [, B4 T, V6 v. i9 gPrint
; X+ x  ~0 s; j& A. S. Q3 U& |Print "X(" & k & ") = " & x(k)
Next k
Print "--------------------------------"
Print "其中各行Ax-b="
& y5 j& g# F+ Q; b$ e; e% C$ ~8 @/ EPrint
For i = 1 To n
t = 0
+ X$ ^5 C" W, J, d8 SFor j = 1 To n
( A$ X% i2 y& I9 F5 s2 ]2 _4 U8 Et = t + a2(i, j) * x(j)
9 w5 s( B. o+ A6 n2 fNext j
. a- q" z% |% ~) p' p7 |2 qt = t - a2(i, n + 1)
. o9 R  f6 ?. J, T; F0 GPrint Spc(5); "第" & i & "行："; t
6 u' m5 r+ A6 ]3 VPrint
. J# K8 _5 b! `" m0 b7 g8 z8 ?. c. gNext i
7 L# K0 G$ `. Z* I3 [# A& M
. h0 y: C$ x$ eEnd Sub

ch123en123

下载学习哦

lq12131010

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

zqyzixin

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