     function MakeBalTree( S : SetOfKeys; lev : integer ) : tree;
     var  med : typekey;
          median : KDKey;
          A : SetOfKeys;
          i, n : integer;
          SubKey : array [1..Max] of typekey;
     begin
     if S=[] then MakeBalTree := nil
     else  begin
          n := SizeOf(S);
          {*** Select subkeys to find median ***}
          for i:=1 to n do SubKey[i] := element(i,S)[lev];
          {*** find median of subkeys ***}
          med := select( n div 2 + 1, SubKey, 1, n );
          A := [];
          for i:=1 to n do
               if element(i,S)[lev] > med then
                    A := A + element(i,S)
               else if element(i,S)[lev] = med then
                    median := element(i,S);
          MakeBalTree := NewNode( median,
                    MakeBalTree( S-A-[median], (lev+1) mod K ),
                    MakeBalTree( A, (lev+1) mod K ) )
          end
     end;
