Вот такая задача:
написать программу, которая читает из типизированного файл целые числа, умножает их на 2 и записывает их в другой типизированный файл.

после ввода чисел постоянно получаю ошибку disk read error, а ввыходной файл ничего не записывается...

program zach_9_4;
uses crt;
const
n = 10;
procedure save_file ( Filename : string );
var
f : file of real;
a : real;
i : byte;
begin
assign (f, filename);
rewrite (f);
for i := 1 to n do
begin
     read (a);
     write (f, a);
end;
close (f);
end;
procedure print_file( filename : string );
var
f : file of real;
i : byte;
a : real;
begin
assign (f, filename);
reset (f);
i := 1;
while i <= n do
begin
     read (f, a);
     writeln (a:4:2);
     i := i + 1;
end;
close (f);
end;
procedure basis_part( fnin, fnout : string );
var
fin, fout : file of real;
a : real;
i : byte;
p : real;
begin
assign (fin, fnin);
assign (fout, fnout);
reset (fin);
rewrite (fout);
p := 1;
i :=1;
while i <= n do
begin
     if frac(a) = 0 then
     begin
          read (fin, a);
          p := p*a*2;
          write (fout, p);

     end;
i:=i+1;
end;
close (fin);
close (fout);
end;

BEGIN
clrscr;
save_file ( 'file1.bin' );
print_file ( 'file1.bin' );
basis_part ('file1.bin', 'file1_out.bin');
print_file ('file1_out.bin');
readkey;
end.

  if frac(a) = 0 then 

и чему равно а на первом проходе?
вот это - тоже что-то не то

  p := p*a*2;

у тебя будет идти накопление произведения.

и еще.
почему ты не хочешь вместо

while i <= n do

сделать

while not(EOF(f)) do

?

вот что теперь получается, исходный файл выводит нормально, а дальше ничего...
и еще я не знаю, как поступить с

if frac(a) = 0 then

uses crt;
const
n = 3;
procedure save_file ( Filename : string );
var
f : file of real;
a : real;
i : byte;
begin
assign (f, filename);
rewrite (f);
for i := 1 to n do
begin
     read (a);
     write (f, a);
end;
close (f);
end;
procedure print_file( filename : string );
var
f : file of real;
i : byte;
a : real;
begin
assign (f, filename);
reset (f);
while not eof(f) do
begin
     read (f, a);
     writeln (a:4:2);

end;
close (f);
end;
procedure basis_part( fnin, fnout : string );
var
fin, fout : file of real;
a : real;
i : byte;

begin
assign (fin, fnin);
assign (fout, fnout);
reset (fin);
rewrite (fout);
while not eof(fin) do
begin
     if frac(a) = 0 then
     begin
          a := a*2;
          write (fout, a);

     end;
end;
close (fin);
close (fout);
end;

BEGIN
clrscr;
save_file ( 'file1.bin' );
print_file ( 'file1.bin' );
basis_part ('file1.bin', 'file1_out.bin');
writeln ( '=========================');
print_file ('file1_out.bin');
readkey;
end.

procedure basis_part( fnin, fnout : string );
var
  fin, fout : file of real;
  a : real;
  i : byte;
begin
  assign (fin, fnin); reset (fin);
  assign (fout, fnout); rewrite (fout);
  while not eof(fin) do
  begin
     read(fin, a); { <--- Ты же не читала из файла... }
     if frac(a) = 0 then
     begin
          a := a*2;
          write (fout, a);

     end;
  end;
  close (fin); close (fout);
end;

ой! и правда! кажется я снова страдаю от своей невнимательности...
спасибо!