[讨论]高斯消去法---这是用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
2 @# l, h0 m$ ki = 1: j = 1
  w% S0 w4 ?! }$ Y  \0 e$ R7 j" Hn = Val(InputBox("请输入矩阵的阶数(即：方程组未知数个数)N", "方程的未知数个数n", 3))
% {) i9 T# ~, z2 o% s4 w: dReDim Preserve a(1 To n, 1 To n + 1)
ReDim Preserve l(1 To n, 1 To n + 1)
; u$ T# t; w5 t* s9 UDim 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
- T3 i3 J) n' j; W" ZFor j = 1 To n
9 y2 M( o& i% k/ s$ M" Y3 j! \a2(i, j) = a(i, j)
Next
Next '将a()的值全部赋给a2()
& ~& U' R. Q! m( A; lm = 0
/ t: {& ^( g) C; h2 K! LD = 1
ReDim x(1 To n)
5 M9 k( M+ [1 rPrint "--------------------------------"
" [% I$ t7 L, h  a4 J( N* R  y) vPrint "您输入的增广矩阵如下："
! T1 U$ P. k; K- F4 r0 kFor i = 1 To n
s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
8 b" h4 c1 b1 u! Z: q& MFor j = 1 To n
a(i, j) = Val(Left(s, InStr(s, " ")))
9 E1 Q2 ?3 R+ Z  ?0 t2 Us = Trim(Right(s, (Len(s) - InStr(s, " "))))
Print a(i, j);
Next
& U- _' W0 U2 ~- s2 g3 K1 j9 H% J8 _a(i, n + 1) = Val(s)
( Y! Q: E$ x5 o: oPrint a(i, n + 1);
Print
/ O: l/ y6 I, `$ G% FNext
* E5 i! O0 s/ r" ^: N
8 \4 p- \# i2 I" G: \- }4 bFor k = 1 To n - 1 '开始消元
# Z% V; G  P9 V7 j3 tIf a(k, k) = 0 Then
! t3 V; A, A4 q6 n$ }( I; pMsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
) G3 I: b9 Q  f' rExit Sub
Else
$ _8 p$ n9 [3 wFor i = k + 1 To n
l(i, k) = a(i, k) / a(k, k)
( A0 m' i( n: }3 R5 UFor j = k + 1 To n + 1
a(i, j) = a(i, j) - l(i, k) * a(k, j)
) x! W8 r2 Q# L+ z2 ~Next
8 o( y% r8 r5 z$ }; [: NNext
& a9 m1 r% N7 y$ kD = D * a(k, k)
3 Q6 f; R5 E# k& f: u1 zEnd If
1 ]. Q0 o. H) A6 rNext k '消元结束
  O5 t2 ?: Z$ b' {If a(n, n) = 0 Then
% a: [7 Q3 I. k& v8 [MsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
% K* G- y$ z8 p$ x; E5 |! O4 sExit Sub
2 ?# Y8 c( g; s1 e: ~; b. iElse
D = D * a(n, n)
% H, ~4 f4 ~( g5 T$ {6 aEnd If
Print "--------------------------------"
Print "系数行列式的值是："; D
x(n) = a(n, n + 1) / a(n, n)
5 x: ]4 T$ n0 R) o- \For k = n - 1 To 1 Step -1 '开始回代
! E9 g5 V4 F1 H0 }: W# w& TFor 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
Next k '结束回代

Print "--------------------------------"
* s. L  x& p" g3 b4 R* R3 x" w6 ^; kPrint "方程组的解如下："

For k = 1 To n
Print
Print "X(" & k & ") = " & x(k)
Next k
8 t* s& T, ]4 ?$ d5 h9 w5 nPrint "--------------------------------"
  P) `/ V* h8 H/ y/ L! LPrint "其中各行Ax-b="
Print
For i = 1 To n
t = 0
For j = 1 To n
t = t + a2(i, j) * x(j)
8 l: J9 }2 K3 @Next j
t = t - a2(i, n + 1)
Print Spc(5); "第" & i & "行："; t
Print
- n- c* F( f, F8 q) BNext i
$ A" N; f# z" u& i& @, \+ j
End SubPrivate Sub gauss_Click() '高斯消去法
5 G3 K) u7 `0 e% uDim 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))
. x: }9 S. z8 x& i9 J2 hReDim Preserve a(1 To n, 1 To n + 1)
ReDim Preserve l(1 To n, 1 To n + 1)
. W% o* Z4 T+ NDim 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)
# _& b0 j- H: u1 I  P$ vNext
4 i# H4 r  w4 q; h( i1 `+ MNext '将a()的值全部赋给a2()
m = 0
4 N$ z# b9 K: gD = 1
# p8 D& S1 Y$ z5 x. T! i* p" BReDim x(1 To n)
Print "--------------------------------"
5 X) Q& K# Z6 e4 w* r+ O3 aPrint "您输入的增广矩阵如下："
4 A- e' O& E6 t: X0 K& d6 H, ?. JFor i = 1 To n
, h& l* i) g  bs = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
* S1 K( y9 s$ Y1 H. w: _For j = 1 To n
9 A/ V3 O) E% J- h/ xa(i, j) = Val(Left(s, InStr(s, " ")))
/ p9 X" X7 S4 b. q  ]s = Trim(Right(s, (Len(s) - InStr(s, " "))))
- H. H( X8 K4 E$ i8 w0 S) vPrint a(i, j);
Next
a(i, n + 1) = Val(s)
1 ]& A' @- z( M4 Z# p. |- s) `Print a(i, n + 1);
Print
; z. c/ e' j) G; aNext

