[讨论]高斯消去法---这是用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
  O; x! z6 ]1 Bi = 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
. A1 [$ n, t2 kReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()
For i = 1 To n
For j = 1 To n
" V4 Z" b+ R4 ?' ga2(i, j) = a(i, j)
Next
( B& v) L$ b$ |9 lNext '将a()的值全部赋给a2()
; o2 r! W2 @2 hm = 0
, m7 A1 r6 I. y6 v! W4 M- m$ eD = 1
3 B) e) L7 r, f! cReDim x(1 To n)
Print "--------------------------------"
  u! E6 K4 ]% \: x8 CPrint "您输入的增广矩阵如下："
+ ~: h7 k# k$ H% U6 i. Q3 O& c/ ]For i = 1 To n
! P& q4 f+ c2 g" {9 v" Rs = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
For j = 1 To n
6 N0 B' R3 a# U: K8 v) Ya(i, j) = Val(Left(s, InStr(s, " ")))
s = Trim(Right(s, (Len(s) - InStr(s, " "))))
6 b3 T( v' U! f) P+ S3 _% cPrint a(i, j);
4 ?/ x7 }, ]' ^5 k6 `4 e# _Next
a(i, n + 1) = Val(s)
Print a(i, n + 1);
Print
Next
( G4 m& w- v) }6 Z: n* S) P
For k = 1 To n - 1 '开始消元
4 {3 l4 u9 G0 H+ N, g% TIf a(k, k) = 0 Then
/ P  G! p7 _1 @5 S5 ?MsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
$ `' Z* G( t7 FExit Sub
3 \$ i' u& W- k2 D: N; z: r  tElse
, P: k) S8 t2 Z& p: a" j7 h1 U5 dFor i = k + 1 To n
l(i, k) = a(i, k) / a(k, k)
For j = k + 1 To n + 1
/ R8 O2 t# ]8 G  \a(i, j) = a(i, j) - l(i, k) * a(k, j)
  H: `4 d% B( J( ]3 s. vNext
Next
D = D * a(k, k)
End If
4 `2 D, h$ [0 A) ]. a3 ~: {+ Z7 \Next k '消元结束
$ _/ H' r; e% w% D2 X7 kIf a(n, n) = 0 Then
" Z  R( S" w2 [. J6 }MsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
% Q  M6 s6 o5 N, |8 j$ fExit Sub
Else
* A) b! \2 J; r! \  {7 aD = D * a(n, n)
End If
Print "--------------------------------"
3 j: ^+ f; l% V" g1 a/ ^Print "系数行列式的值是："; D
* K3 {- T4 [1 V, [x(n) = a(n, n + 1) / a(n, n)
. A/ j) ?* k8 Z' p6 JFor k = n - 1 To 1 Step -1 '开始回代
For j = k + 1 To n
m = m + a(k, j) * x(j)
( T( D" n' A9 j0 A' MNext j
x(k) = (a(k, n + 1) - m) / a(k, k)
# P% l6 U# t; Z8 Z/ S6 z* Cm = 0
Next k '结束回代
& n# T5 K4 p; J! W
8 O; y9 k/ p5 b/ {Print "--------------------------------"
Print "方程组的解如下："

For k = 1 To n
( I- L7 ?& B- X) E. lPrint
# a" v4 U6 w3 V& qPrint "X(" & k & ") = " & x(k)
. `+ e& t8 f3 n$ k, ANext k
; p; `) @  x) ~% ?: B* PPrint "--------------------------------"
Print "其中各行Ax-b="
& N4 z) ?5 x6 S# U2 ^; DPrint
For i = 1 To n
t = 0
For j = 1 To n
4 o; }! n. r# A& u0 I$ O) e7 \t = t + a2(i, j) * x(j)
0 N/ U3 C6 S! J7 p0 iNext j
t = t - a2(i, n + 1)
Print Spc(5); "第" & i & "行："; t
Print
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
0 a' x+ I" ~) n7 o; C! Bi = 1: j = 1
n = Val(InputBox("请输入矩阵的阶数(即：方程组未知数个数)N", "方程的未知数个数n", 3))
3 f4 q0 U2 J! A" _ReDim Preserve a(1 To n, 1 To n + 1)
1 b. [- Z" H% R4 @0 iReDim Preserve l(1 To n, 1 To n + 1)
* o* C1 _- }9 O5 W  HDim 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()
- J  F- _* X- ]$ _2 m4 mFor i = 1 To n
For j = 1 To n
& F7 S* V$ ~/ \$ w, e) L2 Aa2(i, j) = a(i, j)
Next
7 }  {" Y7 ~6 r7 w) F5 W6 [Next '将a()的值全部赋给a2()
8 B/ K1 d# _' Y- ^' @' }9 v- L" f" Ym = 0
D = 1
, s( }" x+ L/ bReDim x(1 To n)
+ O* u2 F. e( A9 R0 f' SPrint "--------------------------------"
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, " ")))
% h) m; k6 Q, v9 G: o' js = Trim(Right(s, (Len(s) - InStr(s, " "))))
Print a(i, j);
Next
7 ?! C9 `  o: k& \2 ra(i, n + 1) = Val(s)
Print a(i, n + 1);
Print
6 \9 U& H& w6 i+ g+ MNext
" C& R" b" I- q6 y8 ^/ k" n
For k = 1 To n - 1 '开始消元
If a(k, k) = 0 Then
$ t+ R% @3 L, W, z1 A+ Z5 q# a2 _2 tMsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
Exit Sub
Else
For i = k + 1 To n
- r# Z  N. A8 V6 X. a! ^0 j( _1 @l(i, k) = a(i, k) / a(k, k)
1 S3 o9 z7 t$ w& ~$ \6 @For j = k + 1 To n + 1
) v' o4 g! Z) z7 j- T5 ha(i, j) = a(i, j) - l(i, k) * a(k, j)
Next
Next
/ ]4 @4 J4 M$ w7 _: q# N4 nD = D * a(k, k)
9 x7 o% a+ y3 C9 \/ [9 NEnd If
Next k '消元结束
" a$ p' u4 D( [If a(n, n) = 0 Then
MsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
: h! N' z  U9 O! S: ^+ BExit Sub
Else
D = D * a(n, n)
9 p! U: P7 m% n2 B! ~End If
Print "--------------------------------"
Print "系数行列式的值是："; D
& Z' d7 `/ B6 ?9 cx(n) = a(n, n + 1) / a(n, n)
For k = n - 1 To 1 Step -1 '开始回代
6 v' X& x; Y& _# i8 z9 V+ tFor j = k + 1 To n
! a3 C$ A1 ]5 b! u, Z- qm = m + a(k, j) * x(j)
Next j
x(k) = (a(k, n + 1) - m) / a(k, k)
m = 0
Next k '结束回代
/ {# A- b3 Q0 K# F) [* A
/ W2 i" x& \+ l! u: l4 B+ L. g. zPrint "--------------------------------"
Print "方程组的解如下："

For k = 1 To n
Print
Print "X(" & k & ") = " & x(k)
! v; n0 Y1 j# s9 o# `  KNext k
Print "--------------------------------"
2 v) S" S7 Z3 }2 o  S) bPrint "其中各行Ax-b="
Print
! V6 ^2 Y# ~! KFor i = 1 To n
& w0 Z+ v- X+ z! @5 C3 ~5 ut = 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
Print
Next i

0 o: t; D$ X' ~3 R2 f) VEnd Sub

ch123en123

下载学习哦

lq12131010

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

zqyzixin

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