[讨论]高斯消去法---这是用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
' Y, K# Q  w! E5 ~2 En = Val(InputBox("请输入矩阵的阶数(即：方程组未知数个数)N", "方程的未知数个数n", 3))
6 ]# Z+ L. J& f" I- z0 {7 ^/ R0 K( |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
0 S3 @" \9 `7 }8 _ReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()
3 q# _  u" w. n7 z& h8 g: nFor i = 1 To n
  G+ J6 _2 [$ ?9 U2 H* }For j = 1 To n
a2(i, j) = a(i, j)
$ G* U( @/ |, n) jNext
5 T  H' Z) _7 w- K: s& J$ \/ f9 L/ e( QNext '将a()的值全部赋给a2()
1 l& f/ w" e. t, t; Em = 0
D = 1
+ @0 }, F1 U: w$ K( J* I( B4 mReDim x(1 To n)
Print "--------------------------------"
Print "您输入的增广矩阵如下："
8 Z4 w- l  K. \; U/ EFor i = 1 To n
s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
For j = 1 To n
- F2 ^" X9 o8 ha(i, j) = Val(Left(s, InStr(s, " ")))
9 _( V0 D0 x0 b2 fs = Trim(Right(s, (Len(s) - InStr(s, " "))))
Print a(i, j);
Next
a(i, n + 1) = Val(s)
Print a(i, n + 1);
Print
) l4 n2 B+ k, g. `, A6 q0 fNext
/ I6 s' f! r; a. z, c4 ~$ b
For k = 1 To n - 1 '开始消元
If a(k, k) = 0 Then
MsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
1 S* s  d, V0 FExit Sub
" |! y4 I2 G8 c* X5 t& ^$ l6 g% UElse
For i = k + 1 To n
l(i, k) = a(i, k) / a(k, k)
For j = k + 1 To n + 1
  ~4 L" s& j2 \, K0 C, e' O$ la(i, j) = a(i, j) - l(i, k) * a(k, j)
Next
Next
/ c. m/ l0 ~1 gD = D * a(k, k)
8 k# R+ ^  M" t3 N, \& s! x3 IEnd If
Next k '消元结束
If a(n, n) = 0 Then
MsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
Exit Sub
Else
& _9 M- f1 g$ r' VD = D * a(n, n)
) S2 n5 c. e& P. B; KEnd If
  {! n! s1 _" W: iPrint "--------------------------------"
# e( N. Y* C" C" TPrint "系数行列式的值是："; D
x(n) = a(n, n + 1) / a(n, n)
For k = n - 1 To 1 Step -1 '开始回代
For j = k + 1 To n
% S. j3 ^: P* Y4 I& km = m + a(k, j) * x(j)
Next j
x(k) = (a(k, n + 1) - m) / a(k, k)
m = 0
2 Y* E+ H* |# t( gNext k '结束回代
9 c2 C3 h; g4 U
& `- I. M! S/ j7 `* dPrint "--------------------------------"
4 m# B$ q8 b- e! `/ bPrint "方程组的解如下："

( j+ u4 g# U4 ?& W2 L$ SFor k = 1 To n
Print
Print "X(" & k & ") = " & x(k)
' L  q; D/ a1 @" `Next k
Print "--------------------------------"
: _+ q! w' A3 v* y$ V7 W# _/ c( RPrint "其中各行Ax-b="
) H  S# I7 y/ x. tPrint
) k5 e, Z; \+ b; J/ F4 R' bFor i = 1 To n
t = 0
For j = 1 To n
t = t + a2(i, j) * x(j)
) N: B. J+ |# D* p% i; q0 D" QNext j
. Q1 J7 @8 p2 ~! H8 t3 rt = t - a2(i, n + 1)
Print Spc(5); "第" & i & "行："; t
Print
" u9 Y, H% p! ~, ?, Z, Z! aNext 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
n = Val(InputBox("请输入矩阵的阶数(即：方程组未知数个数)N", "方程的未知数个数n", 3))
5 I; K" x/ Z5 U5 y  eReDim Preserve a(1 To n, 1 To n + 1)
) n: E1 \( Z; [! E( jReDim 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
& B+ s0 V: K6 NReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()
$ v+ v9 z. w7 kFor i = 1 To n
. `0 O* `) V6 d4 QFor j = 1 To n
8 m- v' B$ L" i' q, xa2(i, j) = a(i, j)
Next
Next '将a()的值全部赋给a2()
( g$ [( z4 d3 Y; H/ lm = 0
D = 1
0 l# W1 A! H2 X8 U1 A# TReDim x(1 To n)
7 w" x, o( S3 J$ D& KPrint "--------------------------------"
Print "您输入的增广矩阵如下："
' E9 Q4 u8 t$ {" QFor i = 1 To n
s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
) a5 f5 n  y% T5 D$ W4 xFor j = 1 To n
! n3 r& [" t& ?1 _5 M: |a(i, j) = Val(Left(s, InStr(s, " ")))
- W4 G3 S7 j8 o% j. `s = Trim(Right(s, (Len(s) - InStr(s, " "))))
Print a(i, j);
Next
  k  p! i2 D6 Wa(i, n + 1) = Val(s)
Print a(i, n + 1);
Print
Next
/ R& [9 g7 L& u4 O
$ w9 t5 ], J6 U9 V: F# j, J9 iFor k = 1 To n - 1 '开始消元
7 p+ y2 q; i3 X: |' j! M2 WIf a(k, k) = 0 Then
8 p8 E$ S  [5 m  O8 ?* C( a, DMsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
# b. j, p2 e/ x3 qExit Sub
Else
' i& q( b+ u( Y- H: a/ p% ?9 GFor i = k + 1 To n
  i' E. j, T3 D6 nl(i, k) = a(i, k) / a(k, k)
For j = k + 1 To n + 1
" s. j) k" Y( m& N$ d! u% h+ da(i, j) = a(i, j) - l(i, k) * a(k, j)
+ |9 [( d& T& m$ [  U& e9 [Next
Next
D = D * a(k, k)
  @0 Q0 Y/ I* w$ O8 w6 SEnd If
9 H! Q2 Q/ L  k! `1 W: YNext k '消元结束
! F& E$ K( V) vIf a(n, n) = 0 Then
" C  ^# q  t% F" Q, d" X! b1 p5 tMsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
Exit Sub
Else
2 \* ^& G1 i+ L' ^9 c2 D- d0 \D = D * a(n, n)
End If
Print "--------------------------------"
Print "系数行列式的值是："; D
9 Q. v6 g0 `! d& X, Y4 s8 S& ~x(n) = a(n, n + 1) / a(n, n)
For k = n - 1 To 1 Step -1 '开始回代
  x2 Z" `: h: y* }7 N/ yFor j = k + 1 To n
1 r& o) T/ }4 Q0 |) Im = m + a(k, j) * x(j)
Next j
x(k) = (a(k, n + 1) - m) / a(k, k)
m = 0
9 G3 b- f' @1 r4 w! BNext k '结束回代
: M: a3 I2 z2 z9 ]- o$ f
) Z% `/ D, M% ^% j% [" a+ c& }5 i, rPrint "--------------------------------"
Print "方程组的解如下："
" C) N; v" h  d, V' E" z8 i. H
/ d6 ^# \/ _; m1 X8 P5 aFor k = 1 To n
" A7 v$ w1 [: mPrint
Print "X(" & k & ") = " & x(k)
Next k
Print "--------------------------------"
Print "其中各行Ax-b="
Print
7 b; \3 H9 j, W4 b3 H) dFor i = 1 To n
t = 0
For j = 1 To n
- w9 t, L* {) p$ m5 k0 j* Ft = t + a2(i, j) * x(j)
4 \9 |: `6 J# gNext j
t = t - a2(i, n + 1)
Print Spc(5); "第" & i & "行："; t
Print
Next i
" S; `7 @. A( R. ]$ Q0 l, s
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

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