[讨论]高斯消去法---这是用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
+ R, w# K& l; a' `- Oi = 1: j = 1
7 K- j  H4 j2 t: i: z$ j% s$ Rn = Val(InputBox("请输入矩阵的阶数(即：方程组未知数个数)N", "方程的未知数个数n", 3))
ReDim Preserve a(1 To n, 1 To n + 1)
- {! M1 [3 `# V/ Q; V1 A" w$ ]ReDim Preserve l(1 To n, 1 To n + 1)
' D4 [% r7 p( t8 IDim k As Integer, D As Single, m As Single, x() As Single, t As Single, a2() As Single
$ A! G! E/ t" O( R$ KReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()
For i = 1 To n
( B5 U& A: |' b  d0 F4 }1 Z# X1 dFor j = 1 To n
a2(i, j) = a(i, j)
; x7 w5 z% ?' c$ YNext
, L) z- H1 a4 |, ENext '将a()的值全部赋给a2()
m = 0
9 O7 @* F& W, U% {: z" DD = 1
* U' S4 A+ [' w' G8 H3 A& GReDim x(1 To n)
8 ^; `) w9 y3 R' [Print "--------------------------------"
Print "您输入的增广矩阵如下："
For i = 1 To n
s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
For j = 1 To n
9 Q1 A) X0 R# z" a: ea(i, j) = Val(Left(s, InStr(s, " ")))
+ [' f: K8 C. K3 us = Trim(Right(s, (Len(s) - InStr(s, " "))))
Print a(i, j);
, X. D6 F6 b# S/ P! M# `+ SNext
a(i, n + 1) = Val(s)
Print a(i, n + 1);
Print
) u+ \0 N% {+ ?. n/ Z& FNext

. Z  C# ?4 C& p* w2 G1 Z' d1 f- ZFor k = 1 To n - 1 '开始消元
% r$ C9 z- X$ G" A! J: nIf a(k, k) = 0 Then
MsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
2 ~. P) A; |8 H4 |7 C- @Exit Sub
Else
For i = k + 1 To n
l(i, k) = a(i, k) / a(k, k)
For j = k + 1 To n + 1
a(i, j) = a(i, j) - l(i, k) * a(k, j)
! |" }4 O0 Z! W' m! P6 PNext
Next
D = D * a(k, k)
5 d9 V8 ?6 [( x: B. o6 F5 YEnd If
Next k '消元结束
If a(n, n) = 0 Then
. i& f5 y  Z. V: @MsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
6 u7 j% ]" `5 \# N8 H+ I+ IExit Sub
" P% m/ l0 e' c% f, ~  H' TElse
" X9 X) K* ^1 b1 ZD = D * a(n, n)
3 L7 x" K9 U- U: f( YEnd If
" @, ~' h" o. \0 R& _  g% S  w0 pPrint "--------------------------------"
7 b7 h3 K# p- m( l6 f7 h+ @5 i, s# t$ fPrint "系数行列式的值是："; D
+ C9 _+ ^+ `( V( C! A5 Tx(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+ q; T: A0 h8 Sx(k) = (a(k, n + 1) - m) / a(k, k)
, N' P7 _. b  T1 s% W9 d& Xm = 0
Next k '结束回代
" E; U$ c$ y# C" W# _( d& s- A
Print "--------------------------------"
) ]8 t9 A* [0 N5 |Print "方程组的解如下："

9 o6 L5 `& g1 ~6 I9 G' jFor k = 1 To n
" Q4 a3 T% P! |( }/ m5 M* uPrint
% }2 v$ r. ~9 v5 T" K# C$ _, tPrint "X(" & k & ") = " & x(k)
Next k
Print "--------------------------------"
1 h4 {' s* @6 t. g: l1 o0 R* @6 J9 [6 NPrint "其中各行Ax-b="
Print
) e6 W* {6 H9 g" h. j3 w- C( `% u) LFor i = 1 To n
3 b  Z0 N) I% r+ U: l( Q9 ct = 0
For j = 1 To n
t = t + a2(i, j) * x(j)
Next j
) f" E2 h6 c) R. z& K7 Pt = t - a2(i, n + 1)
Print Spc(5); "第" & i & "行："; t
3 x( V+ d6 ^- Q; F9 ^  W- }Print
  ^6 r6 F9 L. K' _# _8 c! g, MNext i

