Лабораторные работы по вычислительной математике

ЛАБОРАТОРНАЯ РАБОТА №4 «Методы решения систем
линейных уравнений ».
Студента группы ПВ-22 Малютина Максима.
Задание. Решить систему по схеме Халецкого с точностью до
0,0001.
Вариант 8.
При разбиении матрицы А на две треугольные, используются
следующие формулы:
M=1..n.
Получены следующие результаты:
Матрица T: Матрица R:
Матрица X:
program lab_3;
{ Лабораторная работа по вычмслительной математике N 3
Нахождение матрицы, обратной данной }
const Sizem = 10; { максимальная размерность матрицы }
type mattype = array [1..Sizem,1..Sizem] of double;
{ процедура для вывода матрицы на экран }
procedure WriteMat (var m : mattype;n,n1 : byte);
var k,i : byte;
begin
writeln;
for k := 1 to n do
begin
for i := 1 to n1 do
write(m[k,i] : 7:3,' ');
writeln
end;
end;
{ процедура ввода значений элементов матрицы }
procedure inputmat (var m : mattype; var n : byte);
var k,i : byte;
begin
writeln;
write ('Размер матрицы = ');
readln(n);
for k := 1 to n do
for i := 1 to n do
read (m[k,i]);
end;
{ процедура транспонирования матрицы }
procedure Transpose (var m : mattype;n : byte);
var k,i : byte;
ttt : double;
begin
for k := 1 to n do
for i := k+1 to n do
begin
ttt := m[k,i];
m[k,i] := m[i,k];
m[i,k] := ttt;
end;
end;
{ процедура умножения двух матриц (a*b=c) }
procedure MulMat (a : mattype; ma,na : byte;
b : mattype; mb,nb : byte;
var c : mattype; var mc,nc : byte);
var k,i,j : byte;
s : double;
begin
if na = nb then
begin
mc := ma;
nc := nb;
for k := 1 to mc do
for j := 1 to nc do
begin
s := 0;
for i := 1 to nc do
s := s+a[k,i]*b[i,j];
c[k,j] := s;
end;
end
else
begin
writeln('Неправильный размер матрицы !');
halt
end;
end;
{ процедура получения двух треугольных матриц
произведение которых равно матрице m }
procedure GetRnT (var m,r,t : mattype; n : byte);
var k,i,m1,l : byte;
begin
for k := 1 to n do
for i := 1 to n do
begin
if k=i then r[k,i] := 1
else r[k,i] := 0;
t[k,i] := 0;
end;
for m1 := 1 to n do
begin
if m1 = 1 then
begin
for i := 1 to n do
t[i,1] := m[i,1];
for i := 2 to n do
r[1,i] := m[1,i]/t[1,1];
end
else
begin
k := m1;
for i := m1 to n do
begin
t[i,k] := m[i,k];
for l := 1 to k-1 do
t[i,k] := t[i,k] - t[i,l]*r[l,k];
end;
i := m1;
for k := i+1 to n do
begin
r[i,k] := m[i,k];
for l := 1 to i-1 do
r[i,k] := r[i,k] - t[i,l]*r[l,k];
r[i,k] := r[i,k] / t[i,i];
end;
end;
end;
end;
{ процедура обращения нижней треугольной матрицы }
procedure BackMat (var t : mattype; n : byte);
var i,k,l : byte;
x : mattype;
begin
for i := 1 to n do
x[i,i] := 1/t[i,i];
for k := 1 to n-1 do
for i := k+1 to n do
begin
x[i,k] := 0;
for l := k to i-1 do
x[i,k] := x[i,k] - t[i,l]*x[l,k];
x[i,k] := x[i,k]/t[i,i];
end;
t := x
end;
var m,m1,r,t : mattype;
n : byte;
{ ------------- основная программа ---------------- }
begin
writeln ('Лабораторная работа N 2 ');
InputMat(m,n); { ввод матрицы m }
GetRnT(m,r,t,n);{получение треугольных матриц t и r}
Writeln('Матрица T: ');
WriteMat(t,n,n);
readln;
Writeln('Матрица R: ');
WriteMat(r,n,n);
readln;
BackMat(t,n); { обращение матрицы t }
Transpose(r,n); { транспонирование матрицы r }
BackMat(r,n); {обращение матрицы r (транcпонир.)}
Transpose(r,n);{транспонирование обращенной м-цы r }
MulMat(r,n,n,t,n,n,m1,n,n);
{получение матрицы,обратной матрице m}
WriteMat (m1,n,n);{ печать обратной матрицы }
readln;
MulMat(m,n,n,m1,n,n,m,n,n); { Проверка вычислений }
WriteMat(m,n,n);
readln;
end.