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

god

Private Sub gauss_Click() '高斯消去法
: x  H" z- f2 X' Q. E' J, lDim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single
0 G3 W$ A& G$ i: n$ _i = 1: j = 1
n = Val(InputBox("请输入矩阵的阶数(即：方程组未知数个数)N", "方程的未知数个数n", 3))
ReDim Preserve a(1 To n, 1 To n + 1)
. c0 C; J; f- G7 I3 DReDim 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
) z: U& \! q* |9 C% {  s: YReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()
" `4 V& Y" V4 w1 H' ZFor i = 1 To n
6 a: X) R; K5 c; ?+ m* [6 [# QFor j = 1 To n
& y7 s: O/ V6 p) P. {3 s+ Ua2(i, j) = a(i, j)
- n0 b6 a7 ~4 O/ a3 Q0 k; {& GNext
/ U+ [* k4 ^1 Z2 pNext '将a()的值全部赋给a2()
. B) \: \- [7 p: X9 tm = 0
! I. u4 K* y: ~$ U( cD = 1
ReDim x(1 To n)
/ B2 E# y2 _( t4 z' SPrint "--------------------------------"
6 }3 Y8 H2 G* R- k! aPrint "您输入的增广矩阵如下："
For i = 1 To n
. i4 i; Y5 z7 b  C' w" o! O  gs = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
For j = 1 To n
1 Q* R2 M6 s- z+ b* \a(i, j) = Val(Left(s, InStr(s, " ")))
4 N* P; L4 y3 b7 T: Js = Trim(Right(s, (Len(s) - InStr(s, " "))))
Print a(i, j);
Next
a(i, n + 1) = Val(s)
Print a(i, n + 1);
( z+ d9 h1 q! f3 [2 e9 iPrint
Next

For k = 1 To n - 1 '开始消元
If a(k, k) = 0 Then
! _; o) U, ?5 H- h: j1 j4 ?! XMsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
% O. K" R' [" kExit Sub
* A, T/ G: D" O) {3 u1 qElse
For i = k + 1 To n
8 J% u" @1 l% `( I- m7 Nl(i, k) = a(i, k) / a(k, k)
0 |4 Z* B6 V, e8 {3 m+ N& M5 pFor j = k + 1 To n + 1
a(i, j) = a(i, j) - l(i, k) * a(k, j)
+ l( [% X: Q7 I1 VNext
Next
D = D * a(k, k)
End If
) Y0 E6 v" }. yNext k '消元结束
If a(n, n) = 0 Then
MsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
Exit Sub
$ J5 @+ X- v9 qElse
# P6 M8 m) u2 B( I, a) L# p; a2 XD = D * a(n, n)
End If
& v2 h9 u, X, L4 gPrint "--------------------------------"
Print "系数行列式的值是："; D
x(n) = a(n, n + 1) / a(n, n)
, F+ [' P5 G8 r( U: fFor k = n - 1 To 1 Step -1 '开始回代
For j = k + 1 To n
' O9 e$ A" ]/ O1 qm = m + a(k, j) * x(j)
1 }, X/ I/ w: B! lNext j
# j4 i) o1 t5 K" J; p: F" Hx(k) = (a(k, n + 1) - m) / a(k, k)
m = 0
, e9 T2 T3 P- QNext k '结束回代
+ y2 M" X0 h! B
2 Z! B- u4 @; S4 n) x' H! RPrint "--------------------------------"
Print "方程组的解如下："
- y7 @0 i9 f; r) R- U* G2 _6 [
For k = 1 To n
Print
; t# y% h$ |6 ^, u0 O3 H5 _9 @Print "X(" & k & ") = " & x(k)
9 i4 ^3 g  j- ]! x, }+ Y* }Next k
Print "--------------------------------"
Print "其中各行Ax-b="
Print
# i/ E' j7 e% ?0 ]. o# r) b+ V  rFor i = 1 To n
t = 0
For j = 1 To n
t = t + a2(i, j) * x(j)
+ L3 P( a5 h( x$ RNext j
t = t - a2(i, n + 1)
9 s' f7 j- X4 e1 \. y  HPrint Spc(5); "第" & i & "行："; t
+ n6 {. ~* W6 @9 M6 FPrint
Next i

End SubPrivate Sub gauss_Click() '高斯消去法
  A' l5 l$ Y7 j; l# N0 A6 q7 s6 MDim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single
i = 1: j = 1
( g7 F- ~/ y; q9 A$ O( G) G2 R( S2 Qn = Val(InputBox("请输入矩阵的阶数(即：方程组未知数个数)N", "方程的未知数个数n", 3))
7 d& j6 P# ]% c, B/ h$ mReDim Preserve a(1 To n, 1 To n + 1)
& h; S8 `! l$ V5 j( {- T' V% FReDim 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()
! c/ Z( q+ F$ n* {3 m/ DFor i = 1 To n
For j = 1 To n
/ X& n8 _: b" s5 Va2(i, j) = a(i, j)
Next
Next '将a()的值全部赋给a2()
m = 0
7 z7 ]" P* f* E9 a  F; FD = 1
$ E& \" n8 ^, j  c; _4 q. ]ReDim x(1 To n)
% Q5 c" W$ r( P1 L, b0 ?, Q: r6 a* qPrint "--------------------------------"
$ \0 k# x5 G9 [6 D; gPrint "您输入的增广矩阵如下："
For i = 1 To n
s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
For j = 1 To n
/ N' x1 a  T0 |a(i, j) = Val(Left(s, InStr(s, " ")))
) N: S$ U" E+ w- o2 J. q7 B0 O8 G# @5 Qs = Trim(Right(s, (Len(s) - InStr(s, " "))))
5 Q% g0 g7 X" W' h# ]. L+ H8 w+ ZPrint a(i, j);
Next
) a2 i6 }" O1 q7 Wa(i, n + 1) = Val(s)
- r+ p; Y4 N" A3 r. Q! [Print a(i, n + 1);
8 ?; Z) q: t2 f  H* B8 w* mPrint
( p, D6 U5 t2 O+ P# s2 GNext

For k = 1 To n - 1 '开始消元
If a(k, k) = 0 Then
MsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
- O' V1 p% y: q# _( u/ ]  r4 QExit Sub
8 ~) w( F# U) g8 c; bElse
7 H/ W2 j$ y8 M7 tFor 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)
, n$ X2 y; R5 dNext
/ h$ P6 @2 I* A" E9 {- ]. [Next
5 q& H0 l: y, W% e, _3 I$ R- hD = D * a(k, k)
1 i* q* N- a7 E  d: m; UEnd If
; W- ]& B, e/ xNext k '消元结束
If a(n, n) = 0 Then
8 {' P2 V, i  a' x! Z) j/ D" mMsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
6 T5 K1 E5 V  |* G! _Exit Sub
Else
6 T9 N+ Q3 J# ]+ Y  ^/ j: p  d" w9 dD = D * a(n, n)
* i& p" Z! e" [- C7 ^8 Q& Q4 GEnd If
Print "--------------------------------"
' ~, S3 Z  c2 ~" ?Print "系数行列式的值是："; D
x(n) = a(n, n + 1) / a(n, n)
% q7 z% F+ V. K. ]& f# UFor k = n - 1 To 1 Step -1 '开始回代
5 V# c8 h& k0 Z3 t  F( D. ]For j = k + 1 To n
m = m + a(k, j) * x(j)
Next j
) q) |) [" P+ J& h2 B; Tx(k) = (a(k, n + 1) - m) / a(k, k)
m = 0
Next k '结束回代
& ^& ^' s8 X6 r! |, z: y
4 u" e7 @8 H2 J+ o; j; ^6 Q/ l! TPrint "--------------------------------"
- w2 {7 i, C$ F4 M/ \" g% {Print "方程组的解如下："

, f: [) }7 @5 `# O$ ?, ]For k = 1 To n
Print
Print "X(" & k & ") = " & x(k)
Next k
Print "--------------------------------"
Print "其中各行Ax-b="
Print
For i = 1 To n
t = 0
For j = 1 To n
t = t + a2(i, j) * x(j)
( V6 i) g9 ~/ I1 r2 N3 BNext j
t = t - a2(i, n + 1)
Print Spc(5); "第" & i & "行："; t
1 n9 q4 M$ M2 `Print
0 e' R, Y; n" |. q! lNext i
& }' F! [5 a9 k" W8 h9 D0 o
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

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