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

god

Private Sub gauss_Click() '高斯消去法
' g' ^$ a5 r/ l5 MDim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single
; i+ ]# ^. m1 w# p* w! c( H$ p$ X* ui = 1: j = 1
+ q9 r$ T: `2 D4 B; _* f) x1 Bn = Val(InputBox("请输入矩阵的阶数(即：方程组未知数个数)N", "方程的未知数个数n", 3))
9 q1 h# o6 m8 G* }  WReDim Preserve a(1 To n, 1 To n + 1)
6 J6 Z+ k' q2 B# V9 l& n9 D! ~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()
For i = 1 To n
For j = 1 To n
a2(i, j) = a(i, j)
Next
8 I! \4 |: }) Z  t; k6 SNext '将a()的值全部赋给a2()
m = 0
$ b- ?6 n# r" K6 F% F/ E) sD = 1
ReDim x(1 To n)
Print "--------------------------------"
# `. v4 M0 H  zPrint "您输入的增广矩阵如下："
For i = 1 To n
4 H( z( h; |$ G" c" Vs = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
For j = 1 To n
. ]/ ~9 N6 G& B- b8 U/ L$ ha(i, j) = Val(Left(s, InStr(s, " ")))
$ q- L3 ?+ b) s) I! Us = Trim(Right(s, (Len(s) - InStr(s, " "))))
Print a(i, j);
Next
a(i, n + 1) = Val(s)
* d" D7 i; W: K7 U' @8 N: d' K0 zPrint a(i, n + 1);
Print
Next

1 }2 e8 g7 Q7 m# q2 L8 F- h7 }For k = 1 To n - 1 '开始消元
. i/ R0 I/ f0 k4 |& eIf a(k, k) = 0 Then
MsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
Exit Sub
Else
+ A- |1 _) a$ `3 x( N. _, x4 EFor i = k + 1 To n
/ q6 P$ h. ^, t: X  Vl(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)
- D* `2 I+ q0 t+ KNext
Next
1 S  s6 H4 }! [. F$ lD = D * a(k, k)
  I4 X8 Z- ?! g( |$ O9 ^+ }End If
Next k '消元结束
- j9 x# F8 m# W3 AIf a(n, n) = 0 Then
MsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
Exit Sub
7 N, U1 l, n% {& ~1 M# L$ v; B. sElse
D = D * a(n, n)
End If
+ ?1 g  a1 l3 L. Q" j  @6 I' zPrint "--------------------------------"
" b! o# L" R7 y$ W- q% c6 vPrint "系数行列式的值是："; D
9 K% |6 D: M6 F7 I; px(n) = a(n, n + 1) / a(n, n)
1 t: c4 `8 d  b0 h; {# bFor k = n - 1 To 1 Step -1 '开始回代
For j = k + 1 To n
m = m + a(k, j) * x(j)
Next j
! \0 n  I' b# e' p6 x( Dx(k) = (a(k, n + 1) - m) / a(k, k)
( X7 G( ^* y) J( v4 sm = 0
Next k '结束回代

Print "--------------------------------"
7 l: U2 [6 U+ mPrint "方程组的解如下："

For k = 1 To n
Print
$ U7 C: a9 l  H: rPrint "X(" & k & ") = " & x(k)
1 O; L- y+ u/ F. L$ Q" ^' O: }Next k
: J. T; j+ L5 u( QPrint "--------------------------------"
Print "其中各行Ax-b="
Print
For i = 1 To n
t = 0
2 l$ d9 ], [0 m7 Q. k* k% JFor j = 1 To n
/ y& i) T! d( O1 d8 C. mt = t + a2(i, j) * x(j)
/ H7 `  Z' y' |; HNext j
/ |6 U$ t5 [- m& A3 g5 l6 ]! At = t - a2(i, n + 1)
Print Spc(5); "第" & i & "行："; t
Print
3 D0 s" w# h) N9 INext 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
i = 1: j = 1
1 h, }  l4 j, U5 _" mn = Val(InputBox("请输入矩阵的阶数(即：方程组未知数个数)N", "方程的未知数个数n", 3))
ReDim Preserve a(1 To n, 1 To n + 1)
/ ~8 ?" j" r& s9 N0 MReDim 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
$ F. o* h" @( q4 j  aReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()
7 ]* t8 f; L% u& ^& \3 WFor i = 1 To n
" O& u4 y, `( PFor j = 1 To n
a2(i, j) = a(i, j)
9 J* a9 c3 z* u& L3 y  q( QNext
Next '将a()的值全部赋给a2()
* V; A& c. r9 o1 @6 Um = 0
D = 1
6 b* z6 a" a! k2 _ReDim x(1 To n)
; v2 m" ?: J2 p0 B3 }, Z* {Print "--------------------------------"
Print "您输入的增广矩阵如下："
5 F: w4 Q% k" r' Y0 y6 A& ^" x9 oFor i = 1 To n
s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
, y& z/ `3 k3 m3 l7 \2 M; P/ kFor j = 1 To n
a(i, j) = Val(Left(s, InStr(s, " ")))
s = Trim(Right(s, (Len(s) - InStr(s, " "))))
Print a(i, j);
5 t* ]4 c: ^/ l; j( L' t- I" xNext
a(i, n + 1) = Val(s)
8 K* \  ]2 y: `3 N6 v3 s4 nPrint a(i, n + 1);
$ M% K) U) F$ R% n/ d# lPrint
Next

+ l/ L2 f6 r* NFor k = 1 To n - 1 '开始消元
/ O1 R% v  K6 n* F& H) EIf a(k, k) = 0 Then
MsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
Exit Sub
1 @: x! W# N: E. v, `* OElse
0 g/ ?, b$ Y; k: q7 l* `  @For i = k + 1 To n
l(i, k) = a(i, k) / a(k, k)
2 ~# d6 I$ W* M+ OFor j = k + 1 To n + 1
a(i, j) = a(i, j) - l(i, k) * a(k, j)
Next
: A) u8 f- Q# X' q, T# x" N* ~# \Next
& l! z8 H- s) ]. k  T3 |D = D * a(k, k)
End If
1 u* z! ]; C* |: N) S) m$ ZNext k '消元结束
7 I" t. I4 n" B9 KIf a(n, n) = 0 Then
6 V( c) s) U6 r, N! S1 @" `MsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
Exit Sub
Else
D = D * a(n, n)
  d* M1 H9 x4 i1 m, yEnd If
: p4 p3 B, ^5 r. w% @& Z$ z( e5 sPrint "--------------------------------"
Print "系数行列式的值是："; D
/ n& r) u4 F+ wx(n) = a(n, n + 1) / a(n, n)
For k = n - 1 To 1 Step -1 '开始回代
! M* q% [* S4 S* v% |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)
( D8 o- i; C; s7 Mm = 0
8 W% H( w: F, lNext k '结束回代
0 s0 \$ k: u" V% |8 t
Print "--------------------------------"
! v% Z8 b6 v8 D* N, dPrint "方程组的解如下："

# p4 k2 \, g8 e/ E' NFor k = 1 To n
  n* _  x5 z( x7 ^Print
Print "X(" & k & ") = " & x(k)
; _# I' D: ~, U7 ENext k
Print "--------------------------------"
Print "其中各行Ax-b="
Print
2 \5 x/ J& t6 z. c( _. _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)
$ M! t: Y8 ~( Y- u. j  k5 f+ |Print Spc(5); "第" & i & "行："; t
+ E' a- q4 ]# f4 }+ t" m( PPrint
# H$ k; h# }2 K( q' u, _1 r& j$ p6 wNext i
3 T4 W: S, l7 b3 I( O' B. 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

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