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

god

Private Sub gauss_Click() '高斯消去法
. P- k, S( _; `; o* _' EDim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single
. b0 ^7 y; t" R' [' n) |; |i = 1: j = 1
9 U9 [5 K0 }2 m4 f2 o/ O3 \, ?5 Un = Val(InputBox("请输入矩阵的阶数(即：方程组未知数个数)N", "方程的未知数个数n", 3))
. Z8 G' y0 l8 H% \ReDim Preserve a(1 To n, 1 To n + 1)
# [3 v3 s# x9 c/ G3 d$ c! RReDim Preserve l(1 To n, 1 To n + 1)
* W7 L* \8 J  ]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()
6 G: s7 ], _- L. EFor i = 1 To n
& O% v5 q' k, K: g1 nFor j = 1 To n
. q  a3 z: X& y) i# {- ya2(i, j) = a(i, j)
  D  e+ E3 G. D3 C7 m, SNext
: s; Z! _! L0 U5 s( M1 v8 MNext '将a()的值全部赋给a2()
m = 0
D = 1
ReDim x(1 To n)
+ P' @$ A" E) b# p- {+ fPrint "--------------------------------"
2 @8 d+ m! W* u" yPrint "您输入的增广矩阵如下："
; ?' X# k- E& K; j# \0 e% k. YFor i = 1 To n
s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
6 D; U$ C5 v' S1 }5 `! [( ]4 V- gFor j = 1 To n
a(i, j) = Val(Left(s, InStr(s, " ")))
  B8 C' F; G: X# c6 p* Ss = Trim(Right(s, (Len(s) - InStr(s, " "))))
: D  H9 b! P2 H% j- n% vPrint a(i, j);
Next
) r/ H$ ]6 I5 |( va(i, n + 1) = Val(s)
Print a(i, n + 1);
Print
% H; l4 Y9 Y" X2 j- O7 k4 @Next

For k = 1 To n - 1 '开始消元
8 r/ J4 C/ F" v7 b* a2 }/ TIf a(k, k) = 0 Then
2 z; f1 T4 G- R0 [MsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
Exit Sub
' z5 [# c6 }* N; U6 j+ v! Z6 NElse
For i = k + 1 To n
l(i, k) = a(i, k) / a(k, k)
, v6 J! K6 v  ^& u) d4 dFor j = k + 1 To n + 1
a(i, j) = a(i, j) - l(i, k) * a(k, j)
Next
Next
+ H4 n3 |7 S/ _D = D * a(k, k)
6 O$ k5 X/ x) V! `7 S% {' q0 eEnd If
Next k '消元结束
If a(n, n) = 0 Then
4 Y$ J! x3 w8 f1 w/ D1 ^9 S$ z* H' p; RMsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
4 u0 l4 p. E0 u! a' I3 r6 w! ^Exit Sub
Else
D = D * a(n, n)
9 A6 F; Q' \, r1 l& f, @: p" F* ~End If
3 w. B! I# r8 b4 mPrint "--------------------------------"
Print "系数行列式的值是："; 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)
% B; H: @% q4 T, s8 M9 ]Next j
x(k) = (a(k, n + 1) - m) / a(k, k)
6 `- l6 `6 L: j2 Mm = 0
Next k '结束回代

7 H6 H7 E% w$ c$ E$ j! bPrint "--------------------------------"
Print "方程组的解如下："

For k = 1 To n
+ K+ T" Z  T+ n( v# z- \  EPrint
Print "X(" & k & ") = " & x(k)
Next k
1 q& ]) j1 F4 {  F( E6 @Print "--------------------------------"
Print "其中各行Ax-b="
Print
For i = 1 To n
t = 0
) h1 m$ p/ Y5 I2 F3 L9 XFor j = 1 To n
t = t + a2(i, j) * x(j)
Next j
t = t - a2(i, n + 1)
  n/ g5 X: n5 U" J7 Q: c1 `Print Spc(5); "第" & i & "行："; t
Print
0 X  A# Y0 U/ E  pNext i

