PROCEDURE SORT (VAR QQ :INTEGER ; VAR X:KOSU  ) ;
    VAR J,I,M,JN,SM,AB:INTEGER ;

    BEGIN
      FOR I:=1 TO N DO
      BEGIN
        Y[I]:=0 ;
        Z[I]:=0
      END ;
      FOR I:=N DOWNTO 1 DO
      BEGIN
        J:=X[I] ;
        Y[I]:=Z[J] ;
        Z[J]:=I
      END ;
      JN:=1 ;
      SM:=1 ;
      I:=QQ ;
      WHILE I>=0 DO
      BEGIN
        J:=Z[I] ;
        WHILE J<>0 DO
        BEGIN
          W[J]:=JN ;
          J:=Y[J] ;
          WHILE J>0 DO
          BEGIN
            SM:=SM+1 ;
            W[J]:=JN ;
            J:=Y[J]
          END ;
          JN:=JN+SM ;
          SM:=1
        END ;
        I:=I-1
      END ;
      FOR I:=1 TO N DO
      BEGIN
        Y[I]:=0 ;
        Z[I]:=0
      END ;
      FOR I:=N DOWNTO 1 DO
      BEGIN
        J:=W[I] ;
        Y[I]:=Z[J] ;
        Z[J]:=I
      END ;
      FOR I:=1 TO N DO
      BEGIN
        IF Z[I]<=0 THEN BEGIN
          AB:=I-1 ;
          M:=Z[AB] ;
          Z[I]:=Y[M]
        END
      END ;
      FOR I:=1 TO N DO
      BEGIN
        M:=Z[I] ;
        W[I]:=X[M]
      END ;
      FOR I:=1 TO N DO
        X[I]:=W[I] ;
   END ;

PROCEDURE PACK (VAR MAXX,QQ,N:INTEGER ;VAR X,Y : KOSU ; VAR BB:KAZU);

  VAR     J ,T : INTEGER ;

    BEGIN
      MAXX:=0 ;
      FOR J:=1 TO N DO
      BEGIN
        FOR T:=1 TO N DO
          BB[J,T]:=0 ;
        Z[J]:=0 ;
        Y[J]:=1
      END ;
      FOR T:=1 TO N DO
      BEGIN
        J:=1 ;
        WHILE Z[J]+X[T]>QQ DO
        BEGIN
          J:=J+1 ;
          IF MAXX<J THEN MAXX:=J
        END ;
        BB[Y[J],J]:=T ;
        Z[J]:=Z[J]+X[T] ;
        Y[J]:=Y[J]+1
      END;

   END ;