Решение СЛАУ методом простой итерации(Метод Якоби)

Uses Crt;
 Type
   vector = array[1..5] of real;
   matrix = array[1..5,1..5] of real;
 Const
   n:integer=5;
   e:real=0.001;
Var
   m,i,j,k,max:integer;  sum:array [1..5] of real;
   sum1,sum2:real;
   a:matrix;
   b,beta,x_curr,x_prev,x_tmp:vector;
 
 
 BEGIN
 
   a[1,1]:=0.405;  a[1,2]:=0.05;   a[1,3]:=0.04;   a[1,4]:=0;     a[1,5]:=0.09;  b[1]:=1.065;
   a[2,1]:=-0.061; a[2,2]:=0.53;   a[2,3]:=0.073;  a[2,4]:=0.11;  a[2,5]:=-0.06; b[2]:=0.975;
   a[3,1]:=0.07;   a[3,2]:=-0.036; a[3,3]:=0.38;   a[3,4]:=0.03;  a[3,5]:=0.02;  b[3]:=-1.312;
   a[4,1]:=-0.05;  a[4,2]:=0;      a[4,3]:=0.066;  a[4,4]:=0.58;  a[4,5]:=0.23;  b[4]:=1.066;
   a[5,1]:=0;      a[5,2]:=0.081;  a[5,3]:=-0.05;  a[5,4]:=0;     a[5,5]:=0.41;  b[5]:=-0.048;
 
   sum1:=0; sum2:=0; k:=0;
 
  for i:=1 to n do
    beta[i]:=b[i]/a[i,i];
 
  Repeat
    inc(k);
     if k <> 1 then
       for i:=1 to n do
         x_prev[i]:=x_tmp[i];
    for i:=1 to n do
      begin
         sum1:=0;
        for j:=1 to i-1 do
          sum1:=sum1 + a[i,j] * x_prev[j];
          sum2:=0;
        for j:=i+1 to n do
          sum2:=sum2 + a[i,j] * x_prev[j];
          x_curr[i]:=(b[i] - sum1 - sum2)/a[i,i];
      end;
    for i:=1 to n do
      x_tmp[i]:=x_curr[i];
      max:=1;
    for i:=1 to n-1 do
      if abs(x_curr[max]-x_prev[max]) < abs(x_curr[i+1]-x_prev[i+1]) then
         max:=i+1;
  Until  abs(x_curr[max]-x_prev[max]) < e;
    for i:=1 to n do
        writeln('x[',i,']=',x_curr[i]:2:3);
        writeln('Êîë-âî èòåðàöèé=',k);
END.

Uses Crt;
 Type
   vector = array[1..5] of real;
   matrix = array[1..5,1..5] of real;
 
 Const
   n:integer=5;
   e:real=power(10,-3);
 Var
   i,j,k,max:integer;
   Ek,sum1,sum2:real;
   a,alpha:matrix;
   b,beta,x_curr,x_prev,x_tmp:vector;
   
 BEGIN
 
   a[1,1]:=0.405;  a[1,2]:=0.05;   a[1,3]:=0.04;   a[1,4]:=0;     a[1,5]:=0.09;  b[1]:=1.065;
   a[2,1]:=-0.061; a[2,2]:=0.53;   a[2,3]:=0.073;  a[2,4]:=0.11;  a[2,5]:=-0.06; b[2]:=0.975;
   a[3,1]:=0.07;   a[3,2]:=-0.036; a[3,3]:=0.38;   a[3,4]:=0.03;  a[3,5]:=0.02;  b[3]:=-1.312;
   a[4,1]:=-0.05;  a[4,2]:=0;      a[4,3]:=0.066;  a[4,4]:=0.58;  a[4,5]:=0.23;  b[4]:=1.066;
   a[5,1]:=0;      a[5,2]:=0.081;  a[5,3]:=-0.05;  a[5,4]:=0;     a[5,5]:=0.41;  b[5]:=-0.048;
 
Writeln('Исходная матрица имеет вид:');
  for i:=1 to n do begin
  for j:=1 to n do
     write('  ',a[i,j]:1:3);
     writeln;
  end;
  
