[讨论]高斯消去法---这是用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
6 V- o/ C( }+ j( X. R2 bi = 1: j = 1
n = Val(InputBox("请输入矩阵的阶数(即：方程组未知数个数)N", "方程的未知数个数n", 3))
% r6 s5 t9 V3 |9 n5 |* n" e/ F/ v; DReDim 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
; Z2 V( b* Q8 r! ~  A" a& Z+ ]For j = 1 To n
a2(i, j) = a(i, j)
Next
Next '将a()的值全部赋给a2()
m = 0
D = 1
2 X6 x8 G! I. j5 ?% e' mReDim x(1 To n)
3 x; n; C' X7 h- ~: nPrint "--------------------------------"
: B9 N9 E5 Z  Y3 I8 d9 gPrint "您输入的增广矩阵如下："
For i = 1 To n
& z; M5 m, h0 G4 ^6 g& os = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
* b. x3 ?& U3 f% b4 l7 BFor j = 1 To n
a(i, j) = Val(Left(s, InStr(s, " ")))
! H1 h/ @& A& i0 a& ?  Bs = Trim(Right(s, (Len(s) - InStr(s, " "))))
Print a(i, j);
Next
) _0 Z: x# m& X4 Sa(i, n + 1) = Val(s)
' d+ k( W- W( a- \9 W, [# pPrint a(i, n + 1);
4 o/ @( b/ a3 }Print
, R7 G6 Y9 i2 g+ ?0 a  j/ B+ GNext

! M9 ]  A: S( A2 o0 UFor k = 1 To n - 1 '开始消元
/ [6 z9 e, H7 [6 _  BIf a(k, k) = 0 Then
& E5 j, g$ X8 A/ _. ~6 Y7 c0 ~' xMsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
Exit Sub
; L: O# `  r( p4 EElse
" U2 [( Z3 c. P: f& eFor i = k + 1 To n
3 Q; ]6 {2 h0 m1 }l(i, k) = a(i, k) / a(k, k)
For j = k + 1 To n + 1
; X2 f) o) A: a$ \# O1 ta(i, j) = a(i, j) - l(i, k) * a(k, j)
Next
  \8 E, s. T) k- e6 D) eNext
9 e4 b: [, N2 E1 ^' FD = D * a(k, k)
5 ^8 R! S+ g  H% X2 d. Q4 e: R/ hEnd If
0 K6 T. h, [; m6 ZNext k '消元结束
If a(n, n) = 0 Then
MsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
Exit Sub
Else
; {9 p3 c/ W) @D = D * a(n, n)
' ~" G2 @+ C1 Y4 b+ y0 WEnd If
* n( d) `3 M4 M& y4 s0 H( hPrint "--------------------------------"
3 ^) j, e. y' L! _" RPrint "系数行列式的值是："; D
x(n) = a(n, n + 1) / a(n, n)
For k = n - 1 To 1 Step -1 '开始回代
6 C: V% w8 U, V) _8 dFor j = k + 1 To n
m = m + a(k, j) * x(j)
, `$ P; R% C; L- h% e1 VNext j
x(k) = (a(k, n + 1) - m) / a(k, k)
m = 0
Next k '结束回代

Print "--------------------------------"
. m/ L. l4 C/ b3 s$ APrint "方程组的解如下："

For k = 1 To n
Print
, z' R) v0 e1 J- HPrint "X(" & k & ") = " & x(k)
" ~6 R' q2 z9 [# I& BNext k
Print "--------------------------------"
Print "其中各行Ax-b="
Print
6 A" Y+ b; ?4 b3 F1 T1 q* W" T$ [+ QFor i = 1 To n
t = 0
For j = 1 To n
( ]3 K) r) c5 nt = t + a2(i, j) * x(j)
' L5 z; Y9 a7 o! v; }# ^Next j
t = t - a2(i, n + 1)
Print Spc(5); "第" & i & "行："; t
3 A- c1 \* |# JPrint
Next i

End SubPrivate 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
% \+ M( T8 s2 ~8 V! X% ^7 I5 zn = Val(InputBox("请输入矩阵的阶数(即：方程组未知数个数)N", "方程的未知数个数n", 3))
) [+ x9 F1 ~8 [9 Q$ @8 Z' k* lReDim Preserve a(1 To n, 1 To n + 1)
ReDim Preserve l(1 To n, 1 To n + 1)
, R+ p1 E$ z4 d1 `8 C+ z6 e0 J& LDim 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 r, A+ `1 }) N' c' o- `/ X: HFor i = 1 To n
4 {0 X2 \- M4 U+ _For j = 1 To n
a2(i, j) = a(i, j)
' y0 K9 k2 M6 R* r  n/ ZNext
! s. {: E; J/ s9 \Next '将a()的值全部赋给a2()
7 o2 o1 Y& S; H& a( T4 Dm = 0
8 A" {$ e' Z; RD = 1
0 c) F# |6 w' o( m) ~7 f2 Y; wReDim x(1 To n)
Print "--------------------------------"
Print "您输入的增广矩阵如下："
* j: g. K/ a) l# H; t4 r. ~For i = 1 To n
s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
$ E% l2 X2 U- I- H6 YFor j = 1 To n
- t1 m# I& `8 K) c" Sa(i, j) = Val(Left(s, InStr(s, " ")))
s = Trim(Right(s, (Len(s) - InStr(s, " "))))
Print a(i, j);
Next
a(i, n + 1) = Val(s)
Print a(i, n + 1);
Print
Next

