[讨论]高斯消去法---这是用VB编的

god

Private Sub gauss_Click() '高斯消去法
. q' y0 K- U- D9 c; YDim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single
& i* o7 U3 b" B! H# wi = 1: j = 1
3 @7 {6 ?5 {2 j/ R9 {n = Val(InputBox("请输入矩阵的阶数(即：方程组未知数个数)N", "方程的未知数个数n", 3))
ReDim Preserve a(1 To n, 1 To n + 1)
5 j  _  r6 {- z; w) f5 C6 l% uReDim Preserve l(1 To n, 1 To n + 1)
: H& ]8 W, a- k1 s, H% KDim k As Integer, D As Single, m As Single, x() As Single, t As Single, a2() As Single
: T2 Q& h5 c3 H3 ]% X& XReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()
For i = 1 To n
8 C; N8 i% m( Z% |For j = 1 To n
a2(i, j) = a(i, j)
Next
) k" W' ]  r" j2 g9 h- H: z! ZNext '将a()的值全部赋给a2()
' D" E, J2 [$ x* Nm = 0
D = 1
ReDim x(1 To n)
# H8 S: {5 Z7 H9 tPrint "--------------------------------"
/ J1 J- Y6 r4 G2 @+ cPrint "您输入的增广矩阵如下："
7 u- }6 }2 K) l7 c2 p. E- j$ B  VFor i = 1 To n
. q9 m! T" E0 X* t. T% Hs = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
For j = 1 To n
  S& L# P* k* r( m/ _2 ra(i, j) = Val(Left(s, InStr(s, " ")))
s = Trim(Right(s, (Len(s) - InStr(s, " "))))
8 v$ Y# B. G; m& H) {9 QPrint a(i, j);
9 F( q% h7 k) r! `) q/ LNext
8 s1 K  [$ T& ea(i, n + 1) = Val(s)
" Q/ ?' E* p% l! q) L; U% p( UPrint a(i, n + 1);
Print
Next
# |' k8 r9 \5 v' A# V9 x6 ?
For k = 1 To n - 1 '开始消元
If a(k, k) = 0 Then
( t6 A) H# @4 _/ SMsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
Exit Sub
% m+ J0 |7 J  ?+ cElse
For i = k + 1 To n
l(i, k) = a(i, k) / a(k, k)
For j = k + 1 To n + 1
7 q) |0 r! ]: a$ C- R3 h/ sa(i, j) = a(i, j) - l(i, k) * a(k, j)
  w4 d$ I* g& l1 T" N4 HNext
Next
D = D * a(k, k)
+ l1 d- l- ?! V+ w. EEnd If
6 {. x+ h. t8 X! e' x& ZNext k '消元结束
  A/ S( G% ?, `3 qIf a(n, n) = 0 Then
; }% F: ]2 L: jMsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
: c* U. b8 z2 \9 ~Exit Sub
Else
D = D * a(n, n)
& F9 Q5 R8 Z5 J0 `End If
Print "--------------------------------"
Print "系数行列式的值是："; D
x(n) = a(n, n + 1) / a(n, n)
For k = n - 1 To 1 Step -1 '开始回代
; j% q0 ]1 z7 M# A  @1 O& ?# uFor j = k + 1 To n
& K# O# ^6 W5 h% o9 s5 @  H0 im = m + a(k, j) * x(j)
4 p- G0 _% M' L0 _0 {, [Next j
& L* M. V8 ~; ]. wx(k) = (a(k, n + 1) - m) / a(k, k)
, p3 ?- S; S# O9 Y0 b0 sm = 0
: m4 z6 Y- _, U. r3 V" ^# Q/ s# ~Next k '结束回代

; y" i; R) `! lPrint "--------------------------------"
* P' \5 M& S( DPrint "方程组的解如下："

