Внешние сортировки, Помогите пожалуйста написать программу внешней сортировки Опции

[forex1992]

Здравствуйте!!!!
Подскажите или напишите пожалуйста программу сортировки естественным слиянием,
результат сортировки должен быть представлен после выполнения каждого шага

var f1,f2,f3:Text;     
      kol_otr:Byte;     
      r2:integer;  

procedure MyWrite(number:Byte; a:integer); 
begin    
  CASE number of     
    1: writeln(f1,a);             
    2: writeln(f2,a);              
    3: writeln(f3,a);           
  end; 
end;  

procedure Myread(number:Byte; var a:integer); 
begin    
  CASE number of     
    1: read(f1,a);     
    2: read(f2,a);     
    3: read(f3,a)    
  end; 
end;  

function MyEof(number:Byte):Boolean; 
begin    
  CASE number of     
    1: MyEof:=Eof(f1);     
    2: MyEof:=Eof(f2);     
    3: MyEof:=Eof(f3)    
  end; 
end;   

procedure razd(VAR f1,f2,f3:Text); 
var a,b:Integer;     
      tek_file:BYTE;   
begin      
  reset(f1);      
  rewrite(f2);      
  rewrite(f3);      
  tek_file:=2;      
  if not eof(f1) then  begin          
    read(f1,a);          
    Mywrite(tek_file,a);        
  end;      
  while not eof(f1) do begin          
    read(f1,b);          
    if b<a then            
      if tek_file=2 then tek_file:=3                          
        else tek_file:=2;          
    a:=b;          
    MyWrite(tek_file,a);        
  end;      
  close(f1);      
  close(f2);      
  close(f3);   
end;  

procedure sliyan(var k_o:Byte); 
var a,b,x:integer;     
      tek_file:integer;  
  procedure kon_otr(tek_file:Byte; buf:integer);   
  var r1: integer;   
  begin     
    writeln(f1,buf);     
    r1:=buf;     
    myread(tek_file,r2);    
    if r1<=r2 then       
      repeat         
        writeln(f1,r2);         
        r1:=r2;     
        myread(tek_file,r2);
     until r1>=r2;    
  end;   
begin
  k_o:=0;  
  reset(f2);
    reset(f3);
    rewrite(f1);
    if not eof(f2) then Myread(2,a);
    if not eof(f3) then Myread(3,b);
    while not eof(f2) and not eof(f3) do begin
      if a<b then begin 
        Mywrite(1,a); 
        tek_file:=2 
      end
      else begin 
        Mywrite(1,b); 
        tek_file:=3 
      end;
      Myread(tek_file,x);
      if tek_file=2 then begin
           //if x<a then kon_otr(2,b);
           a:=x;
      end;  
      if tek_file=3 then begin  
           //if x<b then kon_otr(3,a);
           b:=x;  
      end;
    end;
    close(f1);
    close(f2);
    close(f3);
end;  

begin  
  assign(f1,'a.txt');  
  assign(f2,'b.txt');  
  assign(f3,'c.txt');  
  repeat  
    razd(f1,f2,f3);  
    sliyan(kol_otr); 
  until  kol_otr=1; 
  close(f1);  
  close(f2);  
  close(f3); 
end.

[volvo]

В строку поиска заносишь +естест* +слия* и получаешь десяток реализаций... Берешь любую и добавляешь вывод там, где захочется... Зачем приводить еще одну программу, к тому же заведомо нерабочую?

[Lapp]

Зачем приводить еще одну программу, к тому же заведомо нерабочую?

Могу высказать предположение, зачем . Чтобы явно продемонстрировать, насколько трудно бывает людям понять, что можно делать массив из файловых переменных )). И ведь на какие ухищрения идут, а?..

procedure MyWrite(number:Byte; a:integer); 
begin    
  CASE number of     
    1: writeln(f1,a);             
    2: writeln(f2,a);              
    3: writeln(f3,a);           
  end; 
end;  

procedure Myread(number:Byte; var a:integer); 
begin    
  CASE number of     
    1: read(f1,a);     
    2: read(f2,a);     
    3: read(f3,a)    
  end; 
end;  

function MyEof(number:Byte):Boolean; 
begin    
  CASE number of     
    1: MyEof:=Eof(f1);     
    2: MyEof:=Eof(f2);     
    3: MyEof:=Eof(f3)    
  end; 
end;

Ну, не шедевр, а?? И все вместо того, чтоб просто написать: write(f[i]), read(f[i]), eof(f[i])..