Writeln('Преобразованная матрица имеет вид:');
  for i:=1 to n do begin
  for j:=1 to n do
     if i<>j then
  alpha[i,j]:=(-a[i,j])/(a[i,i])
          else
          alpha[i,j]:=0;
      end;
for i:=1 to n do begin
for j:=1 to n do
       write('  ',alpha[i,j]:1:3);
       writeln;
 end;
 
Writeln('Проверим достаточное условие сходимости итерационной последовательности:' );
 for i:=1 to n do begin
 for j:=1 to n do
    Ek:=Ek+sqr(alpha[i,j]);
   end;
    Ek:=sqrt(Ek);
 
if Ek>1 then
        begin
      writeln (' Eвклидова норма матрицы ',Ek:1:3,'>1; условие не выполнено.');
        exit;
     end
      else
     begin
      writeln (' Eвклидова норма матрицы ',Ek:1:3,'<1; условие выполнено.');
   end;
 
Ek:=0; sum1:=0; sum2:=0; k:=0;
 
  for i:=1 to n do
    beta[i]:=b[i]/a[i,i];
   
  Repeat
    inc(k);
     if k <> 1 then
       for i:=1 to n do
         x_prev[i]:=x_tmp[i];
    for i:=1 to n do
      begin
         sum1:=0;
        for j:=1 to i-1 do
          sum1:=sum1 + a[i,j] * x_prev[j];
          sum2:=0;
        for j:=i+1 to n do
          sum2:=sum2 + a[i,j] * x_prev[j];
          x_curr[i]:=(b[i] - sum1 - sum2)/a[i,i];
      end;
    for i:=1 to n do
      x_tmp[i]:=x_curr[i];
      max:=1;
    for i:=1 to n-1 do
      if abs(x_curr[max]-x_prev[max]) < abs(x_curr[i+1]-x_prev[i+1]) then
         max:=i+1;
  Until  abs(x_curr[max]-x_prev[max]) < e;
       writeln('Кол-во итераций=',k);
       writeln('Корни системы:');
    for i:=1 to n do
        write('  x[',i,']=',x_curr[i]:2:3);
END.

Const c=10;
 
Var
   E: real;
   n: integer; // размер сетки
   matrix: array[1..c,1..c] of real;  //матрица
   freekf: array[1..c] of real;  //свобод коэфы
   k: array[1..c] of real;
   x: array[1..c] of real;
   d: array[1..c] of real;
   i,j: integer;
   max: real;
 
BEGIN
  writeln('введите погрешность мзерения E=');
  read(E);
  writeln('введите размер сетки n=');
  read(n);
 
  write('введите матрицу');
  writeln;
  for i:=1 to n do   //ввод матрицы
    begin
      for j:=1 to n do
        readln(matrix[i,j]);
    end;
  writeln;
 
  writeln('свободные коэф');
  for i:=1 to n do readln(freekf[i]);  //ввод свобод коэф
 
  for j:=1 to n do
    for i:=1 to n do
      x[j]:=x[j]+abs(matrix[j,i]);    //  для проверки условия
 
  if (x[1]<1) and (x[2]<1) and (x[3]<1) and (x[4]<1) and (x[5]<1) and (x[6]<1) and (x[7]<1) and (x[8]<1) then  //проверка условия (*)
     Begin
       for i:=1 to n do k[i]:=freekf[i];
       Repeat
         for i:=1 to n do x[i]:=0; //обнулил х
 
         for j:=1 to n do
           for i:=1 to n do
             x[j]:=x[j]+matrix[j,i]*k[i];
 
         for i:=1 to n do x[i]:=x[i]+ freekf[i];
 
         for i:=1 to n do d[i]:=abs(k[i]-x[i]); // разность итераций n-(n+1)
 
         for i:=1 to n do k[i]:=x[i];  // запомнить х
 
         max:=d[1];
         for i := 1 to n-1 do
           if  max<d[i+1] then max:=d[i+1];
           
         writeln;
         for i:=1 to n do write(' x',i,'=',x[i]:1:4);
 
        until E>max;
      End;
END.