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

god

Private Sub gauss_Click() '高斯消去法
9 z$ u3 r% z5 Z- [  `Dim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single
6 d( Z# A; `/ P9 l& Oi = 1: j = 1
3 d- u5 K1 L- ?/ @  J& [, kn = 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)
  h# R. K4 G; K' A" gDim 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()
' _& G& _" {# X  |! `' `For i = 1 To n
7 _& ^- B# W# l7 x2 o( j  \2 {For j = 1 To n
2 ~6 d& ?' B. \a2(i, j) = a(i, j)
, s+ |; d( i' HNext
2 S: D) D, I5 P* lNext '将a()的值全部赋给a2()
m = 0
D = 1
ReDim x(1 To n)
Print "--------------------------------"
Print "您输入的增广矩阵如下："
For i = 1 To n
' r# i  ^8 f0 {) C: k. F; D- c$ Cs = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
1 y2 W7 E- S" r3 {! g& eFor j = 1 To n
a(i, j) = Val(Left(s, InStr(s, " ")))
* O- X9 E$ K7 ~4 U* f, Ys = Trim(Right(s, (Len(s) - InStr(s, " "))))
Print a(i, j);
4 X+ ]+ u9 s- X& z- DNext
a(i, n + 1) = Val(s)
5 ^6 K2 f6 u' j8 n  ]Print a(i, n + 1);
. d0 Z' _8 w+ w( z4 N4 w/ ^Print
Next
! X- N1 d* o- C2 u9 s0 F& q( V
For k = 1 To n - 1 '开始消元
If a(k, k) = 0 Then
MsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
Exit Sub
, P" B  a; G4 p, Q7 m6 S7 N7 bElse
For i = k + 1 To n
; K+ u6 c5 `8 v! `l(i, k) = a(i, k) / a(k, k)
For j = k + 1 To n + 1
. q: D* e  ]/ ]8 @a(i, j) = a(i, j) - l(i, k) * a(k, j)
Next
Next
1 c- i+ y& m( S5 i0 n- wD = D * a(k, k)
6 K' o! F$ \' L; s9 q% N) a. H- `. [End If
Next k '消元结束
If a(n, n) = 0 Then
MsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
0 U- i9 J, E* g; `Exit Sub
2 T3 U" `$ J+ Q  J5 j1 _  o2 uElse
D = D * a(n, n)
1 T5 W+ {/ q1 S4 V* KEnd If
1 M6 u: m" `+ O& t( kPrint "--------------------------------"
Print "系数行列式的值是："; D
, h2 {" B5 o' m9 {/ f) sx(n) = a(n, n + 1) / a(n, n)
  z/ I$ k# ?, {2 }6 zFor k = n - 1 To 1 Step -1 '开始回代
& u$ A6 R* s8 S, W$ k" u' }6 d8 tFor j = k + 1 To n
( C" ~" J' b0 w# n! _6 vm = m + a(k, j) * x(j)
Next j
x(k) = (a(k, n + 1) - m) / a(k, k)
m = 0
0 k3 a5 T, y% S' P8 SNext k '结束回代

Print "--------------------------------"
Print "方程组的解如下："
' r: o9 S$ c1 `) ^. t
For k = 1 To n
Print
! ]1 |& e" B7 c/ D* kPrint "X(" & k & ") = " & x(k)
Next k
Print "--------------------------------"
Print "其中各行Ax-b="
! P" f- ?+ J! ]9 d* c# aPrint
For i = 1 To n
t = 0
9 w# b% D+ u! M) @% d$ Z4 nFor j = 1 To n
t = t + a2(i, j) * x(j)
Next j
t = t - a2(i, n + 1)
4 h5 ]8 Y1 l' |( H6 V$ ^+ iPrint Spc(5); "第" & i & "行："; t
1 O' R- D* Z: |" NPrint
7 j5 }7 ~, u8 j4 T9 a7 Y. CNext i
3 o4 v" n6 M, Z) }
End SubPrivate Sub gauss_Click() '高斯消去法
Dim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single
) R) D. @; V3 }6 j: g$ P% ji = 1: j = 1
n = Val(InputBox("请输入矩阵的阶数(即：方程组未知数个数)N", "方程的未知数个数n", 3))
, q1 Q; x9 Y& t9 o$ j# AReDim Preserve a(1 To n, 1 To n + 1)
ReDim Preserve l(1 To n, 1 To n + 1)
- {* \" _* t3 I9 J" W7 F3 xDim k As Integer, D As Single, m As Single, x() As Single, t As Single, a2() As Single
0 M$ [6 Q$ ^  j0 ]6 M! _" o6 TReDim 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)
Next
6 ~6 z, g. U8 j. M  r5 O, LNext '将a()的值全部赋给a2()
# O: Y1 K$ t- ]% X$ b+ ^! Im = 0
D = 1
ReDim x(1 To n)
7 W7 U" K" ]9 G- lPrint "--------------------------------"
Print "您输入的增广矩阵如下："
& K0 R) }5 |6 {4 q0 C1 O7 MFor i = 1 To n
s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
! O, L/ p% c% m) @' \) ]$ ~1 vFor j = 1 To n
a(i, j) = Val(Left(s, InStr(s, " ")))
s = Trim(Right(s, (Len(s) - InStr(s, " "))))
2 x  |3 I0 P$ NPrint a(i, j);
Next
3 g& Q0 o& z# x4 `a(i, n + 1) = Val(s)
Print a(i, n + 1);
$ b9 P9 t$ t: t7 U9 ^Print
Next

