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

god

Private Sub gauss_Click() '高斯消去法
: N5 G! g$ D4 n. P* j6 d- x& \Dim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single
i = 1: j = 1
n = Val(InputBox("请输入矩阵的阶数(即：方程组未知数个数)N", "方程的未知数个数n", 3))
4 j0 v+ m+ |& ]' ~$ mReDim Preserve a(1 To n, 1 To n + 1)
ReDim Preserve l(1 To n, 1 To n + 1)
& C8 n; d& Y, N" Y9 ~Dim 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()
+ V/ N4 e# O8 _( \: y+ p3 ~For i = 1 To n
For j = 1 To n
' Y1 O6 r( j' ]' R% x9 Ea2(i, j) = a(i, j)
( u. z% O0 L  h- a6 Y# q! ^Next
Next '将a()的值全部赋给a2()
m = 0
D = 1
ReDim x(1 To n)
Print "--------------------------------"
Print "您输入的增广矩阵如下："
9 b: r+ O# F0 \; C" MFor i = 1 To n
s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
) ^( ^3 u4 b4 L3 c" `' s) sFor j = 1 To n
a(i, j) = Val(Left(s, InStr(s, " ")))
0 R' ~' G9 ~& p1 N1 ds = Trim(Right(s, (Len(s) - InStr(s, " "))))
Print a(i, j);
- A5 M$ k* d: ?0 L4 ^Next
1 F  q* q5 W. \/ @a(i, n + 1) = Val(s)
Print a(i, n + 1);
Print
Next
* u0 a7 l3 I+ t) S' n7 j* G
For k = 1 To n - 1 '开始消元
If a(k, k) = 0 Then
MsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
Exit Sub
* Q& M: e% w6 T! bElse
For i = k + 1 To n
6 h( Q# h4 r# U; Z6 r0 Yl(i, k) = a(i, k) / a(k, k)
% T% Y9 R$ j( s  oFor j = k + 1 To n + 1
" _0 z& R6 d5 i0 F, m1 na(i, j) = a(i, j) - l(i, k) * a(k, j)
$ [1 D* s4 B' ^  u! `# W: @Next
Next
D = D * a(k, k)
End If
1 p0 z! @* r: Q8 s7 R" {0 gNext k '消元结束
1 W& ~+ H! J- C5 O3 s: zIf a(n, n) = 0 Then
MsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
# E- c2 D/ O" q1 H% iExit Sub
Else
4 \0 `" S9 `2 B6 CD = D * a(n, n)
; v" g3 l& W7 r+ C* a0 ?. H' PEnd If
Print "--------------------------------"
Print "系数行列式的值是："; D
, k! j3 s) p7 ?: N" J& nx(n) = a(n, n + 1) / a(n, n)
4 z7 i; [! s4 F5 b0 WFor k = n - 1 To 1 Step -1 '开始回代
; ]2 p! V6 I0 `& \7 Z/ b  y3 F  ^& KFor j = k + 1 To n
m = m + a(k, j) * x(j)
; v5 z& S4 u- X* X( Y/ N" L7 u/ zNext j
. B4 [' A! }3 L/ S" \0 M7 R8 D4 Kx(k) = (a(k, n + 1) - m) / a(k, k)
m = 0
0 V. w0 O  L2 g3 k& \/ j/ HNext k '结束回代

Print "--------------------------------"
% f1 s) Q, d( D! OPrint "方程组的解如下："

2 V/ e3 _8 G; N8 n  D( hFor k = 1 To n
Print
Print "X(" & k & ") = " & x(k)
# |- o1 ^: A0 x8 K$ u$ J; o0 {7 HNext k
Print "--------------------------------"
Print "其中各行Ax-b="
) \4 e9 G% w, T; TPrint
For i = 1 To n
9 K- \# I( }5 Q. m% At = 0
) S( x& @& p# ^  d6 B2 ]7 r" U* NFor j = 1 To n
# l/ x. _; i  e3 c# ot = t + a2(i, j) * x(j)
7 F" M. K( U+ `  Y4 c" W# G+ INext j
' e3 J# t& L+ @9 Zt = t - a2(i, n + 1)
% D# {5 V- F# m, q& h% ~- |Print Spc(5); "第" & i & "行："; t
Print
8 [' I% F; U7 `" `6 wNext i
8 W* p( J9 D# c! R: F
End SubPrivate Sub gauss_Click() '高斯消去法
Dim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single
! m- q1 \. X# ^8 v/ Z9 Q: n# \1 Li = 1: j = 1
' V% Y. k5 s* q5 `n = Val(InputBox("请输入矩阵的阶数(即：方程组未知数个数)N", "方程的未知数个数n", 3))
ReDim Preserve a(1 To n, 1 To n + 1)
4 N# J8 c+ `  _3 |, B+ F& TReDim Preserve l(1 To n, 1 To n + 1)
1 L% y' _+ K- `, ^5 @6 O" ?Dim 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()
7 e/ l! _9 Z( t1 D* r' Y( c6 J. n+ mFor i = 1 To n
For j = 1 To n
2 \, h6 g' m, r; Ia2(i, j) = a(i, j)
& a  X& ?4 E% i) B' vNext
Next '将a()的值全部赋给a2()
m = 0
D = 1
ReDim x(1 To n)
. E) H* @7 |- G# w& ^( EPrint "--------------------------------"
Print "您输入的增广矩阵如下："
9 x( c2 y0 R2 I8 o: z$ K9 x: DFor i = 1 To n
s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
For j = 1 To n
0 M0 x9 U) q2 w" i% y2 wa(i, j) = Val(Left(s, InStr(s, " ")))
- r- V% q+ W/ {8 _5 P7 [! vs = Trim(Right(s, (Len(s) - InStr(s, " "))))
Print a(i, j);
Next
( x+ D/ b) W( ?! Ta(i, n + 1) = Val(s)
$ [* }7 M2 E; N% ^; T  h0 [7 }+ MPrint a(i, n + 1);
Print
' d( K4 x& P1 G" ONext

. y9 D# x0 ]$ h7 T9 O! |1 R  PFor k = 1 To n - 1 '开始消元
If a(k, k) = 0 Then
MsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
  n& D# w7 [6 b. @. i- dExit Sub
Else
For i = k + 1 To n
3 l: s7 l" [; \+ {5 W& v. ^l(i, k) = a(i, k) / a(k, k)
/ \2 W- l" E# T3 F; J$ X# ~+ A4 q; p! qFor j = k + 1 To n + 1
a(i, j) = a(i, j) - l(i, k) * a(k, j)
Next
' a: k7 P( O& `$ u1 l7 VNext
+ h, ~) v0 b8 z$ M, P$ z. X3 E7 l8 pD = D * a(k, k)
End If
3 o6 e. i8 \- D! UNext k '消元结束
. b, {( ?( c) X2 N, `% z$ QIf a(n, n) = 0 Then
$ p; L: W6 t4 Q: CMsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
2 ^& \- b' M% Z: b6 ?, a& @Exit Sub
Else
% K( F, \4 {7 XD = D * a(n, n)
End If
Print "--------------------------------"
3 X* c  [' l( y! c/ `2 V: TPrint "系数行列式的值是："; D
x(n) = a(n, n + 1) / a(n, n)
3 K4 ^+ s. h  e5 u6 t% U! ZFor k = n - 1 To 1 Step -1 '开始回代
For j = k + 1 To n
" M& K3 H- o+ `" vm = m + a(k, j) * x(j)
5 ~! b# ]1 X' h7 _8 [% H. gNext j
x(k) = (a(k, n + 1) - m) / a(k, k)
% N: @; M9 ^" y; m$ pm = 0
Next k '结束回代
1 P+ U4 k/ I: N
$ S5 J8 O- y- ^' pPrint "--------------------------------"
* }7 S/ I4 Z' w* z: Z1 R. ]1 w  PPrint "方程组的解如下："
2 a7 Y) j& r( q' S
For k = 1 To n
' y( [8 Q+ o0 r5 U& [Print
3 O# f: i6 m) r+ iPrint "X(" & k & ") = " & x(k)
% {7 i& {( D( ]' i; w: A7 x; LNext k
% y7 @. b3 t& x" ]. N  iPrint "--------------------------------"
) W7 C, ]1 D2 t1 QPrint "其中各行Ax-b="
7 f  P, B0 i; F6 A8 w" B2 VPrint
For i = 1 To n
t = 0
2 D9 }) h! z$ `For j = 1 To n
t = t + a2(i, j) * x(j)
Next j
t = t - a2(i, n + 1)
- x! M3 _0 x5 H. QPrint Spc(5); "第" & i & "行："; t
Print
, _3 @/ `# e& }& y% D8 rNext i
) f7 @- J3 }4 ~1 b
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

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