Решение систем линейных уравнений методом Зейделя

Const
  n = 4; { Порядок системы уравнений }
  m = 200; { Допустимое число итераций }
Type
  row = Array [1 .. n] Of real;
  matrix = Array[1 .. n] Of row;
 
{ Исходные данные: матрицы A и B (свободные члены) }
Const
  A: matrix =
    ((8, 5, -3, 4),
     (2, 2, -1, 1),
     (3, 3, -2, 2),
     (4, 3, -1, 2));
 
  {
    ((24, -2, 2, 1),
     (-1, 21, 2, -1),
     (1, 2, 28, -2),
     (0, 1, -2, 20));
  }
 
  B: row =
    (-8, 6, -2, -4);
  {
    (54, -61, 28, -45);
  }
 
Var
  X: row; { Вектор решения для текущей итерации }
  i, j: word;
  S, Tolerance: real;
 
Procedure Seidel(Var A: matrix; Var B, X: row; n, m: word;
          Tolerance: real);
Var
  Y: row; { Вектор решения для предыдущей итерации }
  T: real;
  i, j, l: word;
 
  Tolerance_stop_flag: boolean;
Const
  k: word = 0;
  Iteration_stop_flag: boolean = false;
Begin
  For i := 1 To n Do Begin
    Y[i] := 0; X[i] := 0
  End;
 
  Repeat
    k := k + 1;
    For i := 1 To n Do Begin
      If A[i, i] = 0 Then Begin
        l := i;
        Repeat
          l := l + 1;
          If (A[l, i] = 0) and (l = n) Then Begin
            WriteLn('Mistake of reduction of system for ', i, 'equation!'); Halt
          End
        Until A[l, i] <> 0;
        T := B[i]; B[i] := B[l]; B[l] := T;
 
        For j := 1 To n Do Begin
          T := A[i, j]; A[i, j] := A[l, j]; A[l, j] := T
        End;
        WriteLn(i, 'and ', l, ' equations of system are rearranged !')
      End;
 
      S := 0;
      For j := 1 To n Do
        If j <> i Then S := S + A[i, j] * X[j];
      X[i] := (B[i] - S) / A[i, i]
    End;
 
    i := 1;
    Tolerance_stop_flag := False;
    Repeat
      If Abs(X[i] - Y[i]) > Tolerance
        Then Tolerance_stop_flag := True
      Else i := i + 1
    Until (i = n) or Tolerance_stop_flag;
 
    If not Tolerance_stop_flag Then Begin
      Iteration_stop_flag := True;
      Writeln('Number of iterations: ', k)
    End
    Else
      For i := 1 To n Do Y[i] := X[i]
  Until (k = m) or Iteration_stop_flag;
 
  If not Iteration_stop_flag Then
    WriteLn('The given number of iterations achieved! ', m)
End; {Seidel}
 
begin
  WriteLn('Метод Зейделя'); WriteLn('A', 'B': 22);
 
  For i := 1 To n Do Begin
    For j := 1 To n Do Write(A[i, j]:4:0);
    WriteLn(B[i]:10:0)
  End;
  Repeat
    Write('Допустимая точность решения? '); ReadLn(Tolerance)
  Until (Tolerance > 0) and (Tolerance < 1);
 
  Seidel(A, B, X, n, m, Tolerance);
 
  WriteLn('Result vector X   ', 'Error B-AX': 25);
  For i := 1 To n Do Begin
    S := 0;
    For j := 1 To n Do
      S := S + A[i, j] * X[j];
    WriteLn(X[i]:15:8, '':13, (B[i]-S):15:8)
  End;
  ReadLn
end.