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

god

Private Sub gauss_Click() '高斯消去法
, h) N* I9 W" `1 \' k$ _Dim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single
2 o5 y* q0 Z7 G% Z+ W# Ii = 1: j = 1
* U) }& N5 d+ [( ?0 W# O8 Xn = Val(InputBox("请输入矩阵的阶数(即：方程组未知数个数)N", "方程的未知数个数n", 3))
8 P" L  W( X: M" K. T0 eReDim Preserve a(1 To n, 1 To n + 1)
- i7 Y" Q" E; Z7 ]7 k6 j# E% V0 ZReDim 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
  r. E) B. \! T# M4 [/ xReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()
0 l; }$ t( U0 E" OFor i = 1 To n
, k5 T3 R7 ~' QFor j = 1 To n
a2(i, j) = a(i, j)
) \+ _3 K' a7 J6 z- F# ~8 {# pNext
- \$ X  |4 E4 _: A5 z8 Q( L3 NNext '将a()的值全部赋给a2()
m = 0
D = 1
ReDim x(1 To n)
Print "--------------------------------"
& M4 t6 V5 Y# @9 }Print "您输入的增广矩阵如下："
2 Y" K& \  O3 }, Q' p, CFor i = 1 To n
* v& m1 B8 y* V0 G' _s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
For j = 1 To n
  M; Q. [* f! ]. S  ia(i, j) = Val(Left(s, InStr(s, " ")))
# ~: G8 u0 z5 y2 O, Fs = Trim(Right(s, (Len(s) - InStr(s, " "))))
Print a(i, j);
Next
a(i, n + 1) = Val(s)
! `# P/ I# K4 X9 N  V  EPrint a(i, n + 1);
, a$ C* R' c, W4 i( WPrint
+ f: ~9 B! i! [+ \Next
. X( y+ j" S  L* V* F) ~3 ~* r
1 T. m2 y) v$ T! o; ^1 V& gFor k = 1 To n - 1 '开始消元
If a(k, k) = 0 Then
' K1 [  c* L1 \% wMsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
Exit Sub
Else
) d. u) S. e' ZFor i = k + 1 To n
( C8 e6 {( d1 ll(i, k) = a(i, k) / a(k, k)
For j = k + 1 To n + 1
8 T0 X4 ?4 v& a- _/ j5 q0 G7 Ja(i, j) = a(i, j) - l(i, k) * a(k, j)
8 P! Z1 s5 S3 F: X; q& c7 B8 f1 R+ bNext
( r7 D- O) K8 h  C+ ONext
D = D * a(k, k)
End If
Next k '消元结束
/ [/ E, t- n4 T& ~$ uIf a(n, n) = 0 Then
  f' ~; J1 ^+ CMsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
  A! Q; f% F4 A5 Q$ H. OExit Sub
- y- |$ I( f9 e( o& z  [5 e' EElse
D = D * a(n, n)
/ K/ E* g5 Z, uEnd If
, L5 T" l& R# q0 B& x/ GPrint "--------------------------------"
1 F5 r; `, u; o1 t, V) o& UPrint "系数行列式的值是："; D
# l. Y! M1 X6 e. ]x(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
Next k '结束回代

