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

god

Private Sub gauss_Click() '高斯消去法
2 t: |( E. F4 Y0 tDim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single
, w0 b/ O* C' ki = 1: j = 1
6 w$ d' M! X, _: G: yn = Val(InputBox("请输入矩阵的阶数(即：方程组未知数个数)N", "方程的未知数个数n", 3))
! R' ?" {. C' WReDim 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
ReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()
For i = 1 To n
1 s0 K8 H0 f4 j/ t/ GFor j = 1 To n
; o& t7 z+ @0 h5 v* u7 ^+ w: ra2(i, j) = a(i, j)
* g) j% G! ^% B2 V" F( ?Next
( Y: Z* G5 Y! y* c' _Next '将a()的值全部赋给a2()
m = 0
! G9 e! Z. i9 i' p& s: H  CD = 1
! t9 X- w1 I. S( M# ?. h9 [ReDim x(1 To n)
Print "--------------------------------"
Print "您输入的增广矩阵如下："
For i = 1 To n
s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
For j = 1 To n
a(i, j) = Val(Left(s, InStr(s, " ")))
# f  }$ r% a; t6 J6 fs = Trim(Right(s, (Len(s) - InStr(s, " "))))
5 V5 @) [; a6 }9 Y" L: F8 pPrint a(i, j);
Next
a(i, n + 1) = Val(s)
+ x) R, T$ G+ K2 f7 lPrint a(i, n + 1);
Print
Next

3 I* `1 U- O) y) C8 n# oFor k = 1 To n - 1 '开始消元
* d4 y, n* u$ G" R- i( T7 V4 WIf a(k, k) = 0 Then
( l9 W; Z* [. c3 s: Z% R; CMsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
" Q/ c& p0 |" d4 h: iExit Sub
' W" A  C% @( l, xElse
: K9 f! v: G2 v' R% vFor i = k + 1 To n
l(i, k) = a(i, k) / a(k, k)
- u, A# L! O/ GFor j = k + 1 To n + 1
a(i, j) = a(i, j) - l(i, k) * a(k, j)
+ S1 Y9 R. x6 y# _9 P% F2 ENext
Next
0 b; ]8 I/ e4 ?* E7 Y4 yD = D * a(k, k)
End If
Next k '消元结束
If a(n, n) = 0 Then
& a2 z. f' J4 D9 P2 ^; X; @MsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
Exit Sub
7 a# D9 s$ k4 u5 R4 g; x8 f( FElse
- Y9 [# q$ f# nD = D * a(n, n)
; P2 R+ F1 G! F0 I" A, c2 i& IEnd If
Print "--------------------------------"
Print "系数行列式的值是："; D
& R3 M" x# j: e& `$ S3 U( o; `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)
# q& _) k) z# Y: W, r( LNext j
x(k) = (a(k, n + 1) - m) / a(k, k)
( m5 C1 C  L8 e& J" I" |1 vm = 0
; z' A3 Q' H4 m1 O3 s! ]Next k '结束回代

Print "--------------------------------"
Print "方程组的解如下："

( b# J5 k4 d5 M+ t# ]2 rFor k = 1 To n
Print
: c( ~. ]7 N/ L+ Y& c; h: @Print "X(" & k & ") = " & x(k)
Next k
/ Y. H# S; k( X5 m& MPrint "--------------------------------"
Print "其中各行Ax-b="
Print
3 S3 e6 H8 U1 {0 d" SFor i = 1 To n
t = 0
For j = 1 To n
5 X6 p1 V; D1 g/ r: V2 @t = t + a2(i, j) * x(j)
Next j
# m6 |) g4 W8 U7 rt = t - a2(i, n + 1)
Print Spc(5); "第" & i & "行："; t
! H8 {! C: C2 Y$ h7 cPrint
& |0 V0 I5 _/ VNext i
3 D6 G4 d. c5 I: g
9 ~* Z- k# \% ^. [End SubPrivate Sub gauss_Click() '高斯消去法
5 c* E* ], o1 t; m  ^8 mDim 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))
ReDim Preserve a(1 To n, 1 To n + 1)
5 ^& C9 [+ c2 E4 S5 w1 BReDim 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
. f" L! q9 `- @+ k) H3 S; DReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()
For i = 1 To n
For j = 1 To n
- w7 B9 T1 [9 x" Ma2(i, j) = a(i, j)
& ^  v- z# r, s. }Next
Next '将a()的值全部赋给a2()
m = 0
) m+ o! }5 B' f8 M* z9 [D = 1
3 c5 o% m3 t" G- A: `ReDim x(1 To n)
' C# R/ |9 _% O& Y0 @) e8 NPrint "--------------------------------"
Print "您输入的增广矩阵如下："
For i = 1 To n
, {3 j& C& R& Y. R+ y$ ^8 @s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
" r$ [& O" B) x; i; O5 hFor j = 1 To n
a(i, j) = Val(Left(s, InStr(s, " ")))
3 l8 L* t8 S; \7 ?* a7 X# e9 w/ os = Trim(Right(s, (Len(s) - InStr(s, " "))))
* A( f; w7 B  ]Print a(i, j);
: u& ~/ Y. g% u! X0 a" XNext
a(i, n + 1) = Val(s)
4 [! \% I7 y6 J+ z- sPrint a(i, n + 1);
. N) J2 E' ?) @, `, a" C; ]- uPrint
* n# u$ d+ G1 Z: g& LNext