# M4 W2 y3 P( xFor k = 1 To n - 1 '开始消元
If a(k, k) = 0 Then
MsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
! ?+ M  @% }8 B" y+ E  JExit Sub
; R) r4 t6 V" L, ^6 GElse
For i = k + 1 To n
l(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
Next
- \) k) Q- W. e2 U& O: vD = D * a(k, k)
4 `8 f- ^' k1 A( ?8 dEnd If
. |" B( ^: c1 ~1 e, g1 WNext k '消元结束
; }  v4 n- c- m% ~; d4 ?4 WIf a(n, n) = 0 Then
9 v8 V8 C" F. [/ K# i; NMsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
' s4 d2 f5 N1 G3 n" q% |; zExit Sub
7 f: z. A0 q6 N1 m8 }Else
2 [. a/ x- {8 \& GD = D * a(n, n)
End If
& k8 j8 D  n8 t& \: w( r% h! F* SPrint "--------------------------------"
5 j! V' G5 W2 {2 s" nPrint "系数行列式的值是："; 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)
8 T" ?4 x& }# }0 pNext j
! ~) _, V* r4 }1 wx(k) = (a(k, n + 1) - m) / a(k, k)
) z  `2 M$ L' Q% j8 i$ @1 Cm = 0
Next k '结束回代
7 y$ p) r7 N" ]$ h" ]2 f7 F
Print "--------------------------------"
: `2 v6 r9 b, C! R/ G1 YPrint "方程组的解如下："

For k = 1 To n
Print
Print "X(" & k & ") = " & x(k)
( l4 g. X9 s0 R, zNext k
Print "--------------------------------"
Print "其中各行Ax-b="
Print
7 F  A9 U$ z+ m9 x" l3 n3 sFor i = 1 To n
t = 0
$ E7 o+ {: V3 D0 uFor j = 1 To n
4 n( O5 H- L' ?t = t + a2(i, j) * x(j)
' Z4 c* q% g* n9 b* R& gNext j
9 T" F+ t+ b& Y; E# }9 `t = t - a2(i, n + 1)
: \2 X0 v" C/ a5 O  d# J$ H" `Print Spc(5); "第" & i & "行："; t
Print
/ A- b3 o% [  J  ?  dNext i
# I8 p- B6 N- g& n$ M. c
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

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