[讨论]高斯消去法---这是用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)
8 i: h7 @/ G9 L0 Q8 PReDim 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()
4 }# a& ]4 @( @- ^. IFor i = 1 To n
For j = 1 To n
a2(i, j) = a(i, j)
Next
Next '将a()的值全部赋给a2()
m = 0
; U- T: |6 h2 M$ \: z1 I) R! {D = 1
/ ^( _7 \9 Y! j' AReDim x(1 To n)
Print "--------------------------------"
Print "您输入的增广矩阵如下："
For i = 1 To n
- B4 u0 t7 {' n' z  n' ^8 p7 u- Ps = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
For j = 1 To n
a(i, j) = Val(Left(s, InStr(s, " ")))
; ]9 |& ^) R+ n8 \) Ns = Trim(Right(s, (Len(s) - InStr(s, " "))))
Print a(i, j);
! _3 Y/ S' J' G, X+ U  M0 I& rNext
" }6 b) Z% _5 W  o& B8 F) R8 Qa(i, n + 1) = Val(s)
4 L4 d" Q9 [* d1 b. M+ UPrint a(i, n + 1);
Print
4 o  }* P$ ]0 H  WNext

. q  U: G) }( X% ]# k5 Z9 `3 T) R. AFor k = 1 To n - 1 '开始消元
If a(k, k) = 0 Then
2 H1 [2 W9 K# T2 I, q; R! _MsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
Exit Sub
9 q* V; f! \6 BElse
3 z( X  p2 h6 t3 wFor 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)
Next
) Q% o7 `+ u/ R1 x. M! WNext
- X: p/ o- Q- Q5 yD = D * a(k, k)
End If
% n. G7 n) ~+ V+ b- g2 B! YNext k '消元结束
+ E5 `( a6 B5 Z! R. L. U6 nIf a(n, n) = 0 Then
0 P- y# Y9 r% k6 I9 J0 |: }MsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
Exit Sub
" f  n( r6 x$ C; [# d' oElse
: x  w: o0 ^# ^/ B1 G1 |3 h4 F- VD = D * a(n, n)
. T0 z: `( o/ v; K/ D. B9 g. \% bEnd If
Print "--------------------------------"
, G, y9 w+ T/ b' i5 ]Print "系数行列式的值是："; D
3 S1 k8 D& v1 s$ L& F: ~' Yx(n) = a(n, n + 1) / a(n, n)
: T$ T0 U6 c6 N- o# i% U( u6 r$ c; K% vFor k = n - 1 To 1 Step -1 '开始回代
& L0 t7 i# q0 B) YFor j = k + 1 To n
m = m + a(k, j) * x(j)
Next j
3 I6 Y7 R* F8 tx(k) = (a(k, n + 1) - m) / a(k, k)
( v, ]' i* i4 O2 o- f' I$ Am = 0
* {, z$ G7 n0 u* jNext k '结束回代
2 B5 [: d4 h& |# o$ T$ q- X2 ~
Print "--------------------------------"
Print "方程组的解如下："
) Z" c! ^$ _8 [; u- X) G8 }
/ a% H5 r( n: z5 qFor k = 1 To n
7 E/ A# |. @( oPrint
Print "X(" & k & ") = " & x(k)
Next k
Print "--------------------------------"
Print "其中各行Ax-b="
Print
8 [+ ~* O% u0 Q, ]* WFor i = 1 To n
t = 0
For j = 1 To n
7 A9 O) F( `* a, e5 c8 It = t + a2(i, j) * x(j)
$ ~! T2 E+ }& BNext j
1 l8 b& d1 K6 Gt = t - a2(i, n + 1)
Print Spc(5); "第" & i & "行："; t
! m2 B+ k0 M. g  k2 gPrint
0 i6 G, E. a1 W# _Next i

End SubPrivate Sub gauss_Click() '高斯消去法
# Q! ]  X- x. z, I! KDim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single
  \; Z. H$ x" M' ]0 X5 H/ Q0 m" Hi = 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)