* U& i- i. x% A8 V/ T9 z- wFor k = 1 To n - 1 '开始消元
If a(k, k) = 0 Then
MsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
7 N' X$ P# z3 `# C2 D- C3 wExit Sub
" P# |  i; ~+ OElse
* w! _; [+ H' ?0 |9 t* M- rFor i = k + 1 To n
; z/ |2 F( p4 w7 \  m# ?' R8 d- zl(i, k) = a(i, k) / a(k, k)
+ K" y1 a" M( BFor j = k + 1 To n + 1
a(i, j) = a(i, j) - l(i, k) * a(k, j)
Next
Next
D = D * a(k, k)
End If
, r1 x- ]. T- \* K+ FNext k '消元结束
/ t! T) O: z1 k+ Z. t$ YIf a(n, n) = 0 Then
MsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
- Z* r  U6 `8 U% ?% L( rExit Sub
/ p" `0 _" P/ D! \$ k# |Else
1 e& ?, e4 t- p: _9 x' V5 [D = D * a(n, n)
$ D* C+ p3 z. f- |- DEnd If
Print "--------------------------------"
* }0 B; U' S% WPrint "系数行列式的值是："; D
0 a4 x5 J6 U4 |2 `% u9 bx(n) = a(n, n + 1) / a(n, n)
8 e' l6 U) H4 k8 o3 ]) Z* MFor k = n - 1 To 1 Step -1 '开始回代
* F, y3 s' t" OFor j = k + 1 To n
. E3 ]3 U8 I% B5 [m = m + a(k, j) * x(j)
Next j
3 i. z, h4 T/ r# e1 |& G7 |x(k) = (a(k, n + 1) - m) / a(k, k)
# r  c; q# H; ]$ ]" J/ F6 Wm = 0
Next k '结束回代

' `4 e0 g9 v) N7 @: k+ }) k3 |( _Print "--------------------------------"
1 Z- B; L& }1 {3 g9 S. Z9 RPrint "方程组的解如下："
) D% d2 D, u& v' a! I' G; O$ u
% Y0 E' D, @+ H9 H% s. L; M8 UFor k = 1 To n
' C% t% n9 Q: ~, ]4 aPrint
2 E5 u4 X* A9 O0 b$ ^% C: APrint "X(" & k & ") = " & x(k)
( `1 \  q2 v1 V5 o2 d- ~Next k
Print "--------------------------------"
Print "其中各行Ax-b="
! L3 e. {& e! D; }3 L/ @. QPrint
8 s9 z/ A% |& [8 R! Z' MFor i = 1 To n
t = 0
4 Q" C2 S" q3 iFor j = 1 To n
t = t + a2(i, j) * x(j)
Next j
t = t - a2(i, n + 1)
Print Spc(5); "第" & i & "行："; t
Print
Next i

3 i) f* R% F4 wEnd Sub

ch123en123

下载学习哦

lq12131010

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

zqyzixin

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