PROGRAM SortMerge (Input,Output, FR,F0,F1,F2);

CONST
   MaxSize = 2000;

   m = 100000000;   {random num generator}     
   b = 31415821;
   m1 = 10000;

TYPE
   ArrayType = Array[1..MaxSize] of Integer;
   
VAR
   A : ArrayType;
   FR, F0, F1, F2 : Text;
   NumTests, Size, MaxKey, k, j : Integer;
   RandNum, Count, TotalCount : Integer4;
   Another : Char;
   Again : Boolean;






{Generate a pseudo-random number between 0 and 1.
RandNum should be seeded at start of each program. }

FUNCTION Random : Real;


FUNCTION Mult (p, q :Integer4) : Integer4;
Var 
   p1 , p0, q1, q0 : Integer4;
Begin
   p1 := p DIV m1;
   p0 := p MOD m1;
   q1 := q DIV m1;
   q0 := q MOD m1;
   Mult := (((p0*q1 + p1*q0) MOD m1) * m1 + p0*q0) MOD m;
End;


Begin
   RandNum := (Mult(RandNum,b) + 1) MOD m;
   Random := RandNum / m;
End;









PROCEDURE FillArray (VAR TestArray : ArrayType;
                     Size, MaxKey : Integer);
Var
   i, j : Integer;
 
Begin
   FOR i := 1 to Size DO
    Begin
      TestArray[i] := Trunc(Random * MaxKey);
     { Writeln(TestArray[i]);}
    End;

{  i := 1;
   REPEAT
       FOR j := 0 TO 4 DO
         Write(TestArray[i+j]);
       Writeln;
       i := i + 5;
    UNTIL i >= Size;}
End;







PROCEDURE Merge (Var A : ArrayType;  
                 Left1, Right1, Right2 : Integer);
                 
VAR
   i,j,k,l : Integer;
   D : ArrayType;

Begin
   i := Left1;
   j := Right1 + 1;
   k := 1;      {Index into merge array}

   WHILE (i <= Right1) AND (j <= Right2) DO
     Begin
       Count := Count + 1;
       IF A[i] <= A[j] THEN
         Begin
           D[k] := A[i];
           i := i + 1;
         End
       ELSE
         Begin
           D[k] := A[j];
           j := j + 1;
         End;
       k := k + 1;
     End;

   IF i > Right1 THEN
     WHILE j <= Right2 DO
       Begin
         D[k] := A[j];
         j := j + 1;
         k := k + 1;
       End
   ELSE
     WHILE i <= Right1 DO
       Begin
         D[k] := A[i];
         i := i + 1;
         k := k + 1;
       End;

   FOR l := 1 to k-1 DO     {Copy back to A}
      A[Left1+l-1] := D[l];

 
End;
     



PROCEDURE MERGESORT (Var A : ArrayType;
                     Left, Right : Integer);
Var
   mid : Integer;

Begin
   If Left <> Right Then
     Begin
       mid := (Left + Right) DIV 2;
       MergeSort(A,Left,mid);
       MergeSort(A,mid+1,Right);
       Merge(A,Left,mid,Right);
     End;
End;





PROCEDURE TwoWayMerge;

Var
   keyX, keyY : Integer;
   NotWritten : Boolean;

Begin
   Reset(F0);
   Reset(F1);
   Rewrite(F2);

   Read(F0,keyX);
   Read(F1,keyY);
   While (Not EOF(F0)) AND (Not EOF(F1)) Do
     Begin
      If keyX <= KeyY Then
        Begin
         Writeln(F2,KeyX);
         Readln(F0,keyX);
        End
      Else
        Begin
         Writeln(F2,KeyY);
         Readln(F1,KeyY);
        End;
     End;        

   NotWritten := True;

   If EOF(F0) Then
    Begin
      While Not EOF(F1) Do
        Begin
         If NotWritten Then
           If keyX <= KeyY Then
             Begin
              Writeln(F2,keyX);
              NotWritten := False;
             End
           Else
             Begin
              Writeln(F2,keyY);
              Readln(F1,keyY);
             End
         Else
           Begin
            Writeln(F2,keyY);
            Readln(F1,keyY);
           End;
        End;
      If NotWritten Then
        If keyX <= KeyY Then
         Begin
          Writeln(F2,KeyX);
          Writeln(F2,keyY);
         End
        Else
         Begin
          Writeln(F2,keyY);
          Writeln(F2,keyX);
         End
      Else
        Writeln(F2,keyY);
    End
   Else
    Begin
      While Not EOF(F0) Do
        Begin
         If NotWritten Then
           If keyX <= KeyY Then
             Begin
              Writeln(F2,keyX);
              Readln(F0,keyX);
             End
           Else
             Begin
              Writeln(F2,keyY);
              NotWritten := False;
             End
         Else
           Begin
            Writeln(F2,keyX);
            Readln(F0,keyX);
           End;
        End;
      If NotWritten Then
        If keyX <= KeyY Then
         Begin
          Writeln(F2,keyX);
          Writeln(F2,keyY);
         End
        Else
         Begin
          Writeln(F2,keyY);
          Writeln(F2,keyX);
         End
      Else
        Writeln(F2,keyX);
    End;
End;




   

BEGIN

   Writeln('Seed random number generator');
   Readln(RandNum);

      Writeln('Array size?');
      Readln(Size);
      Writeln('Key range?');
      Readln(MaxKey);
      FillArray(A,Size,MaxKey);
      MergeSort(A,1,Size);
      Rewrite(F0);
      For j := 1 to Size Do
         Writeln(F0,A[j]);

      Writeln('Array size?');
      Readln(Size);
      Writeln('Key range?');
      Readln(MaxKey);
      FillArray(A,Size,MaxKey);
      MergeSort(A,1,Size);
      Rewrite(F1);
      For j := 1 to Size Do
         Writeln(F1,A[j]);

     twowaymerge;


{   Again := True;
   Repeat
      Writeln('Array size?');
      Readln(Size);
      Writeln('Key range?');
      Readln(MaxKey);
      Writeln('Number of tests?');
      Readln(NumTests);
      TotalCount := 0;
      For j := 1 to NumTests Do
        Begin
          Count := 0;  
          FillArray(A,Size,MaxKey);
          MergeSort(A,1,Size);
          TotalCount := TotalCount + Count;
        End;
      Writeln('Average comparisons is ',                 
TotalCount/NumTests:9:1);
      Writeln;
      Writeln('Another?');
      Readln(Another);
      If (Another <> 'Y') AND (Another <> 'y') Then
         Again := False;
   Until Not Again;
}



 {   k := 1;
   REPEAT
      FOR j := 0 TO 4 DO
         Write(A[k+j]);
      Writeln;
      k := k + 5;
   UNTIL k >= Size;  
}
END.