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

god

Private Sub gauss_Click() '高斯消去法
# ~8 \- q4 V3 [+ N- _( YDim 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)
ReDim Preserve l(1 To n, 1 To n + 1)
7 {+ q. w' f. c4 h5 x: X! NDim k As Integer, D As Single, m As Single, x() As Single, t As Single, a2() As Single
! q0 u, s9 x& E# `9 X) e3 hReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()
For i = 1 To n
For j = 1 To n
  g" W. r# g" ]8 ea2(i, j) = a(i, j)
Next
Next '将a()的值全部赋给a2()
m = 0
D = 1
4 i8 R& ^0 e. t. m) i: ]3 |ReDim x(1 To n)
Print "--------------------------------"
Print "您输入的增广矩阵如下："
For i = 1 To n
s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
For j = 1 To n
8 k1 Z+ @; R8 A: {$ za(i, j) = Val(Left(s, InStr(s, " ")))
s = Trim(Right(s, (Len(s) - InStr(s, " "))))
) b) H; N$ _5 c8 UPrint a(i, j);
Next
a(i, n + 1) = Val(s)
Print a(i, n + 1);
( z0 L1 V6 _+ X" ~; Z+ o0 HPrint
' O" O- g8 D" J/ O' y( p9 o; a( s7 d6 `Next
4 L  w& c8 j- W- G9 A7 t
For k = 1 To n - 1 '开始消元
" R$ j% C& U9 ^- ?& VIf a(k, k) = 0 Then
' `8 \; Q- ~: k$ [+ RMsgBox " 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)
* B9 h) G0 h( m! C% Q9 sFor j = k + 1 To n + 1
a(i, j) = a(i, j) - l(i, k) * a(k, j)
Next
% r' `" j( T; z4 @* A9 ^: _0 mNext
5 f6 v1 u2 m* a9 k! LD = D * a(k, k)
End If
Next k '消元结束
- O& W* l$ h2 {  s$ P# u$ E1 I4 nIf a(n, n) = 0 Then
3 d2 F- J/ i$ ]0 s3 u: qMsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
5 |  t- v; N; ~( TExit Sub
7 z: [+ [4 H5 B) ~  v1 l/ k0 `Else
7 S" ~7 I" e5 p& GD = D * a(n, n)
End If
Print "--------------------------------"
Print "系数行列式的值是："; D
x(n) = a(n, n + 1) / a(n, n)
! P! K5 x% d# F, B0 rFor k = n - 1 To 1 Step -1 '开始回代
1 U  g  ^8 _5 k0 D0 h' }For j = k + 1 To n
: G0 s. _$ y1 y$ G7 j/ qm = m + a(k, j) * x(j)
& W/ |" [3 e& O% e2 @7 H1 b$ W1 PNext j
! D+ x1 Z! U3 p/ a: ux(k) = (a(k, n + 1) - m) / a(k, k)
5 v7 @3 G- {6 n4 Fm = 0
Next k '结束回代
0 h/ \6 ^2 u  ?" F/ i1 t4 `  f) A8 N
) g6 j5 v. w6 M/ BPrint "--------------------------------"
6 M! o2 g7 X& Q; l3 aPrint "方程组的解如下："

3 O/ o" G: Q/ y2 ]7 J9 ?$ f; bFor k = 1 To n
) V2 d( }/ j: I/ i' ZPrint
, ^' k# N3 k8 ~& @+ dPrint "X(" & k & ") = " & x(k)
+ y8 n: g, V# c( O' |7 B; ^Next k
Print "--------------------------------"
- @- C# x  k+ VPrint "其中各行Ax-b="
' @3 h0 Z. N0 S6 q& T8 p8 VPrint
For i = 1 To n
t = 0
For j = 1 To n
t = t + a2(i, j) * x(j)
Next j
t = t - a2(i, n + 1)
Print Spc(5); "第" & i & "行："; t
6 ?6 y4 w' b6 |2 ^# s/ t( yPrint
Next i

End SubPrivate Sub gauss_Click() '高斯消去法
Dim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single
) `: L- r& `7 h5 R+ B+ Q, O; Ti = 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)
1 ]' @3 S, ]- E  {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()
  ~1 |, ~# x/ p; [7 BFor i = 1 To n
