Процедура Intersection работает неправильно

program lab13;
uses crt,unions;
     var A,B,C : array[1..1000] of union ;
     D,F : array[1..3000] of union ;
     ar,br,cr,k,v:integer;
begin
clrscr;
writeln('Vvedite razmernost A');
readln(ar);
fillrandom(@A,ar);
writeln('Vvedite razmernost B');
readln(br);
fillrandom(@B,br);
writeln('Vvedite razmernost C');
readln(cr);
fillrandom(@C,cr);
writeln('Mnojestvo A:'); show(@A,ar);
writeln('Mnojestvo B:'); show(@B,br);
writeln('Mnojestvo C:'); show(@C,cr);
disection(@B,@C,br,cr,k,@d);
readln(k);
intersection(@A,@D,ar,k,v,@f);
readln(k);
show(@f,k);
end.
 
модуль:
 
unit unions;
interface
type union = ^integer;
type ar=array[1..1] of integer;
procedure show(x:union;n:integer);
 
procedure fillrandom(x:union; num:integer);
 
procedure unite(x,y:union;n,m:integer;var z:union);
 
procedure intersection(x,y:union;n,m:integer;var k:integer;z:union);
 
procedure disection(x,y:union;n,m:integer;var k:integer;z:union);
 
procedure subunity(x,y:union;n,m:integer;var z:boolean);
 
implementation
uses crt;
 
 
procedure show;
var
i:integer;
xx:^ar ABSOLUTE x;
begin
    for i:=1 to n do write(xx^[i],', ');
  writeln;
end;
 
 
procedure fillrandom;
var
i:integer;{index hehe}
xx:^ar ABSOLUTE x;
begin
    randomize;
    for i:=1 to num do xx^[i]:=random(256);
{zapolnayem randomom;}
end;
 
 
procedure unite;
var
i:integer;
xx:^ar ABSOLUTE x;
yy:^ar ABSOLUTE y;
zz:^ar ABSOLUTE z;
begin
for i:=1 to (m+n) do
    begin
    if i<=n then
        zz^[i]:=xx^[i]
    else
        zz^[i]:=yy^[i];
    end;
end;
 
procedure intersection;
var
i,j:integer;
xx:^ar ABSOLUTE x;
yy:^ar ABSOLUTE y;
zz:^ar ABSOLUTE z;
begin
k:=0;
for i:=1 to n do begin
 for j:=i to m do begin
    if xx^[i]=yy^[j] then begin inc(k);
    zz^[k]:=xx^[i]; end;
end;
end;
end;
 
procedure disection;
var
i,j:integer;
xx:^ar ABSOLUTE x;
yy:^ar ABSOLUTE y;
zz:^ar ABSOLUTE z;
begin
k:=0;
for i:=1 to n do begin
 for j:=i to m do begin
   if xx^[i]<>yy^[j] then begin inc(k); zz^[k]:=xx^[i]; inc(k); zz^[k]:=yy^[j]; end;
end;
end;
end;
 
procedure subunity;
var
i,j,k:integer;
xx:^ar ABSOLUTE x;
yy:^ar ABSOLUTE y;
temp:integer;
begin
if n>m then begin temp:=n; n:=m; m:=temp; end;
for i:=1 to n do begin
for j:=i to m do begin
if xx^[i]=yy^[j] then inc(k);
end;end;
if k<>n then z:=false else z:=true;
end;
 
end.