Cod sursa(job #480128)

Utilizator cont_de_testeCont Teste cont_de_teste Data 26 august 2010 15:01:18
Problema Sum Scor 50
Compilator fpc Status done
Runda Arhiva de probleme Marime 1.55 kb
type vec = string [255] ;

var N, j, i, k, l, y : longint ;
    v : array[1 .. 100000] of longint ;
    f, g : text ;
    x : vec ;
    Bufin, Bufout : Array[1 .. 1] of byte;


    procedure fisier;
        begin
            assign ( f,'sum.in' ) ; reset ( f ) ;
            assign ( g,'sum.out') ; rewrite ( g ) ;
            SetTextBuf ( f, Bufin ) ;
            SetTextBuf ( g, Bufout ) ;
        end;

    procedure ciur;
        begin
            for i := 1 to 100000 do
                v[i] := i ;

            i := 2 ;
            while ( i <= 100000 ) do
                begin
                    if ( v[i] = i ) then
                        begin
                            j := i ;
                            while j <= 100000 do
                                begin
                                    v[j] := v[j] div i * ( i - 1 ) ;
                                    j := j + i ;
                                end;
                        end;
                    if ( i = 2 ) then inc ( i, 1 )
                    else inc ( i, 2 ) ;
                end;
        end;

    procedure citire ;
        begin
            readln ( f, N ) ;
        end ;


    procedure main ;
        begin
            for i := 1 to N do
                begin
                    readln ( f, y ) ;
                    writeln ( g, int64 ( v[y] ) * int64 ( y shl 1 ) ) ;
                end;
        end;

    //---------------------
    begin
        fisier ; ciur ; citire ; main ;
        close ( f ) ; close ( g ) ;
    end.