Cod sursa(job #25739)

Utilizator botaMihai Botezatu Catalin bota Data 4 martie 2007 14:21:42
Problema Puteri Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.18 kb
var i,j,n,m,h,x,g,s,d,f,e,aux,aux1,nr,cmmdc,cmmdc1:longint;
    k,l:text;
    a:array[1..100,1..3] of integer;
    b:array[1..100] of longint;
begin
assign(k,'puteri.in');
reset(k);
assign(l,'puteri.out');
rewrite(l);
read(k,n);
for i:=1 to n do begin
x:=0;
for j:=1 to 3 do begin
read(k,a[i,j]);
x:=x*10+a[i,j];
end;
m:=m+1;
b[m]:=x;
end;
for h:=1 to m-1 do
for g:=h+1 to m do begin
s:=b[h]+b[g];
e:=s mod 10        ;
d:=(s div 10)mod 10;
f:=(s div 100)mod 10;
aux:=f;aux1:=d;
if f=d then cmmdc:=f;
while aux-aux1<>0 do begin
if aux1=0 then begin  cmmdc:=aux; break;end;
if aux=0 then begin cmmdc:=aux1;    break;          end;
	   if (aux>=aux1)and(aux1<>0)and(aux<>0) then begin aux:=aux-aux1;cmmdc:=aux;end
		       else begin aux1:=aux1-aux;cmmdc:=aux; end;
end;
if d=e then cmmdc1:=d
       else
    while d-e<>0 do
	begin
	   if d=0 then begin cmmdc1:=e;break;end;
	   if e=0 then begin cmmdc1:=d;break;end;
	   if (d>=e)and(d<>0)and(e<>0) then begin d:=d-e;cmmdc1:=d; end
		  else begin e:=e-d;cmmdc1:=d; end;
	end;

if cmmdc1=0 then cmmdc1:=cmmdc;

if (cmmdc1=cmmdc)and(cmmdc<>1)and(cmmdc1<>1) then nr:=nr+1;
end;
write(l,nr);
close(k);
close(l);
end.