program RAZENI (input, output );
{ program umoznuje testovat zakladni algoritmz razeni }
{$s-}
Uses Crt,Dos;

const
     Pocet=5000;
     MAX = Pocet;

type
    TYP_KLIC    = integer;
    TYP_HODNOTA = real;
    INDEX       = 0..MAX;
    POLE_PRVKU  = array [INDEX ] of integer;
    NORM = 1..8;
    cas = record
           h, m, s, ms : word;Cas:Real;
     End;

var A : POLE_PRVKU;
    HOD1,MIN1,SEC1,SSEC1,HOD2,MIN2,SEC2,SSEC2  :WORD;
    PPOR,PPRES : longint;
    I,N,OPAKUJ,ii : integer;
    ZN : char;
    DRUHCIN : NORM;
    POKR : Boolean;
    cs:Cas;
    Vysl:Real;


{********************************************************************}
{**********procedury pro pocitani doby razeni*******************}
procedure cas_start(var sc : cas);      {odecte startovni cas}
begin
  gettime(sc.h, sc.m, sc.s, sc.ms);
  writeln('Start: ',sc.h,':',sc.m,':',sc.s,'.',sc.ms);
end;

function cas_stop(sc : cas): real;     {vraci pocet milisekund - real}
var
  kc : cas;                             {koncovy cas}
begin
  gettime(kc.h, kc.m, kc.s, kc.ms);
  writeln('Konec: ',kc.h,':',kc.m,':',kc.s,'.',kc.ms);
  if kc.ms < sc.ms then begin
    kc.ms := kc.ms + 100;
    sc.s := sc.s + 1;
  end;
  if kc.s < sc.s then begin
    kc.s := kc.s + 60;
    sc.m := sc.m + 1;
  end;
  if kc.m < sc.m then begin
    kc.m := kc.m + 60;
    sc.h := sc.h + 1;
  end;
  cas_stop := (kc.h-sc.h)*3600000+(kc.m-sc.m)*60000+(kc.s-sc.s)*1000+(kc.ms-sc.ms)*10;
end;

{procedury pro nastaveni casovace pro odecteni doby razeni}
procedure timer_start;
begin
  asm
    in al, 61h                  {0. bit 61h = GATE casovace 42h}
    mov ah, 0feh                {nastavit 0. bit = reset citace}
    and al, ah
    out 61h, al                 {zapis na port}

    mov al, 10110110b           {ridici slovo}
    out 43h, al
    mov al, 0
    out 42h, al
    mov al, 0
    out 42h, al

    in al, 61h                  {cteni portu 61h}
    mov ah, 01h                 {nulovat 0. bit - spusteni citace}
    or al, ah
    out 61h, al                 {zapis na port}
  end;
end;

function timer_stop:real;       {vraci pocet miliseknud}
var
  lsb, msb : byte;
begin
  asm
    mov al, 10110110b           {ridici slovo - 2. casovac, 3. mod, dva byty}
    out 43h, al
    in al, 42h
    mov lsb, al
    in al, 42h
    mov msb, al
  end;
  timer_stop := (65535-(256*msb+lsb))/(18.2*655.35);
end;
{********************************************************************}


procedure  MERGE_SORT (var A:POLE_PRVKU;     {Razene pole     }
                           N:INDEX           {Pocet prvku pole});
{Procedura seřadi zadané pole metodou slučováni po 2,4,8,.. prvcích}

var I,J,          { indexy prvku ve zdrojovych polich }
    K,L,          { indexy prvku v cilovych polich }
    P,            { pocet prvku p-tice }
    Q,R,          { pocty prvku, ktere zbyva sloucit v p-tici }
    M,            { kolik prvku zbyva celkem }
    H,            { smer ukladani v cilovem poli }
    POM : INDEX;
    NAHORU : Boolean;
    B : array [0..2*MAX] of integer;    { pomocne pole }

begin

  for I:=1 to N do B[I]:=A[I]; { kopírování pole A do pomocného pole B }
  NAHORU := true;
  P := 1;
  repeat
    H := 1;
    M := N;
    if NAHORU then
               begin
                 I := 1;  { počáteční hodnoty indexů ve zdrojovém poli}
                 J := N;
                 K := N+1;  { počáteční hodnoty indexů v cílovém poli }
                 L := 2*N
               end
              else
               begin
                 K := 1;   { počáteční hodnoty indexů ve zdrojovém poli}
                 L := N;
                 I := N+1;   { počáteční hodnoty indexů v cílovém poli }
                 J := 2*N
               end;
    repeat
      if M >= P then Q := P
                else Q := M;
      M := M-Q;
      if M >= P then R := P
                else R := M;
      M := M-R;

     { slučování dílčích posloupností délky R a Q }

      while (Q <> 0)and(R <> 0) do
      begin
        if B[I] < B[J]
                    then
                         begin
                             B[K] := B[I];
                             K := K+H;
                             I := I+1;
                             Q := Q-1
                         end
                    else
                         begin
                             B[K] := B[J];
                             K := K+H;
                             J := J-1;
                             R := R-1
                         end;
       PPOR:=PPOR+1;PPRES:=PPRES+1;
     end;

{ kopírování  nesloučeného zbytku jedné z dílčích posloupností }

      while R <> 0 do
            begin
                 B[K] := B[J];
                 K := K+H;
                 J := J-1;
                 R := R-1;
                 PPRES:=PPRES+1;
            end;

      while Q <> 0 do
            begin
               B[K] := B[I];
               K := K+H;
               I := I+1;
               Q := Q-1;
               PPRES:=PPRES+1;
            end;

    { zmena smeru ukladani v cilovem poli }

      H := -H;
      POM := K; K := L; L := POM;

    until M = 0; { všechny dílčí posloupnosti délky P jsou sloučeny }

    NAHORU := not NAHORU;
    P := 2*P;
  until P >= N;   { celé pole je jediná dílčí posloupnost }

 { kopírování z pomocného pole B do pole A }

  if not NAHORU then for I := 1 to N do A[I] := B[I+N]
                else for I := 1 to N do A[I] := B[I] ;

  PPRES:=PPRES+N;
end;  {konec procedury RAZENI SLUCOVANIM}






Begin
     ClrScr;
     WriteLn;
     For i:=1 to Pocet do
     Begin
          a[ii]:=Random(Pocet);
          {Write(Pole[i],' ');}
     End;
     Timer_Start;
     Merge_Sort(a,Pocet);
     Vysl:=Timer_Stop;
     WriteLn(Vysl);
     {For i:=1 to Pocet do
     Begin
          Write(a[i],' ');
     End;}
     ReadKey;
End.