Data commit

Task/Arithmetic-numbers/FreeBASIC/arithmetic-numbers.basic

@@ -0,0 +1,43 @@
+' Rosetta Code problem: https://rosettacode.org/wiki/Arithmetic_numbers
+' by Jjuanhdez, 06/2022
+
+Dim As Double t0 = Timer
+Dim As Integer N = 1, ArithCnt = 0, CompCnt = 0
+Dim As Integer Div, DivCnt, Sum, Quot
+
+Print "The first 100 arithmetic numbers are:"
+Do
+    Div = 1 : DivCnt = 0 : Sum = 0
+    Do
+        Quot = N / Div
+        If Quot < Div Then Exit Do
+        If Quot = Div AndAlso (N Mod Div) = 0 Then 'N is a square
+            Sum += Quot
+            DivCnt += 1
+            Exit Do
+        End If
+        If (N Mod Div) = 0 Then
+            Sum += Div + Quot
+            DivCnt += 2
+        End If
+        Div += 1
+    Loop
+
+    If (Sum Mod DivCnt) = 0 Then                   'N is arithmetic
+        ArithCnt += 1
+        If ArithCnt <= 100 Then
+            Print Using "####"; N;
+            If (ArithCnt Mod 20) = 0 Then Print
+        End If
+        If DivCnt > 2 Then CompCnt += 1
+        Select Case ArithCnt
+        Case 1e3
+            Print Using !"\nThe #######th arithmetic number is #####,### up to which ###,### are composite."; ArithCnt; N; CompCnt
+        Case 1e4, 1e5, 1e6
+            Print Using "The #######th arithmetic number is #####,### up to which ###,### are composite."; ArithCnt; N; CompCnt
+        End Select
+    End If
+    N += 1
+Loop Until ArithCnt >= 1e6
+Print !"\nTook"; Timer - t0; " seconds on i5 @3.20 GHz"
+Sleep