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

god

Private Sub gauss_Click() '高斯消去法
5 u% O% g$ F5 f  N0 w! ^! Y# dDim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single
: `6 c+ M  {1 W& j4 }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)
6 m6 B4 t6 O* H$ T: SDim k As Integer, D As Single, m As Single, x() As Single, t As Single, a2() As Single
3 {5 {) N  M( @) IReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()
For i = 1 To n
For j = 1 To n
  _' k7 ?5 P5 _/ va2(i, j) = a(i, j)
' L& t$ [6 w  x# V% s0 p; [! mNext
+ Q. A1 [) Y6 |8 d5 gNext '将a()的值全部赋给a2()
m = 0
( m4 L) c* P8 _! A1 pD = 1
ReDim x(1 To n)
" v' c1 U' N9 q! e% NPrint "--------------------------------"
Print "您输入的增广矩阵如下："
4 ]1 J0 E% M1 K, y8 m" EFor i = 1 To n
s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
For j = 1 To n
! k5 U) p. A9 n( {- R2 i& oa(i, j) = Val(Left(s, InStr(s, " ")))
s = Trim(Right(s, (Len(s) - InStr(s, " "))))
$ P& h" d8 H) ?Print a(i, j);
4 u2 j& L. I% G6 ZNext
  V3 ^1 ]: m, ]' v9 X# o1 |a(i, n + 1) = Val(s)
# u3 _: I! ^- V) a; [. C5 N4 NPrint a(i, n + 1);
3 g2 Y+ {2 Z( r+ ^* [# KPrint
6 e& z; N: d% MNext

For k = 1 To n - 1 '开始消元
6 Q, ?  p/ j) N5 ^, s7 j+ @) q" sIf a(k, k) = 0 Then
/ Q( F: @6 o0 J" wMsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
1 k$ e* y9 t3 |6 ]1 i) CExit Sub
Else
For i = k + 1 To n
l(i, k) = a(i, k) / a(k, k)
For j = k + 1 To n + 1
1 t+ f0 z7 S, u- {0 \: ea(i, j) = a(i, j) - l(i, k) * a(k, j)
Next
Next
D = D * a(k, k)
1 J5 E4 z" [* F, y5 V% d- \( ]End If
& S  L$ U, R. Y* R$ D( aNext k '消元结束
If a(n, n) = 0 Then
MsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
Exit Sub
Else
D = D * a(n, n)
End If
, D7 @# X! @0 f  p3 J& i( yPrint "--------------------------------"
7 L4 `! g3 O8 [. V8 S4 bPrint "系数行列式的值是："; D
2 {/ c3 a# W- h8 Ux(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)
! Z6 n1 R+ H# b4 F- km = 0
; y4 X: x" P  {; W7 b8 g3 }6 qNext k '结束回代

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

For k = 1 To n
% Q; ~% Z* F. G! |* e6 MPrint
* x9 n3 B$ z  D& C& ^0 I% N: oPrint "X(" & k & ") = " & x(k)
Next k
Print "--------------------------------"
Print "其中各行Ax-b="
+ w- I8 w$ G" |% f6 n# q7 lPrint
' t# ]4 V( N! T$ L: c! m* i: ^For i = 1 To n
. i7 B5 R/ [' u6 a: i: }& P( Ft = 0
. l: A; c" h. J% o8 |. r2 r5 U0 VFor j = 1 To n
$ |" U; v- {' E  `t = t + a2(i, j) * x(j)
Next j
5 K* C* T; H) C+ h$ `& h5 }* U) ut = t - a2(i, n + 1)
0 C3 ~5 t3 N% z, v( s1 r$ @Print Spc(5); "第" & i & "行："; t
Print
Next i

' h0 ^& W! t0 SEnd SubPrivate Sub gauss_Click() '高斯消去法
Dim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single
* L0 |6 {3 c2 u; s  Ci = 1: j = 1
n = Val(InputBox("请输入矩阵的阶数(即：方程组未知数个数)N", "方程的未知数个数n", 3))
ReDim Preserve a(1 To n, 1 To n + 1)
6 G( {( H# a7 `  Q7 {ReDim Preserve l(1 To n, 1 To n + 1)
7 g2 w6 M1 t% p* e, S- F( k7 cDim k As Integer, D As Single, m As Single, x() As Single, t As Single, a2() As Single
, |: P; h, d3 K8 m$ AReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()
* c7 N0 d  P1 s( C( u: I0 S6 }For i = 1 To n
- b5 g$ p, E/ _8 LFor j = 1 To n
a2(i, j) = a(i, j)
Next
Next '将a()的值全部赋给a2()
, R: o4 l! }  c; r. }! mm = 0
1 @+ I0 ]) V, q7 gD = 1
3 x* M: f4 ^7 W/ IReDim x(1 To n)
( ^# p. c( e! jPrint "--------------------------------"
Print "您输入的增广矩阵如下："
( D3 u" Z/ q& A% d3 f) H: WFor i = 1 To n
; W, ^% X" K9 U4 z  ?s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
For j = 1 To n
" h* K0 U+ l  U7 P, {1 z0 v. Ta(i, j) = Val(Left(s, InStr(s, " ")))
s = Trim(Right(s, (Len(s) - InStr(s, " "))))
- [" s! W6 B& j4 `' S+ @6 SPrint a(i, j);
+ j' ?/ C* d/ F  uNext
a(i, n + 1) = Val(s)
Print a(i, n + 1);
Print
Next
, ]% P# c# M; X# G6 x# P
4 X% ^  v6 x: _. aFor k = 1 To n - 1 '开始消元
# b7 y7 s- [  i  _4 XIf a(k, k) = 0 Then
% J! S) h. D+ v, bMsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
5 {! X0 P, t# U: v' `Exit Sub
Else
For i = k + 1 To n
l(i, k) = a(i, k) / a(k, k)
For j = k + 1 To n + 1
8 k8 D$ t$ F/ v' o! y* U3 F: N  t! Na(i, j) = a(i, j) - l(i, k) * a(k, j)
/ w8 o9 F/ S8 Z2 A1 K# MNext
Next
D = D * a(k, k)
End If
( y: U; i. Z) [: }. H, [2 yNext k '消元结束
If a(n, n) = 0 Then
* v9 ?% R# h6 T; ]( Z) i  B& u! sMsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
! o  t! }9 ~3 y& X' m# x5 F/ JExit Sub
2 z! t) \  j7 h& ]2 S' q% hElse
D = D * a(n, n)
: B4 u6 V0 z! A, |End If
9 q) v  q# j  s: U- y$ vPrint "--------------------------------"
, ]1 D9 \1 {+ xPrint "系数行列式的值是："; D
% \/ V. U: e8 i  v4 V- u9 vx(n) = a(n, n + 1) / a(n, n)
4 c* m$ E, o* ^' g7 i6 J3 hFor k = n - 1 To 1 Step -1 '开始回代
For j = k + 1 To n
+ |$ X1 W' z/ ~2 A: Dm = m + a(k, j) * x(j)
  g8 V/ H& R, `  J* }Next j
0 J) K5 C) ^3 t. {3 G$ p9 U5 ix(k) = (a(k, n + 1) - m) / a(k, k)
m = 0
: O5 Y" x% l/ r- {Next k '结束回代
9 {& i  U, Z1 Z( K* ]/ t
+ L% W( M: W: a7 j; s+ J3 |Print "--------------------------------"
Print "方程组的解如下："
8 }! ]: B. K: U, C, I8 [! C- Z
For k = 1 To n
Print
Print "X(" & k & ") = " & x(k)
6 @% P' E- r- H2 b0 HNext k
Print "--------------------------------"
$ H5 B; Z2 J" r% Y! |Print "其中各行Ax-b="
2 B; Q/ s2 U7 G3 M% s5 FPrint
  @2 g3 [- T2 W2 d, a5 ?% |For i = 1 To n
8 `3 m' |1 L0 f$ Z& A/ ~& _t = 0
3 m2 h7 u, O% W0 P, b! R7 pFor j = 1 To n
8 S0 l$ ]1 v8 c0 H2 ^t = t + a2(i, j) * x(j)
Next j
0 j6 F+ o+ t' _+ e1 z, Ut = t - a2(i, n + 1)
Print Spc(5); "第" & i & "行："; t
Print
Next i

0 c: x# V; E* V, f  yEnd Sub

ch123en123

下载学习哦

lq12131010

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

zqyzixin

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