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

god

Private Sub gauss_Click() '高斯消去法
* Z8 [. D7 r7 Y; ]+ a: ]& KDim 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))
0 n% H8 d  S1 s4 ?) G# bReDim Preserve a(1 To n, 1 To n + 1)
  F$ N  b( d  F& ~+ @. X& `+ g2 CReDim Preserve l(1 To n, 1 To n + 1)
5 _; _$ U% W9 X6 u+ ~2 y9 k9 @& U2 Y% qDim k As Integer, D As Single, m As Single, x() As Single, t As Single, a2() As Single
6 S7 x7 L4 q* O) w7 ^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)
7 U9 L' M. [' |$ MNext
Next '将a()的值全部赋给a2()
m = 0
+ B9 `( P/ d  F  d2 ~* M) N1 uD = 1
* `) f7 ~  F2 K) MReDim x(1 To n)
Print "--------------------------------"
Print "您输入的增广矩阵如下："
) F7 l0 [0 h# E+ \For i = 1 To n
s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
, _, b  Y* ~0 aFor j = 1 To n
9 s& r4 O+ c9 }0 T  v% S1 i* q# V7 Ba(i, j) = Val(Left(s, InStr(s, " ")))
) C% a- Y( c4 Q  {: Q2 gs = Trim(Right(s, (Len(s) - InStr(s, " "))))
' z' T+ [1 U8 N6 ~/ J4 {Print a(i, j);
Next
a(i, n + 1) = Val(s)
Print a(i, n + 1);
Print
Next
2 Z# H8 U4 m. N- J9 T. R& ^- P
For k = 1 To n - 1 '开始消元
' b" v, h( y+ v0 {" g% d/ QIf a(k, k) = 0 Then
MsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
# l# M% I3 t4 i1 B# c5 U4 f5 kExit Sub
0 v3 J5 z" q$ a' N$ P$ m% tElse
For i = k + 1 To n
. ~. _) \3 ~% d' e) N  cl(i, k) = a(i, k) / a(k, k)
For j = k + 1 To n + 1
. W* j$ E  m# {" w9 n) La(i, j) = a(i, j) - l(i, k) * a(k, j)
, S6 Y6 F4 k5 KNext
6 Y0 B* J5 W' ?0 ^Next
5 @* E0 ^' y! s9 W( z+ v+ VD = D * a(k, k)
8 n( V' d  i" m4 w% H: KEnd If
Next k '消元结束
If a(n, n) = 0 Then
MsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
. C2 S+ W# f! z0 M7 hExit Sub
; I' ]6 `4 o' ~$ `) f) eElse
D = D * a(n, n)
/ U. B+ g- c. M$ ]" w8 D. GEnd If
Print "--------------------------------"
; g5 ?6 f. G3 jPrint "系数行列式的值是："; D
x(n) = a(n, n + 1) / a(n, n)
For k = n - 1 To 1 Step -1 '开始回代
For j = k + 1 To n
m = m + a(k, j) * x(j)
Next j
  k' G3 c1 W" k5 G1 |x(k) = (a(k, n + 1) - m) / a(k, k)
