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

god

Private Sub gauss_Click() '高斯消去法
! d9 O0 G! A/ c3 Y% K" VDim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single
8 d/ [+ O1 H2 I* N  ei = 1: j = 1
n = 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)
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()
0 w6 b$ j+ H2 H' d# a3 g% FFor i = 1 To n
For j = 1 To n
a2(i, j) = a(i, j)
Next
. U% ~6 O% u$ u; w6 ^, ?6 [Next '将a()的值全部赋给a2()
m = 0
' Z5 n& P! f3 b4 r/ m! o% nD = 1
ReDim x(1 To n)
4 X0 [3 U/ k) X, iPrint "--------------------------------"
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, " ")))
s = Trim(Right(s, (Len(s) - InStr(s, " "))))
; k7 m0 [8 N7 r, ?* g5 WPrint a(i, j);
Next
6 R0 x! c8 ^- P+ t. za(i, n + 1) = Val(s)
& }% h% R( d( z; r' J/ cPrint a(i, n + 1);
Print
Next
8 `5 Y  K8 ]3 Z1 ^  ^, w- X5 C
' W  q! b$ {" F3 k; w9 D2 ]For k = 1 To n - 1 '开始消元
If a(k, k) = 0 Then
& Q  T% C! O, t. F: g4 z& eMsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
Exit Sub
Else
4 A9 T2 O# @  q% ?4 f! x$ ?For i = k + 1 To n
2 O3 ^- K6 t% V* T! ]8 el(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
; v! b; @2 U9 D* g- n- P% RNext
D = D * a(k, k)
End If
Next k '消元结束
5 y6 `5 U' l" Z  ], aIf a(n, n) = 0 Then
MsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
Exit Sub
Else
D = D * a(n, n)
End If
Print "--------------------------------"
Print "系数行列式的值是："; D
x(n) = a(n, n + 1) / a(n, n)
$ }8 o  M0 Y$ a8 M9 \9 ~For k = n - 1 To 1 Step -1 '开始回代
For j = k + 1 To n
m = m + a(k, j) * x(j)
Next j
x(k) = (a(k, n + 1) - m) / a(k, k)
, g' C- b: m4 ?8 [! P* \; q. Em = 0
# Y4 F. ]( v! v  M8 i3 d8 nNext k '结束回代
4 c- c% F/ }9 I8 A/ p- A
Print "--------------------------------"
+ d6 {5 g! Y. c' o( ^- GPrint "方程组的解如下："

For k = 1 To n
8 f. {8 o7 u  OPrint
( p. A/ u! W. N/ h4 ZPrint "X(" & k & ") = " & x(k)
" x0 F( Y, Y( `/ @5 v' o" D" C7 fNext k
* k1 s3 n+ c$ q" YPrint "--------------------------------"
1 ~0 N3 H' `3 wPrint "其中各行Ax-b="
' U" f7 o8 o* t) X8 BPrint
' l/ ~: a+ {8 K* P& w* b, NFor i = 1 To n
t = 0
For j = 1 To n
t = t + a2(i, j) * x(j)
! b7 w6 l. U' H% Y# r* W% ?9 JNext j
) X9 i- H& E5 U2 [  Z: q1 G" `t = t - a2(i, n + 1)
" i' ~5 D4 k; _: N4 fPrint Spc(5); "第" & i & "行："; t
) K% L$ ]4 L5 O3 x9 sPrint
1 _6 Y, H. N9 J3 N7 \  FNext i
2 F( u; v+ f) g
& S5 N: h, T) k. B8 qEnd SubPrivate Sub gauss_Click() '高斯消去法
: }2 n$ u4 y! S9 jDim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single
i = 1: j = 1
+ ~/ D8 O0 ^2 K$ H! u1 i" on = 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)
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()
+ O% @5 @9 I& J* E% T9 ]For i = 1 To n
For j = 1 To n
a2(i, j) = a(i, j)
+ Q* B3 Y# P$ @9 D# iNext
Next '将a()的值全部赋给a2()
: n( a* {: U2 m# O5 G) Wm = 0
& n( P3 x" j9 s4 x- G, l: U' BD = 1
ReDim x(1 To n)
Print "--------------------------------"
Print "您输入的增广矩阵如下："
3 [7 D) I( A1 X0 q- E: MFor i = 1 To n
s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
' \; A* k( e. u( j# H1 d% xFor j = 1 To n
a(i, j) = Val(Left(s, InStr(s, " ")))
$ n# U0 e5 t3 N& T6 I$ `! ]; C" Ps = Trim(Right(s, (Len(s) - InStr(s, " "))))
% j; ~$ o& a% Q9 g2 l) {! RPrint a(i, j);
Next
" w  L* N9 f) ha(i, n + 1) = Val(s)
Print a(i, n + 1);
  V3 i1 k8 A" K0 RPrint
" t; ?) k7 Z9 M2 P1 }Next
6 n! r5 L: q! o* V8 E7 k% u, w8 p! y
, I" r& ?7 M- s. u  f3 V+ Z% sFor k = 1 To n - 1 '开始消元
8 u% g+ [  I+ e) A2 h# ~If a(k, k) = 0 Then
% |! U9 a* D' g% ?* _MsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
4 a# s5 m3 a$ R+ h6 F  C# D8 O# }Exit Sub
Else
For i = k + 1 To n
* V! a5 t: A, q- _l(i, k) = a(i, k) / a(k, k)
$ `; |% U" i0 m1 E. j9 H/ GFor j = k + 1 To n + 1
a(i, j) = a(i, j) - l(i, k) * a(k, j)
9 n& X- @1 e: |3 x7 g" X) yNext
Next
D = D * a(k, k)
! ]" M. D. Q. x" y$ v9 IEnd If
Next k '消元结束
% Z4 T" U" @9 C8 a: c3 bIf a(n, n) = 0 Then
MsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
Exit Sub
Else
D = D * a(n, n)
End If
Print "--------------------------------"
+ I, B/ i* i5 S! yPrint "系数行列式的值是："; 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) L9 ]1 j' @Next j
) A1 w: v* _: H) A: J4 w4 Y1 Zx(k) = (a(k, n + 1) - m) / a(k, k)
/ j( f8 }* I& }' N( E& }* fm = 0
Next k '结束回代
' l; k4 k' @) H% S, a  c. s+ M* j
Print "--------------------------------"
Print "方程组的解如下："

; R3 u" q, X3 v0 G5 H2 dFor k = 1 To n
) _: u7 S6 }1 s+ T( h: K% I: uPrint
6 `& J$ c# |4 f& _$ Q2 _Print "X(" & k & ") = " & x(k)
3 `/ L8 ^/ o4 v3 cNext k
Print "--------------------------------"
  n4 e- E$ ^* J" TPrint "其中各行Ax-b="
Print
3 ]% v+ L8 Y9 WFor i = 1 To n
" J( s# S; H+ F: ?9 j& ht = 0
2 {. i/ }1 C5 r1 TFor j = 1 To n
8 t3 i, K7 d5 W, t4 _% @t = t + a2(i, j) * x(j)
0 \, ~% v! ~! P+ S, f* _Next j
t = t - a2(i, n + 1)
Print Spc(5); "第" & i & "行："; t
* \% \* n7 [( g) XPrint
4 g1 U! n% H$ CNext i
$ d6 x4 Y6 O/ i* o0 S- T5 A( f0 H
0 `" u. R6 S4 lEnd Sub

zqyzixin

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

lq12131010

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

ch123en123

下载学习哦