[讨论]高斯消去法---这是用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
i = 1: j = 1
n = Val(InputBox("请输入矩阵的阶数(即：方程组未知数个数)N", "方程的未知数个数n", 3))
ReDim Preserve a(1 To n, 1 To n + 1)
0 b) O" ?+ I( G. e) vReDim Preserve l(1 To n, 1 To n + 1)
, M. _5 l1 a( P- _8 s9 z) EDim 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 |2 x+ R4 _- l. b( b4 sFor i = 1 To n
2 s  D" c7 [! a6 K1 E. \3 kFor j = 1 To n
' R+ a- M2 n5 F6 B9 pa2(i, j) = a(i, j)
Next
Next '将a()的值全部赋给a2()
m = 0
D = 1
+ A' s! B2 @/ g. q) M% @' x- FReDim x(1 To n)
3 o; E$ S5 z; IPrint "--------------------------------"
Print "您输入的增广矩阵如下："
For i = 1 To n
% {  \% r7 Q% Gs = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
9 X* x; z4 ^& J" x$ X$ n$ jFor j = 1 To n
, T/ l4 J  P- V! \a(i, j) = Val(Left(s, InStr(s, " ")))
- c  c% u9 [1 r& ]2 Ns = Trim(Right(s, (Len(s) - InStr(s, " "))))
- m  Q% R$ r, y4 RPrint a(i, j);
Next
% B4 I9 E  Q& C5 O4 l) b+ Y2 }9 @a(i, n + 1) = Val(s)
+ Y, r0 N9 D7 x, w% k/ C4 K" c% FPrint a(i, n + 1);
Print
* C+ B+ Q6 {8 }" I. B+ j) I0 h0 iNext

