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

god

Private Sub gauss_Click() '高斯消去法
5 n, Y* L+ a" r& w" jDim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single
i = 1: j = 1
+ x# Y( |$ f9 |( C2 Bn = Val(InputBox("请输入矩阵的阶数(即：方程组未知数个数)N", "方程的未知数个数n", 3))
! r* R& g" |- }5 h* }, oReDim Preserve a(1 To n, 1 To n + 1)
" x6 m- f4 V8 W# gReDim 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
9 x( y# e6 S! AReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()
9 ]1 A% O: \4 z) k7 J* N9 n$ \- BFor i = 1 To n
: `, M& @% e5 SFor j = 1 To n
a2(i, j) = a(i, j)
Next
4 M5 A; O; \- wNext '将a()的值全部赋给a2()
5 E1 g! C5 u) w2 B6 p! z( Km = 0
D = 1
ReDim x(1 To n)
Print "--------------------------------"
$ b% l) u, _4 i- P* r1 Z0 A0 UPrint "您输入的增广矩阵如下："
  g% W; r6 h0 C1 L$ N4 G. l( vFor i = 1 To n
+ a) \" l6 r! T7 O; ^! |  gs = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
For j = 1 To n
" q- A, f4 u1 ia(i, j) = Val(Left(s, InStr(s, " ")))
; _* |2 ~0 g5 ws = Trim(Right(s, (Len(s) - InStr(s, " "))))
0 @6 H7 X' \: t% ~% M1 ?% E+ hPrint a(i, j);
: O' U! M; P9 D8 [9 j2 [1 J+ g; kNext
a(i, n + 1) = Val(s)
Print a(i, n + 1);
Print
Next
0 e7 `7 P% N9 s; B
For k = 1 To n - 1 '开始消元
% p2 a+ t" w* E3 [, X0 a3 UIf a(k, k) = 0 Then
- \9 H3 k1 [+ {! o. r' xMsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
Exit Sub
Else
For i = k + 1 To n
* T, [: p! C. o- V) f7 U  n# g$ z6 ?  @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)
Next
  G! x6 e0 j3 Q: D  D% a7 n8 aNext
. K3 n3 u7 G+ sD = D * a(k, k)
End If
Next k '消元结束
If a(n, n) = 0 Then
* Z! G. d; @# d2 e8 `% ZMsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
$ U3 Z# A$ H! F/ X! i8 ^( A8 k! nExit Sub
Else
D = D * a(n, n)
End If
Print "--------------------------------"
! B1 v; n- b! ~4 {Print "系数行列式的值是："; D
0 i' D8 f& y. X4 cx(n) = a(n, n + 1) / a(n, n)
For k = n - 1 To 1 Step -1 '开始回代
) H; _( p  ]/ X2 m; b2 c  v$ A3 SFor j = k + 1 To n
m = m + a(k, j) * x(j)
6 V1 L8 v" s4 f( y) @# I+ dNext j
0 K* }! b7 V$ M7 I& S0 T0 c4 rx(k) = (a(k, n + 1) - m) / a(k, k)
m = 0
Next k '结束回代

Print "--------------------------------"
2 i. {) c% F5 v& {Print "方程组的解如下："

For k = 1 To n
5 C* K/ d1 F% `$ VPrint
/ `! N5 Q' t5 l7 yPrint "X(" & k & ") = " & x(k)
Next k
! g& S  B  y2 DPrint "--------------------------------"
Print "其中各行Ax-b="
; |: e* O2 c3 A. wPrint
For i = 1 To n
t = 0
For j = 1 To n
t = t + a2(i, j) * x(j)
9 |7 r7 y( c% u5 \( n$ ONext j
8 f% V7 `0 h+ D3 J2 P, yt = t - a2(i, n + 1)
: C: C$ w: J- h* G) D1 HPrint Spc(5); "第" & i & "行："; t
Print
Next i
- b0 y, `; h( l8 t: L
+ s) c5 r. Z2 [" O& eEnd SubPrivate Sub gauss_Click() '高斯消去法
, z' Q" E9 V2 Y# L& nDim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single
) M! P; Q4 Q" s1 i+ c- ei = 1: j = 1
n = Val(InputBox("请输入矩阵的阶数(即：方程组未知数个数)N", "方程的未知数个数n", 3))
$ Y' P7 W4 U: `. i5 D7 R! M0 @1 J* TReDim Preserve a(1 To n, 1 To n + 1)
ReDim Preserve l(1 To n, 1 To n + 1)
, g  W9 [; M( m$ _0 J2 K1 ]/ b$ WDim 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()
, X! r7 ~+ q+ pFor i = 1 To n
8 ^) t# V8 y; g  p! sFor j = 1 To n
a2(i, j) = a(i, j)
$ A; E1 x- `4 z7 UNext
, a. c+ M# U* }: rNext '将a()的值全部赋给a2()
0 X$ {! |4 q; h3 Pm = 0
0 ~# n+ D+ S* b" b$ r' d9 jD = 1
ReDim x(1 To n)
Print "--------------------------------"
/ ?+ K6 F) M; p. B  b1 ^) TPrint "您输入的增广矩阵如下："
! `% b' G' h" n" t: t/ G/ pFor i = 1 To n
3 d8 \8 I. |3 S9 Z9 @s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
2 s9 \$ p# W* E* l- G5 YFor j = 1 To n
a(i, j) = Val(Left(s, InStr(s, " ")))
s = Trim(Right(s, (Len(s) - InStr(s, " "))))
Print a(i, j);
% X! a$ d5 G8 X; _: J- x1 \Next
/ S, h8 a% q1 d3 ja(i, n + 1) = Val(s)
Print a(i, n + 1);
( J8 M* t; c2 W6 c) W1 aPrint
Next
% j9 v7 E$ j$ U0 d! C
For k = 1 To n - 1 '开始消元
3 E' Z. x& O' W! xIf a(k, k) = 0 Then
4 q  u7 Z. F' x- I* k+ d5 DMsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
' \- d3 p( T  ]6 c9 a- ~+ MExit Sub
Else
For i = k + 1 To n
l(i, k) = a(i, k) / a(k, k)
' U. |' y+ E1 y9 q% N1 XFor j = k + 1 To n + 1
a(i, j) = a(i, j) - l(i, k) * a(k, j)
+ j4 b* ~' H* bNext
Next
& \/ Q) [5 D" sD = D * a(k, k)
1 r$ G; A$ z# y/ h( [7 d( BEnd If
Next k '消元结束
If a(n, n) = 0 Then
MsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
4 y5 U3 v6 ~1 X) P3 zExit Sub
9 X( e0 @* S: ]$ ?. X$ b' a8 {Else
D = D * a(n, n)
End If
9 Z0 T) N+ _% M/ T+ Y% q. u' U  @  yPrint "--------------------------------"
Print "系数行列式的值是："; D
9 _' ~4 V( B- D3 F( fx(n) = a(n, n + 1) / a(n, n)
For k = n - 1 To 1 Step -1 '开始回代
$ j) h* W. e3 f! EFor j = k + 1 To n
) H4 e0 S  w* S* I1 U4 \m = m + a(k, j) * x(j)
) a5 H' p! [* I/ e% Z8 t: q( bNext j
x(k) = (a(k, n + 1) - m) / a(k, k)
- O. H2 M8 H6 ^4 Lm = 0
# A7 B) C% d# a- l4 l; H' S5 T: G' }5 bNext k '结束回代

Print "--------------------------------"
7 H" v- {' E+ j  n- PPrint "方程组的解如下："

For k = 1 To n
Print
Print "X(" & k & ") = " & x(k)
Next k
Print "--------------------------------"
Print "其中各行Ax-b="
Print
For i = 1 To n
; Z, T" q7 o+ z6 _t = 0
- g% R0 y$ H3 T* t8 gFor j = 1 To n
! z4 T' j, k, Z$ |, N4 Dt = t + a2(i, j) * x(j)
2 L! B- @2 a: \2 E: J0 YNext j
# T1 d2 i% j! ~t = t - a2(i, n + 1)
Print Spc(5); "第" & i & "行："; t
Print
6 R# Q) Y4 k) m6 dNext i
3 v1 ]" E; ?/ z; W
4 A- L  z7 e! b2 D- J; sEnd Sub

ch123en123

下载学习哦

lq12131010

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

zqyzixin

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