Task: Long multiplication








VB: Imports System
Imports System.Console
Imports BI = System.Numerics.BigInteger

Module Module1

    Dim a As Decimal, mx As Decimal = 1E28D, hm As Decimal = 1E14D

    
    Structure bd
        Public hi, lo As Decimal
    End Structure

    
    Function toStr(ByVal a As bd, ByVal Optional comma As Boolean = False) As String
        Dim r As String = If(a.hi = 0, String.Format("{0:0}", a.lo),
                                       String.Format("{0:0}{1:" & New String("0"c, 28) & "}", a.hi, a.lo))
        If Not comma Then Return r 
        Dim rc As String = ""
        For i As Integer = r.Length - 3 To 0 Step -3
            rc = "," & r.Substring(i, 3) & rc : Next
        toStr = r.Substring(0, r.Length Mod 3) & rc
            toStr = toStr.Substring(If(toStr.Chars(0) = "," , 1, 0))
    End Function

    
    Function Pow_dec(ByVal bas As Decimal, ByVal exp As UInteger) As Decimal
        If exp = 0 Then Pow_dec = 1D else Pow_dec = Pow_dec(bas, exp >> 1) : _
        Pow_dec *= Pow_dec : If (exp And 1) <> 0 Then Pow_dec *= bas
    End Function

    Sub Main(ByVal args As String())
         For p As UInteger = 64 To 95 - 1 Step 30                 
            Dim y As bd, x As bd : a = Pow_dec(2D, p)             
            WriteLine("The square of (2^{0}):                    {1,38:n0}", p, a)
            x.hi = Math.Floor(a / hm) : x.lo = a Mod hm           
            Dim BS As BI = BI.Pow(CType(a, BI), 2)                
            y.lo = x.lo * x.lo : y.hi = x.hi * x.hi               
            a = x.hi * x.lo * 2D                                  
            y.hi += Math.Floor(a / hm) : y.lo += (a Mod hm) * hm  
            While y.lo > mx : y.lo -= mx : y.hi += 1 : End While  
            WriteLine(" is {0,75} (which {1} match the BigInteger computation)" & vbLf,
                toStr(y, True), If(BS.ToString() = toStr(y), "does", "fails to"))
        Next
    End Sub

End Module



Fortran: module LongMoltiplication
  implicit none

  type longnum
     integer, dimension(:), pointer :: num
  end type longnum

  interface operator (*)
     module procedure longmolt_ll
  end interface

contains
  
  subroutine longmolt_s2l(istring, num)
    character(len=*), intent(in) :: istring
    type(longnum), intent(out) :: num
    
    integer :: i, l

    l = len(istring)

    allocate(num%num(l))

    forall(i=1:l) num%num(l-i+1) = iachar(istring(i:i)) - 48

  end subroutine longmolt_s2l

  
  function longmolt_ll(a, b) result(c)
    type(longnum) :: c
    type(longnum), intent(in) :: a, b
    
    integer, dimension(:,:), allocatable :: t
    integer :: ntlen, i, j

    ntlen = size(a%num) + size(b%num) + 1
    allocate(c%num(ntlen))
    c%num = 0

    allocate(t(size(b%num), ntlen))
    
    t = 0
    forall(i=1:size(b%num), j=1:size(a%num)) t(i, j+i-1) = b%num(i) * a%num(j)

    do j=2, ntlen    
       forall(i=1:size(b%num)) t(i, j) = t(i, j) + t(i, j-1)/10
    end do

    forall(j=1:ntlen) c%num(j) = sum(mod(t(:,j), 10))

    do j=2, ntlen
       c%num(j) = c%num(j) + c%num(j-1)/10
    end do

    c%num = mod(c%num, 10)
    
    deallocate(t)
  end function longmolt_ll


  subroutine longmolt_print(num)
    type(longnum), intent(in) :: num

    integer :: i, j
    
    do j=size(num%num), 2, -1
       if ( num%num(j) /= 0 ) exit
    end do

    do i=j, 1, -1
       write(*,"(I1)", advance="no") num%num(i)
    end do
  end subroutine longmolt_print

end module LongMoltiplication