$ M6 _( u1 ^: L; F" s. C  Z5 p! g$ bEnd 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
4 ^. F; g5 T5 y* v; S* K- fn = Val(InputBox("请输入矩阵的阶数(即：方程组未知数个数)N", "方程的未知数个数n", 3))
ReDim Preserve a(1 To n, 1 To n + 1)
$ U7 K( S1 Y5 sReDim 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
- W! U3 `! w, d4 [" AReDim Preserve a2(1 To n, 1 To n + 1) '为方便求Ax-b而设的a()
5 }' t, U, \0 }% yFor i = 1 To n
For j = 1 To n
a2(i, j) = a(i, j)
$ _2 K/ v9 N. b. M, C, T$ INext
Next '将a()的值全部赋给a2()
m = 0
) Y1 U( E# A4 f% B' J  @& d1 L& HD = 1
ReDim x(1 To n)
4 n. V$ C& L3 j3 l9 i& yPrint "--------------------------------"
Print "您输入的增广矩阵如下："
! P# {' q5 F3 YFor i = 1 To n
s = Trim(InputBox("请输入增广矩阵的第" & i & "行" + vbCrLf + "各元素之间请用空格分开", i & "行矩阵的输入"))
: G6 Y% D7 e+ U! a7 I& j3 z* fFor j = 1 To n
a(i, j) = Val(Left(s, InStr(s, " ")))
2 A' D8 F4 y; D# as = Trim(Right(s, (Len(s) - InStr(s, " "))))
Print a(i, j);
/ ^! j$ ^) `3 N$ K0 ~0 ]# l5 ]Next
a(i, n + 1) = Val(s)
) W) j5 W8 s/ tPrint a(i, n + 1);
# V* u% ?' M% l; NPrint
Next

For k = 1 To n - 1 '开始消元
2 x1 M+ h; j0 LIf a(k, k) = 0 Then
MsgBox " Sorry！解不出！" + vbCrLf + "原因是：a(" & k & "，" & k & ")=0了！", vbExclamation, "解不出呀！"
* ^2 I6 Q" H* |9 G" R) l+ j$ fExit Sub
) `, b% t& d* s6 v2 TElse
For i = k + 1 To n
* G3 x6 l* I7 p: P0 o# ~l(i, k) = a(i, k) / a(k, k)
For j = k + 1 To n + 1
a(i, j) = a(i, j) - l(i, k) * a(k, j)
( O+ W+ q) v6 KNext
; X, W' a$ i5 i7 H8 L# hNext
* ^4 J' m2 u) R$ q3 \4 R! o6 UD = D * a(k, k)
" O+ `" ^+ d0 |+ N& o( h6 XEnd If
& d/ `9 x9 u# G+ a. P7 G& g9 tNext k '消元结束
4 }- f3 b# g' D! kIf a(n, n) = 0 Then
5 R! p1 X& Q; o7 B% [5 o% pMsgBox "Sorry！“高斯法”对此矩阵无能为力！" + vbCrLf + "原因是：a(n.n)=0了", vbExclamation, "解不出呀！"
$ ?# R  q% \' R0 b' ^Exit Sub
$ b, _, X, e0 @/ F5 ^Else
8 r7 ?  J8 O) a1 p* t9 B, ^& h+ fD = D * a(n, n)
End If
9 V6 m8 t5 M9 [/ |Print "--------------------------------"
7 g' `# @6 A- gPrint "系数行列式的值是："; D
x(n) = a(n, n + 1) / a(n, n)
For k = n - 1 To 1 Step -1 '开始回代
For j = k + 1 To n
' u* T1 w  K  K2 i& ~% J  Om = m + a(k, j) * x(j)
Next j
x(k) = (a(k, n + 1) - m) / a(k, k)
+ k* \* E! e7 ^# ?. F3 K4 _/ jm = 0
Next k '结束回代

Print "--------------------------------"
: M) T% b5 b7 zPrint "方程组的解如下："

For k = 1 To n
Print
; W7 {! Z2 C) ^$ [/ ]9 LPrint "X(" & k & ") = " & x(k)
Next k
) \" U0 ^/ G+ ~4 p! Z% V7 u- dPrint "--------------------------------"
5 n3 g" m- u: x0 Y/ S/ O8 xPrint "其中各行Ax-b="
+ @/ N4 t: j( k: K: iPrint
! ~! _$ k  |7 EFor i = 1 To n
t = 0
4 Y) F0 q; M0 T9 y* ^: a4 f* IFor j = 1 To n
5 S3 f; j9 q9 ^t = t + a2(i, j) * x(j)
5 h: t& a  [7 HNext j
: ]) I+ {8 Y& K- Wt = t - a2(i, n + 1)
Print Spc(5); "第" & i & "行："; t
6 [9 J$ [% T. t' Y, hPrint
Next i
4 w/ M  d$ p2 g+ K! ~  g
End Sub

zqyzixin

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

lq12131010

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

ch123en123

下载学习哦