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

god

Private Sub gauss_Click() '高斯消去法
: z3 ^: q1 I9 N: K5 oDim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single
( O; R1 }# H0 ^. p! ]; Ji = 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()
6 n' A  D& @+ D( tFor i = 1 To n
For j = 1 To n
a2(i, j) = a(i, j)
/ o0 \; s1 d; t3 V( qNext
Next '将a()的值全部赋给a2()
m = 0
. V4 _! w* P# x0 S: e  m, zD = 1
ReDim x(1 To n)
; [! u# J9 X8 ]9 N3 zPrint "--------------------------------"
Print "您输入的增广矩阵如下："
For i = 1 To n
s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
For j = 1 To n
0 l$ y* s; z* d( N+ [0 [a(i, j) = Val(Left(s, InStr(s, " ")))
s = Trim(Right(s, (Len(s) - InStr(s, " "))))
; Z" B( `, v# p1 i" NPrint a(i, j);
2 p" v* E& D% C4 @9 V3 k/ KNext
! v3 i/ h8 f+ b/ S) I- v' `a(i, n + 1) = Val(s)
7 h# u% j: [6 K% J5 [4 @5 d3 y7 PPrint a(i, n + 1);
, v3 I" l) v7 R. dPrint
Next

' Q, Y4 x' |( H4 {+ L8 D2 k, d6 eFor k = 1 To n - 1 '开始消元
* Y1 O2 m& i; l5 k4 E/ @1 ?; q9 P, BIf a(k, k) = 0 Then
MsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
' o' i- M8 Y+ l9 ~' b+ fExit Sub
Else
- Y8 C' t! O0 a" G7 x& {) GFor i = k + 1 To n
l(i, k) = a(i, k) / a(k, k)
$ n  P' E, D& ^8 xFor j = k + 1 To n + 1
a(i, j) = a(i, j) - l(i, k) * a(k, j)
: J) L: a0 y3 n1 u1 ^( l4 nNext
Next
# S& u# h" c! |' pD = D * a(k, k)
End If
9 P+ B1 ?' X: G7 l$ LNext k '消元结束
4 O: O: `. w# M5 d9 }" j0 AIf a(n, n) = 0 Then
' U+ P* A2 A) t4 C7 e8 h1 eMsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
Exit Sub
Else
D = D * a(n, n)
End If
Print "--------------------------------"
Print "系数行列式的值是："; D
- _! I6 l2 ]4 N+ rx(n) = a(n, n + 1) / a(n, n)
; t9 f$ J% [1 ]0 f1 p6 z  i0 wFor k = n - 1 To 1 Step -1 '开始回代
+ h% D% ]- y8 n# R: i: pFor j = k + 1 To n
/ a& R* s) P) e" R5 Rm = m + a(k, j) * x(j)
- E) a4 i7 M& I1 I/ E3 }* X- q6 W1 A" NNext j
% [- B0 a: w$ j$ A( O' K: jx(k) = (a(k, n + 1) - m) / a(k, k)
m = 0
# l' I2 j6 N, m8 k2 vNext k '结束回代
5 p- P. i! l  R
- B; V: _; \1 [; ePrint "--------------------------------"
Print "方程组的解如下："
5 I/ x) ~; P: |3 _
For k = 1 To n
Print
Print "X(" & k & ") = " & x(k)
Next k
Print "--------------------------------"
! c" k/ K5 V; m$ z$ ZPrint "其中各行Ax-b="
$ g+ M& h: W2 }+ v* tPrint
9 n' U9 F+ L, R1 fFor i = 1 To n
( ~6 D) j6 z4 A  @. M+ Tt = 0
: c4 z! ]7 Z" U) F8 @5 ?For j = 1 To n
t = t + a2(i, j) * x(j)
, K* R! a1 y/ H8 ONext j
' B1 ~% Z& u7 E( v* J3 [t = t - a2(i, n + 1)
Print Spc(5); "第" & i & "行："; t
Print
' i2 A, `9 O7 vNext i

2 E& F2 ]  F% {5 g! rEnd 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
$ T3 a) I- @. F' Kn = 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()
' ^7 m$ M0 G3 J/ O; \% [: kFor i = 1 To n
For j = 1 To n
" X; z. w" ^% z" Q  q+ @a2(i, j) = a(i, j)
Next
Next '将a()的值全部赋给a2()
1 j$ ^. M- O6 @+ Z, s+ T" rm = 0
D = 1
5 {6 d* A6 I4 m' S& yReDim x(1 To n)
, f; ?5 S3 ]# x9 |% |7 ~Print "--------------------------------"
Print "您输入的增广矩阵如下："
% Q/ V5 G0 h8 q' r% m7 q1 AFor i = 1 To n
s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
( [" n- S, y/ \# u" _1 i1 \0 XFor j = 1 To n
a(i, j) = Val(Left(s, InStr(s, " ")))
3 N- O4 B8 D0 x# W% l' S( ws = Trim(Right(s, (Len(s) - InStr(s, " "))))
Print a(i, j);
" |3 K( I9 ]$ [: e, vNext
a(i, n + 1) = Val(s)
. P4 l- O: s" ~6 e, KPrint a(i, n + 1);
& Z5 ~, I$ r; y: q- ePrint
' `/ l7 X2 u8 X! k, \1 tNext
/ w1 r6 x' I& j2 f) k7 ~9 J/ O: F
! i% c4 H8 G3 n" qFor k = 1 To n - 1 '开始消元
If a(k, k) = 0 Then
/ i) X8 N+ z. PMsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
Exit Sub
Else
$ ^4 {: d5 I1 w% TFor i = k + 1 To n
l(i, k) = a(i, k) / a(k, k)
. q$ h: p' r, r2 _* DFor j = k + 1 To n + 1
5 U$ h& B! }, w: L8 u# b9 V6 ta(i, j) = a(i, j) - l(i, k) * a(k, j)
4 o5 c6 [2 W5 ]. |6 N: nNext
Next
) h/ I+ F9 z7 z2 {% }$ w7 q5 D6 ED = D * a(k, k)
End If
Next k '消元结束
# z6 h9 E" L1 D# V- gIf a(n, n) = 0 Then
MsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
Exit Sub
" y9 s! I. B" F# t  A6 dElse
D = D * a(n, n)
End If
8 Q7 w; x8 a( D! LPrint "--------------------------------"
Print "系数行列式的值是："; D
x(n) = a(n, n + 1) / a(n, n)
! c, H8 x0 A, X) |( k& vFor k = n - 1 To 1 Step -1 '开始回代
For j = k + 1 To n
m = m + a(k, j) * x(j)
Next j
! z5 @; \+ r4 Dx(k) = (a(k, n + 1) - m) / a(k, k)
m = 0
Next k '结束回代
8 w( O3 F& G! O. t
( U+ Q1 b" ~6 ~4 e: vPrint "--------------------------------"
9 K) k5 o5 @+ i0 pPrint "方程组的解如下："

For k = 1 To n
0 T# _' F+ t& N" ]5 \& f& hPrint
' y0 ]; ^" P: F7 DPrint "X(" & k & ") = " & x(k)
Next k
' t- [& B: O. @* S; iPrint "--------------------------------"
Print "其中各行Ax-b="
Print
For i = 1 To n
t = 0
# w. [/ ~& y. E4 RFor j = 1 To n
t = t + a2(i, j) * x(j)
! h# r3 a$ V3 w* g2 [Next j
- N- G: ~3 H# Z# x' kt = t - a2(i, n + 1)
Print Spc(5); "第" & i & "行："; t
Print
Next i

4 ~" f, I; y2 o0 |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

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