some fortran benchmark

program main
  implicit none
  integer N

  N = 100
  DO
    call runtest(nint(1.0*N))
    call runtest(nint(1.5*N))
    call runtest(nint(2.0*N))
    call runtest(nint(3.5*N))
    call runtest(nint(5.0*N))
    call runtest(nint(7.0*N))
    N = N * 10
  END DO


  call runtest(300)

contains

  subroutine do_matmul(N,A,B,C)
    integer, intent(in) :: N
    integer, intent(in) :: A(:,:), B(:,:)
    integer, intent(out) :: C(:,:)
    C = matmul(A,B)
  end subroutine do_matmul

  subroutine do_sum(N,A,B,C)
    integer, intent(in) :: N
    integer, intent(in) :: A(:,:), B(:,:)
    integer, intent(out) :: C(:,:)
    integer i,j,k
    DO i = 1, N
      DO j = 1, N
        C(i,j) = sum( [(A(i,k)*B(k,j), k = 1, N)] )
      END DO
    END DO
  end subroutine do_sum

  subroutine do_nointrinsic1(N,A,B,C)
    integer, intent(in) :: N
    integer, intent(in) :: A(:,:), B(:,:)
    integer, intent(out) :: C(:,:)
    integer i,j,k, tmp
    DO i = 1, N
      DO j = 1, N
        tmp = 0
        DO k = 1, N
          tmp = tmp + A(i,k) * B(k,j)
        END DO
        C(i,j) = tmp
      END DO
    END DO
  end subroutine do_nointrinsic1

  subroutine do_nointrinsic2(N,A,B,C)
    integer, intent(in) :: N
    integer, intent(in) :: A(:,:), B(:,:)
    integer, intent(out) :: C(:,:)
    integer i,j,k
    DO i = 1, N
      DO j = 1, N
        C(i,j) = 0
        DO k = 1, N
          C(i,j) = C(i,j) + A(i,k) * B(k,j)
        END DO
      END DO
    END DO
  end subroutine do_nointrinsic2

  real function runtest1(N, name, subrout, o_reftime, o_refname) result(time)
    integer, intent(in) :: N
    character(*), target, intent(in) :: name
    interface
       subroutine subrout(N,A,B,C)
         integer, intent(in) :: N
         integer, intent(in) :: A(:,:), B(:,:)
         integer, intent(out) :: C(:,:)
       end subroutine subrout
    end interface
    real, intent(in), optional :: o_reftime
    character(*), target, intent(in), optional :: o_refname

    ! locals
    integer A(N,N), B(N,N), C(N,N)    ! It's just a benchmark, so we don't need to initialize the matrices.
    real start, end, reftime
    character(:), pointer :: refname

    ! body
    call CPU_TIME(start)
    call subrout(N,A,B,C)
    call CPU_TIME(end)
    time = end-start

    if(present(o_reftime)) then
       reftime = o_reftime
    else
       reftime = time
    end if

    if(present(o_refname)) then
       refname => o_refname
    else
       refname => name
    end if

    print '(3x, A,F20.6," seconds, ",F10.3," x time of ",A)', name, time, time/reftime, trim(refname)
  end function runtest1

  subroutine runtest(N)
    integer, intent(in) :: N
    real :: time_n1, time_n2, time_sm, time_mm
    print '("N = ", I0)', N
    time_mm = runtest1(N, "matmul      ", do_matmul)
    time_sm = runtest1(N, "sum         ", do_sum,          time_mm, "matmul")
    time_n1 = runtest1(N, "nointrinsic1", do_nointrinsic1, time_mm, "matmul")
    time_n2 = runtest1(N, "nointrinsic2", do_nointrinsic2, time_mm, "matmul")
  end subroutine runtest

end program main