[讨论]高斯消去法---这是用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))
" R* J2 w; n( u" J! `* Z9 AReDim Preserve a(1 To n, 1 To n + 1)
ReDim Preserve l(1 To n, 1 To n + 1)
  Z5 R) b% o, ~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()
9 U$ ^0 U& e' T  O' T! @For i = 1 To n
. p, Z6 u' g, N9 l0 Z2 r4 U& r1 lFor j = 1 To n
a2(i, j) = a(i, j)
" A5 e  |6 v( j. j. jNext
Next '将a()的值全部赋给a2()
m = 0
D = 1
ReDim x(1 To n)
Print "--------------------------------"
Print "您输入的增广矩阵如下："
For i = 1 To n
s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
For j = 1 To n
( x# {3 M5 |' R6 s$ Na(i, j) = Val(Left(s, InStr(s, " ")))
7 A* p* J$ M9 n/ F6 bs = Trim(Right(s, (Len(s) - InStr(s, " "))))
" W* q) o& w$ c3 YPrint a(i, j);
) f2 s) B' p* Q) j6 GNext
8 ?4 |' i: A2 I3 x9 d. L8 ^/ Z4 E$ t1 }a(i, n + 1) = Val(s)
* Q  n# P& Q( b* m& G2 ePrint a(i, n + 1);
- t% {0 Z2 _  J: _( R) T; l& iPrint
6 H; V0 h8 X( d" e$ q' q" j: p" B) pNext
& Q" I4 S8 I: c. ]# c
: L# f! \  J4 `For k = 1 To n - 1 '开始消元
9 B$ b* E5 b5 b2 B, E3 R, |If a(k, k) = 0 Then
MsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
Exit Sub
& v! F. B( y8 x: C: c9 wElse
, t9 `( Q4 g  G6 PFor i = k + 1 To n
4 ?9 F3 u* N6 A( s8 D$ e% Ql(i, k) = a(i, k) / a(k, k)
For j = k + 1 To n + 1
; A0 @) w$ d$ ^" P1 Ga(i, j) = a(i, j) - l(i, k) * a(k, j)
Next
# b9 u8 X) m- L) u2 v( [Next
' y8 U. X5 I7 z& ~  @. yD = D * a(k, k)
End If
Next k '消元结束
If a(n, n) = 0 Then
MsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
Exit Sub
Else
- E" D4 e# K5 N. I  n7 f. u  @% vD = D * a(n, n)
; e( Y( ]9 a3 c6 z" AEnd If
Print "--------------------------------"
Print "系数行列式的值是："; D
# e, Z( ~& j. T* P5 h5 Rx(n) = a(n, n + 1) / a(n, n)
For k = n - 1 To 1 Step -1 '开始回代
) C2 _% k. E% E6 k9 h3 {: CFor j = k + 1 To n
m = m + a(k, j) * x(j)
) W! {6 ]* z1 E! T2 S* ?# n) j$ w# \Next j
x(k) = (a(k, n + 1) - m) / a(k, k)
2 P% k! s8 y& ~# Jm = 0
Next k '结束回代

Print "--------------------------------"
" f8 y$ i" i: }' }' tPrint "方程组的解如下："

- X6 ^7 m2 k2 y) X) UFor k = 1 To n
Print
Print "X(" & k & ") = " & x(k)
Next k
Print "--------------------------------"
, ]& L, p# G. u* n0 R6 G; zPrint "其中各行Ax-b="
. Q3 Z7 ]5 p' v2 ?" @5 ~Print
- r/ {0 E( u8 U6 LFor i = 1 To n
t = 0
For j = 1 To n
t = t + a2(i, j) * x(j)
9 y$ P: Y$ j8 c" Q" g0 F- vNext j
& l1 \, p$ J; [3 N4 u7 at = t - a2(i, n + 1)
6 [1 ^& S0 S) \! b2 k- OPrint Spc(5); "第" & i & "行："; t
Print
Next i

8 P0 |, w2 A; o9 G; B! KEnd SubPrivate Sub gauss_Click() '高斯消去法
Dim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single
4 l2 u8 K( T: S+ j3 }" Q7 n2 R( Ei = 1: j = 1
+ V; u# Q1 L  H2 a9 M9 b+ f9 Hn = Val(InputBox("请输入矩阵的阶数(即：方程组未知数个数)N", "方程的未知数个数n", 3))
ReDim Preserve a(1 To n, 1 To n + 1)
  ?9 C4 \' h1 J5 qReDim Preserve l(1 To n, 1 To n + 1)
; E$ I; Q# U) Q% MDim 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()
+ I$ i* J" I1 [1 t: ?' b5 S8 B# N4 EFor i = 1 To n
0 e! A  f$ G' e( I& ~# ?For j = 1 To n
- p1 e, {- o+ Ta2(i, j) = a(i, j)
Next
Next '将a()的值全部赋给a2()
8 O  _6 m' h% U/ n. t. _. hm = 0
. j5 Z7 H2 ]5 z! u0 i% K# u1 OD = 1
& a1 V+ k1 N7 d. `! i, C% h+ zReDim x(1 To n)
Print "--------------------------------"
0 ^7 W' i( e+ X( Q" K/ A; K# \Print "您输入的增广矩阵如下："
- q& k' Q, b- l. }; MFor i = 1 To n
s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
, p+ {  X* S# \. J& ?For j = 1 To n
a(i, j) = Val(Left(s, InStr(s, " ")))
s = Trim(Right(s, (Len(s) - InStr(s, " "))))
+ `: j1 \# O! Y( D& {7 o/ k' qPrint a(i, j);
Next
a(i, n + 1) = Val(s)
Print a(i, n + 1);
7 w0 d, V6 X* P+ P- FPrint
Next
* c2 l: f3 b  Z7 ^8 N: d4 B8 X
For k = 1 To n - 1 '开始消元
. C( Z# P' N9 m* O/ l4 FIf a(k, k) = 0 Then
MsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
Exit Sub
Else
) ]5 o; Y& L9 @; B4 K9 LFor 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
) s* S, b( ^; o5 o) ?3 v* l2 RNext
D = D * a(k, k)
$ O$ V" e# ~) x3 f; s% KEnd If
6 w8 ^: L- M' y' f3 U2 W  kNext k '消元结束
If a(n, n) = 0 Then
* T' A% K. ]7 C( h* R4 X- L! sMsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
# T7 `& K7 d- X1 H# o0 B4 MExit Sub
# f1 K4 |/ }4 Q8 l! e& dElse
! Z# J: S0 A, r  v- gD = D * a(n, n)
: J' M: v4 k+ v6 r" QEnd If
: M2 q+ i  S! X4 _* _' FPrint "--------------------------------"
Print "系数行列式的值是："; D
x(n) = a(n, n + 1) / a(n, n)
' S& t/ {: t0 j1 LFor k = n - 1 To 1 Step -1 '开始回代
For j = k + 1 To n
m = m + a(k, j) * x(j)
Next j
x(k) = (a(k, n + 1) - m) / a(k, k)
5 P6 F, R* E0 ^m = 0
5 x5 _6 o1 j$ ENext k '结束回代

( ]3 P& q5 s* T7 iPrint "--------------------------------"
8 h3 D4 Y: z7 u" [$ `# T6 l3 QPrint "方程组的解如下："
$ K8 V9 [& D1 r4 s1 ~& E2 w) Z
For k = 1 To n
# S' l6 u, f0 ]% K* h6 mPrint
Print "X(" & k & ") = " & x(k)
3 [( P% v4 Z8 ~! A# k" g5 UNext k
Print "--------------------------------"
$ J3 Q1 ~: b( j% O6 j- _Print "其中各行Ax-b="
3 d% o( h( ~5 h+ k( M; w! dPrint
! }( O7 n) @/ V9 o9 dFor i = 1 To n
t = 0
For j = 1 To n
t = t + a2(i, j) * x(j)
Next j
t = t - a2(i, n + 1)
" o" m8 M2 i9 i+ V4 ]) yPrint Spc(5); "第" & i & "行："; t
Print
' {! D. C3 S. [) k2 J& hNext i
8 ^# W1 v+ E+ \. b
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

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