gcc/testsuite/gfortran.dg/pr79966.f90

   1 ! { dg-do compile }
   2 ! { dg-options "-O2 -fpeel-loops -finline-functions -fipa-cp-clone -fdump-ipa-inline-details" }
   3
   4 module TensorProducts
   5   use, intrinsic :: iso_fortran_env
   6
   7   implicit none
   8
   9   integer, parameter :: dp = real64 ! KIND for double precision
  10
  11   type Vect3D
  12     real(dp) :: x, y, z
  13   end type
  14
  15 contains
  16
  17   type(Vect3D) pure function MySum(array)
  18     type(Vect3D), intent(in) :: array(:,:)
  19
  20     mysum = Vect3D(sum(array%x), sum(array%y), sum(array%z))
  21   end function
  22
  23   pure subroutine GenerateGrid(N, M, width, height, centre, P)
  24     integer,      intent(in)  :: N, M
  25     real(dp),     intent(in)  :: width, height
  26     type(Vect3D), intent(in)  :: centre
  27     type(Vect3D), intent(out) :: P(N, M)
  28     real(dp)                  :: x(N), y(M)
  29     integer                   :: i, j
  30
  31     x = ([( i, i = 0, N-1 )] * width/(N-1)) - (width / 2) + centre%x
  32     y = ([( j, j = 0, M-1 )] * height/(M-1)) - (height / 2) + centre%y
  33     do concurrent (i = 1:N)
  34       do concurrent (j = 1:M)
  35         P(i, j) = Vect3D(x(i), y(j), centre%z)
  36       end do
  37     end do
  38     P(2:3,2:3)%z = P(2:3,2:3)%z + 1.0_dp*reshape([2,1,1,-2], [2,2])
  39   end subroutine
  40
  41   type(Vect3D) pure function TP_SUM(NU, D, NV) result(tensorproduct)
  42     ! (NU) D (NV)^T, row * matrix * column
  43     ! TODO (#6): TensorProduct: Investigate whether using DO loops triggers a temporary array.
  44     ! copied from Surfaces
  45     real(dp),     intent(in) :: NU(4), NV(4)
  46     type(Vect3D), intent(in) :: D(4,4)
  47     integer                  :: i, j
  48     type(Vect3D)             :: P(4,4)
  49
  50     do concurrent (i = 1:4)
  51       do concurrent (j = 1:4)
  52         P(i,j)%x = NU(i) * D(i,j)%x * NV(j)
  53         P(i,j)%y = NU(i) * D(i,j)%y * NV(j)
  54         P(i,j)%z = NU(i) * D(i,j)%z * NV(j)
  55       end do
  56     end do
  57     tensorproduct = MySum(P)
  58   end function
  59
  60   subroutine RandomSeed()
  61     integer                                 :: seed_size, clock, i
  62     integer,              allocatable, save :: seed(:)
  63
  64     if (.not. allocated(seed)) then
  65       call random_seed(size=seed_size)
  66       allocate(seed(seed_size))
  67       call system_clock(count=clock)
  68       seed = clock + 37 * [( i -1, i = 1, seed_size )]
  69       call random_seed(put=seed)
  70     end if
  71   end subroutine
  72
  73   subroutine RunTPTests()
  74     type(Vect3D)       :: tp, P(4,4)
  75     integer, parameter :: i_max = 10000000
  76     real(dp)           :: NU(4,i_max), NV(4,i_max)
  77     real(dp)           :: sum
  78     real               :: t(2)
  79     integer            :: i
  80
  81 !    print *, 'This code variant uses explicit %x, %y and %z to represent the contents of Type(Vect3D).'
  82     call GenerateGrid(4, 4, 20.0_dp, 20.0_dp, Vect3D(0.0_dp,0.0_dp,20.0_dp), P)
  83     call RandomSeed()
  84 !    call cpu_time(t(1))
  85     do i = 1, 4
  86       call random_number(NU(i,:))
  87       call random_number(NV(i,:))
  88     end do
  89 !    call cpu_time(t(2))
  90 !    print *, 'Random Numbers, time:  ', t(2)-t(1)
  91     sum = 0.0
  92     call cpu_time(t(1))
  93     do i = 1, i_max
  94       tp = TP_SUM(NU(:,i), P(1:4,1:4), NV(:,i))
  95       sum = sum + tp%x
  96     end do
  97     call cpu_time(t(2))
  98     print *, 'Using SUM, time:       ', t(2)-t(1)
  99     print *, 'sum =', sum
 100   end subroutine
 101
 102   end module
 103
 104   program Main
 105   use TensorProducts
 106
 107   implicit none
 108
 109   call RunTPTests()
 110   end program
 111
 112 ! { dg-final { scan-ipa-dump "Inlined tp_sum into runtptests" "inline" } }