. l6 ^  s' t$ F' uFor k = 1 To n - 1 '开始消元
/ ]9 g6 J# r, F+ p& N8 {: WIf a(k, k) = 0 Then
2 r2 x  J* c3 M0 @" j6 vMsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
. R5 S1 W# S5 s+ DExit Sub
Else
6 l8 ?, J* l' L9 Z3 e$ uFor i = k + 1 To n
+ s$ s. p: f# X2 L/ I+ i# i  K5 k6 ]l(i, k) = a(i, k) / a(k, k)
3 O$ n9 C% O/ M  V- l+ l. ?For j = k + 1 To n + 1
8 B: @* p' k1 o2 y. ~, |a(i, j) = a(i, j) - l(i, k) * a(k, j)
( T9 s) ]6 ~9 j( ]# ^  f" GNext
' f) N6 ~8 D( NNext
6 r9 J5 ]( O2 k" R* H: B. m3 {D = D * a(k, k)
( I3 ]3 Y2 g2 H# JEnd If
Next k '消元结束
If a(n, n) = 0 Then
& t% H% F- D: b6 gMsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
1 x( g3 r$ m( T# bExit Sub
0 G2 X) s( v- m9 a( A6 _# bElse
D = D * a(n, n)
End If
Print "--------------------------------"
Print "系数行列式的值是："; D
x(n) = a(n, n + 1) / a(n, n)
0 t& @) N/ a' t+ MFor k = n - 1 To 1 Step -1 '开始回代
1 E% n2 N- g' ]For j = k + 1 To n
2 h4 G( Y2 ^$ o5 K# s. [m = m + a(k, j) * x(j)
4 B! u) z9 {4 D# b% N) V. NNext j
2 g# u. [, ]. N6 Q' y! Nx(k) = (a(k, n + 1) - m) / a(k, k)
m = 0
0 u# O' Z: R1 T" j3 LNext k '结束回代

Print "--------------------------------"
3 `9 \% \2 A' D- ]& l! `Print "方程组的解如下："
9 F: q9 C$ d1 W
8 L8 ]4 c* v: Y/ Z( q4 vFor k = 1 To n
Print
Print "X(" & k & ") = " & x(k)
Next k
; P$ x% l3 R- }, FPrint "--------------------------------"
Print "其中各行Ax-b="
Print
For i = 1 To n
, E: v0 ]& C7 t7 ?t = 0
/ o% \" c# z) R: xFor j = 1 To n
+ G& Z7 i& O# z$ Ft = t + a2(i, j) * x(j)
Next j
t = t - a2(i, n + 1)
Print Spc(5); "第" & i & "行："; t
( X# s+ x  l9 C, ^Print
Next i

% u# k% B& Y3 x& u8 H7 u1 FEnd Sub

ch123en123

下载学习哦

lq12131010

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

zqyzixin

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