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

god

Private Sub gauss_Click() '高斯消去法
1 i. |  Y9 g+ Y; S4 m6 hDim 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)
* z9 [* C6 s9 E% _ReDim Preserve l(1 To n, 1 To n + 1)
) S% N- z& ]1 L5 H1 c1 m! Q; U- HDim k As Integer, D As Single, m As Single, x() As Single, t As Single, a2() As Single
  ?" `- j& l1 q. ]ReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()
; W( ]: J. a# V" M! TFor i = 1 To n
. \* j. Z  V9 A  C$ }1 }' |For j = 1 To n
) M9 h5 o( k! r: b( ~3 f+ ua2(i, j) = a(i, j)
Next
Next '将a()的值全部赋给a2()
; ^: [0 i( Z3 r  E' J- ^% sm = 0
D = 1
ReDim x(1 To n)
: ~' ~9 M0 K/ t  j3 P' ?4 M! jPrint "--------------------------------"
' E$ g/ W) ^' Z' T9 N1 qPrint "您输入的增广矩阵如下："
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, " "))))
Print a(i, j);
Next
a(i, n + 1) = Val(s)
Print a(i, n + 1);
Print
Next

* A2 Y0 j: p7 |$ Y+ `7 _4 \  S' f5 TFor k = 1 To n - 1 '开始消元
' x* `9 |0 J0 q! V: OIf a(k, k) = 0 Then
+ E; ]1 {6 j% J8 s- ?3 `  aMsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
" P) t7 M, G2 f# g. u. g" }( t; LExit Sub
Else
For i = k + 1 To n
% Y$ l- v" `8 `9 }3 {7 u8 Wl(i, k) = a(i, k) / a(k, k)
For j = k + 1 To n + 1
2 ], N' S, @$ L4 w* Ja(i, j) = a(i, j) - l(i, k) * a(k, j)
& C* y' R5 a% P! i6 n4 w) oNext
6 T# M5 y9 T1 GNext
7 `  Z# P) n3 C8 }: i6 zD = D * a(k, k)
End If
Next k '消元结束
If a(n, n) = 0 Then
MsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
$ x# P" j5 R) ?1 h& J, ~Exit Sub
  y% s- T2 ]1 \, F# j- zElse
D = D * a(n, n)
End If
Print "--------------------------------"
. P3 S5 f6 J. W! DPrint "系数行列式的值是："; 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
& D: m" u0 t) _( i5 v" T! s+ C# xx(k) = (a(k, n + 1) - m) / a(k, k)
m = 0
: }! }# z: _$ Y1 b$ G9 D$ cNext k '结束回代
3 _. M2 U% P& u9 E! ~- w' q7 x
Print "--------------------------------"
Print "方程组的解如下："

& A+ `) m7 V6 Q6 A9 [1 nFor k = 1 To n
1 h* ?: _: ~9 L: ?2 l* QPrint
Print "X(" & k & ") = " & x(k)
Next k
& J9 P1 j( u5 y" v$ r0 u& QPrint "--------------------------------"
' f4 g* v% l+ n& t% c) IPrint "其中各行Ax-b="
! P1 O& \* V) X3 W2 q+ p" V: jPrint
0 {2 n; b! F" t. H/ h* X% ]For i = 1 To n
4 ?$ ^6 M  D. a' N% f. y, K4 [7 Ft = 0
For j = 1 To n
  D# |* X: c1 ^1 V2 yt = t + a2(i, j) * x(j)
6 Z" _$ J+ E! B, ~6 |" ?Next j
' Q4 D0 a; b0 m4 j% u! N* Ft = t - a2(i, n + 1)
Print Spc(5); "第" & i & "行："; t
Print
Next i
& A" \- y& y7 c& R
End SubPrivate Sub gauss_Click() '高斯消去法
Dim n As Integer, i As Integer, j As Integer, a() As Single, s As String, l() As Single
& M7 t  d0 h7 W; \, ]. q' Di = 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
1 t* V) }0 M* G) }+ P7 y! mFor j = 1 To n
* \6 p7 _3 O2 M& |* A( Ea2(i, j) = a(i, j)
Next
! Y; z  ^* f5 B3 hNext '将a()的值全部赋给a2()
m = 0
4 a& Z9 w, J" y% V6 k+ ]( z" h" i) tD = 1
ReDim x(1 To n)
/ Z# L1 Q% L) ?* SPrint "--------------------------------"
0 P3 y$ V/ |4 s" e& j  ZPrint "您输入的增广矩阵如下："
- d0 x9 y; E9 MFor i = 1 To n
( _' A8 I& v3 \) D) x- M, z( Ts = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
9 N" S. t) ^$ f2 M( c0 JFor j = 1 To n
4 ~/ a4 G" z7 G1 T" [9 Ya(i, j) = Val(Left(s, InStr(s, " ")))
/ a* Z# ]6 m6 [* Ss = Trim(Right(s, (Len(s) - InStr(s, " "))))
Print a(i, j);
Next
a(i, n + 1) = Val(s)
0 P+ @; `2 ]8 Y0 z0 o7 `* e. oPrint a(i, n + 1);
8 V3 `2 i; N* L8 V3 `6 Q, p/ T; z" LPrint
Next

7 Z$ s3 G, \$ ?- c! c- X9 u' pFor k = 1 To n - 1 '开始消元
+ [1 j* s1 [' F+ q4 A" a2 _If a(k, k) = 0 Then
MsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
Exit Sub
Else
For i = k + 1 To n
# T3 f7 T) g/ {- j3 m# \4 El(i, k) = a(i, k) / a(k, k)
For j = k + 1 To n + 1
2 }: Y0 U* U5 }$ ~; _a(i, j) = a(i, j) - l(i, k) * a(k, j)
; o/ Z6 J7 s5 O3 v" y) O2 Q% p/ \) wNext
0 O, o4 \. m! E  [- x/ DNext
' [; U) w  h) n& s# A. u( ED = D * a(k, k)
End If
Next k '消元结束
0 m. f" t  a$ i7 e8 a; XIf a(n, n) = 0 Then
MsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
6 M6 p8 l( j5 F' M6 @0 q% BExit Sub
6 u! W- i& j; v5 y. l0 DElse
D = D * a(n, n)
End If
+ Q- [& |0 V) x  L. }7 FPrint "--------------------------------"
Print "系数行列式的值是："; D
. ?5 K) U9 I( l/ f4 X: Ux(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
. ^3 a0 ^8 F; B1 D! \x(k) = (a(k, n + 1) - m) / a(k, k)
m = 0
# |! b4 y; n! d, Q' @- Q0 }3 oNext k '结束回代

Print "--------------------------------"
1 q  [. r! o1 A  O4 N9 wPrint "方程组的解如下："

For k = 1 To n
Print
$ o6 f2 n" Z/ {: SPrint "X(" & k & ") = " & x(k)
# }! s+ \0 k: ?' T6 R- YNext k
" N/ R/ o  l9 n. H; VPrint "--------------------------------"
. l$ D5 U* s2 i6 l* }* a/ A$ `" _Print "其中各行Ax-b="
Print
" V3 X2 w) K% M' T  d8 M1 A! \) ZFor i = 1 To n
t = 0
For j = 1 To n
t = t + a2(i, j) * x(j)
Next j
& z. U6 M! u* ^1 ct = t - a2(i, n + 1)
Print Spc(5); "第" & i & "行："; t
Print
Next 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

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