Паскаль АВС.Матрицы.

[Лакира]

проблема: проверяется только последняя матрица. Нужно чтоб проверялись все.

uses crt;

const n=2;
type matr=array [1..n,1..n] of integer;
TFMatr=file of matr;

procedure GetFile (fn :string; f1:TFMatr);
begin
if not FileExists(fn)then begin
assign (f1,fn);
rewrite(f1);
writeln('Файл удачно создан ');end
else 
writeln('Файл с таким именем существует');
end;


procedure Ar(var a:matr;n:integer);
var i,j:integer;
begin
for i:= 1 to n do begin
for j:=1 to n do
write(a[i,j]:6);
writeln();end;
writeln();end;


procedure WriteRec(var a:matr; n:integer);
var i,j:integer;
begin
writeln('Введите элементы матрицы ');
for i:= 1 to n do
for j:=1 to n do
readln(a[i,j]);
end;

procedure WriteOfFile(var f1:TFMatr; a:matr);
begin
reset(f1);
seek(f1,filesize(f1));
write(f1,a);
close(f1);
end;

//посмотреть матрицу в файле 
 
procedure ViewFileRec(var f1:TFMatr);
var i,j:integer;a:matr;
begin
reset(f1);
writeln (' Матрицы ':15);
while not eof(f1)do begin
read(f1,a);
Ar(a,n);
end;
close(f1);
end;


procedure Alg(a:matr; n:integer);
var k,i,j:integer;
begin
k:=0;
for i:=1 to n do 
for j:=1 to n do begin
k:=k+a[i,i];
if (k mod 7=0) then begin
Ar(a,n);
end;end;
end;

procedure WriteOfFile2(fn2:string; n:integer; f1:TFMatr; var f2:TFMatr);
var i,j:integer;
a:matr;
begin
read(fn2);
assign(f2,fn2);
rewrite(f2);
for i:=1 to n do
for j:= 1 to n do write(f2,a);
close(f2);
end;


var f1,f2:TFMatr; fn1,fn2:string; Ma:Matr; k:integer; c:string;
begin
write('Введите имя исходного файла :');
readln(fn1);
GetFile(fn1,f1);
repeat
WriteRec(Ma,n);
WriteOfFile(f1,Ma);
ViewFileRec(f1);
write('Хотите ввести еще матрицу?В случае отказа напишите "нет" на русском языке :');
read(c);
until(c='нет');
Alg(Ma,n);
write('Введите имя результирующего файла :');
readln(fn2);
WriteOfFile2(fn2,n,f1,f2);

end.