Bash script to time code with multiple compilers

Here is a bash script to compile and run a code with multiple compilers (or a single compiler with various sets of compiler options) and print the elapsed times. If the times are not of interest
time ./$exec can be replaced with ./$exec .

#!/bin/bash
# compile and run a program composed of one or more source files with the .f90 extension, using several compilers
# usage: ./cmpl_all.sh mod1.f90 mod2.f90 main.f90

exec=a.out
declare compilers=("lfortran --fast" "gfortran -O3" "ifort -O3" "flang -O3")
declare sources=("$@") 
declare objs=("${sources[@]/.f90/.o}")
print_version=false # print compiler version
 
for FC in "${compilers[@]}"; do # loop over compilers
  echo && echo $FC
  if [ "$print_version" = true ]; then
      $FC --version
  fi
  rm -f *.o $exec # cleanup
  for src in "${sources[@]}"; do
      $FC -c $src
  done
  $FC -o $exec "${objs[@]}"
  time ./$exec
done

Running this with ./cmpl_all.sh fannkuch.f90 from the Benchmarks Game gives output

gfortran -O3
556355
Pfannkuchen(11) = 51

real	0m2.229s
user	0m2.224s
sys	0m0.000s

ifort -O3
556355
Pfannkuchen(11) = 51

real	0m2.361s
user	0m2.347s
sys	0m0.000s

flang -O3
556355
Pfannkuchen(11) = 51

real	0m2.284s
user	0m2.280s
sys	0m0.000s

for the code

! https://benchmarksgame-team.pages.debian.net/benchmarksgame/program/fannkuchredux-ifc-3.html
program fannkuch
  use iso_fortran_env
  use iso_c_binding
  implicit none

  integer,parameter :: ILONG = 8, ISHORT = 1, MAXL = 7
  integer :: NP, maxfk, cksum = 0, current = 0
  integer(ILONG) ::NQ
  integer(ISHORT), allocatable :: blk(:,:), cnt(:)
  logical ::saveblk = .true.
  ! character(len=2) :: arg
  character(len=20) :: out
  logical :: WR = .false., WR1 = .false.

  WR1 = WR1 .or. WR

  ! call get_command_argument(1,arg)
  ! read(arg,'(I2)') NP
  NP = 11 ! original program reads this as in commented line above
  NQ = factorial(MAXL)/MAXL
  allocate(blk(NP,NQ))
  allocate(cnt(NP))
  cnt = 0

  call fkcompute(NP)

  write(out,'(i15)') cksum-2
  write(*,'(a)') trim(adjustl(out))
  write(*,'(a,i0,a,i3)') 'Pfannkuchen(',NP,') =',maxfk

contains

  function factorial(n)
    integer n, factorial, i
    factorial = 1
    do i=1,n
       factorial = factorial*i
    end do
  end function factorial

  subroutine fkcompute(NP)
    integer :: NP
    integer(ILONG) :: bsize
    integer :: i,k,k1
    integer(ISHORT), dimension(NP) :: base,oldbase
    integer :: numblk, ii, nshift
    integer :: maxlevel
    integer(ISHORT),allocatable :: bases(:,:)
    integer ::icksum, imaxfk

    base = [(i,i=1,NP)]
    blk(:,1) = base;

    k = 2;
    bsize = 1;
    maxfk = 0;
    nshift = 1
    maxlevel = min(MAXL,NP);   ! max block level

    do i=2,NP       ! rot count
       current = i
       if(i>=maxlevel) saveblk = .false.

       if(i<=maxlevel) then
          numblk = i-1
          nshift = i
          bsize = bsize*(i-1)
       else
          numblk = (i-1)*factorial(i-1)/bsize
       end if
       oldbase = base
       allocate(bases(NP,numblk))
       do ii=1, numblk
          call baseshift(base, nshift)
          bases(:,ii) = base
       end do

       !$omp  parallel do default(shared) private(ii,k1,icksum,imaxfk) &
       !$omp& if(numblk>1000) schedule(guided) &
       !$omp& reduction(+:cksum) reduction(max: maxfk) 
       do ii = 1, numblk
          k1 = k+bsize*(ii-1)
          if(saveblk) then
             call writeblk(blk(1,k1),blk(1,1),bases(1,ii),bsize)
          end if
          call procblk(blk(1,1),bases(1,ii),bsize,icksum,imaxfk)
          cksum = cksum+icksum
          maxfk = max(maxfk, imaxfk)
       end do
       !$omp end parallel do

       k = k+bsize*numblk
       deallocate(bases)
       if(saveblk) then
          base = oldbase
          cnt(1:nshift-1)=0
          cnt(nshift) = cnt(nshift)+1
       end if
    end do

  end subroutine fkcompute

  recursive subroutine baseshift(base, n)
    integer(ISHORT) :: base(NP)
    integer :: n

    base(1:n) = cshift(base(1:n), 1)
    cnt(n) = cnt(n) +1
    if(cnt(n) >= n) then
       cnt(n) = 0
       if(n == NP) return
       call baseshift(base, n+1)
    end if

  end subroutine baseshift
  
  subroutine procblk(mult,base,bsize,icksum,imaxfk)
    integer(ILONG) :: bsize
    integer(ISHORT) :: base(NP),mult(NP,bsize)
    integer(ISHORT) :: line(NP), t, t1
    integer :: j, ii, iii, icksum, imaxfk

    icksum = 0
    imaxfk = 0

    do iii=1,bsize
       line = base(mult(:,iii));
       j = 0
       t = line(1)
       do while(t /= 1)        ! flip till line(1)==1 
          do ii=1,ishft(t,-1)  ! do the flip
             t1 = line(ii)
             line(ii) = line(t+1-ii)
             line(t+1-ii) = t1
          end do
          t = line(1)
          j = j+1
       end do
       imaxfk = max(imaxfk, j)
       icksum = icksum+j*(ishft(mod(iii,2),1)-1)
    end do
    
  end subroutine procblk

  subroutine writeblk(blk,mult,base,bsize);
    integer(ILONG) :: bsize
    integer(ISHORT) :: blk(NP*bsize),mult(NP*bsize),base(NP)

    blk = base(mult);

  end subroutine writeblk

end program fannkuch
5 Likes

How about just using fpm for this purpose?

for compiler in lfortran gfortran ifort flang; do
  fpm run --runner time --all --compiler $compiler --profile release
done

This would work for any fpm project out of the box.

6 Likes

That would be interesting as an fpm plugin so you could just do "fpm time -compilers “ifort nagfor nvfortran gfortran …” and optionally call gprof to provide a true profiling of the code, which many people are unaware of. Short commands to do profiling and check coverage or to call related compiler-specific tools would make use of often overlooked but powerful development tools easily accessable, I think.

Alternatively, it might be a nice fpm feature to always report runtimes when the verbose mode is present!

2 Likes