Program to calculate pi

[david_uwi]

I wrote one in QB45 it will work until long integers overflow about 5000 digits. It uses Machin's formula. It seems marginally slower that the one you posted.

Code: (Select All)

DefInt C-Q
DefLng Z
fmax = 5020
Dim i(fmax) As Integer, k(fmax) As Integer
Dim ii(fmax) As Integer, kk(fmax) As Integer
tt = Timer
fl = -1: ii(1) = 10: l = 1: m = -1
'calculating arctan(1/5) to fmax d.p.s
While l < fmax - 20
    m = m + 2
    fl = fl * -1
    If m = 1 Then q = 5 Else q = 25
    ir = 0
    For j = l To fmax
        ii(j) = ii(j) + ir * 10
        ir = ii(j) Mod q
        ii(j) = ii(j) \ q
    2 Next j
    zir = 0
    For l = l To fmax
        If ii(l) <> 0 GoTo 5
    Next l
    l = l - 20
    5 If l < 40 Then l = 1
    If m > 3200 Then
        For j = l To fmax
            i(j) = ii(j)
            z = i(j) + zir * 10
            zir = z Mod m
            i(j) = z \ m
        Next j
    End If
    If m < 3201 Then
        ir = 0
        For j = l To fmax
            i(j) = ii(j)
            i(j) = i(j) + ir * 10
            ir = i(j) Mod m
            i(j) = i(j) \ m
        Next j
    End If
    cf = 0
    'add routine
    If fl = 1 Then
        For j = fmax To l Step -1
            If i(j) > 0 Or cf > 0 Then
                k(j) = k(j) + i(j) + cf
                cf = 0
                If k(j) > 9 Then
                    cf = k(j) \ 10
                    k(j) = k(j) Mod 10
                End If
            End If
        Next j
    End If
    If fl = -1 Then
        'subtract routine
        For j = fmax To l Step -1
            k(j) = k(j) - i(j) - cf
            cf = 0
            If k(j) < 0 Then
                cf = 1
                k(j) = 10 + k(j)
            End If
        Next j
    End If
Wend
For j = 1 To fmax
    kk(j) = k(j)
    k(j) = 0: i(j) = 0: ii(j) = 0
Next j
'now let's calculate arctan(1/239)
fl = -1: ii(1) = 10: l = 1: m = -1
While l < fmax - 20
    m = m + 2
    fl = fl * -1
    If m = 1 Then q = 1 Else q = 2
    For n = 1 To q
        ir = 0
        For j = l To fmax
            ii(j) = ii(j) + ir * 10
            ir = ii(j) Mod 239
            ii(j) = ii(j) \ 239
        Next j
    Next n
    For l = l To fmax
        If ii(l) <> 0 GoTo 7
    Next l
    7 l = l - 20
    If l < 40 Then l = 1
    ir = 0
    For j = l To fmax
        i(j) = ii(j)
        i(j) = i(j) + ir * 10
        ir = i(j) Mod m
        i(j) = i(j) \ m
    Next j
    cf = 0
    'add routine
    If fl = 1 Then
        For j = fmax To l Step -1
            k(j) = k(j) + i(j) + cf
            cf = 0
            If k(j) > 9 Then
                cf = k(j) \ 10
                k(j) = k(j) Mod 10
            End If
        Next j
    End If
    If fl = -1 Then
        'subtract routine
        For j = fmax To l Step -1
            k(j) = k(j) - i(j) - cf
            cf = 0
            If k(j) < 0 Then
                cf = 1
                k(j) = 10 + k(j)
            End If
        Next j
    End If
Wend
'multipling atn(1/5) by 16
For m = 1 To 4
    cf = 0
    For j = fmax To 1 Step -1
        kk(j) = kk(j) + kk(j) + cf
        cf = kk(j) \ 10
        kk(j) = kk(j) Mod 10
    Next j
Next m
'multipling atn(1/239) by 4
For m = 1 To 2
    cf = 0
    For j = fmax To 1 Step -1
        k(j) = k(j) + k(j) + cf
        cf = k(j) \ 10
        k(j) = k(j) Mod 10
    Next j
Next m
'16*atn(1/5)-4*atn(1/239) = pi
For j = fmax To 1 Step -1
    kk(j) = kk(j) - k(j) - cf
    cf = 0
    If kk(j) < 0 Then
        cf = 1
        kk(j) = 10 + kk(j)
    End If
Next j
Print ""
Print Using "&"; "3.";
l = -1
For j = 1 To fmax - 20
    l = l + 1
    If l = 50 Then Print "": Print "  ";
    If l = 50 Then l = 0
    Print Using "#"; kk(j);
Next j
Print: Print "time taken= "; Timer - tt; " sec"