Скачиваний:
29
Добавлен:
17.04.2013
Размер:
5.38 Кб
Скачать

unit GaussUnit; interface GaussSolve; implementation {$DOC+} (************************************************************************* $RU Решение системы линейных уравнений методом Гаусса Система имеет вид: Ax = b где A - матрица NxN, x - вектор Nx1, b - вектор Nx1 Входные параметры: A - массив с нумерацией элементов [1..N, 1..N+1]. В столбцах от 1 до N содержит левую часть системы, в столбце N+1 содержит правую часть. N - размер системы Epsilon - погрешность сравнения. Если число по модулю меньше Epsilon то оно считается нолем. Выбирается программистом исходя из задачи. Обычно на несколько порядков меньше, чем средняя величина коэффициентов матрицы A. Выходные параметры: X - массив с нумерацией элементов [1..N] Решение задачи. Результат: True - если матрица невырождена и решение находится в X False - если матрица близка к вырожденной. При этом в X НЕ НАХОДИТСЯ РЕШЕНИЕ. *************************************************************************) function GaussSolve( A : array of array of Real; const N : Integer; out X : array of Real; const Epsilon : Real):Boolean; var k : Integer; u : Integer; m : Integer; j : Integer; i : Integer; t : Real; begin SetBounds( x, [1, n] ); u:=0; Result:=True; repeat u:=u+1; k:=u; while (AbsReal(a[k,u])<=Epsilon)and(k<n) do begin k:=k+1; end; if (k<>n)or (AbsReal(a[n,u])>Epsilon) then begin if k<>u then begin m:=u; repeat t:=a[u,m]; a[u,m]:=a[k,m]; a[k,m]:=t; m:=m+1; until not(m<=n+1); end; j:=n+1; repeat a[u,j]:=a[u,j]/a[u,u]; j:=j-1 until not(j>=u); m:=n+1; if k+1<=n then begin i:=k+1; repeat j:=u+1; repeat a[i,j]:=a[i,j]-a[i,u]*a[u,j]; j:=j+1 until not(j<=m); i:=i+1 until not(i<=n); end; end else begin Result:=False; end; until not((u<>n)and Result); if Result then begin i:=n; repeat x[i]:=a[i,m]; if i<>1 then begin k:=i-1; repeat a[k,m]:=a[k,m]-a[k,i]*x[i]; k:=k-1 until not(k>=1); end; i:=i-1 until not(i>=1); end; end; end.