[讨论]高斯消去法---这是用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
3 X: u- R8 ]0 x- B4 P6 @& Z  Mi = 1: j = 1
! j) s- P3 F  O# Z) c& K8 rn = Val(InputBox("请输入矩阵的阶数(即：方程组未知数个数)N", "方程的未知数个数n", 3))
ReDim Preserve a(1 To n, 1 To n + 1)
4 H0 o# U3 Y: b* G- _: X4 LReDim Preserve l(1 To n, 1 To n + 1)
" n* j7 i6 G' y8 Z# g8 a1 _Dim k As Integer, D As Single, m As Single, x() As Single, t As Single, a2() As Single
' p2 G1 U% t4 V- @ReDim 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
, F( x. R6 J/ k, KNext '将a()的值全部赋给a2()
m = 0
D = 1
ReDim x(1 To n)
7 S% ]) {$ Z( P; m' b3 S' NPrint "--------------------------------"
Print "您输入的增广矩阵如下："
For i = 1 To n
s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
; t8 h- c4 H1 R/ GFor j = 1 To n
# [4 k' C4 x7 G* A2 }- ta(i, j) = Val(Left(s, InStr(s, " ")))
6 Q/ i: K, X7 ]" A- x+ E* ]2 hs = Trim(Right(s, (Len(s) - InStr(s, " "))))
0 r2 n6 i0 T! Y' y( i2 o' ^Print a(i, j);
9 `( a  [- i8 h+ M; K1 I. aNext
a(i, n + 1) = Val(s)
Print a(i, n + 1);
Print
Next
8 M5 d% b7 j% Q% g% _2 z
For k = 1 To n - 1 '开始消元
If a(k, k) = 0 Then
MsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
Exit Sub
Else
0 Y1 g8 b4 ~' R$ Y6 o# _For i = k + 1 To n
* W/ Z2 }/ V. P9 K/ K- \7 p- ~l(i, k) = a(i, k) / a(k, k)
For j = k + 1 To n + 1
) S) C$ _) G: V5 C. v1 ra(i, j) = a(i, j) - l(i, k) * a(k, j)
Next
Next
; V! k4 f  S$ [: t. L; ~D = D * a(k, k)
End If
Next k '消元结束
If a(n, n) = 0 Then
MsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
) Y7 c3 \* a! A5 |' N9 [+ B$ wExit Sub
Else
- ]  X2 h1 l$ t8 c$ x' \+ q+ R2 ~D = D * a(n, n)
End If
- E- ], c% g6 E/ J- c3 V1 n" UPrint "--------------------------------"
1 K- Z$ E5 J5 J5 c1 o* e: h' nPrint "系数行列式的值是："; D
x(n) = a(n, n + 1) / a(n, n)
; R* A* u9 n0 B  Z. IFor 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
( e1 p" P" F* O; M$ bNext k '结束回代
7 i5 @5 r  k$ b& A
Print "--------------------------------"
Print "方程组的解如下："

  h1 a; j6 M6 i$ ^6 l/ jFor k = 1 To n
Print
Print "X(" & k & ") = " & x(k)
  t. F8 Y( D& V8 v7 N' |1 ENext k
/ G8 b: ]* D6 DPrint "--------------------------------"
% e6 H0 W; z+ V% O. U% Z" G0 ~8 zPrint "其中各行Ax-b="
Print
For i = 1 To n
t = 0
For j = 1 To n
/ F/ X% U) W+ m* gt = t + a2(i, j) * x(j)
! \5 e1 t# [% r  xNext j
t = t - a2(i, n + 1)
, x% |6 s. c, {1 ?3 CPrint Spc(5); "第" & i & "行："; t
Print
' S9 P6 r# W5 y1 gNext i

. R+ L1 F# W9 `# i6 P$ `' H4 fEnd SubPrivate Sub gauss_Click() '高斯消去法
0 ^& ^' y# c# T, p4 X  m$ T! `Dim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single
i = 1: j = 1
( K3 }* B! R+ Q& k" e) qn = 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
. B9 j' [& @8 T8 H$ yReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()
5 X  o% t8 q6 r- l1 QFor i = 1 To n
' n, T! _  J+ }2 w0 ?For j = 1 To n
7 P$ E3 o( A* z3 }0 r; |8 h" ca2(i, j) = a(i, j)
1 l7 W1 J9 j' U' N/ t9 I+ [6 DNext
Next '将a()的值全部赋给a2()
m = 0
9 a) [, y' I7 }# uD = 1
2 i- G2 a7 [1 IReDim x(1 To n)
Print "--------------------------------"
2 v$ `& T! z" K* rPrint "您输入的增广矩阵如下："
For i = 1 To n
s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
For j = 1 To n
( R7 A& o4 x5 y5 D8 A6 ia(i, j) = Val(Left(s, InStr(s, " ")))
s = Trim(Right(s, (Len(s) - InStr(s, " "))))
Print a(i, j);
Next
' U& M3 ?3 K# `3 ]a(i, n + 1) = Val(s)
, a" J! E& m. JPrint a(i, n + 1);
Print
) z, n2 p0 h# T- [6 j! bNext

; j& e, \4 \. J3 VFor k = 1 To n - 1 '开始消元
$ Y* C# A9 h) j! a5 {( K* _, f* a0 _If a(k, k) = 0 Then
MsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
Exit Sub
Else
For i = k + 1 To n
6 [8 p5 `  X# j2 Pl(i, k) = a(i, k) / a(k, k)
For j = k + 1 To n + 1
  D  M7 C( e" K- u1 @1 ]a(i, j) = a(i, j) - l(i, k) * a(k, j)
Next
# P9 ^) D! J, M1 M( B' {Next
1 Y9 a) P. g9 n; G' l4 dD = D * a(k, k)
End If
+ L8 t, O  U3 |6 p3 d9 {0 ]0 h3 K0 eNext k '消元结束
/ Y! _& K4 J; gIf a(n, n) = 0 Then
  @- M& y) D* Q& H. f2 O+ F, t7 DMsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
  z6 R% n  Q4 o' I2 X+ D' `Exit Sub
Else
D = D * a(n, n)
End If
& I9 t( U8 J5 C  ^: UPrint "--------------------------------"
8 c' q; n# @4 T7 b! e* {* F: RPrint "系数行列式的值是："; D
x(n) = a(n, n + 1) / a(n, n)
For k = n - 1 To 1 Step -1 '开始回代
  j5 }* ?1 b4 J, zFor j = k + 1 To n
( x+ O4 q$ A' ?# M! H, am = m + a(k, j) * x(j)
$ X' O' |! A! J9 y" ?Next j
8 `8 T7 b7 V2 ^. _' g# Kx(k) = (a(k, n + 1) - m) / a(k, k)
m = 0
Next k '结束回代

- o( G% h" |. m& zPrint "--------------------------------"
3 x0 Q  E- m: ~2 lPrint "方程组的解如下："
7 d6 s7 ~( `5 b6 ?
9 _) ^; r4 s; h% D4 r: ZFor k = 1 To n
Print
3 J! T1 v) n# C, n5 m' L3 I/ |. _Print "X(" & k & ") = " & x(k)
; @5 h8 u5 t! n2 m* zNext k
$ x4 O8 B1 R( @) X# C! ]& dPrint "--------------------------------"
Print "其中各行Ax-b="
( D  c( w) Y+ ]; `Print
For i = 1 To n
t = 0
For j = 1 To n
t = t + a2(i, j) * x(j)
" Y5 F  W2 Q# T* K3 l% l! ANext j
1 Q1 @: {) p6 _% u( e( J) ?t = t - a2(i, n + 1)
) [) k& o, \& }: ]0 W% {Print Spc(5); "第" & i & "行："; t
/ O+ s8 E  d/ z4 @  L, h2 R% KPrint
Next i

# ?1 M- W+ k( J" W0 `# SEnd Sub

zqyzixin

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

lq12131010

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

ch123en123

下载学习哦