[讨论]高斯消去法---这是用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
9 V2 V: m* m9 l9 r$ d- qi = 1: j = 1
n = Val(InputBox("请输入矩阵的阶数(即：方程组未知数个数)N", "方程的未知数个数n", 3))
2 |) g0 K' f7 f  Y5 `6 n7 r9 _ReDim Preserve a(1 To n, 1 To n + 1)
* _4 A5 Q% o( ~9 |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()
* F; p7 L  H5 n/ R1 T6 P2 _For i = 1 To n
3 K1 d2 \) u& r! E# f0 pFor j = 1 To n
a2(i, j) = a(i, j)
Next
Next '将a()的值全部赋给a2()
m = 0
9 o1 X' I" D: ?) y; eD = 1
" D% V' B7 p' aReDim x(1 To n)
Print "--------------------------------"
" N/ V+ m3 N1 b1 r* j2 o+ J; @Print "您输入的增广矩阵如下："
; H1 ^2 d, E" s+ }& \+ FFor i = 1 To n
" G$ b# j/ d# `( p3 c" q2 Os = 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, " "))))
Print a(i, j);
Next
) E8 f, B2 t. N  w# G( h7 ca(i, n + 1) = Val(s)
Print a(i, n + 1);
Print
Next

4 P- T- h; r1 j( `/ f% hFor k = 1 To n - 1 '开始消元
If a(k, k) = 0 Then
MsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
- x0 p/ q3 \# i7 FExit Sub
# u# R0 c7 y; L7 C8 s  tElse
For i = k + 1 To n
l(i, k) = a(i, k) / a(k, k)
For j = k + 1 To n + 1
  U, H5 Q0 }  d- Wa(i, j) = a(i, j) - l(i, k) * a(k, j)
3 M" ?/ Y( q2 A8 kNext
Next
D = D * a(k, k)
End If
Next k '消元结束
, B2 C- D& H8 `( A1 a; t( q6 m8 G# bIf a(n, n) = 0 Then
MsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
Exit Sub
Else
+ A$ Z+ t* T- i1 u/ F7 v# [8 MD = D * a(n, n)
End If
, M2 Y1 T( K7 }+ m/ dPrint "--------------------------------"
Print "系数行列式的值是："; D
x(n) = a(n, n + 1) / a(n, n)
For k = n - 1 To 1 Step -1 '开始回代
" n# G# |, s& B2 `# \9 R4 qFor j = k + 1 To n
m = m + a(k, j) * x(j)
  |4 g8 w3 R. [; Y+ h$ X  CNext j
x(k) = (a(k, n + 1) - m) / a(k, k)
0 |( z- Q' L# C+ em = 0
Next k '结束回代

6 o( c* u1 _- V* [Print "--------------------------------"
/ v; i. a. J! k- h: IPrint "方程组的解如下："
0 D1 j4 g- b' s- M4 _0 A
For k = 1 To n
# H8 t/ k1 G3 l2 Z. n$ APrint
+ P& I$ O8 J: M- Z1 r: y+ pPrint "X(" & k & ") = " & x(k)
: ^# }5 X9 \- k/ y: m( e4 i7 INext k
, ]; ~& H4 P3 N; b4 IPrint "--------------------------------"
8 J/ z/ _! G2 \6 }/ |- H6 H% \Print "其中各行Ax-b="
Print
For i = 1 To n
t = 0
For j = 1 To n
t = t + a2(i, j) * x(j)
1 k0 D! _1 D) X% \Next j
9 w2 F8 L/ S  j0 f+ t, `t = t - a2(i, n + 1)
2 }3 |3 [, v5 A0 \Print Spc(5); "第" & i & "行："; t
' B$ `% p- a, e2 d2 M: hPrint
Next i
9 M/ v# B; u; v6 s* f' x
End SubPrivate Sub gauss_Click() '高斯消去法
Dim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single
$ |) k' ~4 x0 v6 D( E% N) j- Ti = 1: j = 1
9 M6 E/ C* d( [, \0 I; Gn = Val(InputBox("请输入矩阵的阶数(即：方程组未知数个数)N", "方程的未知数个数n", 3))
5 C1 P* B" I4 ~5 x0 {  YReDim Preserve a(1 To n, 1 To n + 1)
1 T) d0 C5 U) ]( Y; zReDim Preserve l(1 To n, 1 To n + 1)
+ Y- R& A- `. K9 JDim k As Integer, D As Single, m As Single, x() As Single, t As Single, a2() As Single
# M9 K+ J  A- c. g. ZReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()
For i = 1 To n
For j = 1 To n
) v) C" Y( J/ ]2 O" ]2 qa2(i, j) = a(i, j)
Next
" B) {- X. _9 a0 J3 DNext '将a()的值全部赋给a2()
# J$ i. c2 r% z! s: `/ z/ C! Z4 Mm = 0
) x  c0 z! m9 XD = 1
ReDim x(1 To n)
7 ^2 A* L4 h  B+ x+ _Print "--------------------------------"
7 Q; b, L3 b: S# y' i8 e8 ~1 j3 C8 sPrint "您输入的增广矩阵如下："
, p4 v! B: K* _" O6 ~For i = 1 To n
: c. }! R; f1 Y, ^$ Bs = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
For j = 1 To n
6 W* F- n2 K3 Y! P! j0 h: Ia(i, j) = Val(Left(s, InStr(s, " ")))
s = Trim(Right(s, (Len(s) - InStr(s, " "))))
# u$ c: r: G: }' hPrint a(i, j);
+ Q1 ~6 O% i9 [! F) GNext
: B% C. y6 G& M$ N7 b0 A& j6 |( qa(i, n + 1) = Val(s)
: k& _. |& @+ O: N& t5 QPrint a(i, n + 1);
/ D. X8 W% }# d6 e- a/ |1 sPrint
Next

For k = 1 To n - 1 '开始消元
If a(k, k) = 0 Then
MsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
Exit Sub
Else
; W7 h4 {9 A; w* T& M: C& X. ?  BFor 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
; n( Y6 N  V& z, N& K  u: yNext
* R' u0 W7 j9 J( BD = D * a(k, k)
End If
Next k '消元结束
If a(n, n) = 0 Then
( d6 q" f* W' c) k+ o$ AMsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
6 H+ q. Z% x1 g  K; {0 T* e3 W) rExit Sub
Else
D = D * a(n, n)
End If
Print "--------------------------------"
Print "系数行列式的值是："; D
. R& J" Z" C- `9 b$ qx(n) = a(n, n + 1) / a(n, n)
1 X; p( ~% N, h. YFor k = n - 1 To 1 Step -1 '开始回代
9 Y5 v* p1 c+ I  M2 S8 q3 [For j = k + 1 To n
m = m + a(k, j) * x(j)
Next j
2 j; W  b3 K& I# d6 Wx(k) = (a(k, n + 1) - m) / a(k, k)
m = 0
+ C; Z$ x- y7 }1 tNext k '结束回代
% ?; c' L5 f( Y$ j! |( v5 e
3 T0 }2 L3 G" ^+ Y; N( JPrint "--------------------------------"
Print "方程组的解如下："
9 v4 |5 U8 R* f' d% t* _
, R9 n* k! U& M' E8 fFor k = 1 To n
9 ?6 y$ e: i+ ~* O5 j5 yPrint
Print "X(" & k & ") = " & x(k)
Next k
Print "--------------------------------"
Print "其中各行Ax-b="
Print
For i = 1 To n
t = 0
For j = 1 To n
4 `, R+ D# X0 p4 @+ }- ?t = t + a2(i, j) * x(j)
Next j
" J5 |2 S" H2 n5 O, X. X( Et = t - a2(i, n + 1)
Print Spc(5); "第" & i & "行："; t
4 M- Z$ R; x6 Z( v% APrint
; k, e4 [- \$ t* X! ?: h4 Y4 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

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