Смекни!
smekni.com

Система дифференциальных уравнений с постоянными коэффициентами (стр. 26 из 26)

Procedure WriteX(n :Integer; x: Vector);

Var

i: Integer;

Begin

For i := 1 to n do

Writeln('x', i, ' = ', x[i]);

End;

{ Функция, реализующая метод Гаусса }

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

Var

i, j, k, l: Integer;

q, m, t: Data;

Begin

For k := 1 to n - 1 do begin

{ Ищем строку l с максимальным элементом в k-ом столбце}

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;

{ Если у всех строк от k до n элемент в k-м столбце нулевой,

то система не имеет однозначного решения }

If l = 0 then begin

Gauss := false;

Exit;

end;

{ Меняем местом l-ую строку с k-ой }

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;

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;

{ Вычисляем решение }

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

n, i: Integer;

a: Matrix ;

b, x: Vector;

Begin

ClrScr;

Writeln('Программа решения систем линейных уравнений по методу Гаусса');

Writeln;

Writeln('Введите порядок матрицы системы (макс. 10)');

Repeat

Write('>');

Read(n);

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

Writeln;

Writeln('Введите расширенную матрицу системы');

ReadSystem(n, a, b);

Writeln;

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

Writeln('Результат вычислений по методу Гаусса');

WriteX(n, x);

end

else

Writeln('Данную систему невозможно решить по методу Гаусса');

Writeln;

End.