|
|
Регистрация | << Правила форума >> | FAQ | Пользователи | Календарь | Поиск | Сообщения за сегодня | Все разделы прочитаны |
|
Опции темы | Поиск в этой теме | Опции просмотра |
#1
|
|||
|
|||
решение системы +определитель
Здравствуйте.
Задание найти решение системы уравнений Ах=в (где А-матрица 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. |