pascalabcnet/InstallerSamples/OMPSamples/QuickSort.pas

//Демонстрация использования параллельных секций на примере быстрой сортировки
var
  a: array of integer;

var
  b: array of integer;         

// Partition - разделение A[l]..A[r] на части A[l]..A[q] <= A[q+1]..A[r]
function Partition(a: array of integer; l, r: integer): integer;
begin
  var i := l - 1;
  var j := r + 1;
  var x := A[l];
  while True do
  begin
    repeat
      i += 1;
    until A[i] >= x;
    repeat
      j -= 1;
    until A[j] <= x;
    if i < j then
      Swap(A[i], A[j])
        else
    begin
      Result := j;
      exit;
    end;
  end;
end;

 // Параллельная  cортировка частей
procedure Sort(A: array of integer; l, r: integer);
begin
  if l >= r then 
    exit;
  var j := Partition(A, l, r);
      {$omp parallel sections}
  begin
    Sort(A, l, j);
    Sort(A, j + 1, r);
  end;
end;
// Параллельная сортировка   
procedure QuickSortParrallel(A: array of integer);
begin
  Sort(A, 0, a.Length - 1)
end;

//Последовательная  Сортировка частей
procedure SortSeq(a: array of integer; l, r: integer);
begin
  if l >= r then 
    exit;
  var j := Partition(A, l, r);
  SortSeq(A, l, j);
  SortSeq(A, j + 1, r);
end;
//Последовательная сортировка
procedure QuickSortSeq(A: array of integer);
begin
  SortSeq(A, 0, a.Length - 1)
end;
 //заполнение массивов равными значениями для обоих сортировок
procedure FillRandArr(A, B: array of integer);
begin
  Randomize;
  for var i := 0 to A.Length - 1 do
  begin
    a[i] := Random(1000);
    b[i] := a[i];
  end;
end;
 //Вывод массива
procedure printArr(A: array of integer);
begin
  Randomize;
  for var i := 0 to A.Length - 1 do
    writeln(a[i]);
end;

begin
  
  SetLength(a, 10000000);
  SetLength(b, 10000000);
  
  FillRandArr(a, b);
  var m1 := Milliseconds;
  QuickSortSeq(B);
  writeln('Последовательное выполнение: ', Milliseconds - m1, 'ms');
  
  var m0 := Milliseconds;
  QuickSortParrallel(a);
  writeln('Параллельное выполнение: ', Milliseconds - m0, 'ms');
  
end.