[讨论]高斯消去法---这是用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
3 R( a5 G$ B. X# U& Z  p5 Sn = 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)
- k% t0 l- w1 C- h% y& ]Dim k As Integer, D As Single, m As Single, x() As Single, t As Single, a2() As Single
9 w7 |# m( f1 y* _0 |0 jReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()
4 D% H9 K7 X7 V- [- p/ |. c; `For i = 1 To n
( [: L+ `: e) o* E8 b5 q1 BFor j = 1 To n
a2(i, j) = a(i, j)
( T- Q; P: R9 F( |Next
Next '将a()的值全部赋给a2()
! r" [* r, E6 t# K$ k( \( Y3 Mm = 0
D = 1
! s7 X: S1 y6 T% uReDim x(1 To n)
Print "--------------------------------"
Print "您输入的增广矩阵如下："
For i = 1 To n
s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
# d) f" J" Z! P. \For j = 1 To n
% J6 e% w) O; T5 @7 ?a(i, j) = Val(Left(s, InStr(s, " ")))
s = Trim(Right(s, (Len(s) - InStr(s, " "))))
% ]% c. T6 e( UPrint a(i, j);
Next
0 y2 U+ [7 T6 E, d! z1 u1 k7 ]a(i, n + 1) = Val(s)
1 |2 n- r' V5 F* dPrint a(i, n + 1);
5 j. U' G4 l+ r, UPrint
" a, ~1 E$ p2 q/ lNext

$ @) T6 `& g3 \( b! l1 zFor k = 1 To n - 1 '开始消元
If a(k, k) = 0 Then
MsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
Exit Sub
) ]  ]1 u& t% O0 e) OElse
8 M; k; c% P/ @9 f. b9 U( EFor i = k + 1 To n
7 J% y- @8 t+ A1 vl(i, k) = a(i, k) / a(k, k)
- D2 P4 {$ J6 p0 ?9 k; X& ]3 zFor j = k + 1 To n + 1
, h. B2 s8 O4 S; ^% g; }$ U* za(i, j) = a(i, j) - l(i, k) * a(k, j)
Next
Next
D = D * a(k, k)
End If
Next k '消元结束
If a(n, n) = 0 Then
' d* a( I! f5 ]* _MsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
2 I  U4 }, i3 ]1 MExit Sub
( b+ i- i1 r$ u$ O/ @/ G8 {Else
D = D * a(n, n)
+ k" f, b4 ~) y, WEnd If
Print "--------------------------------"
) _. ]- ~6 e, ?  vPrint "系数行列式的值是："; D
. E4 v& N, r: n+ y, @0 e  _! Dx(n) = a(n, n + 1) / a(n, n)
0 y8 r- \3 ~1 k) ~0 E/ O/ EFor k = n - 1 To 1 Step -1 '开始回代
For j = k + 1 To n
2 ~2 P' y* p9 O  J  }m = m + a(k, j) * x(j)
) \( u0 d0 ?5 q6 J0 a3 Y9 N9 iNext j
x(k) = (a(k, n + 1) - m) / a(k, k)
0 C: [2 n3 l' ?% v& N1 }# ^- Pm = 0
Next k '结束回代
- G: M. H5 C! ]7 ?+ n( [" ]
8 Y6 \2 F; W8 D  dPrint "--------------------------------"
9 P% w' K7 x9 M( G5 ~( F/ {Print "方程组的解如下："
- Z- m9 o0 E, r! H3 t5 [) ]
) l, d; Y6 o, D" L" `0 AFor k = 1 To n
Print
  z: W! z5 D6 [& K! v% T+ gPrint "X(" & k & ") = " & x(k)
Next k
; f, T4 ~; s5 R: lPrint "--------------------------------"
Print "其中各行Ax-b="
* s. o7 K2 e' S% O! w$ ?Print
For i = 1 To n
  O3 @; ]4 [3 }" o. Q$ tt = 0
2 J1 v$ M; X3 e  }8 X/ K3 JFor j = 1 To n
t = t + a2(i, j) * x(j)
Next j
t = t - a2(i, n + 1)
Print Spc(5); "第" & i & "行："; t
* N, W/ ]- e4 R: _4 p% YPrint
Next i
* i  r& ^) |& w* k8 @9 Z
+ ^5 M9 R6 a7 n8 ~End SubPrivate Sub gauss_Click() '高斯消去法
Dim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single
2 }, H% ~) n/ ]8 G1 m, v# bi = 1: j = 1
  l# ^3 c: {/ H! E- n1 V8 s* w5 i: Hn = Val(InputBox("请输入矩阵的阶数(即：方程组未知数个数)N", "方程的未知数个数n", 3))
