Разработка с использованием сортировки по методу Шелла

const
  max = 100;
 
type
  vector = array [1..max * max] of integer;
  matrix = array [1..max, 1..max] of integer;
 
{Сортировка Шелла }
procedure ShellSort(var A: vector; n_max: integer);
const
  steps = 12;
var
  i, j, l, k, p, n: Integer;
  x: integer;
  s: array [1..steps] of Integer;
begin
  k := 1;
      { Формируем последовательность чисел -
        шаги, с которыми выбираем сортируемые подмассивы }
  for i := steps downto 1 do
  begin
    s[i] := k;
    k := k * 2 + 1;
  end;
  
      { Сортировки подмассивов вплоть до шага 1 -
        обычной сортировки пузырьком }
  for k := 1 to steps do
  begin
    l := s[k];
          { Для каждого шага l нужно отсортировать l подмассивов }
    for p := 1 to l do
    begin
      i := n_max - l;
      n := 1;
              { Сортировка подмассива пузырьком с остановкой }
              { Подмассив - это (A[p], A[p+l], A[p+2*l], ...) }
      while n > 0 do
      begin
        n := 0;
        j := p;
        while j <= i do
        begin
          if A[j] < A[j + l] then
          begin
            x := A[j];
            A[j] := A[j + l];
            A[j + l] := x;
            n := 1;
          end;
          j := j + l;
        end;
        i := i - l;
      end;
    end;
  end;
end;
 
var
  q, temp: vector;
  r: matrix;
  k, imax, j, m, n, i: integer;
 
begin
  n := 8;
  m := 10;
  writeln('Исходная матрица: ');
  k := 0;
  {Формирование массива и свертка матрицы в вектор }
  for i := 1 to n do
  begin
    for j := 1 to m do
    begin
      r[i, j] := -n div 2 + random(m);
      write(r[i, j]:6);
      inc(k);
      q[k] := r[i, j];
    end;
    writeln;
  end;
  
  {Поиск  max }
  imax := 1;
  for i := 1 to n do
    if q[i] > q[imax] then
      imax := i;
  k := 0;      
  for i := 1 to n do
    if q[i] = q[imax] then
    begin
      imax := i;
      inc(k);
      if k = 2 then 
        break;
    end;
 
  if k <> 2 then
  begin
    writeln('Нет 2-го максимума! Выход из программы!');
    exit;
  end
  else
  begin
    writeln('Max: ', q[imax]);
    k := 0;
    for i := imax + 1 to n * m do
    begin
      inc(k);
      temp[k] := q[i];
    end;
    shellsort(temp, k);
    k := 0;
    for i := imax + 1 to n * m do
    begin
      inc(k);
      q[i] := temp[k];
    end;
    writeln('Отсортированная матрица: ');  
    for i := 1 to n do
    begin
      for j := 1 to m do
      begin
        r[i, j] := q[j + m * (i - 1)];
        write(r[i, j]:6);
      end;
      writeln;
    end;
  end;
end.