function e10(e:integer):real;
var r:real;
begin
r:=1.;
while e>0 do
    begin
    r:=r*10.;
    e:=e-1;
    end;
e10:=r;
end;

function rtrunc(r:real):real;
var t,e:real;
    q,i:integer;
begin
t:=0.0;
for i:=10 downto 0 do
    begin
    e:=e10(i);
    q:=trunc(r/e);
    r:=r-q*e;
    t:=t+q*e;
    end;
rtrunc:=t;
end;
