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