MODULE ArithmeticNumbers;
FROM InOut IMPORT WriteString, WriteCard, WriteLn;

CONST
    Max = 13000;

VAR
    divSum: ARRAY [1..Max] OF CARDINAL;
    divCount: ARRAY [1..Max] OF CHAR;
    current, count, composites: CARDINAL;

PROCEDURE CalculateDivisorSums;
VAR div, num: CARDINAL;
BEGIN
    FOR num := 1 TO Max DO
        divSum[num] := 0;
        divCount[num] := CHR(0)
    END;

    FOR div := 1 TO Max DO
        num := div;
        WHILE num <= Max DO
            INC(divSum[num], div);
            INC(divCount[num]);
            INC(num, div)
        END
    END
END CalculateDivisorSums;

PROCEDURE Next(n: CARDINAL): CARDINAL;
BEGIN
    REPEAT INC(n) UNTIL (divSum[n] MOD ORD(divCount[n])) = 0;
    RETURN n
END Next;

PROCEDURE Composite(n: CARDINAL): BOOLEAN;
BEGIN
    RETURN (n>1) AND (divSum[n] # n+1)
END Composite;

BEGIN
    CalculateDivisorSums;
    WriteString("First 100 arithmetic numbers:");
    WriteLn;

    current := 0;
    FOR count := 1 TO 10000 DO
        current := Next(current);
        IF Composite(current) THEN INC(composites) END;
        IF count <= 100 THEN
            WriteCard(current, 5);
            IF count MOD 10 = 0 THEN WriteLn END
        END;

        IF (count = 1000) OR (count = 10000) THEN
            WriteCard(count, 5);
            WriteString(": ");
            WriteCard(current, 5);
            WriteString(", ");
            WriteCard(composites, 5);
            WriteString(" composites");
            WriteLn
        END;
    END
END ArithmeticNumbers.