[讨论]高斯消去法---这是用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
1 B& V3 F0 `  U- Bi = 1: j = 1
% B/ w* h  H5 g  o- B2 {4 c4 zn = Val(InputBox("请输入矩阵的阶数(即：方程组未知数个数)N", "方程的未知数个数n", 3))
: [) J5 O, ~6 XReDim Preserve a(1 To n, 1 To n + 1)
6 H( \% p/ r7 u; y" N* D9 [ReDim Preserve l(1 To n, 1 To n + 1)
% k0 p; _5 A- U9 tDim k As Integer, D As Single, m As Single, x() As Single, t As Single, a2() As Single
% y2 ]$ X- u. x% ~. v- R+ t" hReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()
4 I$ d5 l3 C1 `8 k0 \For i = 1 To n
! P$ ~3 C7 |  y6 JFor j = 1 To n
; F2 ~% z' m6 d* D  g( ]0 m! y+ G' ?a2(i, j) = a(i, j)
, r7 z9 M; [) t+ }. L5 e6 yNext
' C; |# O2 O1 k  uNext '将a()的值全部赋给a2()
* t* m9 @4 x+ g& V$ C2 m: Z& i* _m = 0
D = 1
ReDim x(1 To n)
! p3 q' X2 ]# H# X7 m) b- u( RPrint "--------------------------------"
" N& \8 |  d1 u- z% Y' y4 a2 lPrint "您输入的增广矩阵如下："
For i = 1 To n
s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
For j = 1 To n
! k$ q! u( D/ t8 d" Ga(i, j) = Val(Left(s, InStr(s, " ")))
" H. B+ l8 r9 Ps = Trim(Right(s, (Len(s) - InStr(s, " "))))
) |7 j  r* w* YPrint a(i, j);
# l" F+ P1 Q( j( ~3 `# E3 TNext
* Y1 V  `; B  s( I! M  I' z% Za(i, n + 1) = Val(s)
% }# w# Q8 r7 _Print a(i, n + 1);
/ Q* i5 V2 Y" d8 PPrint
Next
: e/ k$ H2 I8 Y7 n6 o
For k = 1 To n - 1 '开始消元
3 k; P7 c$ I. A* b% }' iIf a(k, k) = 0 Then
3 h4 {3 I" K6 a+ u4 Y+ M( |MsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
, F+ V; f& I- XExit Sub
& ?5 s7 I( h/ q  ]$ c2 SElse
For i = k + 1 To n
) `- c, Q& C/ R) d$ K& L$ ^l(i, k) = a(i, k) / a(k, k)
2 J5 T+ h7 T9 l+ u: iFor j = k + 1 To n + 1
a(i, j) = a(i, j) - l(i, k) * a(k, j)
, B& S6 V7 n. \2 qNext
Next
# g4 {8 N( C7 C" B0 ~D = D * a(k, k)
End If
4 m: N9 L$ ?& g# XNext k '消元结束
& _( u1 N9 }- R* }If a(n, n) = 0 Then
4 h. ]# K# K6 w7 _+ c- w3 U6 C( |MsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
Exit Sub
* g" Y& N& j( V: [6 {2 d$ @& dElse
3 z7 r2 v- i5 U7 S! m' u" OD = D * a(n, n)
End If
Print "--------------------------------"
Print "系数行列式的值是："; D
: z% E$ D( @5 q4 [& l/ s: s; ^x(n) = a(n, n + 1) / a(n, n)
For k = n - 1 To 1 Step -1 '开始回代
For j = k + 1 To n
4 V2 M( L- O2 x8 ~4 n  |m = m + a(k, j) * x(j)
Next j
) @  v2 f( w: v) Z, Jx(k) = (a(k, n + 1) - m) / a(k, k)
m = 0
Next k '结束回代

3 F  D! ~" w* N% rPrint "--------------------------------"
Print "方程组的解如下："
* X5 U- h# N( [; y3 v. z
7 X. e# A0 q5 X7 UFor k = 1 To n
Print
) i4 T/ F! B' iPrint "X(" & k & ") = " & x(k)
5 t: w7 Q9 C' k( z. C8 U+ P) \Next k
Print "--------------------------------"
9 i# N, T- |8 r" \2 n3 B3 pPrint "其中各行Ax-b="
2 i0 T' n: D1 V4 W9 sPrint
For i = 1 To n
, b. g7 m. Q9 q) p6 Pt = 0
" d3 i' c! k* z$ ]For j = 1 To n
t = t + a2(i, j) * x(j)
9 a4 p/ e0 f4 l7 Y8 }. lNext j
  E7 K. Q+ K7 f! dt = t - a2(i, n + 1)
