функция....

[begemotikdin]

Доброго времени суток пишу прогу следующую....
В матрице целых чисел A[n,m] обнулить столбцы, где нет простых и совершенных чисел, если таких нет оставить без изменения матрицу
написал функции по логичскому значений каждого элемента....
проблема в следующем-никак не удается сделать цикл в основной программе по проверке значений матрицы по столбцам и обнуления элементов матрицы....
вот код

uses crt;
function Sover(S:integer):boolean;
var
sum,m:integer;
begin
if S>1 then
begin
sum:=1;
for m:=2 to S div 2 do
if S mod m=0 then sum:=sum+m;
if sum=S then Sover:=True
else Sover:=false;
end
else Sover:=false;
end;
function Prostoe(Pr:integer):boolean;
var
Flag:boolean;
i:word;
begin
if Pr>0 then
begin
Flag:=True;
for i:=2 to Pr div 2 do
if Pr mod i=0 then
begin
Flag:=false;
break;
end
end
else Flag:=false;
Prostoe:=Flag;
end;
var
A:array[1..10,1..10] of integer;
n,m,i,j:word;
F,F1:boolean;
BEGIN
clrscr;
write('->');
readln(n);
write('-)');
readln(m);
for i:=1 to n do
for j:=1 to m do
read (A[i,j]);
writeln;
writeln('A.....');
for i:=1 to n do
begin
for j:=1 to m do
write(A[i,j],' ');
writeln;
end;
for i:=1 to n do
for j:=1 to m do
F:=Sover(a[i,j]);
F1:=Prostoe(A[i,j]);
for i:=1 to n do
for j:=1 to m do
begin
if F xor F1 then
begin
for j:=1 to m do
begin
for i:=1 to n do
A[i,j]:=0;
end;
end;
end;
writeln('....A....');
for i:=1 to n do
begin
for j:=1 to m do
write(A[i,j],' ');
writeln;
end;
readln;
END.

[r9m]

Тебе самому не противно смотреть на такой код?

[puporev]

uses crt;
function Sover(S:integer):boolean;
var sum,m:integer;
begin
if S>1 then
 begin
  sum:=1;
  for m:=2 to S div 2 do
  if S mod m=0 then sum:=sum+m;
  if sum=S then Sover:=True
  else Sover:=false;
 end
else Sover:=false;
end;
function Prostoe(Pr:integer):boolean;
var Flag:boolean;
    i:word;
begin
if Pr>0 then
 begin
  Flag:=True;
  for i:=2 to Pr div 2 do
  if Pr mod i=0 then
   begin
    Flag:=false;
    break;
   end
 end
else Flag:=false;
Prostoe:=Flag;
end;
var A:array[1..10,1..10] of integer;
    n,m,i,j:word;
    F:boolean;
BEGIN
clrscr;
write('n=');readln(n);
write('m=');readln(m);
writeln('Vvedite ',n*m,' celyh chisel:');
for i:=1 to n do
for j:=1 to m do
read (A[i,j]);
readln;
clrscr;
writeln('A.....');
for i:=1 to n do
 begin
  for j:=1 to m do
  write(A[i,j]:4,' ');
  writeln;
 end;
for j:=1 to m do
 begin
  F:=true;
  for i:=1 to n do
  if Sover(a[i,j]) or Prostoe(A[i,j])then
   begin
    F:=false;
    break;
   end;
  if F then
  for i:=1 to n do
  A[i,j]:=0;
 end;
writeln('....A....');
for i:=1 to n do
 begin
  for j:=1 to m do
  write(A[i,j]:4,' ');
  writeln;
 end;
readln
END.

[begemotikdin]

Спасибо..................