; I' g. r- V9 EDim k As Integer, D As Single, m As Single, x() As Single, t As Single, a2() As Single
' w. o$ D) z' M+ s0 HReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()
+ P& {3 W! ]) [$ z. y( f7 YFor i = 1 To n
& g1 U$ x5 c' t8 i( e: L6 FFor j = 1 To n
a2(i, j) = a(i, j)
Next
9 T& U9 @* N) o3 Q) Q6 fNext '将a()的值全部赋给a2()
m = 0
, X6 H; o0 Z+ BD = 1
ReDim x(1 To n)
Print "--------------------------------"
Print "您输入的增广矩阵如下："
+ c2 j8 v2 i- r0 P, s: yFor i = 1 To n
s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
; C4 X* w& D. }- h% wFor j = 1 To n
: K& [. M3 W, ?. d( _a(i, j) = Val(Left(s, InStr(s, " ")))
0 r8 ^, d$ R! _! ns = Trim(Right(s, (Len(s) - InStr(s, " "))))
Print a(i, j);
. a( T( {1 F5 S% I) z9 jNext
* w  a! B7 H7 K. }. D  y& ]a(i, n + 1) = Val(s)
Print a(i, n + 1);
Print
Next

- ?" L# m, V4 [0 IFor k = 1 To n - 1 '开始消元
If a(k, k) = 0 Then
0 ^+ k" `+ K  _$ aMsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
Exit Sub
* ]4 Z4 l: r* ?& p* B# _& QElse
) W# m* ^" V4 j; g! v6 VFor i = k + 1 To n
3 t& U7 b. O# M1 U* ?/ M) J$ [l(i, k) = a(i, k) / a(k, k)
/ _6 o. a2 Y2 K5 F: SFor j = k + 1 To n + 1
: r7 Q  ^' m6 I7 z! pa(i, j) = a(i, j) - l(i, k) * a(k, j)
9 ]; l( U9 g1 {: N' nNext
  N! ^( b  ]7 V; i' P9 jNext
: Y1 ~1 N3 Y0 o7 ^: k: i; p/ vD = D * a(k, k)
0 M' I. [. _& H- LEnd If
Next k '消元结束
If a(n, n) = 0 Then
MsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
Exit Sub
Else
- X% O8 ]4 B4 I9 r8 C- I0 _D = D * a(n, n)
) J; T. {0 ], M9 z) `  y; KEnd If
Print "--------------------------------"
Print "系数行列式的值是："; D
7 p6 h. h$ @" W: lx(n) = a(n, n + 1) / a(n, n)
For k = n - 1 To 1 Step -1 '开始回代
  C. j: Q) G+ ^. ~For j = k + 1 To n
. s) w5 A3 O3 U0 v  gm = m + a(k, j) * x(j)
, s- n, q" p/ o6 o# q6 E: G4 xNext j
x(k) = (a(k, n + 1) - m) / a(k, k)
m = 0
/ {* ^6 J3 U* `1 T' `( mNext k '结束回代

Print "--------------------------------"
Print "方程组的解如下："
: e0 E% t  r6 s' W; o
For k = 1 To n
Print
Print "X(" & k & ") = " & x(k)
# `. b' a' u1 x3 A# O2 n3 h6 T3 iNext k
- E1 o% z( t. n  w; F1 ?Print "--------------------------------"
- m6 S5 V# p$ N) SPrint "其中各行Ax-b="
$ b1 t' ~9 @4 n( q( @1 y4 iPrint
; a% Z7 N/ j3 P+ ^For i = 1 To n
3 v. U, X! a8 zt = 0
+ A5 [2 C8 h- L6 @8 Y8 z7 TFor j = 1 To n
/ r! I, Z; f/ i4 }$ t  ^t = t + a2(i, j) * x(j)
% S! Q  w; N7 lNext j
t = t - a2(i, n + 1)
Print Spc(5); "第" & i & "行："; t
0 S: d7 G% F6 w4 ^" RPrint
Next i
! S# q: U0 F9 v3 v
$ a# K0 C" @5 W: z8 jEnd Sub

ch123en123

下载学习哦

lq12131010

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

zqyzixin

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