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

god

Private Sub gauss_Click() '高斯消去法
: x. E: t% [" j3 q* r" mDim 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)
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
9 [8 j  N4 H( \For j = 1 To n
a2(i, j) = a(i, j)
' y; ?5 {1 N9 b. @, RNext
4 t9 N4 |  ~4 e9 d0 hNext '将a()的值全部赋给a2()
m = 0
! s* h- z; W1 G. c- g" BD = 1
ReDim x(1 To n)
Print "--------------------------------"
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, " ")))
s = Trim(Right(s, (Len(s) - InStr(s, " "))))
1 d0 a3 G/ K. MPrint a(i, j);
6 E3 \& q8 B) U2 FNext
6 P1 I. u8 e, @" r3 }a(i, n + 1) = Val(s)
Print a(i, n + 1);
Print
( o  ?: ]2 f2 {5 r% KNext

For k = 1 To n - 1 '开始消元
1 X3 z' ]: ?7 C$ O$ v2 WIf a(k, k) = 0 Then
MsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
; t( I$ d* @  P( e9 g# p1 B; dExit Sub
Else
For i = k + 1 To n
l(i, k) = a(i, k) / a(k, k)
' G) s" a- O9 X7 Y6 o( B% ~% Z* i/ ^For 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)
. s7 M: r: ]+ s# T- TEnd If
. t0 D. g1 d, V; k: P. p1 }7 U: xNext k '消元结束
3 w  y* y' p' NIf a(n, n) = 0 Then
MsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
/ R+ u* r+ M, r8 G% e" ^Exit Sub
0 n" G' E" R% F  LElse
D = D * a(n, n)
% i% B) b4 q8 y& v, R- t8 V3 DEnd If
Print "--------------------------------"
- m; e" r+ u3 p  k1 [2 ~Print "系数行列式的值是："; D
4 ]% z6 n$ w+ |* C% |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)
" R  P$ g0 m% l7 z1 D4 u- F3 N) Pm = 0
Next k '结束回代
" B9 k% v0 V5 W7 c# J
- s& O) G' l" X: V: pPrint "--------------------------------"
Print "方程组的解如下："

9 @# _) ?8 t' W0 E6 L/ V* V8 kFor k = 1 To n
Print
Print "X(" & k & ") = " & x(k)
Next k
Print "--------------------------------"
Print "其中各行Ax-b="
Print
; W$ P! e$ d& S- {% F  E( D5 m4 ?For i = 1 To n
& D9 _1 I8 ~! O' p; F9 S$ tt = 0
, {* E# {" [0 z0 h8 o2 vFor j = 1 To n
7 c, i8 B! l6 zt = t + a2(i, j) * x(j)
+ P. x. t9 X0 E) N& I1 X# K# ENext j
# i8 H2 x! Z( X. E1 p" Ot = t - a2(i, n + 1)
Print Spc(5); "第" & i & "行："; t
Print
9 S5 s3 |# S7 W9 iNext i
) S' p; l( j- Y: o1 ^# d0 a8 ~
7 G3 V( l) x, F7 C, O" IEnd 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))
' p+ b- a) n. {5 T, RReDim Preserve a(1 To n, 1 To n + 1)
1 v. c( v% h; z' Z6 ~; s2 MReDim Preserve l(1 To n, 1 To n + 1)
0 K! j' O8 h" A2 X! k& |Dim k As Integer, D As Single, m As Single, x() As Single, t As Single, a2() As Single
4 v) q& u6 B# {4 EReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()
For i = 1 To n
, A+ \4 Z1 z5 I0 ^0 ~+ i3 ?! wFor j = 1 To n
7 @. P% t5 w* ba2(i, j) = a(i, j)
Next
Next '将a()的值全部赋给a2()
m = 0
( G3 ]0 C+ f, i# F  c" d4 j9 U" m5 sD = 1
ReDim x(1 To n)
Print "--------------------------------"
, D6 \  B! `. V) A+ Y* a4 s. ]1 SPrint "您输入的增广矩阵如下："
For i = 1 To n
' C8 h' B1 m# ]* `1 L8 v  E# f* `s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
For j = 1 To n
4 J1 x; q1 o5 c9 {% xa(i, j) = Val(Left(s, InStr(s, " ")))
* V& O4 V) i- K6 Rs = Trim(Right(s, (Len(s) - InStr(s, " "))))
! s4 c# L- ?8 S1 M1 q, t, DPrint a(i, j);
Next
8 e* Q# n, \/ ]3 @5 n1 va(i, n + 1) = Val(s)
: V' x+ y9 q% zPrint a(i, n + 1);
Print
* t4 D9 w, X9 ?4 ZNext

For k = 1 To n - 1 '开始消元
If a(k, k) = 0 Then
5 o- x* |+ P4 Y) `MsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
; O0 d; `1 d0 o% ]" b3 j6 MExit Sub
5 t3 o7 l8 {/ X! u  ^/ k6 lElse
* J0 ]4 h, c9 b1 C* N( O+ L  P: uFor i = k + 1 To n
# l" T0 s- n% U$ H5 b7 Z6 m1 Bl(i, k) = a(i, k) / a(k, k)
For j = k + 1 To n + 1
' o: b0 h6 n) I) x" qa(i, j) = a(i, j) - l(i, k) * a(k, j)
Next
Next
8 e& V& Y# |+ Z) Z% B: K8 w: uD = D * a(k, k)
End If
Next k '消元结束
If a(n, n) = 0 Then
  n* P; |: _- HMsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
Exit Sub
Else
$ T% P5 k8 j! b8 |% ]; SD = D * a(n, n)
. W# S0 l5 e& lEnd If
9 i7 j) _  G2 r: }* F& ZPrint "--------------------------------"
) V+ T( R, U. p+ }% D% Z2 s: CPrint "系数行列式的值是："; D
% z) b5 D& z% V7 T% ]7 Z' Y8 xx(n) = a(n, n + 1) / a(n, n)
7 G+ ~/ l# u5 a4 {0 D  eFor 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 '结束回代
# U2 k' J' P) k1 W" ~3 p0 h
  {7 @8 f2 d7 S; s) ~4 U+ o4 J& tPrint "--------------------------------"
Print "方程组的解如下："
2 d( b& B. ]# A" \* o" g: l
For k = 1 To n
Print
* W( V" {5 T7 HPrint "X(" & k & ") = " & x(k)
Next k
" [% J: k  U5 I' ~! e/ [8 aPrint "--------------------------------"
- B% p6 f' C5 \+ U  FPrint "其中各行Ax-b="
Print
# s+ Q. T' X& H% M1 t. _* eFor i = 1 To n
8 O5 A( o2 i. f( I* tt = 0
# ]( |+ ]* E& D( R7 DFor j = 1 To n
t = t + a2(i, j) * x(j)
1 A8 p5 [: e. x6 I) XNext j
; X, p1 {4 J7 }2 v$ _0 B$ I: G  xt = t - a2(i, n + 1)
3 G4 \7 Y0 u7 A  _: PPrint Spc(5); "第" & i & "行："; t
Print
8 C  G5 G" H, W+ h8 g6 x1 hNext i
* t3 D1 S% I3 P) w3 s: s5 T
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

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