Divide et impera – Sortare prin interclasare

{sortare prin interclasare - divide et impera}
program sortare;
type vector=array[1..10] of integer; 
var a:vector; n,i:integer; 

procedure sort(p,q:integer;var a:vector); 
var m:integer; 
begin 
if a[p]>a[q] then 
  begin 
    m:=a[p]; 
    a[p]:=a[q]; 
    a[q]:=m 
  end; 
end; 

procedure interc(p,q,m:integer;var a:vector); 
var b:vector; i,j,k:integer; 
begin 
i:=p; 
j:=m+1; 
k:=1; 
while (i<=m) and (j<=q) do 
  if a[i]<=a[j] then 
   begin 
     b[k]:=a[i]; 
     i:=i+1; 
     k:=k+1 
   end 
   else 
   begin 
     b[k]:=a[j];
     j:=j+1;
     k:=k+1 
   end; 
  if i<=m then 
   for j:=i to m do 
     begin 
       b[k]:=a[j]; 
       k:=k+1; 
     end 
   else 
   for i:=j to q do 
     begin 
       b[k]:=a[j]; 
       k:=k+1; 
     end; 
    k:=1; 
    for i:=p to q do 
      begin 
        a[i]:=b[k]; 
        k:=k+1; 
      end 
end; 

procedure divimp(p,q:integer; var a:vector); 
var m:integer; 
begin 
if (q-p)<=1 then sort(p,q,a) else 
begin 
m:=(p+q) div 2; 
divimp(p,m,a); 
divimp(m+1,q,a); 
interc(p,q,m,a); 
end 
end; 

begin 
write('n= ');
read(n); 
for i:=1 to n do 
  begin 
    write('a[',i,']=');
    readln(a[i]); 
  end; 
divimp(1,n,a); 
for i:=1 to n do writeln(a[i]); 
end. 
{PascalZone.uv.ro}