how to save without uae 7500*7500 array

const    maxn=7501;
var
        num,a,heap:array [1..maxn] of integer;
        d:Array [1..maxn,0..maxn] of integer;
        t,tot,n,i,j:integer;
  procedure qsort(l,r:integer);
    var i,j,mid,temp:integer;
  begin
  i:=l;j:=r;mid:=heap[(l+r) div 2];
    repeat
      while heap[i]<mid do inc(i);
      while heap[j]>mid do dec(j);
      if i<=j then begin
        temp:=heap[i];heap[i]:=heap[j];heap[j]:=temp;
        inc(i);dec(j);
      end;
    until i>j;
    if l<j then qsort(l,j);
    if i<r then qsort(i,r);
  end;
  procedure make_heap;
    var x,i,k:integer;
  begin
    x:=heap[1];i:=1;k:=i*2;
    while k<=tot do begin
      if heap[k]>heap[k+1] then k:=k+1;
      if x>heap[k] then begin
        heap[i]:=heap[k];
        i:=k;k:=2*i;
      end
      else break;
    end;
    heap[i]:=x;
  end;
begin
fillchar(num,sizeof(num),0);fillchar(d,sizeof(d),0);
t:=0;tot:=0;
repeat
  inc(t);
  read(a[t]);
  inc(num[a[t]]);
until eoln;
readln;
n:=a[t];
for i:=1 to n do if num[i]=0 then begin
  inc(tot);
  heap[tot]:=i;
end;
qsort(1,tot);
for i:=1 to t do begin
  inc(d[a[i],0]);
  d[a[i],d[a[i],0]]:=heap[1];
  inc(d[heap[1],0]);
  d[heap[1],d[heap[1],0]]:=a[i];
  dec(num[a[i]]);
  if num[a[i]]=0 then begin
                   heap[1]:=a[i];
                   make_heap;
                 end
                 else begin
                   heap[1]:=heap[tot];
                   dec(tot);
                   make_heap;
                 end;
end;
for i:=1 to n do begin
  for j:=1 to d[i,0] do heap[j]:=d[i,j];
  qsort(1,d[i,0]);
  write(i,':');
  for j:=1 to d[i,0] do write(' ',heap[j]);
  writeln;
end;
end.

use dinamically allocated lists