Cod sursa(job #362599)

Utilizator basketbalistu92alexandru catalisan basketbalistu92 Data 10 noiembrie 2009 12:21:03
Problema Multiplu Scor 0
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.01 kb
function bol(a:integer):boolean;
var c:integer;
begin
bol:=true;
 while a<>0 do begin
   c:=a mod 10;
   a:=a div 10;
   if c>1 then begin bol:=false; exit; end;
 end;
end;

function rezolva(a,b:integer):integer;
var m,d,c:integer;
begin
m:=a*b;
c:=a;
d:=1;
 while d<c div 2 do begin
    inc(d);
    if (a mod d=0)and(b mod d=0) then
    while (a mod d=0)and(b mod d=0) do begin
                                       a:=a div d;b:=b div d;m:=m div d;end;
 end;
rezolva:=m;
end;

function det(a:byte):byte;
var d:byte;
begin
d:=1;
 while a mod 10>1 do begin inc(d); a:=(a mod 10)*d; end;
 det:=d;
end;

var a,b,m,d:integer;
begin
assign(input,'multiplu.in');reset(input);
assign(output,'multiplu.out');rewrite(output);
  readln(a,b);
  m:=rezolva(a,b);
  d:=det(m mod 10);
  m:=m*d;
  if m mod 10=1 then begin d:=1; while not bol(m) do begin inc(d,10); m:=m*d; if bol(m) then break
                                  else m:=m div d; end; end;
  write(m);
close(input);close(output);
end.