" A) W$ ]7 c2 w- RFor k = 1 To n - 1 '开始消元
If a(k, k) = 0 Then
) m+ |) V) x, D& uMsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
- [7 G4 [3 k( ^: V; E% wExit Sub
Else
- C* }+ C3 d2 D( gFor i = k + 1 To n
l(i, k) = a(i, k) / a(k, k)
0 @& E' M3 c1 y7 t* k. w; nFor j = k + 1 To n + 1
a(i, j) = a(i, j) - l(i, k) * a(k, j)
  \* f. Z1 e/ p9 V& t. fNext
Next
D = D * a(k, k)
End If
( t9 f. U+ E: r0 ?, k- SNext k '消元结束
If a(n, n) = 0 Then
MsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
# o! \% _3 I# h( S0 z0 X- L9 P4 tExit Sub
Else
D = D * a(n, n)
End If
Print "--------------------------------"
+ b% ?! `  `0 H, J3 R& SPrint "系数行列式的值是："; D
% l$ U0 b( Q; t0 V* |x(n) = a(n, n + 1) / a(n, n)
& L( X( g6 r7 U% @2 h& R9 }& R8 ^" C: CFor k = n - 1 To 1 Step -1 '开始回代
& h( r+ s) E' N) j+ MFor j = k + 1 To n
m = m + a(k, j) * x(j)
Next j
x(k) = (a(k, n + 1) - m) / a(k, k)
& y5 d! f/ j* s/ E5 O4 w/ `m = 0
Next k '结束回代

Print "--------------------------------"
$ R# Y/ d  `8 ^* {1 E3 UPrint "方程组的解如下："
0 ], Z% X, k; n" B
+ M& d% c* D" d, f8 h. G! M) N) UFor k = 1 To n
5 y4 @1 J; r6 x  v6 k4 b# _2 k$ H9 PPrint
Print "X(" & k & ") = " & x(k)
Next k
" r* t* l7 D& j- K- \( p- ?+ yPrint "--------------------------------"
Print "其中各行Ax-b="
Print
& m* [) _# g: m' sFor i = 1 To n
t = 0
For j = 1 To n
t = t + a2(i, j) * x(j)
6 N: o8 ^" U4 A) h- _; f  {Next j
9 {* ?/ o( e- s( Et = t - a2(i, n + 1)
5 @% G; H/ q3 f: ?Print Spc(5); "第" & i & "行："; t
Print
% I" M( |$ R6 \: WNext i

End SubPrivate Sub gauss_Click() '高斯消去法
/ @5 [" l" a6 y, ^6 {$ X- dDim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single
. k. d& \' N: \$ Fi = 1: j = 1
. I7 d+ C- Z* mn = 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
2 w. E3 X3 A! w. q; q/ gReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()
$ U$ |- U: v( v% x7 OFor i = 1 To n
For j = 1 To n
5 |7 K! o3 ]- m0 |8 g4 H8 E; da2(i, j) = a(i, j)
* w0 T4 T+ N6 c4 z  sNext
Next '将a()的值全部赋给a2()
3 O" b+ x# q* e8 @; A. Wm = 0
D = 1
ReDim x(1 To n)
Print "--------------------------------"
; w+ M6 h; a; G5 Y/ h9 |; R' XPrint "您输入的增广矩阵如下："
: s: b4 B; D2 U8 K5 ^% oFor i = 1 To n
s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
. h5 a* E/ t3 @9 QFor j = 1 To n
a(i, j) = Val(Left(s, InStr(s, " ")))
3 s% U+ l" h% o1 v7 X* Vs = Trim(Right(s, (Len(s) - InStr(s, " "))))
Print a(i, j);
" s4 _6 A: S& E% o/ s# m9 G9 g% INext
a(i, n + 1) = Val(s)
Print a(i, n + 1);
6 I; E1 s3 [/ a# V6 pPrint
. g; K0 G6 j- xNext
( \; w# |9 F$ w% K
! b. t" _/ J4 |& ?7 u5 GFor k = 1 To n - 1 '开始消元
$ s" n3 u4 ]" d6 B: V4 W2 e( EIf a(k, k) = 0 Then
( Y9 Z' f. l4 O# z1 UMsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
7 v0 N2 d3 w5 k' ^* B2 G5 V  xExit Sub
Else
For i = k + 1 To n
l(i, k) = a(i, k) / a(k, k)
  k/ M' |) ~. A- R8 XFor j = k + 1 To n + 1
a(i, j) = a(i, j) - l(i, k) * a(k, j)
Next
Next
' B* V, ]% D2 X+ }. nD = D * a(k, k)
End If
' M' F! O) @7 S5 B) l% s, DNext k '消元结束
" T0 O1 F$ _) Z% Y' N5 S! PIf a(n, n) = 0 Then
6 ~4 ?. e) \' U& O* e# U5 Q5 V. E" tMsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
Exit Sub
, [: g' ^! m$ h" \Else
/ z6 A+ O& {" _0 j3 U* XD = D * a(n, n)
End If
( _- a5 \7 n6 kPrint "--------------------------------"
; u$ H8 M! ?/ L! [1 oPrint "系数行列式的值是："; D
- o+ I( ]4 j8 _/ _4 Bx(n) = a(n, n + 1) / a(n, n)
; C; H4 M( H% U' q; RFor k = n - 1 To 1 Step -1 '开始回代
* v  z- v2 g! H9 H- ~" jFor j = k + 1 To n
m = m + a(k, j) * x(j)
Next j
% `6 Y# A* C; m9 P1 Dx(k) = (a(k, n + 1) - m) / a(k, k)
/ |8 Q6 r# L  r" d; M1 c  Xm = 0
) ^* k4 M- F  h0 Z3 O. nNext k '结束回代

8 f. i0 p1 z* y: l/ a# M/ S& gPrint "--------------------------------"
2 b) u6 d3 H; o! n$ sPrint "方程组的解如下："

6 B) ~- j5 @( x' T2 B, N# x% B' z% rFor k = 1 To n
Print
, T- f# C* K' O% JPrint "X(" & k & ") = " & x(k)
Next k
Print "--------------------------------"
- C0 L0 n7 X1 k( x/ w! @Print "其中各行Ax-b="
- t  |/ y$ E$ f+ t4 w/ |Print
( d8 `, C9 e" bFor i = 1 To n
# w5 m' g( p8 p" l6 pt = 0
! C& b! ?5 D  \& f. @, vFor j = 1 To n
' D- p4 O2 v' u; L) ?0 @% O( nt = t + a2(i, j) * x(j)
Next j
; _2 ]* Z4 l0 Z5 Ft = t - a2(i, n + 1)
Print Spc(5); "第" & i & "行："; t
Print
Next i

( F0 b; N) C9 C4 BEnd Sub

ch123en123

下载学习哦

lq12131010

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

zqyzixin

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