[讨论]高斯消去法---这是用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
8 A- _1 g; M! T+ w% N+ Sn = Val(InputBox("请输入矩阵的阶数(即：方程组未知数个数)N", "方程的未知数个数n", 3))
3 _% I0 J7 _( D- n  xReDim Preserve a(1 To n, 1 To n + 1)
% X/ g1 B9 L) N9 \1 T2 U. ~# yReDim 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
; N% b/ |7 j+ b$ v7 q: i$ b8 ~ReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()
For i = 1 To n
9 i  a- E6 e; Z4 `For j = 1 To n
a2(i, j) = a(i, j)
+ }1 z, s3 [7 u8 x% b! l8 NNext
Next '将a()的值全部赋给a2()
m = 0
D = 1
9 d' F4 m5 i7 W; G- G/ c6 s2 j+ D  MReDim x(1 To n)
Print "--------------------------------"
Print "您输入的增广矩阵如下："
For i = 1 To n
, k: O" u- v# M. M$ ]1 w# p+ ls = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
6 B4 c+ c# J$ N. u* WFor j = 1 To n
! i8 k3 g7 G) G4 U& la(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)
, J; S  b5 ]( M; @Print a(i, n + 1);
2 b' ]6 m, e: l# [6 |+ APrint
Next

7 x& L# D( ]9 |( _( lFor k = 1 To n - 1 '开始消元
If a(k, k) = 0 Then
MsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
Exit Sub
2 d$ h! e1 K1 x$ H; o2 tElse
For i = k + 1 To n
) Q4 |( X$ E1 g% ~7 q9 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)
$ \0 I2 h/ g9 G# `) f: Q7 hNext
" f6 B, Y4 D/ tNext
D = D * a(k, k)
End If
9 d" H/ [5 l0 A' y$ z. iNext k '消元结束
% O, a7 ^# E; K, N/ _' h4 _If a(n, n) = 0 Then
MsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
Exit Sub
* w: \2 |9 f3 Y' DElse
D = D * a(n, n)
. B8 I, a9 R7 L/ {2 X7 NEnd If
0 e2 m: y9 e& Y1 j( Z2 Y2 {4 R! P! b/ CPrint "--------------------------------"
7 h7 a- g) ]# q1 Q/ CPrint "系数行列式的值是："; D
x(n) = a(n, n + 1) / a(n, n)
* v# O# ~* w5 MFor k = n - 1 To 1 Step -1 '开始回代
) b' F& ~% X: P4 b2 M! u- M+ E# cFor j = k + 1 To n
  R3 U3 _# t# f3 ^2 z; wm = m + a(k, j) * x(j)
3 I4 d" ^/ W! v- }$ {8 B: c% q- ?Next j
, m$ h0 l$ L  L+ v& F: a6 ax(k) = (a(k, n + 1) - m) / a(k, k)
m = 0
Next k '结束回代
! I; z! D5 i" i/ a! u
Print "--------------------------------"
Print "方程组的解如下："
2 |4 o4 ~, K* f' b
For k = 1 To n
7 p( q$ E) R5 a/ M8 T8 f' E( TPrint
- u- W+ x1 w1 ^2 k1 |; uPrint "X(" & k & ") = " & x(k)
Next k
1 H, P8 Z2 h) H( ]1 B- B+ c; |4 \, KPrint "--------------------------------"
2 w/ g# b. s2 J; m+ t) r/ P/ vPrint "其中各行Ax-b="
: h: T* @! L5 G. Y9 L. TPrint
For i = 1 To n
& Y* ?1 l. ^: ?% l- ?/ y8 rt = 0
' R$ c7 m" e9 x# b6 J& r3 MFor j = 1 To n
t = t + a2(i, j) * x(j)
Next j
t = t - a2(i, n + 1)
Print Spc(5); "第" & i & "行："; t
Print
  @" p- t& e* A7 r/ Z$ aNext i