1 b6 d: {: m9 s6 v! [! u: W( iFor k = 1 To n
Print
  v/ T1 K6 r& {) V& @0 fPrint "X(" & k & ") = " & x(k)
! _" q- H7 h, w3 y. p' `Next k
9 N0 p3 e  w1 B- o/ W- S0 k$ T. VPrint "--------------------------------"
7 T; ~- F9 T3 W$ Y- DPrint "其中各行Ax-b="
Print
For i = 1 To n
2 `' f, v8 y* N: Q+ ^t = 0
For j = 1 To n
t = t + a2(i, j) * x(j)
9 D; f5 F# h4 ], JNext j
t = t - a2(i, n + 1)
Print Spc(5); "第" & i & "行："; t
Print
Next i

End SubPrivate Sub gauss_Click() '高斯消去法
! o3 a* i: {) e, B/ r2 K& ]Dim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single
6 [! S% c5 D; g) M; Ii = 1: j = 1
2 p; }, X) Q* h/ ?* en = Val(InputBox("请输入矩阵的阶数(即：方程组未知数个数)N", "方程的未知数个数n", 3))
ReDim Preserve a(1 To n, 1 To n + 1)
) z  L! T5 z+ h; f& ?' IReDim Preserve l(1 To n, 1 To n + 1)
/ i* v' g5 A6 {) p' {% o5 ]# A/ o! xDim 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()
, q3 d6 R5 Z8 f& T3 J) }: KFor i = 1 To n
For j = 1 To n
a2(i, j) = a(i, j)
; r9 A# f: _' e) w# R  s/ q0 J# fNext
Next '将a()的值全部赋给a2()
5 ~! @# O6 F& V& j1 _m = 0
1 u3 Q- M+ ^7 v. zD = 1
% t7 `+ b4 T8 m' TReDim x(1 To n)
Print "--------------------------------"
" P; |! Q) L7 _/ _# Z) y, mPrint "您输入的增广矩阵如下："
For i = 1 To n
7 f& r$ R* c2 P" Z" rs = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
For j = 1 To n
a(i, j) = Val(Left(s, InStr(s, " ")))
6 S7 `; s1 i6 f- Ws = Trim(Right(s, (Len(s) - InStr(s, " "))))
Print a(i, j);
; S8 r( B% m# Z+ a9 Z$ K+ [  [Next
a(i, n + 1) = Val(s)
/ `6 A; ~, G+ iPrint a(i, n + 1);
Print
% y* v) N% r1 b1 y2 p  @% V/ @" GNext

For k = 1 To n - 1 '开始消元
+ V! f; Q- a, Y' {If a(k, k) = 0 Then
% a" {7 U; |% X8 J5 X5 ^MsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
! p6 x( {9 Z, V& @- Q2 T. XExit Sub
# \5 e% P( q* }3 @+ w) ?. GElse
/ s7 `2 a1 I6 p' hFor i = k + 1 To n
6 {( q* s$ \6 T2 x& V) y1 Al(i, k) = a(i, k) / a(k, k)
1 P( q7 X% s' S8 p% j0 v! o- IFor j = k + 1 To n + 1
  g* a, o" t- i% u$ U3 N4 Pa(i, j) = a(i, j) - l(i, k) * a(k, j)
Next
Next
  ?5 G1 u# ?+ B# j6 L7 c+ wD = D * a(k, k)
" C. H2 @: ^3 t8 h+ sEnd If
8 u/ ?' y8 M3 q9 DNext k '消元结束
4 N( X! `& |) `9 ^; V' B: `If a(n, n) = 0 Then
MsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
Exit Sub
Else
" S! p7 ^  i) |6 [: u" a0 M- o; _3 N9 MD = D * a(n, n)
+ Z0 n! z- x- S3 I( u8 ?0 zEnd If
( s6 q% g4 q' b1 x& F* f  G2 IPrint "--------------------------------"
0 S+ v8 c5 L- H3 H% EPrint "系数行列式的值是："; D
x(n) = a(n, n + 1) / a(n, n)
For 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)
m = 0
Next k '结束回代
- Q- I4 [- r5 z
) }# T7 Q& T  g$ I; u# T4 E* S) J# X, MPrint "--------------------------------"
3 J+ q/ X7 l1 t) pPrint "方程组的解如下："
& ^6 _# c0 a, w) [9 c) e+ ^" S
+ V' q/ r: R  G3 o3 FFor k = 1 To n
Print
/ {! V  _) ^4 c( r% B  lPrint "X(" & k & ") = " & x(k)
2 m( a5 [4 T0 W/ S3 Q$ W% ANext k
Print "--------------------------------"
" y6 s9 r# r  JPrint "其中各行Ax-b="
7 d9 u4 P8 j% J) ^- ZPrint
% i* J; d0 P" [2 w4 c3 b* [For i = 1 To n
+ V5 T' ]8 c% S; N$ i1 j. _t = 0
( c" K+ ]. x6 |. M- K9 P: p, sFor j = 1 To n
t = t + a2(i, j) * x(j)
: n6 ]- D$ |6 x# k& \Next j
t = t - a2(i, n + 1)
1 C6 i* j  v, q5 g. n8 f. J& NPrint Spc(5); "第" & i & "行："; t
Print
Next i
& M+ ]6 m. ^1 @% 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

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