0 N  a0 r/ K0 `1 K) I' J1 S1 CEnd SubPrivate Sub gauss_Click() '高斯消去法
" _% B8 ]) V) J) j8 G& WDim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single
i = 1: j = 1
7 P9 c# q+ y% J) j# Y) f# Tn = Val(InputBox("请输入矩阵的阶数(即：方程组未知数个数)N", "方程的未知数个数n", 3))
6 {6 i' e8 |5 l2 I/ X; t( PReDim Preserve a(1 To n, 1 To n + 1)
* Q- W! a; X; m' J7 U2 a% v% vReDim Preserve l(1 To n, 1 To n + 1)
! {* H' W* ^( V* mDim k As Integer, D As Single, m As Single, x() As Single, t As Single, a2() As Single
' A& v; z! O: \% C+ f  oReDim 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)
$ \  ~4 t! [: N4 w, R9 j2 w0 sNext
Next '将a()的值全部赋给a2()
m = 0
  s' ~9 q5 Q* Y! {6 E9 s# cD = 1
ReDim x(1 To n)
/ K/ C' R2 E' K7 a  `Print "--------------------------------"
3 t+ l3 [$ }; u0 X  vPrint "您输入的增广矩阵如下："
" o1 q: \4 }3 \  C% c' TFor i = 1 To n
, }* @6 ^# o' x: }# _* \2 k7 xs = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
For j = 1 To n
a(i, j) = Val(Left(s, InStr(s, " ")))
& e, \2 |4 z! d3 C4 b  Ls = Trim(Right(s, (Len(s) - InStr(s, " "))))
# n6 b" @" k! ]! B( O( }) @% mPrint a(i, j);
6 M+ p- o2 |- E4 \! ]7 XNext
a(i, n + 1) = Val(s)
Print a(i, n + 1);
Print
Next
% [! E2 u. r4 b2 B/ v: B6 g- B5 b
6 C  \% Z2 O8 M9 VFor k = 1 To n - 1 '开始消元
If a(k, k) = 0 Then
MsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
Exit Sub
Else
For i = k + 1 To n
l(i, k) = a(i, k) / a(k, k)
1 ?, R9 @, N4 N5 ~' |2 O9 _$ tFor j = k + 1 To n + 1
a(i, j) = a(i, j) - l(i, k) * a(k, j)
Next
: x, i% ]6 \& F2 H& w( l' N5 N8 hNext
/ v1 ]5 \; z3 s* y6 i0 v# h( KD = D * a(k, k)
End If
Next k '消元结束
4 J( p" C# l' }4 p5 z$ u- A8 XIf a(n, n) = 0 Then
, ~( ?' Y# d( a7 ~( g: ]MsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
2 }8 g" A! W- W  _9 r; k% s+ PExit Sub
$ d) L2 q2 O3 ^& AElse
D = D * a(n, n)
End If
/ A3 h$ m. t: C! z* }$ APrint "--------------------------------"
/ e2 A+ y. m# MPrint "系数行列式的值是："; D
x(n) = a(n, n + 1) / a(n, n)
. T3 j: H8 r9 jFor k = n - 1 To 1 Step -1 '开始回代
* l9 o3 G3 ?2 G4 j* Y4 x+ nFor j = k + 1 To n
( J2 h4 O, E% N3 z8 _m = m + a(k, j) * x(j)
Next j
x(k) = (a(k, n + 1) - m) / a(k, k)
' J/ s5 j# R" d% Z2 o5 O% t. am = 0
; ]( s  W. z$ n, xNext k '结束回代

Print "--------------------------------"
6 ~( x3 `) {; u3 EPrint "方程组的解如下："

  X: v: P6 r/ x  |For k = 1 To n
Print
Print "X(" & k & ") = " & x(k)
Next k
8 y  y2 X: B1 i2 E1 Y4 z4 XPrint "--------------------------------"
! D  ^% F, @+ D" r( F! V9 MPrint "其中各行Ax-b="
Print
For i = 1 To n
% M2 Q+ A6 |; }' Bt = 0
; x2 |% X! ?3 Z0 _For j = 1 To n
6 i7 |- u) _) z0 I" kt = t + a2(i, j) * x(j)
7 ?3 d. ^  F# z" K1 {, ]. ]! l& ~$ t, hNext j
  @( i* n2 L: Z, ^& `5 Y- B, f' Dt = t - a2(i, n + 1)
Print Spc(5); "第" & i & "行："; t
Print
Next i

8 }( R9 k2 R0 xEnd Sub

ch123en123

下载学习哦

lq12131010

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

zqyzixin

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