1! { dg-do compile }
2! { dg-options "-O2 -fpeel-loops -finline-functions -fipa-cp-clone -fdump-ipa-inline-details" }
3
4module 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
15contains
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! See PR88711. Inliner is currently not able to figure out that inlining tp_sum is a good idea.
112! { dg-final { scan-ipa-dump "Inlined tp_sum/\[0-9\]+ into runtptests/\[0-9\]+" "inline" { xfail *-*-* } } }
113