m = 0
Next k '结束回代
9 v) g- u% P4 }; z$ p$ `+ W
# E2 G5 N! B! x( `& U" g  |$ MPrint "--------------------------------"
. f2 g/ b4 Y( g6 _& HPrint "方程组的解如下："
# p- Z6 d) @: n/ f$ o9 T* p7 q
$ E$ g. Z4 @$ O$ M! h4 Z& Y* ZFor k = 1 To n
$ m% D: \( z1 s; bPrint
) e; R0 ?3 S7 x4 r6 l/ w, b1 M6 K' GPrint "X(" & k & ") = " & x(k)
0 Z7 }2 A  m8 Z& jNext k
/ Y* m5 k. o4 L2 u/ E9 ~Print "--------------------------------"
. b- O' p0 H* n& U: oPrint "其中各行Ax-b="
) |* ^% f1 b; k) L: iPrint
3 z$ m5 b9 j# k2 z* Q' P. W3 S1 AFor i = 1 To n
t = 0
For j = 1 To n
8 V' r, r# J7 W9 G. Zt = t + a2(i, j) * x(j)
Next j
t = t - a2(i, n + 1)
Print Spc(5); "第" & i & "行："; t
Print
Next i
6 u0 O7 B! q1 O8 [
End SubPrivate Sub gauss_Click() '高斯消去法
: d' L4 T. J) i- ~( dDim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single
i = 1: j = 1
/ _# h( b6 R! z7 _" v/ An = Val(InputBox("请输入矩阵的阶数(即：方程组未知数个数)N", "方程的未知数个数n", 3))
6 k3 t, J2 c9 V* IReDim Preserve a(1 To n, 1 To n + 1)
# ?7 q/ {, W% H! l9 [4 PReDim Preserve l(1 To n, 1 To n + 1)
3 l" x. t# d5 g* b( M8 MDim 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()
For i = 1 To n
For j = 1 To n
; ^# A8 ~) ~$ O9 h8 qa2(i, j) = a(i, j)
Next
. G/ ~; k6 }/ E+ W! Y! Z: z3 ]% \Next '将a()的值全部赋给a2()
m = 0
D = 1
ReDim x(1 To n)
) \: d) O. r3 {, w, aPrint "--------------------------------"
Print "您输入的增广矩阵如下："
0 W, ?& M$ d, {' j$ [1 u" HFor i = 1 To n
% ^& q) B0 D8 ns = 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, " "))))
8 x; n) w0 }* w( j6 m8 WPrint a(i, j);
% ?3 Y6 h/ [2 o: y3 KNext
a(i, n + 1) = Val(s)
Print a(i, n + 1);
Print
Next

% O9 D% J# _1 pFor k = 1 To n - 1 '开始消元
If a(k, k) = 0 Then
MsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
, Q4 _& }4 _  {* t' dExit Sub
Else
For i = k + 1 To n
# h# R+ P$ p( J* L8 z: C- b" @9 T$ ]3 zl(i, k) = a(i, k) / a(k, k)
  i) f4 `" L; u' z0 gFor j = k + 1 To n + 1
a(i, j) = a(i, j) - l(i, k) * a(k, j)
Next
4 \/ }; O$ ^  t7 ~Next
D = D * a(k, k)
: \" P: V* c% f4 T4 _End If
Next k '消元结束
, R. Q' z* ?, m5 CIf a(n, n) = 0 Then
4 w0 ?) {$ i  H" T/ M) S+ q4 CMsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
Exit Sub
( P5 @$ C$ s) w/ G# U) UElse
D = D * a(n, n)
End If
2 S' a5 t9 `0 G  y  p$ TPrint "--------------------------------"
; t+ f' O9 S$ [Print "系数行列式的值是："; D
5 h8 N# j" q. w% _5 Y$ f# C$ cx(n) = a(n, n + 1) / a(n, n)
For k = n - 1 To 1 Step -1 '开始回代
) L+ v4 E6 n. R& MFor j = k + 1 To n
& q4 e' T% W. L1 _6 p1 Q% a& Em = m + a(k, j) * x(j)
) h& N2 w4 s& H9 d) X- LNext j
& Q7 {3 a- e" @1 bx(k) = (a(k, n + 1) - m) / a(k, k)
, `: j; U& e- k  ?m = 0
Next k '结束回代

Print "--------------------------------"
. v. ]& m" n0 _$ ^* ZPrint "方程组的解如下："

8 k( Y. C. C. @) l* zFor k = 1 To n
Print
Print "X(" & k & ") = " & x(k)
) _$ f% s# ~' Z( }! `. bNext k
& G% n7 t3 G( u/ x3 V7 R  b! WPrint "--------------------------------"
# i" {8 W" \6 b: U+ n0 L) tPrint "其中各行Ax-b="
Print
0 W6 J4 V- K9 E( CFor i = 1 To n
t = 0
For j = 1 To n
t = t + a2(i, j) * x(j)
1 ^1 ]7 f: I5 S0 Z" cNext j
( m! j) u  Z$ b5 V- H. h2 Yt = t - a2(i, n + 1)
) C1 k6 |0 V2 @/ L9 P$ x9 C7 JPrint Spc(5); "第" & i & "行："; t
" h( E/ e" U  }# LPrint
) f- W0 n4 n6 y, [. l8 \4 \1 ENext i

6 m( W7 P" B1 ]" KEnd Sub

ch123en123

下载学习哦

lq12131010

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

zqyzixin

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