procedure sort( var r : ArrayToSort; lo, up : integer );

     label     999;
     var  d, i, j : integer;
          tempr : ArrayEntry;
     begin
     d := up-lo+1;
     while d>1 do begin
          if d<5 then    d := 1
               else d := trunc( 0.45454*d );
          {*** Do linear insertion sort in steps size d ***}
          for i:=up-d downto lo do begin
               tempr := r[i];
               j := i+d;
               while j <= up do
                    if tempr.k > r[j].k then begin
                         r[j-d] := r[j];
                         j := j+d
                         end
                    else goto 999;  {*** break ***}
               999:
               r[j-d] := tempr
               end
          end
     end;