Лабораторные работы по численным методам / 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.