[АннаZ111]

Здравствуйте.
Задание найти решение системы уравнений Ах=в (где А-матрица 4 на 4)Методом Гаусса с выбором главного элемента, посчитать невязку e=Ax-b и найти определитель матрицы А.
У меня почему-то "не считает определитель", ошибку не могу найти, поэтому прошу вашей помощи

Код:

Uses CRT;
Const

maxn = 4;

Type

Data = Real;

Matrix = Array[1..maxn, 1..maxn] of Data;

Vector = Array[1..maxn] of Data;

{ ВВедение расширенной матрицы }

Procedure ReadSystem(n: Integer; var a: Matrix; var b: Vector);

Var

i, j, r: Integer;

Begin

r := WhereY;

GotoXY(2, r);

Write('A');

For i := 1 to n do begin

GotoXY(i*6+2, r);

Write(i);

GotoXY(1, r+i+1);

Write(i:2);

end;

GotoXY((n+1)*6+2, r);

Write('b');

For i := 1 to n do begin

For j := 1 to n do begin

GotoXY(j * 6 + 2, r + i + 1);

Read(a[i, j]);

end;

GotoXY((n + 1) * 6 + 2, r + i + 1);

Read(b[i]);

end;

End;





{ Метод Гаусса }

Function Gauss(n: Integer; a: Matrix; b: Vector; var x:Vector): Boolean;

Var

det,d: real;
i, j, k,p, l: Integer;

q, m, t: Data;

Begin

For k := 1 to n - 1 do begin

{ poisk stroku s max elementon v k-om stoldce}

l := 0;

m := 0;

For i := k to n do

If Abs(a[i, k]) > m then begin

m := Abs(a[i, k]);

l := i;

end;

{ ÿ }

If l = 0 then begin

Gauss := false;

Exit;

end;         p:=0;

{ меняем строки}

If l <> k then begin

For j := 1 to n do begin

t := a[k, j];

a[k, j] := a[l, j];

a[l, j] := t;
if odd(k-l) {считаем нечетные перестновки}
then inc(p);

end;

t := b[k];

b[k] := b[l];

b[l] := t;

end;

{ преобразование матрицы }

For i := k + 1 to n do begin

q := a[i, k] / a[k, k];

For j := 1 to n do

If j = k then

a[i, j] := 0

else

a[i, j] := a[i, j] - q * a[k, j];

b[i] := b[i] - q * b[k];
end;
end;
{determinant}
    d:=1;

     for i:=1 to n do
     d:=d*a[i,i];
     for i:=1 to p do
     d:=(-1)*d;
    Det:=d;

{ решение }

x[n] := b[n] / a[n, n];

For i := n - 1 downto 1 do begin

t := 0;

For j := 1 to n-i do

t := t + a[i, i + j] * x[i + j];

x[i] := (1 / a[i, i]) * (b[i] - t);


end;



Gauss := true;

End;

Var
det:real;
n, i,k: Integer;

a: Matrix ;

b, x,e: Vector;

Begin
clrscr;

Writeln('Programma resheniy po metodu Gaussa');

Writeln;

Writeln('vvedite porydok matricy');

Repeat

Write('>');

Read(n);

Until (n > 0) and (n <= maxn);

Writeln;

Writeln('vvedite rashirennuy matricy');

ReadSystem(n, a, b);

Writeln;

If Gauss(n, a, b, x) then begin

Writeln('Rezultat'); write('x=');
for i:=1 to n do
Write( x[i]:3:12,' ');
writeln; write('e='); for i:=1 to n do
e[i]:=a[i,1]*x[1]+a[i,2]*x[2]+a[i,3]*x[3]+a[i,4]*x[4]-b[i];

for i:=1 to n do
write (e[i]:3:12,' '); writeln;
Writeln('det=',det:10:2);
end

else

Writeln('nelzy reshit');

Writeln;


End.