* n+ P  P+ J. I, _2 L" _
End SubPrivate 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
! T7 R4 l7 a1 y2 h$ x, {% Dn = Val(InputBox("请输入矩阵的阶数(即：方程组未知数个数)N", "方程的未知数个数n", 3))
5 {) l. `0 z- O- ^, }# X; }ReDim Preserve a(1 To n, 1 To n + 1)
ReDim Preserve l(1 To n, 1 To n + 1)
( Z1 N3 b1 {# ]) z# }- J- n3 pDim k As Integer, D As Single, m As Single, x() As Single, t As Single, a2() As Single
+ X: h; K8 _" w' X1 k. |ReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()
For i = 1 To n
For j = 1 To n
7 d0 R0 q0 ]  o3 O" Ra2(i, j) = a(i, j)
Next
( o5 @/ i* B" m/ ~$ F7 S9 hNext '将a()的值全部赋给a2()
m = 0
D = 1
3 a% }0 h3 L' CReDim x(1 To n)
/ f1 j) t3 w2 [6 t5 ^' XPrint "--------------------------------"
Print "您输入的增广矩阵如下："
. X" h" X+ s' NFor i = 1 To n
4 F) V( x! m- K/ F+ l2 js = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
For j = 1 To n
a(i, j) = Val(Left(s, InStr(s, " ")))
s = Trim(Right(s, (Len(s) - InStr(s, " "))))
Print a(i, j);
: r! @' T  G7 eNext
6 |9 X, G' }. I9 u6 Ta(i, n + 1) = Val(s)
; M7 I0 B" v: B% v& g- m0 w6 h* rPrint a(i, n + 1);
9 S5 ~& Q! s& N0 NPrint
Next

For k = 1 To n - 1 '开始消元
2 J% z. k% u& x) \& L* cIf a(k, k) = 0 Then
3 x+ W) [1 k7 D8 @8 j& z- f9 VMsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
9 Q! ]$ G& u; R% ~6 pExit Sub
% r1 y! {. i- ~$ ?/ wElse
5 |( w4 ^. s+ X( KFor i = k + 1 To n
5 B+ z7 _3 j1 V" c0 b  N: N% ql(i, k) = a(i, k) / a(k, k)
3 F2 B3 Z' d, F- eFor j = k + 1 To n + 1
a(i, j) = a(i, j) - l(i, k) * a(k, j)
Next
# g! A" v+ H' o/ h9 M: P: A/ aNext
3 Q" k! o* }) }- p  R2 \$ h5 r# BD = D * a(k, k)
2 _4 H+ X+ R5 t5 wEnd If
9 T  j! k/ q# R, q. Z$ O3 `Next k '消元结束
* V2 {+ e- R$ `+ i& q0 _  t* RIf a(n, n) = 0 Then
MsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
! S" q* I. t/ h: kExit Sub
Else
D = D * a(n, n)
  e3 I5 S# q3 iEnd If
Print "--------------------------------"
/ m; q+ @# X  Z0 Q6 ]Print "系数行列式的值是："; D
x(n) = a(n, n + 1) / a(n, n)
6 E% E% k  i$ \" N2 r/ DFor k = n - 1 To 1 Step -1 '开始回代
For j = k + 1 To n
  w: p, \3 x$ a& e- l! Am = m + a(k, j) * x(j)
Next j
x(k) = (a(k, n + 1) - m) / a(k, k)
m = 0
Next k '结束回代
2 c; x# ^) W5 j& N- z* G2 _
Print "--------------------------------"
9 I  d4 `' x, ]6 n# HPrint "方程组的解如下："

6 A1 Z" V5 E' oFor k = 1 To n
Print
3 q0 `2 E* i! MPrint "X(" & k & ") = " & x(k)
Next k
9 Z* }/ ]* w6 J+ K! TPrint "--------------------------------"
4 c- B2 H5 x' [6 p. jPrint "其中各行Ax-b="
3 \8 j+ J; K; A1 F4 T& \Print
7 |# e  I$ W* Z  B% x8 mFor i = 1 To n
8 x) G/ f4 x3 Vt = 0
For j = 1 To n
t = t + a2(i, j) * x(j)
. h. u1 g5 s4 F5 _6 b* d3 _$ pNext j
# f# p& @$ i  r# |# Y/ |: E; p" Wt = t - a2(i, n + 1)
Print Spc(5); "第" & i & "行："; t
) ^& t) o2 g5 u& U  IPrint
$ N4 _$ _6 k5 e6 M4 cNext i
$ M3 s) Y; f4 R' ^
2 \6 P* q1 G  O+ o/ Z: EEnd Sub

ch123en123

下载学习哦

lq12131010

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

zqyzixin

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