" I  k  `" P% \1 ~. \" \ReDim Preserve a(1 To n, 1 To n + 1)
) B9 Q+ O9 ]9 P3 r, a4 S3 \" [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
, F1 c3 w1 Z9 W8 R# }& v2 {- G* sReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()
6 L; k7 ^: l3 vFor i = 1 To n
" [6 `* r& {4 Z3 Z# pFor j = 1 To n
a2(i, j) = a(i, j)
Next
7 s, G3 }$ P7 E- X+ H% v- }Next '将a()的值全部赋给a2()
3 U) v/ h1 `5 ~) gm = 0
D = 1
8 K9 q0 K' {# d7 z1 EReDim x(1 To n)
Print "--------------------------------"
( F9 o6 Y( ?$ d* J) S+ APrint "您输入的增广矩阵如下："
) ?: n/ C( b2 t( RFor i = 1 To n
s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
" V  Z  \: t2 ~% CFor j = 1 To n
" ], q, @/ t; |, T3 ja(i, j) = Val(Left(s, InStr(s, " ")))
s = Trim(Right(s, (Len(s) - InStr(s, " "))))
8 _; ]4 v3 g4 G4 m$ b+ M: KPrint a(i, j);
8 ~+ N6 t. G! {9 G! ~Next
1 Y8 B$ J8 r; k& Ha(i, n + 1) = Val(s)
; K* z" k; ?; x' a- qPrint a(i, n + 1);
Print
Next
, y8 j8 J" R# F/ S( Y3 X9 ?0 j
7 S) y: Z3 b" h3 ?$ JFor k = 1 To n - 1 '开始消元
& _7 a: u. u3 u  i+ }: dIf a(k, k) = 0 Then
MsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
2 y. z# x  z2 O* @' gExit Sub
! Q. ^: \: k+ ^/ gElse
  T+ D- N# p4 G2 jFor i = k + 1 To n
l(i, k) = a(i, k) / a(k, k)
For j = k + 1 To n + 1
3 u5 u, w1 K* w0 X( x) J( za(i, j) = a(i, j) - l(i, k) * a(k, j)
6 m8 |0 {9 H3 r- zNext
8 U! e# Z6 ?0 C1 @Next
: R4 [+ K$ j5 d/ E" g" w% R! \% cD = D * a(k, k)
End If
Next k '消元结束
If a(n, n) = 0 Then
MsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
# l1 l: }. G7 v' JExit Sub
! ]: n' f6 r" \! a/ y2 T0 I$ p4 p( @Else
) x+ d# W2 G/ _" j6 x; A% jD = D * a(n, n)
! g& Y8 o( j! `) tEnd If
) O0 O( r# c/ k: V, t* IPrint "--------------------------------"
( q* L6 S; }( t7 I# m3 KPrint "系数行列式的值是："; D
/ N3 B) R7 n2 B& F' ^x(n) = a(n, n + 1) / a(n, n)
, @4 w' q- }9 D6 H8 dFor k = n - 1 To 1 Step -1 '开始回代
% ^: x) k* A: \, b3 uFor j = k + 1 To n
m = m + a(k, j) * x(j)
Next j
x(k) = (a(k, n + 1) - m) / a(k, k)
2 b1 I7 I' p( m. Am = 0
Next k '结束回代
6 f! Z) l# }7 i0 w4 A
Print "--------------------------------"
Print "方程组的解如下："
  W3 |- ^1 o6 X
# p4 k0 O: @/ q7 \4 R7 S9 h4 mFor k = 1 To n
Print
Print "X(" & k & ") = " & x(k)
( x6 ~4 k+ H4 W' O3 c+ [Next k
' z0 C( N1 l  \* RPrint "--------------------------------"
. u! f/ j' }, m) K8 ?8 OPrint "其中各行Ax-b="
Print
For i = 1 To n
t = 0
For j = 1 To n
t = t + a2(i, j) * x(j)
+ B' P( L5 s! g7 g0 xNext j
; \0 M% k9 t: G( `* G' k  S# Jt = t - a2(i, n + 1)
2 U) Y3 `' [  K3 ePrint Spc(5); "第" & i & "行："; t
- {& H. e6 l, s# B  M8 u% B% a% uPrint
& ]- G/ @0 d. q& \- uNext i

& L# e/ m1 W9 a6 ^; ]) tEnd Sub

ch123en123

下载学习哦

lq12131010

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

zqyzixin

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