[讨论]高斯消去法---这是用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
* y4 X* Z- M0 i" Ni = 1: j = 1
n = Val(InputBox("请输入矩阵的阶数(即：方程组未知数个数)N", "方程的未知数个数n", 3))
ReDim Preserve a(1 To n, 1 To n + 1)
. x+ y# L: o) z5 C: rReDim 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
% y/ ^3 P- G! j7 Z" k4 P9 Ua2(i, j) = a(i, j)
Next
Next '将a()的值全部赋给a2()
m = 0
/ j. \* E  J# U% i2 KD = 1
3 [; C! }0 m9 cReDim x(1 To n)
2 y& C" o7 o; v3 c, r" }Print "--------------------------------"
% E! e) P+ f! j' {7 d6 nPrint "您输入的增广矩阵如下："
9 {9 p% ^; ]  I  b, z7 w. AFor i = 1 To n
) _& Y. l4 \( p" xs = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
* t$ c# k7 Q! [4 Q. BFor j = 1 To n
a(i, j) = Val(Left(s, InStr(s, " ")))
% U3 d& i/ B' l9 ns = Trim(Right(s, (Len(s) - InStr(s, " "))))
Print a(i, j);
Next
6 x% e0 H# z# ?$ k# ja(i, n + 1) = Val(s)
# t, |9 e' b- Q/ I$ FPrint a(i, n + 1);
Print
# @2 @# S' T; M' T6 o9 o# yNext
+ I6 Y6 @4 a' h( E  [6 C3 U8 A
For k = 1 To n - 1 '开始消元
' s0 E3 m, ~# M) \* }If a(k, k) = 0 Then
MsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
Exit Sub
Else
2 q% I# q( h, c4 M+ s. ~; B! EFor i = k + 1 To n
& T7 I8 |. j5 b% Hl(i, k) = a(i, k) / a(k, k)
4 c( X7 g+ A7 {% r, SFor j = k + 1 To n + 1
a(i, j) = a(i, j) - l(i, k) * a(k, j)
6 r; Z; [$ f0 E* N4 ~. VNext
2 W2 ^+ z/ E( F- [Next
D = D * a(k, k)
End If
Next k '消元结束
& t3 q) P7 ?4 e+ _0 c6 g  gIf a(n, n) = 0 Then
MsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
# T8 O9 U$ \$ Z* S+ c7 s; pExit Sub
Else
D = D * a(n, n)
End If
Print "--------------------------------"
" G1 e/ |3 a/ L0 k& o3 EPrint "系数行列式的值是："; D
) a! u9 e) @' @4 f9 ]0 x" G6 M0 ]x(n) = a(n, n + 1) / a(n, n)
% X4 M( g, r7 K8 q7 k7 i5 N9 kFor k = n - 1 To 1 Step -1 '开始回代
For j = k + 1 To n
4 s( U3 H, }! D  Gm = m + a(k, j) * x(j)
! N2 B6 \" K' l* r) v5 sNext j
& K% S- Z& c7 mx(k) = (a(k, n + 1) - m) / a(k, k)
m = 0
4 j. j: w. _0 D1 \6 |+ @Next k '结束回代
# V; k' Z; @6 A" b  _2 F' L: d
1 ?% k/ t& O) k2 Z. tPrint "--------------------------------"
" |. L$ ?% y4 F" T2 X8 k3 _Print "方程组的解如下："

For k = 1 To n
Print
& i  F. N- O1 @; L$ XPrint "X(" & k & ") = " & x(k)
Next k
. }9 Z- y% y2 Q; L7 e" A; U* iPrint "--------------------------------"
/ ?; {1 B" X, }; ]Print "其中各行Ax-b="
+ Z0 S+ s. g, i  ?. V2 d3 l* ?4 d; lPrint
- a% W6 P- v/ L9 C. wFor i = 1 To n
t = 0
. T6 k$ W! @# G: MFor j = 1 To n
9 ]* y2 e: D/ G2 E* at = t + a2(i, j) * x(j)
3 a, Z$ w) q1 E" A6 n. SNext j
6 s% h7 r% T" q2 L9 p5 `( ~2 t  Ct = t - a2(i, n + 1)
, k* P) ?/ _9 i* E- q, z; F( A& TPrint Spc(5); "第" & i & "行："; t
Print
Next i

3 i6 b& i5 t6 F  AEnd SubPrivate Sub gauss_Click() '高斯消去法
0 ]; ?% p  n! @+ L8 ]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)
5 D; c& I( O: {4 j! CReDim 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)
Next
" F) {$ F2 ^4 L  HNext '将a()的值全部赋给a2()
" U2 `# q, ?) A; r9 Y  V  Hm = 0
D = 1
ReDim x(1 To n)
Print "--------------------------------"
Print "您输入的增广矩阵如下："
For i = 1 To n
s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
8 I- {/ t* S3 `! ^/ b9 DFor j = 1 To n
a(i, j) = Val(Left(s, InStr(s, " ")))
s = Trim(Right(s, (Len(s) - InStr(s, " "))))
& x3 O* q" X' I. {6 W  O5 dPrint a(i, j);
. E# e" Z% d: k2 T5 rNext
a(i, n + 1) = Val(s)
Print a(i, n + 1);
6 i  Y" R! ^0 ?) g4 {/ ZPrint
/ d: _6 ?$ q0 M7 A$ H% h5 `Next
8 [0 H- B: X; I5 x/ ^  w
3 \4 z& }& K. R# _- c) VFor k = 1 To n - 1 '开始消元
$ W0 H6 f4 l9 ]If a(k, k) = 0 Then
MsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
/ E. m0 Q7 D; r$ l$ y8 Q6 zExit Sub
" e: S9 S  [9 |- h% H. zElse
For i = k + 1 To n
l(i, k) = a(i, k) / a(k, k)
For j = k + 1 To n + 1
' s* b2 q- H6 r: Ia(i, j) = a(i, j) - l(i, k) * a(k, j)
Next
3 P: ~4 |( ~$ u2 k) [Next
% I; ~* }* ?/ @1 }6 f! ?- X4 {1 Z! P6 jD = D * a(k, k)
. `" T: \. o9 S% c/ @9 u0 NEnd If
Next k '消元结束
If a(n, n) = 0 Then
MsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
Exit Sub
! r% N& q$ U3 l& aElse
D = D * a(n, n)
  Z2 R$ C. y/ EEnd If
2 S( x9 z; i* o* SPrint "--------------------------------"
Print "系数行列式的值是："; D
x(n) = a(n, n + 1) / a(n, n)
8 ^# W& s# |4 f7 Z  _) w* p( b: `For k = n - 1 To 1 Step -1 '开始回代
6 N8 R# q4 Z( F  b+ X6 xFor j = k + 1 To n
m = m + a(k, j) * x(j)
" z/ G0 E1 W7 X; s  t9 T7 N# SNext j
/ w' K2 \2 h7 g" t5 W; |; o! l+ Qx(k) = (a(k, n + 1) - m) / a(k, k)
m = 0
( N. P" Z4 _8 _- s! `Next k '结束回代

1 F+ f, L2 _9 \8 j6 OPrint "--------------------------------"
Print "方程组的解如下："

For k = 1 To n
Print
Print "X(" & k & ") = " & x(k)
Next k
Print "--------------------------------"
" s% U# C$ g9 e" }0 t1 W3 yPrint "其中各行Ax-b="
7 \" }+ N$ Z4 |  cPrint
For i = 1 To n
t = 0
0 H; o0 H* p$ P/ C. e2 F( ZFor j = 1 To n
" Z' r7 G% C8 Ot = t + a2(i, j) * x(j)
Next j
t = t - a2(i, n + 1)
Print Spc(5); "第" & i & "行："; t
Print
  G! }' P  [4 t2 P% P3 INext 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

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