word MAX = 13000;

[MAX+1]word divisorSum;
[MAX+1]byte divisorCount;

proc calculateDivisorSums() void:
    word num, div;
    for div from 1 by 1 upto MAX do
        for num from div by div upto MAX do
            divisorSum[num] := divisorSum[num] + div;
            divisorCount[num] := divisorCount[num] + 1
        od
    od
corp

proc arithmetic(word n) bool:
    divisorSum[n] % divisorCount[n] = 0
corp

proc composite(word n) bool:
    n > 1 and divisorSum[n] /= n+1
corp

proc main() void:
    word num, nthArithm, composites;
    calculateDivisorSums();

    writeln("First 100 arithmetic numbers:");

    num := 0;
    composites := 0;
    for nthArithm from 1 upto 10000 do
        while num := num+1; not arithmetic(num) do od;
        if composite(num) then composites := composites + 1 fi;

        if nthArithm <= 100 then
            write(num:5);
            if nthArithm % 10 = 0 then writeln() fi
        fi;

        if nthArithm = 1000 or nthArithm = 10000 then
            writeln();
            writeln("The ",nthArithm,"th arithmetic number is ",num,".");
            writeln("Of the first ",nthArithm," arithmetic numbers, ",
                    composites," are composite.")
        fi
    od
corp