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

god

Private Sub gauss_Click() '高斯消去法
: k. K$ Q; D0 dDim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single
i = 1: j = 1
8 `; G) X9 X  h3 a( `5 kn = 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
! y+ h- z8 U2 o0 TReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()
3 E8 E/ t) Z, r7 a. [8 nFor i = 1 To n
For j = 1 To n
: h1 j5 V& m) g1 n. ua2(i, j) = a(i, j)
3 b" M% T9 v1 \* o5 B' F7 I5 d2 G" w( QNext
+ T4 e/ M4 V' I3 _: sNext '将a()的值全部赋给a2()
! w" a- k9 T* {& e. {m = 0
D = 1
ReDim x(1 To n)
Print "--------------------------------"
2 x: B( B& |8 [/ y$ SPrint "您输入的增广矩阵如下："
For i = 1 To n
s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
" A3 W% h! R" w" SFor 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
9 o" Z# g* Q" [* y. o, L  ra(i, n + 1) = Val(s)
: E' z/ z' t0 [* NPrint a(i, n + 1);
2 ]+ U) i7 G: K) V1 }Print
Next
- X$ W! s5 T% |# d, C; O# r2 m
For k = 1 To n - 1 '开始消元
If a(k, k) = 0 Then
6 }9 }: |+ f, R& wMsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
; W. E% I0 p  p+ \2 @Exit Sub
- m. `% E- `/ {, O7 o7 BElse
8 V( q# R) ~$ }: c2 r9 M9 @For i = k + 1 To n
: }/ }) c# T( u" I4 {8 Fl(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)
" ~& I3 h2 f% M8 K; M& J2 c5 D8 ^/ r, KNext
Next
5 B4 f  J- l2 Q# P6 A0 rD = D * a(k, k)
# ^5 c& _1 E! a2 T1 LEnd If
Next k '消元结束
If a(n, n) = 0 Then
$ D3 m) O7 R3 D& e6 qMsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
Exit Sub
Else
D = D * a(n, n)
End If
1 M6 k9 S* [' \/ PPrint "--------------------------------"
, i7 ?" H) j3 Z" ~" {Print "系数行列式的值是："; D
x(n) = a(n, n + 1) / a(n, n)
8 G$ z. x! V" q; MFor k = n - 1 To 1 Step -1 '开始回代
4 O4 ]# K) I. j* R- t+ g7 {: vFor j = k + 1 To n
+ ~+ `( d, |9 Y2 A" A, [m = m + a(k, j) * x(j)
8 q* n) z$ ?: ~  V1 k/ A# PNext j
- N/ Q9 g; _% Tx(k) = (a(k, n + 1) - m) / a(k, k)
9 m& d  c, F8 @( U8 nm = 0
Next k '结束回代

Print "--------------------------------"
9 J; o$ B. U! c; Q* yPrint "方程组的解如下："

For k = 1 To n
Print
, x( k) |# }$ W, |6 _* A( \$ nPrint "X(" & k & ") = " & x(k)
Next k
Print "--------------------------------"
1 L( l% J0 j  m) ]7 q. o7 J2 f/ RPrint "其中各行Ax-b="
' S' ~' m, T1 F# A5 c" [Print
For i = 1 To n
( s7 p. N- ?* g/ bt = 0
For j = 1 To n
t = t + a2(i, j) * x(j)
Next j
  B/ S, |  ]5 Wt = t - a2(i, n + 1)
Print Spc(5); "第" & i & "行："; t
" ?- R' z7 Z  v9 \; E: cPrint
Next i

  r. P* x  Q2 T2 k" d4 cEnd SubPrivate Sub gauss_Click() '高斯消去法
# T( t. v* b2 b6 P  r6 ~5 aDim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single
i = 1: j = 1
- l1 E" g+ h% u% v8 G; pn = Val(InputBox("请输入矩阵的阶数(即：方程组未知数个数)N", "方程的未知数个数n", 3))
' ]3 Y) z- N+ B1 I& [2 ^1 UReDim Preserve a(1 To n, 1 To n + 1)
ReDim Preserve l(1 To n, 1 To n + 1)
  U+ [, Y: }( a, L( X/ A/ WDim 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()
, I5 A: k' P4 ~' M( u- ^* M: U' JFor i = 1 To n
For j = 1 To n
a2(i, j) = a(i, j)
/ z- A- N3 W, S# U$ lNext
Next '将a()的值全部赋给a2()
8 _0 @$ f$ ^& T) ?8 r* i5 ym = 0
4 |8 ~5 a: _4 L9 x6 @; {" DD = 1
ReDim x(1 To n)
Print "--------------------------------"
Print "您输入的增广矩阵如下："
1 e. w: h9 N$ d3 D, C; lFor i = 1 To n
: o/ [$ z, W8 Is = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
For j = 1 To n
. Y+ f1 ^1 q' @" @a(i, j) = Val(Left(s, InStr(s, " ")))
s = Trim(Right(s, (Len(s) - InStr(s, " "))))
Print a(i, j);
Next
a(i, n + 1) = Val(s)
Print a(i, n + 1);
5 e6 p7 v; X7 y& r, K  ?Print
Next
) Q3 f7 f' o$ L5 h% Z& K0 r
For k = 1 To n - 1 '开始消元
# x( Q2 m7 I/ `If a(k, k) = 0 Then
MsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
Exit Sub
% d  b# R8 d7 ?. t( e7 Z4 AElse
For i = k + 1 To n
, _. B) B0 o4 K- K; Q/ fl(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)
- \' Q" Y% W5 y5 P- kNext
! H( S- {5 q) I/ gNext
D = D * a(k, k)
End If
Next k '消元结束
. h) P( u( _# G2 @$ J! T7 f7 IIf a(n, n) = 0 Then
9 t# W6 O2 U2 _" A, XMsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
( C$ o3 G% P9 k! zExit Sub
Else
  c5 J) H! n5 vD = D * a(n, n)
" d4 h1 o, M  z9 ZEnd If
Print "--------------------------------"
& p2 R( W, V% v0 g+ K  kPrint "系数行列式的值是："; D
x(n) = a(n, n + 1) / a(n, n)
For k = n - 1 To 1 Step -1 '开始回代
For j = k + 1 To n
$ r  A" E( ?# i# Tm = m + a(k, j) * x(j)
Next j
- T2 Q: E. p. K1 jx(k) = (a(k, n + 1) - m) / a(k, k)
, S1 T; I% f3 i, A; r% Wm = 0
Next k '结束回代
, P- p! j0 z$ K( h, m/ O+ p) ]
9 W; g, Q; Q  b" ?$ Z, T( fPrint "--------------------------------"
Print "方程组的解如下："

+ Y, y6 I% v7 [7 j" g, p- y/ xFor k = 1 To n
- p  R, o9 R# i; v7 e  R' wPrint
Print "X(" & k & ") = " & x(k)
Next k
Print "--------------------------------"
Print "其中各行Ax-b="
Print
0 F3 W2 G& ~4 uFor i = 1 To n
t = 0
9 K1 J4 J. h) q- L5 a. vFor j = 1 To n
t = t + a2(i, j) * x(j)
Next j
t = t - a2(i, n + 1)
! I; q4 C( P; a3 `Print Spc(5); "第" & i & "行："; t
. _8 t3 x. J3 J- i2 I& zPrint
7 t% O& ^& {7 G( M$ ?( S4 PNext i
" S" D' g3 l# H6 g2 y8 s6 _, I8 k
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

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