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

god

Private Sub gauss_Click() '高斯消去法
0 `  s: C) G0 F, I  u( ]5 mDim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single
  Q8 H3 _' ?1 V/ @) yi = 1: j = 1
n = Val(InputBox("请输入矩阵的阶数(即：方程组未知数个数)N", "方程的未知数个数n", 3))
1 C2 b: t2 o$ y" s( jReDim Preserve a(1 To n, 1 To n + 1)
2 o2 U2 L. U4 l; f3 n  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
ReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()
For i = 1 To n
For j = 1 To n
! Z; m. b5 b- A/ Z+ B# L! W/ }a2(i, j) = a(i, j)
Next
Next '将a()的值全部赋给a2()
. B# r! H- b1 o7 {- sm = 0
( }& h: l" Q* G5 S. g& W/ nD = 1
ReDim x(1 To n)
Print "--------------------------------"
Print "您输入的增广矩阵如下："
0 _2 ?5 P* B2 b" Q1 e" p* Z/ {For i = 1 To n
: {7 T0 L- {. E; t/ ]2 Gs = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
For j = 1 To n
/ v' T7 j/ W5 G7 e) \1 w! Ja(i, j) = Val(Left(s, InStr(s, " ")))
% z) U% O' b' E, H  |s = Trim(Right(s, (Len(s) - InStr(s, " "))))
5 Y. v; v' y( O4 ?' t; v, sPrint a(i, j);
9 [0 z& |6 N* S7 `) M/ ]7 Z( n2 Q7 ?* GNext
a(i, n + 1) = Val(s)
Print a(i, n + 1);
Print
Next

For k = 1 To n - 1 '开始消元
If a(k, k) = 0 Then
0 s0 i& i8 G# B  [6 b6 GMsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
Exit Sub
9 F6 M; B3 u+ j, [' x$ UElse
7 B6 w7 R& V6 {* G* wFor i = k + 1 To n
l(i, k) = a(i, k) / a(k, k)
' x4 e9 i5 T2 x+ pFor j = k + 1 To n + 1
7 ]4 b2 X' Q1 |a(i, j) = a(i, j) - l(i, k) * a(k, j)
Next
Next
- e0 B# s8 j2 I! W; _2 kD = D * a(k, k)
End If
; i3 L$ P7 |3 t# W; w  QNext k '消元结束
If a(n, n) = 0 Then
MsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
; X  j" c. Z3 B, |# z+ i/ A# |1 L$ E- IExit Sub
: R6 U$ U+ a, u! \Else
D = D * a(n, n)
End If
* A+ J2 p5 m2 BPrint "--------------------------------"
) v% P% O2 E4 b2 g4 ^: I; [; CPrint "系数行列式的值是："; D
% ^* C- W5 G/ }( v  |4 r) ]9 zx(n) = a(n, n + 1) / a(n, n)
For k = n - 1 To 1 Step -1 '开始回代
- I  h. j8 h% J2 h' x; Y2 b! vFor j = k + 1 To n
m = m + a(k, j) * x(j)
Next j
x(k) = (a(k, n + 1) - m) / a(k, k)
m = 0
! h& W- _4 q6 y5 f. TNext k '结束回代
1 d& s3 s( ]1 S3 H/ D& k% f
7 x; O3 R7 N4 v: x* mPrint "--------------------------------"
Print "方程组的解如下："
: p: p/ }, N$ B' r9 \
3 K# L# L! s0 {# Z8 q; @For k = 1 To n
Print
; k) p- ?+ c: o& R+ gPrint "X(" & k & ") = " & x(k)
3 ^% Q5 i7 b1 YNext k
Print "--------------------------------"
Print "其中各行Ax-b="
Print
For i = 1 To n
4 t* B8 D+ S% {5 P0 z$ pt = 0
For j = 1 To n
9 Q7 ]3 c0 X$ i3 It = t + a2(i, j) * x(j)
' i/ ~! [9 e8 NNext j
& }  K. F/ m# Q+ C/ O8 s; |t = t - a2(i, n + 1)
Print Spc(5); "第" & i & "行："; t
Print
& `3 _4 C/ ^# H& T5 a+ nNext 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
7 N- i: r( @& u- D' E9 \: J& b( Ji = 1: j = 1
1 s& [, [! ?6 A8 H) m, ]  M: Hn = Val(InputBox("请输入矩阵的阶数(即：方程组未知数个数)N", "方程的未知数个数n", 3))
- _' ?& D" Z/ }, i. T( aReDim Preserve a(1 To n, 1 To n + 1)
4 X  V4 P0 o1 |6 P3 p5 z7 DReDim Preserve l(1 To n, 1 To n + 1)
. J7 v% d3 t. M* z. |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
5 @1 A# \% m2 j% B& b% gNext '将a()的值全部赋给a2()
m = 0
D = 1
% h+ }0 H7 K, h: d( @2 @ReDim x(1 To n)
Print "--------------------------------"
1 _% A7 a- j% f+ SPrint "您输入的增广矩阵如下："
For i = 1 To n
9 |) {  O& C" ?6 P- w2 ^/ Ys = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
5 c5 f9 {/ B7 S, G2 g# pFor j = 1 To n
0 n( z$ @% F) T" Xa(i, j) = Val(Left(s, InStr(s, " ")))
# @" F8 J$ W& P3 ^9 f- Vs = Trim(Right(s, (Len(s) - InStr(s, " "))))
* ?5 _/ T: N/ l1 ~Print a(i, j);
3 ?0 F4 l3 _) H/ ZNext
) v$ U. p1 {; s0 v3 C+ V9 Da(i, n + 1) = Val(s)
" Z; t; W% m; b" O$ }7 [( A' D! UPrint a(i, n + 1);
8 X, o9 X0 Z* s6 DPrint
Next

For k = 1 To n - 1 '开始消元
If a(k, k) = 0 Then
1 A5 Z4 y2 }  i& d# @MsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
Exit Sub
Else
For i = k + 1 To n
8 ^6 \$ H, c* Jl(i, k) = a(i, k) / a(k, k)
For j = k + 1 To n + 1
8 u0 ^5 s. g" `, z' D- fa(i, j) = a(i, j) - l(i, k) * a(k, j)
& C' T) S0 `5 I$ uNext
Next
: s& N/ z! Z, s3 ID = D * a(k, k)
/ Y. T7 K8 N6 M. jEnd If
Next k '消元结束
6 s$ c6 c2 C% H* IIf a(n, n) = 0 Then
MsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
$ J% M3 W8 V# ?6 ZExit Sub
" q' i6 l9 D5 [1 [3 E$ CElse
D = D * a(n, n)
End If
- A4 Q# u& Y4 n  E' a( z) ^Print "--------------------------------"
Print "系数行列式的值是："; D
0 C3 Q: ?0 t1 h+ r( T5 ux(n) = a(n, n + 1) / a(n, n)
4 q9 L; u9 v! j. \( DFor k = n - 1 To 1 Step -1 '开始回代
. U) b+ g; ]. M) W' A# u* BFor j = k + 1 To n
m = m + a(k, j) * x(j)
, B% F8 Y2 f+ g$ ^" d' VNext j
x(k) = (a(k, n + 1) - m) / a(k, k)
3 a! t0 }$ G$ D$ x& _m = 0
3 b7 b% u' c# A$ k% O5 P0 HNext k '结束回代
9 v' N, e0 m8 o, n* S, p! {
: n; j/ N- G, N2 F$ oPrint "--------------------------------"
% g9 U5 r0 Y8 \Print "方程组的解如下："

) v0 r6 i- U, l, {5 h/ {' P& D/ jFor k = 1 To n
  Z- L+ R$ V  P2 y3 `7 }Print
2 r# A$ X/ s" t7 U4 [' j/ F" zPrint "X(" & k & ") = " & x(k)
9 J& [1 D2 R5 p* D4 ^' a: XNext k
Print "--------------------------------"
Print "其中各行Ax-b="
Print
For i = 1 To n
t = 0
For j = 1 To n
  ]3 M8 O3 n7 }3 w; At = t + a2(i, j) * x(j)
Next j
! S& C4 c0 \4 Zt = t - a2(i, n + 1)
Print Spc(5); "第" & i & "行："; t
$ y. V1 f# t$ z# k, d8 t/ t: OPrint
Next i
) m+ ]- }. W8 y  W3 t
+ H1 g. e* A! t/ 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

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