Поменять местами min и max элементы в матрице на диагоналях, параллельных главной

const
  e = 0.0000000000000000001;
 
const
  N = 3;
 
var
  g, j, i: integer;
  max1, max2, min1, min2: integer;
  max, min: real;
 
function z2(a, b: real; k, m: integer): real;
var
  i: integer;
  x, y, s, t, slag, p, h: real;
 
begin
  if (a > 709) or (b > 709) or (a < (-18)) or (b < (-18)) then write('ошибочка') else begin
    begin
      h := (b - a) / m;
      x := a + k * h;
      p := 1;
      slag := x;
      i := 1;
      while abs(slag) > e do 
      begin
        p := p + slag;
        slag := slag * x / (i + 1);
        i := i + 1;
      end;
      y := x;
      while y > 2 * pi do
        y := y - 2 * pi;
      s := 0;
      t := y;
      i := 1;
      while abs(t) > e do 
      begin
        s := s + t;
        t := t * (-1) * y * y / (2 * i * (2 * i + 1));
        i := i + 1;
      end;
    end;
    z2 := s * p;
  end;
end;
 
type
  arrayNN = array [1..N, 1..N] of real;
 
var
  A1: arrayNN;
 
procedure read_array(var A: arrayNN; N: integer);
var
  i, j, m: integer;
begin
  m := sqr(n) - 1;
  for i := 1 to N do
    for j := N downto 1 do 
    begin
      if i mod 2 = 0 then
        a[i, j] := z2(-2, 3, ((i - 1) * n) + j, m)
      else a[i, j] := z2(-2, 3, (i * N - j + 1), m);
    end;
end;
 
procedure write_array(A: arrayNN; N: integer);
var
  i, j: integer;
begin
  for i := 1 to N do 
  begin
    for j := 1 to N do
      write(A[i, j], ' ');
    writeln;
  end;
end;
 
begin
  read_array(A1, N);
  write_array(A1, N);
  for i := 1 to n - 1 do
  begin
    g := 1;
    j := i;
    
    max := A1[g, j];
    min := A1[g, j];
    max1 := g;
    max2 := j;
    min1 := g;
    min2 := j;
    
    while j <> n do
    begin
      g := g + 1;
      j := j + 1;
      if A1[g, j] > max then
      begin
        max := A1[g, j];
        max1 := g;
        max2 := j;
      end;
      
      if A1[g, j] < min then
      begin
        min := A1[g, j];
        min1 := g;
        min2 := j;
      end;
    end;
    
    A1[max1, max2] := min;
    A1[min1, min2] := max;
  end;
  writeln;
  writeln;
  write_array(A1, N)
end.

{определение суммы элементов ниже главной диагонали}  
  for i:=1 to n do
   for j:=1 to m do
    if i > j then inc(sum1, arr[i, j]);

const
  n = 5;
begin
  Randomize;
  var a : array [1..n, 1..n] of Integer;
  for var Row := 1 to n do
    for var Col := 1 to n do
      a[Row, Col] := Random(-9,+9);
      
  WriteLn('Исходная:');
  for var Row := 1 to n do
    begin
      for var Col := 1 to n do
        Write(a[Row, Col]:3);
      WriteLn;
    end;
  WriteLn;
  
  /// Поиск и обмен min и max диагоналей
  for var Start := 1 to N-1 do // Последнюю из одного элемента рассматривать не имеет смысла
    begin
      var min := 0; var max := 0;
      for var i := 1 to N - Start do
        if A[Start + i, 1 + i] < A[Start + min, 1 + min] then min := i
        else if A[Start + i, 1 + i] > A[Start + max, 1 + max] then max := i;
      if min <> max then
        Swap(A[Start + min, 1 + min], A[Start + max, 1 + max]);
    end;
 
  WriteLn('Изменённая:');
  for var Row := 1 to n do
    begin
      for var Col := 1 to n do
        Write(a[Row, Col]:3);
      WriteLn;
    end;
  WriteLn;
end.