[讨论]高斯消去法---这是用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
" `% H/ ~& f5 Si = 1: j = 1
! A* o" o6 n/ Mn = Val(InputBox("请输入矩阵的阶数(即：方程组未知数个数)N", "方程的未知数个数n", 3))
$ C: m$ j2 I4 r4 M# ^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
ReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()
For i = 1 To n
- Q' @' P( E" v' F. NFor j = 1 To n
a2(i, j) = a(i, j)
- P) F; c) }/ b) E; [. D! H1 A4 gNext
1 O$ e2 h4 w. [+ u6 K( k% [Next '将a()的值全部赋给a2()
m = 0
6 O/ J7 v: f+ j# U6 UD = 1
1 Q5 B0 R, D( LReDim x(1 To n)
! S) \- m( B: V4 @Print "--------------------------------"
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, " ")))
s = Trim(Right(s, (Len(s) - InStr(s, " "))))
Print a(i, j);
Next
' ]/ H# S8 f  e: ?2 Ja(i, n + 1) = Val(s)
9 a2 U! b) ^9 xPrint a(i, n + 1);
Print
8 t4 }3 ]6 r9 F# P/ A* E* XNext

For k = 1 To n - 1 '开始消元
If a(k, k) = 0 Then
MsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
0 K6 y6 F+ p( @1 B' k: GExit Sub
Else
For i = k + 1 To n
l(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)
0 i. F2 h+ I4 R8 [) TNext
Next
D = D * a(k, k)
End If
& o- N2 J" {# B- c5 ^. u7 B- _Next k '消元结束
If a(n, n) = 0 Then
MsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
' a. t* {; R3 ?1 _' A, aExit Sub
0 q# _: }9 v6 @' M1 P% I8 D; ?; A! kElse
D = D * a(n, n)
  V' O  E6 n4 _. R0 e0 o0 O$ _. h7 vEnd If
  N: E0 f" F1 U/ VPrint "--------------------------------"
3 i0 `+ ]$ C% d, C% pPrint "系数行列式的值是："; D
+ v5 S: q! o; [+ d! n- Wx(n) = a(n, n + 1) / a(n, n)
For k = n - 1 To 1 Step -1 '开始回代
, j) `2 Q& E5 d, U0 T9 s5 w3 KFor j = k + 1 To n
0 K- f7 U/ B* p+ w' y. I, K0 u# Bm = m + a(k, j) * x(j)
Next j
6 ?9 e4 n1 n: l! h/ _# Dx(k) = (a(k, n + 1) - m) / a(k, k)
m = 0
4 T0 i5 h1 r8 J  j- qNext k '结束回代
7 b6 B- v* d; v! Q
Print "--------------------------------"
Print "方程组的解如下："

For k = 1 To n
Print
Print "X(" & k & ") = " & x(k)
$ K. w0 z* R! n8 X4 [) a$ `Next k
: v" v5 C0 y, [8 ^- BPrint "--------------------------------"
  l# L( t0 P5 @; |Print "其中各行Ax-b="
Print
For i = 1 To n
5 x; z5 h9 B* L2 mt = 0
For j = 1 To n
t = t + a2(i, j) * x(j)
* N6 V1 s1 |3 U0 b: R( n5 ~Next j
$ ^  O# v4 `, `8 kt = t - a2(i, n + 1)
' O% I9 P. f, v) G4 g/ qPrint Spc(5); "第" & i & "行："; t
' w, x7 B# x$ l# s- N9 a) e. ^Print
$ d, i: t' x: l  Q/ l0 _Next i
5 E' F3 w9 {- l, _. A. D0 M
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
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
ReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()
9 {7 ~" E6 ^) N/ ?) d" A, e- [/ j6 tFor i = 1 To n
0 \2 w, Y! Q- g8 \" ?1 Z& bFor j = 1 To n
a2(i, j) = a(i, j)
; P) B- }( n/ t" q( V7 ONext
Next '将a()的值全部赋给a2()
5 f. Y6 v1 x& c3 xm = 0
D = 1
ReDim x(1 To n)
Print "--------------------------------"
/ o" h8 Q7 P8 m4 @Print "您输入的增广矩阵如下："
For i = 1 To n
s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
/ b( k! j# k4 `0 q8 RFor j = 1 To n
1 f. R& @4 h& Q* G& Ra(i, j) = Val(Left(s, InStr(s, " ")))
s = Trim(Right(s, (Len(s) - InStr(s, " "))))
Print a(i, j);
+ K. G6 k% o0 [5 g& Y/ I' fNext
a(i, n + 1) = Val(s)
Print a(i, n + 1);
Print
Next
2 F$ r% @: X7 f1 q) U& w- l- `
' x. x5 w$ j% w% k4 a" \* tFor k = 1 To n - 1 '开始消元
, l+ K" h; a3 C: D+ W+ kIf a(k, k) = 0 Then
: p, Y  O8 c7 i% i  q$ A, hMsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
& ]& q2 b' g: f0 V9 Y7 d6 Y! HExit Sub
' l0 r: W  j2 B! r: HElse
- k9 s! |% b% y/ Z& }For i = k + 1 To n
. C" ~/ e* l2 y) Q$ f! ?; p0 pl(i, k) = a(i, k) / a(k, k)
7 F' \% S6 g5 D% M& Q- fFor j = k + 1 To n + 1
/ q. R+ w9 y# `5 M. ^. b7 {# ha(i, j) = a(i, j) - l(i, k) * a(k, j)
Next
Next
D = D * a(k, k)
End If
2 N! p% P! Y+ D8 uNext k '消元结束
: A6 ^' o8 k/ r& a$ q( iIf a(n, n) = 0 Then
1 J) B6 n. S. J( x8 l7 MMsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
Exit Sub
7 g- Y; Q6 `1 E3 VElse
/ g# H, b' G3 J- kD = D * a(n, n)
" t- l' r0 y2 ^* A- m4 zEnd If
* f% G# Y3 t- ]- ]! ^% F0 ^8 C2 WPrint "--------------------------------"
Print "系数行列式的值是："; D
x(n) = a(n, n + 1) / a(n, n)
: p7 Z& F" E+ e9 f4 g. EFor k = n - 1 To 1 Step -1 '开始回代
; D1 E1 x+ `) t2 a$ |- V* l) qFor j = k + 1 To n
8 {9 {7 q' H* y  x6 m- [m = m + a(k, j) * x(j)
Next j
x(k) = (a(k, n + 1) - m) / a(k, k)
8 @. N6 t! c6 Y' Y, X: ~m = 0
Next k '结束回代
1 R" q+ D' l. {5 m
" ]2 W* T+ Q$ U2 x, i* tPrint "--------------------------------"
Print "方程组的解如下："
; P1 }$ ?" |& W7 {8 Z
5 I6 }2 O* B1 x) P- D; hFor k = 1 To n
Print
8 O, X; N# R& y: TPrint "X(" & k & ") = " & x(k)
Next k
Print "--------------------------------"
Print "其中各行Ax-b="
* L. N/ u6 \& P" D& d6 L3 W4 n1 @. @Print
For i = 1 To n
t = 0
For j = 1 To n
1 b- p  O0 u7 r5 Wt = t + a2(i, j) * x(j)
3 H! e) ~% L& J1 a8 }& fNext j
t = t - a2(i, n + 1)
Print Spc(5); "第" & i & "行："; t
Print
Next i

& W5 l7 L0 P% E. ]; f; DEnd Sub

ch123en123

下载学习哦

lq12131010

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

zqyzixin

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