src/main.F90

   1 PROGRAM mul
   2   USE naivmat
   3   USE bettmat
   4   USE dotmat
   5   USE iso_fortran_env, only: error_unit
   6   IMPLICIT none
   7
   8   integer, parameter :: seed = 123456
   9   real :: time
  10   integer :: dim = 10, multype = 1, real_kind, stat
  11   character(5) :: kind_arg
  12
  13   IF (command_argument_count() < 1) THEN
  14      write (error_unit, *) "Usage: mul KIND", char(10), &
  15                            "where KIND is one of: 4, 8, 16"
  16      STOP
  17   END IF
  18
  19   call get_command_argument(1, kind_arg)
  20
  21   read (kind_arg, *, iostat = stat) real_kind
  22
  23   IF (stat .ne. 0) THEN
  24      write (error_unit, *) "Couldn't parse kind number argument"
  25      STOP
  26   END IF
  27
  28   DO WHILE (dim < 2000)
  29
  30      SELECT CASE(real_kind)
  31         CASE (4,1)
  32            time = measure_4(dim)
  33         CASE (8,2)
  34            time = measure_8(dim)
  35         CASE (16,3)
  36            time = measure_16(dim)
  37         CASE default
  38            write (error_unit, *) "wrong kind for real: ", real_kind
  39            STOP
  40
  41      END SELECT
  42
  43      print '(I11," ",ES11.5)', dim, time
  44
  45      dim = dim * 2
  46
  47   END DO
  48
  49 CONTAINS
  50
  51   SUBROUTINE init_random_seed()
  52     integer :: i, n
  53
  54     call random_seed(size = n)
  55
  56     call random_seed(put = (/ ((seed + i) * 37, i = 1, n) /))
  57
  58   END SUBROUTINE init_random_seed
  59
  60
  61   real FUNCTION measure_4(dim) result(time)
  62     integer, intent(in) :: dim
  63     real(kind=4), dimension(:,:), allocatable :: mat1, mat2, res
  64     real :: start, end
  65
  66     call init_random_seed()
  67
  68     allocate(mat1(dim,dim))
  69     allocate(mat2(dim,dim))
  70     allocate(res(dim,dim))
  71
  72     call random_number(mat1)
  73     call random_number(mat2)
  74
  75     call cpu_time(start)
  76
  77     SELECT CASE(multype)
  78        CASE (1)
  79           res = naivmull(mat1, mat2)
  80        CASE (2)
  81           res = bettmull(mat1, mat2)
  82        CASE (3)
  83           res = dotmull(mat1, mat2)
  84        CASE default
  85           res = matmul(mat1, mat2)
  86
  87     END SELECT
  88
  89     call cpu_time(end)
  90
  91     time = end - start
  92
  93   END FUNCTION measure_4
  94
  95
  96   real FUNCTION measure_8(dim) result(time)
  97     integer, intent(in) :: dim
  98     real(kind=8), dimension(:,:), allocatable :: mat1, mat2, res
  99     real :: start, end
 100
 101     call init_random_seed()
 102
 103     allocate(mat1(dim,dim))
 104     allocate(mat2(dim,dim))
 105     allocate(res(dim,dim))
 106
 107     call random_number(mat1)
 108     call random_number(mat2)
 109
 110     call cpu_time(start)
 111
 112     SELECT CASE(multype)
 113        CASE (1)
 114           res = naivmull(mat1, mat2)
 115        CASE (2)
 116           res = bettmull(mat1, mat2)
 117        CASE (3)
 118           res = dotmull(mat1, mat2)
 119        CASE default
 120           res = matmul(mat1, mat2)
 121
 122     END SELECT
 123
 124     call cpu_time(end)
 125
 126     time = end - start
 127
 128   END FUNCTION measure_8
 129
 130
 131   real FUNCTION measure_16(dim) result(time)
 132     integer, intent(in) :: dim
 133     real(kind=16), dimension(:,:), allocatable :: mat1, mat2, res
 134     real :: start, end
 135
 136     call init_random_seed()
 137
 138     allocate(mat1(dim,dim))
 139     allocate(mat2(dim,dim))
 140     allocate(res(dim,dim))
 141
 142     call random_number(mat1)
 143     call random_number(mat2)
 144
 145     call cpu_time(start)
 146
 147     SELECT CASE(multype)
 148        CASE (1)
 149           res = naivmull(mat1, mat2)
 150        CASE (2)
 151           res = bettmull(mat1, mat2)
 152        CASE (3)
 153           res = dotmull(mat1, mat2)
 154        CASE default
 155           res = matmul(mat1, mat2)
 156
 157     END SELECT
 158
 159     call cpu_time(end)
 160
 161     time = end - start
 162
 163   END FUNCTION measure_16
 164
 165 END PROGRAM mul