" g& F! x# }6 T; x) K( p) lPrint Spc(5); "第" & i & "行："; t
Print
  q) v9 e4 `6 h  s# h, c/ h6 fNext i

+ J/ }" m2 n( I+ J( lEnd SubPrivate Sub gauss_Click() '高斯消去法
Dim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single
! w! C7 Y# t6 N7 Ai = 1: j = 1
5 `5 I4 l6 Y0 J: Z) _! ^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
7 P# ]& l, Z% YReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()
For i = 1 To n
. L+ w8 Z+ y6 y; f" c2 ^9 RFor j = 1 To n
a2(i, j) = a(i, j)
& Y* ?/ t' F9 s7 b$ o3 uNext
0 H$ G7 B6 T- a; d3 v& xNext '将a()的值全部赋给a2()
* S8 F) U& \- O2 H! j# |/ w6 ^m = 0
: n0 N1 F- m3 g8 m4 ?, H* e. F. G+ MD = 1
ReDim x(1 To n)
! K+ t' k+ a; L+ g- U* m/ yPrint "--------------------------------"
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, " ")))
; K3 u& F% }  P8 q$ ls = Trim(Right(s, (Len(s) - InStr(s, " "))))
  z0 D, S6 p! }7 R% }Print a(i, j);
2 E" A( P5 c% g& v/ j( ENext
a(i, n + 1) = Val(s)
Print a(i, n + 1);
# t9 A! m% @8 V5 B# }. W# ePrint
# H7 M% Q. Z  L, d, [2 b2 MNext

$ N! _- I5 O7 zFor k = 1 To n - 1 '开始消元
, j* V; D7 y4 N! R; y2 ~! gIf a(k, k) = 0 Then
MsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
Exit Sub
1 \! v: `8 s! @& p' U0 B- BElse
For i = k + 1 To n
l(i, k) = a(i, k) / a(k, k)
For j = k + 1 To n + 1
8 T, V- H) n4 W' t2 ]: ya(i, j) = a(i, j) - l(i, k) * a(k, j)
+ F* L7 N3 r  ]. A% t# R" pNext
Next
2 O2 }8 q% U, b9 Q6 O; xD = D * a(k, k)
End If
/ [" [9 T# N; hNext k '消元结束
If a(n, n) = 0 Then
MsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
Exit Sub
Else
D = D * a(n, n)
End If
Print "--------------------------------"
1 M9 H% k. ?3 Z5 |9 sPrint "系数行列式的值是："; D
+ A$ f4 L7 F' nx(n) = a(n, n + 1) / a(n, n)
5 y8 ~% U7 G# _/ N9 |/ I& CFor k = n - 1 To 1 Step -1 '开始回代
) |2 r8 i: U* a+ J) F, DFor j = k + 1 To n
m = m + a(k, j) * x(j)
  v3 n! d1 e( `8 A6 MNext j
x(k) = (a(k, n + 1) - m) / a(k, k)
m = 0
Next k '结束回代
" j; w0 _& B% u4 g' J+ q6 ?8 F
6 T: t# k( `" b# ~6 v  I: ~Print "--------------------------------"
( e$ \  c3 n# |/ [+ D$ ]Print "方程组的解如下："
  E, v" g' m3 T7 ~) T# o" t
For k = 1 To n
Print
. F' x8 A1 a4 z. U* s0 MPrint "X(" & k & ") = " & x(k)
Next k
Print "--------------------------------"
: Z$ z# ?9 U( r( r5 \3 o8 n! ~Print "其中各行Ax-b="
Print
For i = 1 To n
- C% D2 w8 Z+ o; |7 _( i! J, e- |9 Qt = 0
1 E- M3 R. R1 L* }% X8 ?+ V( U8 o( ?For j = 1 To n
3 D  T  Q: }. C7 X) o( Y$ r4 t3 ?t = t + a2(i, j) * x(j)
/ p) D) m; @4 \7 q! g/ CNext j
t = t - a2(i, n + 1)
Print Spc(5); "第" & i & "行："; t
! I  Q, {% s. s/ p4 IPrint
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

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