/ s3 n  T+ e4 x' UFor k = 1 To n - 1 '开始消元
/ U& I3 R" m9 N1 a( _! ]2 W$ s5 QIf a(k, k) = 0 Then
MsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
; p/ `# M0 [9 F0 I" ^) IExit Sub
- M- r% N% |& C! W3 M7 J) WElse
8 H8 r9 s6 f1 H$ DFor i = k + 1 To n
5 w* Z! \  v4 k% z8 T4 o; @$ A% {l(i, k) = a(i, k) / a(k, k)
For j = k + 1 To n + 1
( Q" M5 m" g% M. s; ga(i, j) = a(i, j) - l(i, k) * a(k, j)
0 b+ ^, c7 i, V9 {, V8 VNext
7 ]# R9 y  }% V! A  Y% ~8 D, O& DNext
D = D * a(k, k)
# l5 B* i2 ?# u. f" nEnd If
Next k '消元结束
' H, X" |* {4 A4 q4 y# M! u# @: ]% dIf a(n, n) = 0 Then
+ Q" T+ H" E7 H. _& C) u  x( Z6 EMsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
7 u8 M4 \1 E0 b4 C" }6 B$ lExit Sub
' E' T. h& J$ `% [Else
# g+ z) j) S+ sD = D * a(n, n)
  }# x6 l2 [* X, J, n: w8 WEnd If
Print "--------------------------------"
Print "系数行列式的值是："; D
0 I! M9 e) N! Nx(n) = a(n, n + 1) / a(n, n)
For k = n - 1 To 1 Step -1 '开始回代
) d( ]4 ?6 K( m3 z- |; TFor 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
% g( l; S7 }1 R! R2 Q: A8 F6 pNext k '结束回代
, n; V( u0 a+ r2 H
, Q! t4 r# r$ {) _% Z! TPrint "--------------------------------"
: @! h5 d9 Y& O2 zPrint "方程组的解如下："
' E" N: M' X. `. m6 A( h7 r1 y
For k = 1 To n
; Y) N) b/ U& SPrint
0 l8 v1 t( Y# p( ~% Z9 l/ qPrint "X(" & k & ") = " & x(k)
Next k
' @4 p. f0 d& L5 X) f" d$ U0 o9 RPrint "--------------------------------"
7 ~2 [" J. k2 ?9 X9 h5 U1 \/ CPrint "其中各行Ax-b="
1 @8 j3 ^: [- N& FPrint
3 P9 p4 f" Q* [) A* t, uFor i = 1 To n
: V1 P. q( e/ c5 D& u$ At = 0
For j = 1 To n
t = t + a2(i, j) * x(j)
: B  o, U5 w1 h2 s, G* c3 D, uNext j
: B( P5 y5 J" B+ M) I: Ht = t - a2(i, n + 1)
Print Spc(5); "第" & i & "行："; t
Print
& Q' A$ P1 p% hNext 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

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