Лабораторные работы по численным методам / 2 / 2

uses crt;
const n=40; epsilon=1E-10;
var i,j,k: integer;
a,aa,s,edn,obr: array [1..n,1..n] of real;
b,bb,bbb,ab,x,y,d,dd: array [1..n] of real;
tmp,det,max,maxo,maxn,prog,obdet,sum: real;
f,f1,f2: text;

begin

var start:=System.DateTime.Now;

assign(f,'исходная матрица.txt');
Reset(f);
assign(f1,'корни уравнений.txt');
rewrite(f1);
assign(f2,'обратная матрица.txt');
reset(f2);

//считывание исходной матрицы
for i:=1 to n do
begin
for j:=1 to n do
read(f,a[i,j]);
readln(f,b[i]);
end;

aa:=a;
bb:=b;

//находим норму для исходной матрицы
max:=0;
for i:=1 to n do
begin
sum:=0;
for j:=1 to n do sum:=sum+abs(a[i,j]);
d[i]:=sum;
if d[i]>max then max:=d[i];
end;


for i:=1 to n do
begin
tmp:=0;
for k:=1 to (i-1) do
tmp:=tmp+s[k,i]*s[k,i];
s[i,i]:=sqrt(a[i,i]-tmp);
for j:=(i+1) to n do
begin
tmp:=0;
for k:=1 to (i-1) do
tmp:=tmp+s[k,i]*s[k,j];
s[i,j]:=(a[i,j]-tmp)/s[i,i];
end;
end;

for i:=1 to n do
begin
tmp:=0;
for k:=1 to (i-1) do
tmp:=tmp+s[k,i]*y[k];
y[i]:=(b[i]-tmp)/s[i,i];
edn[i,k]:=y[i];
end;

for i:=n downto 1 do
begin
tmp:=0;
for k:=(i+1) to n do
tmp:=tmp+s[i,k]*x[k];
x[i]:=(y[i]-tmp)/s[i,i];
end;

//считывание обратной матрицы
for i:=1 to n do
begin
for j:=1 to n do
read(f2,obr[i,j]);
end;

//находим норму для обратной матрицы
maxo:=0;
for i:=1 to n do
begin
sum:=0;
for j:=1 to n do sum:=sum+abs(obr[i,j]);
dd[i]:=sum;
if dd[i]>maxo then maxo:=dd[i];
end;

//опрелелитель обратной матрицы
for k:=1 to n do
for i:=k+1 to n do
for j:=k+1 to n do
begin
obr[i,j]:=obr[i,j]-obr[i,k]*obr[k,j]/obr[k,k];
obdet:=obr[1,1];
end;
for i:=2 to n do
obdet:=obdet*obr[i,i];
writeln('Определитель обратной матрицы =',obdet);


//вывод корней в файл
for i:=1 to n do
writeln(f1,'x[',i,']=',x[i]);

//определитель матрицы
for k:=1 to n do
for i:=k+1 to n do
for j:=k+1 to n do
begin
a[i,j]:=a[i,j]-a[i,k]*a[k,j]/a[k,k];
det:=a[1,1];
end;
for i:=2 to n do
det:=det*a[i,i];
writeln('Определитель исходной матрицы =',det);



//исходную матрицу умножаем на корни уравнений
for i:=1 to n do
begin
ab[i]:=0;
for j:=1 to n do
ab[i]:=ab[i]+aa[i,j]*x[j];
end;

// вычитаем свободные члены(невязка)
for j:=1 to n do
bbb[j]:=ab[j]-bb[j];

//находим норму невязки
maxn:=abs(bbb[1]);
for j:=1 to n do
if abs(bbb[j])>maxn then maxn:=abs(bbb[j]);

// норму обратной матрицы * на норму невязку
prog:=maxn*maxo;
writeln('Прогрешность:',prog);

writeln('Проверка.Произведение определителей = ',det*obdet);
writeln('Норма исходной матрицы =',max);
writeln('Норма обратной матрицы =',maxo:7:5);
writeln('Число обусловленности = ',(max*maxo):7:5);

close(f);
close(f1);
close(f2);

var finish:=System.DateTime.Now;
writeln('Время выполнения = ',(finish - start).TotalSeconds,' секунд');

end.