bacSC 2015

program bac2015;
uses wincrt;
type
    tab = array [1..100] of integer;
var
 t : tab;
 n : integer;

procedure saisi(var n : integer);
    begin
        repeat
            write('N = ');
             readln(n);
        until n in [3..10] ;
    end;
    Procedure fillt(var t : tab ; n :integer);
        var
            a : Integer;
        begin
            Randomize;
            for a:=1 to n do
                repeat
                    t[a]:=random(1000);
                    {write('T[',a,'] = ');
                     readln(t[a]);  }
                until (t[a]>= 10) and (t[a]<=999);
        end ;
        function prem(x: integer ): Boolean;
            var
                a: integer;
            begin

                a:=2;
                while (x mod a <> 0 ) and (a <= x div 2 ) do
                    a:=a+1;
                prem := a> x div 2 ;
            end;
            function riche(x: integer): boolean;
                var
                    y,compt,d: integer;
                begin
                    y:=x;
                    compt:=1;
                    d:=2;
                    repeat
                        if x mod d = 0 then
                            begin
                                x := x div 2;
                                compt:=compt+1;
                            end
                        Else
                            begin
                                compt:=1;
                                repeat
                                    d:=d+1;
                                until prem(d);
                            end;
                    until ( d = y ) or (compt = 2);
                    riche := compt = 2 ;
                end;
                procedure aff(t : tab ; n : Integer);
                    var
                        a : integer;
                    begin
                        write('Nombres Riches : ');
                        for a:=1 to n do
                            if riche(t[a]) then
                                write(t[a]:6);
                        writeln;
                        write('T : ');
                            for a:=1 to n do
                                write(t[a]:6);
                    end;
begin
    saisi(n);
    fillt(t,n);
    aff(t,n);
End.