7 Z! [6 |6 r- @/ DFor j = 1 To n
$ X- ]3 u0 U5 i' f4 d. U1 `# za2(i, j) = a(i, j)
4 _2 b6 x% m1 S% I& o" CNext
Next '将a()的值全部赋给a2()
% L9 ]1 _0 @" V. d# `- Z3 ]m = 0
D = 1
4 A; L/ @6 g6 a' p- eReDim x(1 To n)
" g; f3 g- ^. nPrint "--------------------------------"
Print "您输入的增广矩阵如下："
For i = 1 To n
s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
" d  N& u  \+ k% O' _For j = 1 To n
a(i, j) = Val(Left(s, InStr(s, " ")))
' h7 z* B9 O5 T9 W) D' ts = Trim(Right(s, (Len(s) - InStr(s, " "))))
Print a(i, j);
Next
% r0 }- x% {! h( S3 I! O& Ja(i, n + 1) = Val(s)
. O7 F* v7 n9 M0 h( n" I0 oPrint a(i, n + 1);
Print
7 M% r* n- k- f% {- `Next

' _, n* r1 M+ KFor k = 1 To n - 1 '开始消元
If a(k, k) = 0 Then
1 _1 V3 H: P( y2 a; g; \$ q$ AMsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
Exit Sub
/ c, b3 O# E1 f' X. |Else
For i = k + 1 To n
l(i, k) = a(i, k) / a(k, k)
For j = k + 1 To n + 1
3 o- T3 D; k7 P% ja(i, j) = a(i, j) - l(i, k) * a(k, j)
Next
Next
D = D * a(k, k)
End If
Next k '消元结束
6 q2 z" k6 h9 }2 I! O' P0 CIf a(n, n) = 0 Then
: H5 ]& D& H; j7 m" c2 ?) |6 F  KMsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
+ {! t1 r' S0 U  a' g2 }Exit Sub
Else
D = D * a(n, n)
# T% T. Y3 z& w! p3 `End If
7 {; a- M3 [: L# X3 R0 K2 z* D5 r4 wPrint "--------------------------------"
$ S* _8 S& \5 T2 c& {5 \+ K* s8 YPrint "系数行列式的值是："; D
! H3 p$ U* {5 W. V  \& \x(n) = a(n, n + 1) / a(n, n)
' q$ c4 ]9 K, c, GFor k = n - 1 To 1 Step -1 '开始回代
For j = k + 1 To n
m = m + a(k, j) * x(j)
Next j
- [9 J) H6 X$ e; ex(k) = (a(k, n + 1) - m) / a(k, k)
; m$ u# ^& U6 w# {m = 0
Next k '结束回代

Print "--------------------------------"
5 ]' ?; C0 K: L- F5 n3 c+ KPrint "方程组的解如下："
# G) v% ^1 i8 ^0 F7 M! h( J. Q
) [! B8 g: L# M- K( O- o# aFor k = 1 To n
Print
, O8 I5 d5 `& Y# GPrint "X(" & k & ") = " & x(k)
; f  |* S: q! Z) O9 g0 j5 D8 u- oNext k
Print "--------------------------------"
0 z  p& l' O- jPrint "其中各行Ax-b="
Print
% b2 R9 l' P' D9 P2 V  FFor i = 1 To n
t = 0
For j = 1 To n
9 w1 Q4 \  b7 p9 B) P% at = t + a2(i, j) * x(j)
Next j
t = t - a2(i, n + 1)
Print Spc(5); "第" & i & "行："; t
Print
Next 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

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