[讨论]高斯消去法---这是用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))
4 ?  Y+ N* s. \ReDim Preserve a(1 To n, 1 To n + 1)
- d" C0 t+ w- ^3 m' B  W" 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()
, _, ~2 V3 L) D3 m7 E& E8 pFor i = 1 To n
* g7 F7 F, e$ J+ k" T& fFor j = 1 To n
4 f- M) s% q! q3 X6 Ua2(i, j) = a(i, j)
' I( E0 z1 [8 a8 P! G# v/ gNext
' ?0 H8 p: ^/ t% yNext '将a()的值全部赋给a2()
m = 0
) d+ u& ~5 n/ c" J- k: c6 E" c, }D = 1
ReDim x(1 To n)
; E5 d( O/ X5 ?/ H% x0 A% v" V, DPrint "--------------------------------"
Print "您输入的增广矩阵如下："
For i = 1 To n
s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
For j = 1 To n
a(i, j) = Val(Left(s, InStr(s, " ")))
9 S) ~$ \* K( l! B7 z5 Q, Ys = Trim(Right(s, (Len(s) - InStr(s, " "))))
+ R1 w" }% U0 v# O0 ~& y0 ePrint a(i, j);
4 y% n' t0 T) T# B/ X/ ^Next
a(i, n + 1) = Val(s)
, E, P5 Z! W$ F: p  R$ FPrint a(i, n + 1);
Print
9 p, f9 K! |0 D$ Z2 s* yNext
6 ?( ~) o/ Y  X* r- J
! J% X* o6 D, o* Z$ uFor k = 1 To n - 1 '开始消元
If a(k, k) = 0 Then
& }. g! e6 b5 F- X! AMsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
( b+ I9 W* x- S* `8 x  Z9 x) [Exit Sub
; i0 Z) M( ^: Z' y/ @" b4 zElse
, V" d$ v# _3 O) a* ~& n: _For i = k + 1 To n
l(i, k) = a(i, k) / a(k, k)
1 W! ?; X0 @- G2 A7 `For j = k + 1 To n + 1
0 C" l$ X, f3 M3 Q& ?4 ha(i, j) = a(i, j) - l(i, k) * a(k, j)
Next
Next
4 ^) y) o4 B' v: R2 @% N$ W9 eD = D * a(k, k)
' m9 ^, A" }6 Q0 b9 |End If
Next k '消元结束
4 U4 K+ v) H1 f6 e1 ~% a. UIf a(n, n) = 0 Then
MsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
) T& ?: O/ c8 C4 b. B$ U4 {Exit Sub
, I+ k) @3 G( `7 ]7 K8 J- |% YElse
! K1 C( q$ x- G: UD = D * a(n, n)
( m/ o0 v/ J% b) k6 w3 v' N& k# `End If
! n2 k, t8 {$ G( ?0 MPrint "--------------------------------"
Print "系数行列式的值是："; D
x(n) = a(n, n + 1) / a(n, n)
For k = n - 1 To 1 Step -1 '开始回代
For j = k + 1 To n
* c* u) c9 ~* x7 f* |; F* V( G7 wm = m + a(k, j) * x(j)
! A! q9 g, f! @$ ONext j
7 t9 ^  I9 Z) m# F; _x(k) = (a(k, n + 1) - m) / a(k, k)
; m, b: [7 i( i# H! d3 {! b  f) Im = 0
Next k '结束回代
( R# ?  n; F5 Y
+ N6 b8 j1 p3 h6 APrint "--------------------------------"
Print "方程组的解如下："

For k = 1 To n
Print
Print "X(" & k & ") = " & x(k)
Next k
Print "--------------------------------"
Print "其中各行Ax-b="
Print
3 s  {" v1 F1 m! e8 Q1 O+ y: gFor i = 1 To n
. @; J* x9 D5 X* O- |t = 0
For j = 1 To n
1 E$ r( L! q# c0 b, ?& l1 c/ Mt = t + a2(i, j) * x(j)
Next j
t = t - a2(i, n + 1)
" j, ^7 q) x5 m% Z! [: Y: SPrint Spc(5); "第" & i & "行："; t
Print
6 o" X0 t$ z7 X4 _0 }) N. {" _Next i

% U$ w4 T. Z$ B8 OEnd SubPrivate Sub gauss_Click() '高斯消去法
Dim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single
. j! z8 M1 [5 vi = 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()
For i = 1 To n
For j = 1 To n
a2(i, j) = a(i, j)
' }: Y# V" K8 F. F, W' jNext
Next '将a()的值全部赋给a2()
m = 0
( l; |2 y: c5 |+ j0 GD = 1
ReDim x(1 To n)
Print "--------------------------------"
. ~2 g1 k, b* D, ]0 M# W' pPrint "您输入的增广矩阵如下："
  O8 a0 C7 G+ {For i = 1 To n
  G3 ]- B1 C* S" ^( |2 F8 vs = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
For j = 1 To n
$ _  z) P" _7 U. n4 Ra(i, j) = Val(Left(s, InStr(s, " ")))
+ |5 h7 t* q7 X7 \9 Hs = Trim(Right(s, (Len(s) - InStr(s, " "))))
Print a(i, j);
Next
a(i, n + 1) = Val(s)
Print a(i, n + 1);
Print
3 R" W8 p6 t3 ]Next

7 c" |& v: H) qFor k = 1 To n - 1 '开始消元
If a(k, k) = 0 Then
3 ?0 y% z& \4 @; B! MMsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
( N" [7 h8 F( t+ y% ?Exit Sub
) t$ J+ I! i* J3 HElse
) l; J) T. _2 K( Y) nFor i = k + 1 To n
- Y) U2 p  N! h7 nl(i, k) = a(i, k) / a(k, k)
! j9 C% ]$ |* ~; e+ X) V0 H# uFor j = k + 1 To n + 1
" x6 s. R9 j# g) |- l& Fa(i, j) = a(i, j) - l(i, k) * a(k, j)
Next
0 T/ G3 X% J6 o) {! e2 ]7 JNext
; g+ e- O  X0 y" p& x6 E8 ~D = D * a(k, k)
2 c* H2 _0 Y' H/ oEnd If
Next k '消元结束
3 o. R: d. D+ u: |: zIf a(n, n) = 0 Then
MsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
Exit Sub
Else
D = D * a(n, n)
End If
* E/ X; o6 ~/ E$ d# [Print "--------------------------------"
Print "系数行列式的值是："; D
x(n) = a(n, n + 1) / a(n, n)
For k = n - 1 To 1 Step -1 '开始回代
6 q! m) t! A- U( w  qFor j = k + 1 To n
4 ~! Q( [, g: c% o) m6 hm = m + a(k, j) * x(j)
Next j
& j! d7 z8 c, o8 I( P8 W5 T0 z; Dx(k) = (a(k, n + 1) - m) / a(k, k)
# b/ _- H0 K! }) f1 q) @4 Em = 0
Next k '结束回代

: {) B, b7 Z; N! ^0 y6 ?Print "--------------------------------"
Print "方程组的解如下："

For k = 1 To n
Print
6 o8 |& ]& u  D0 T& _4 I& R6 V7 KPrint "X(" & k & ") = " & x(k)
. g; `5 y9 @. G2 G& ONext k
3 u! E. O: m6 ]4 g( mPrint "--------------------------------"
Print "其中各行Ax-b="
- F, b, F& B% |! o" U- ^Print
For i = 1 To n
t = 0
For j = 1 To n
t = t + a2(i, j) * x(j)
Next j
# Q5 D0 H2 r, g. vt = t - a2(i, n + 1)
Print Spc(5); "第" & i & "行："; t
Print
4 }! R# y0 {) q3 S/ Q  p8 SNext i

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

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