uses crt;
const
Nmax=9;
eps=0.00001; { все числа, меньшие eps, в процессе решения полагаются равными 0 }
type
matr=array [1..Nmax,1..Nmax] of real;
mas=array [1..Nmax] of real;
var
i,j,N:integer;
b,x:mas;
a:matr;
{*** метод Гаусса *******}
procedure gausss(ag:matr; bg:mas; var xg:mas; Ng:integer);
Var
k,ig,jg:byte;
m,s:real;
blg:boolean;
c:mas;
begin
{ приведение к треугольному виду}
For k:=1 to Ng-1 do
begin
If ABS(ag[k,k])<eps then
begin
ig:=k;
blg:=false;
repeat
Inc(ig);
if ABS(ag[ig,k])>eps then
begin
blg:=true;
c:=ag[k];
ag[k]:=ag[ig];
ag[ig]:=c;
s:=bg[k];
bg[k]:=bg[ig];
bg[ig]:=s;
end;
until blg;
end;
m:=ag[k,k];
for jg:=k to Ng do
ag[k,jg]:=ag[k,jg]/m;
bg[k]:=bg[k]/m;
for ig:=k+1 to Ng do
if ABS(ag[ig,k])>eps then
begin
m:=ag[ig,k];
for jg:=k to Ng do
ag[ig,jg]:=ag[k,jg]-ag[ig,jg]/m;
bg[ig]:=bg[k]-bg[ig]/m;
end
else
ag[ig,k]:=0;
end;
{расчет неизвестных х в обратном порядке}
xg[Ng]:=bg[Ng]/ag[Ng,Ng] ;
for ig:=(Ng-1) downto 1 do
begin
s:=0;
For jg:=ig+1 to Ng do
s:=s+ag[ig,jg]*xg[jg] ;
xg[ig]:=bg[ig]-s;
end;
end;
BEGIN {***** тело программы ******}
clrscr;
Write('N= ');
Readln(N);
writeln ('ввод матрицы коэффициентов при неизвестных х');
for i:=1 to N do
for j:=1 to N do
begin
write('a[',i,',',j,'] = ');
readln(a[i,j]);
end;
writeln ('ввод столбца свободных членов');
for i:=1 to N do
begin
write('b[',i,'] = ');
readln(b[i]);
end;
Writeln;
gausss (a,b,x,N);
writeln ('Вывод результатов решения системы уравнений методом Гаусса');
for i:=1 to N do
writeln('x[',i,'] = ',x[i]:0:5);
readln
END.