procedure PRIRSLUC(var A:TYPPOLE;     {Razene pole     }
                   N:integer          {Pocet prvku pole});
          {Procedura seradi zadane pole metodou primeho slucovami. }
          {Sekvencni pristup k poli je dan programove              }

procedure PRIROZEN;

var EOR : Boolean;
    E,F : TYPPOLE;
    I,J,K,L : integer;

  procedure SKOPIRUJPRVEK(var X,Y:TYPPOLE;var P,R:integer);
  begin
    Y[R] := X[P];
    Y[0] := Y[0] + 1;
    P := P + 1;
    R := R + 1;
    if P=X[0]+1 then EOR := true
                else EOR := X[P-1]>X[P]
  end;

  procedure SKOPIRUJBEH(var X,Y:TYPPOLE;var P,R:integer);
  begin
    repeat
      SKOPIRUJPRVEK(X,Y,P,R);
    until EOR
  end;

  procedure DISTRIBUCE;
  begin
    repeat
      SKOPIRUJBEH(A,E,I,J);
      if I<=A[0] then SKOPIRUJBEH(A,F,I,K);
    until I=A[0]+1
  end;

  procedure SLUCBEH;
  begin
    repeat
      if E[J]<F[K] then begin
                          SKOPIRUJPRVEK(E,A,J,I);
                          if EOR then SKOPIRUJBEH(F,A,K,I)
                        end
                   else begin
                          SKOPIRUJPRVEK(F,A,K,I);
                          if EOR then SKOPIRUJBEH(E,A,J,I)
                        end;
    until EOR
  end;

  procedure SLUCOVANI;
  begin
    while(J<=E[0])and(K<=F[0]) do
    begin
      SLUCBEH;
      L := L + 1
    end;
    while J<=E[0] do
    begin
      SKOPIRUJBEH(E,A,J,I);
      L := L + 1
    end;
    while K<=F[0] do
    begin
      SKOPIRUJBEH(F,A,K,I);
      L := L + 1
    end
  end;

begin {Procedura PRIROZENESLUCOVANI}
  repeat
    I := 1;
    J := 1;
    K := 1;
    A[0] := N;
    E[0] := 0;
    F[0] := 0;
    DISTRIBUCE;
    I := 1;
    J := 1;
    K := 1;
    A[0] := 0;
    L := 0;
    SLUCOVANI
  until L=1
end; {Procedura PRIROZENESLUCOVANI}

begin
  PRIROZEN
end;    {Procedura PRIRCLUC}
NI
  until L=1
end; {Procedura PRIROZENESLUCOVANI}

begin
  PRIROZEN
end;    {Procedura PRIRCLUC}