[讨论]高斯消去法---这是用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
+ _  x* d; P/ D# Y3 G; h$ j6 Tn = 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)
/ A  Q/ {) e8 o: m6 EDim k As Integer, D As Single, m As Single, x() As Single, t As Single, a2() As Single
" H0 h4 K% N+ C; Y1 f0 ^# _- uReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()
- S- ]# c  z9 r( `- E1 ?; w5 ?For i = 1 To n
9 J5 i9 ?5 v/ t) _0 M3 mFor j = 1 To n
/ w( J- l) \) k7 [1 w+ La2(i, j) = a(i, j)
- i, P* ^- h( B. d8 A6 R4 DNext
Next '将a()的值全部赋给a2()
m = 0
D = 1
; A8 ^" d2 S3 r! t3 q# S% ZReDim x(1 To n)
% i: Q6 O9 L. Q' \6 NPrint "--------------------------------"
+ t& ~# d& X( O; j- J7 hPrint "您输入的增广矩阵如下："
9 B  ]' w; N9 m; h1 uFor i = 1 To n
s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
For j = 1 To n
1 T# k2 ?# g! ]) t- X+ O# v; na(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)
8 L- ~( ~8 @- Z6 ?  U: Y* q+ A& \Print a(i, n + 1);
Print
Next
6 X/ G' F* V/ c& ^5 D- k" M; v9 W
For k = 1 To n - 1 '开始消元
If a(k, k) = 0 Then
MsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
0 g* B: p3 R% C6 AExit Sub
Else
For i = k + 1 To n
% P- ?- V" r2 p# w' Vl(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)
Next
  y; q) y1 F( k0 lNext
. H! Q# t; H+ g# dD = D * a(k, k)
- ?2 l9 g& E. r0 @, y, GEnd If
1 K# G" i# T: @8 v# Z2 @Next k '消元结束
: q7 S0 K" s3 [4 RIf a(n, n) = 0 Then
MsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
" T% H" Z7 Z; E& O5 b& sExit Sub
Else
D = D * a(n, n)
% P7 K- F9 x! p* P' IEnd If
5 c8 S' ?' J+ J; t! q! Y9 W, LPrint "--------------------------------"
Print "系数行列式的值是："; D
x(n) = a(n, n + 1) / a(n, n)
5 H/ I. t1 ~5 S+ U; rFor k = n - 1 To 1 Step -1 '开始回代
+ k* E; B& O% DFor j = k + 1 To n
m = m + a(k, j) * x(j)
' L9 ^' X& V+ ANext j
" W1 h2 _* d) Y0 P9 {x(k) = (a(k, n + 1) - m) / a(k, k)
8 u1 N# L& t  W1 sm = 0
Next k '结束回代
% m$ I2 p" F2 @+ J  c; v8 s
0 R1 Y8 \% Z; N7 ?. s; q6 ]Print "--------------------------------"
+ c0 Z# d& P5 O# N5 s* MPrint "方程组的解如下："

For k = 1 To n
Print
1 S3 I7 X) F1 }0 L5 O: qPrint "X(" & k & ") = " & x(k)
Next k
Print "--------------------------------"
Print "其中各行Ax-b="
Print
For i = 1 To n
, K4 ?& J0 e, S/ Vt = 0
5 q2 r! s  _! A7 C4 RFor j = 1 To n
3 ^. t8 H  U+ ]5 M: dt = t + a2(i, j) * x(j)
Next j
' q9 A# H8 T2 h! At = t - a2(i, n + 1)
Print Spc(5); "第" & i & "行："; t
3 [, |- J; l" RPrint
Next i
8 L6 C: B' K" J. E
End SubPrivate Sub gauss_Click() '高斯消去法
Dim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single
, Q- i4 F+ z5 Y; C, d, yi = 1: j = 1
n = Val(InputBox("请输入矩阵的阶数(即：方程组未知数个数)N", "方程的未知数个数n", 3))
3 ]9 X4 s; y2 ]0 ]- v- AReDim Preserve a(1 To n, 1 To n + 1)
1 y. _) {0 E" s; G! cReDim Preserve l(1 To n, 1 To n + 1)
' ^/ J9 Y3 w. Z" s! C" v7 mDim k As Integer, D As Single, m As Single, x() As Single, t As Single, a2() As Single
5 v% O; N: P, G% D# l+ O! \- PReDim 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)
# M' y4 u4 v: N9 Y0 E0 Q- o3 mNext
Next '将a()的值全部赋给a2()
m = 0
* m3 c1 R6 G3 C9 l' j  C' G$ |D = 1
ReDim x(1 To n)
Print "--------------------------------"
Print "您输入的增广矩阵如下："
' q2 g) y7 j  q4 |  D' v& w( EFor i = 1 To n
& A. i& t7 a0 j  h0 p* q& R% Os = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
! Y. p7 S8 a0 m2 |4 r9 m* ^For j = 1 To n
a(i, j) = Val(Left(s, InStr(s, " ")))
' c( k9 J" \  F7 }/ s9 ?s = Trim(Right(s, (Len(s) - InStr(s, " "))))
9 D1 A) I0 a+ q! ]! K( ePrint a(i, j);
( V' ?. s6 H( i5 r9 r8 `- H2 z$ c' \3 _Next
a(i, n + 1) = Val(s)
Print a(i, n + 1);
Print
$ Q. a" m3 _8 C3 m5 Z3 yNext
( c2 W6 G/ O2 f, L# O$ ]
" o( x1 y1 l; Y# x$ L& NFor k = 1 To n - 1 '开始消元
If a(k, k) = 0 Then
# q+ m7 g1 |; g; b( u" m) MMsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
Exit Sub
) S6 e! K  S) l; YElse
+ _+ N/ H0 K. }9 U0 aFor i = k + 1 To n
7 h8 r4 r; H' ~* y/ Ql(i, k) = a(i, k) / a(k, k)
For j = k + 1 To n + 1
4 V' Q, e8 f) \8 v: q& f, va(i, j) = a(i, j) - l(i, k) * a(k, j)
: i, q8 H, [: [' ^/ I( @& J% g7 B7 U; VNext
9 I+ ]* g7 m2 {0 ^9 }( q. RNext
D = D * a(k, k)
End If
Next k '消元结束
If a(n, n) = 0 Then
MsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
Exit Sub
Else
: k* `% J3 F, kD = D * a(n, n)
End If
Print "--------------------------------"
Print "系数行列式的值是："; D
x(n) = a(n, n + 1) / a(n, n)
For k = n - 1 To 1 Step -1 '开始回代
: i# W4 [0 |2 l7 OFor j = k + 1 To n
m = m + a(k, j) * x(j)
Next j
: d# w$ a5 l/ Y  k2 n& R* Ix(k) = (a(k, n + 1) - m) / a(k, k)
m = 0
Next k '结束回代
1 Q* u& ?  L$ T. K+ d4 X
& k% W' \4 k  l$ {* ^0 e- EPrint "--------------------------------"
Print "方程组的解如下："
+ u$ Z& I7 j! w' a: L; U9 `+ O
- z2 i9 i: b1 Y0 |7 v0 J- E! c3 gFor k = 1 To n
& O1 S; P0 ^/ L5 u4 j3 r7 @3 b( FPrint
( y/ {" n3 {& j- p/ t9 TPrint "X(" & k & ") = " & x(k)
Next k
Print "--------------------------------"
Print "其中各行Ax-b="
2 h: E* Q2 L) b: \5 I4 l& rPrint
' j8 U$ |' M, X' {2 A, E; MFor i = 1 To n
t = 0
* N# @8 b$ ?( F1 i3 J* }For j = 1 To n
) K( K  k. b# bt = t + a2(i, j) * x(j)
Next j
t = t - a2(i, n + 1)
+ P* c1 e& w" @+ F& k# _' U0 lPrint Spc(5); "第" & i & "行："; t
; n- O; M* t- W8 k& ePrint
Next i

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

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