8 Y: g  P# a( s4 @0 UPrint "--------------------------------"
8 F- ?2 z$ d3 a( s, BPrint "方程组的解如下："

For k = 1 To n
( [! A- K; m. E) }" R" K' @8 rPrint
Print "X(" & k & ") = " & x(k)
Next k
Print "--------------------------------"
' e3 E1 X1 H, r! {8 h; TPrint "其中各行Ax-b="
Print
5 L& r: ~$ F$ V- xFor i = 1 To n
t = 0
! D, j- [' W. v4 Q. ?For j = 1 To n
1 e. L! C6 h% i  st = t + a2(i, j) * x(j)
1 w6 K( R1 P) @4 uNext j
( {( k5 Y( _( ^, Ot = t - a2(i, n + 1)
Print Spc(5); "第" & i & "行："; t
Print
7 I- p6 D: h  |) pNext i
, x& t8 v7 t4 V' G$ ~$ L
* R/ y9 j: H" a# gEnd SubPrivate Sub gauss_Click() '高斯消去法
Dim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single
; {: W0 ?( A2 T3 H4 u; T" y* Mi = 1: j = 1
5 W) f6 x+ |4 ?" q0 ^  S+ [* R1 Xn = Val(InputBox("请输入矩阵的阶数(即：方程组未知数个数)N", "方程的未知数个数n", 3))
! z( G3 R7 D3 |& I" jReDim 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
" G; C8 x( t5 r( gReDim 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)
Next
, N% g5 z  u) w0 b% _/ dNext '将a()的值全部赋给a2()
m = 0
& ?- U3 y+ L0 _) @" VD = 1
% r/ m/ M# ~2 yReDim x(1 To n)
Print "--------------------------------"
Print "您输入的增广矩阵如下："
( {" s' M& J7 @) V" C5 nFor i = 1 To n
s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
% S/ A7 v# \+ N: J6 `4 oFor j = 1 To n
a(i, j) = Val(Left(s, InStr(s, " ")))
s = Trim(Right(s, (Len(s) - InStr(s, " "))))
$ s& ~- B/ k- z- B4 [, FPrint a(i, j);
. y7 ^+ w, q- S/ Q/ h  R( ?Next
a(i, n + 1) = Val(s)
$ w# c" r, [, UPrint a(i, n + 1);
. Z4 A" y7 h! Z# z! cPrint
5 n) G( j" g/ k/ S8 XNext
$ Y/ Y2 u) m" ?" Y* j
% [! D: e  W% l; sFor k = 1 To n - 1 '开始消元
If a(k, k) = 0 Then
MsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
2 _1 D; H1 M1 p7 M; x! d6 E7 a2 YExit Sub
Else
For i = k + 1 To n
8 d6 |8 z4 f9 Q8 T. ml(i, k) = a(i, k) / a(k, k)
/ Z2 E+ T  J* aFor j = k + 1 To n + 1
( D6 q* x; v% _7 h+ O: Sa(i, j) = a(i, j) - l(i, k) * a(k, j)
6 v! Q# n3 V+ u. V8 X7 E9 {Next
Next
$ k# v2 a' g% e  _2 \5 W, kD = D * a(k, k)
End If
Next k '消元结束
If a(n, n) = 0 Then
$ D' r/ ~. t$ I* s( |% i3 aMsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
Exit Sub
Else
. ]2 x2 k% l, v6 ~4 C  @D = D * a(n, n)
9 ^- k& f1 S. M0 |, L6 q; A$ _End If
Print "--------------------------------"
Print "系数行列式的值是："; D
/ g9 \! ~' _2 H: G( H4 s, cx(n) = a(n, n + 1) / a(n, n)
1 }! E! p: i, I4 Z# L+ bFor 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
: C! g9 ]( s. W# _5 gNext k '结束回代

Print "--------------------------------"
Print "方程组的解如下："

For k = 1 To n
% `: d2 M9 E* K# H6 tPrint
Print "X(" & k & ") = " & x(k)
2 q. ^  B( i& e8 L# \Next k
. Q: X6 r4 [7 _" rPrint "--------------------------------"
: h9 R/ h- a, Y* x' N/ T& G! v& lPrint "其中各行Ax-b="
9 d8 K( h( k6 O, j9 XPrint
For i = 1 To n
t = 0
For j = 1 To n
& W  G3 Y$ f: H0 C' o5 q; e$ {; }t = t + a2(i, j) * x(j)
7 d, U* ?2 ~) y) \) D$ X, @& N, JNext j
t = t - a2(i, n + 1)
! q0 a' m2 E' M; A8 q* K; U4 U+ _9 h2 FPrint Spc(5); "第" & i & "行："; t
& g4 J+ c% w! d. F3 IPrint
$ ]* Y& ~9 Y1 _4 YNext i

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

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