libgomp/testsuite/libgomp.fortran/target-imperfect-transform-2.f90

   1 ! { dg-do run }
   2
   3 ! Like imperfect-transform.f90, but enables offloading.
   4
   5 program foo
   6   integer, save :: f1count(3), f2count(3)
   7   !$omp declare target enter (f1count, f2count)
   8
   9   f1count(1) = 0
  10   f1count(2) = 0
  11   f1count(3) = 0
  12   f2count(1) = 0
  13   f2count(2) = 0
  14   f2count(3) = 0
  15
  16   call s1 (3, 4, 5)
  17
  18   ! All intervening code at the same depth must be executed the same
  19   ! number of times.
  20   if (f1count(1) /= f2count(1)) error stop 101
  21   if (f1count(2) /= f2count(2)) error stop 102
  22   if (f1count(3) /= f2count(3)) error stop 103
  23
  24   ! Intervening code must be executed at least as many times as the loop
  25   ! that encloses it.
  26   if (f1count(1) < 3) error stop 111
  27   if (f1count(2) < 3 * 4) error stop 112
  28
  29   ! Intervening code must not be executed more times than the number
  30   ! of logical iterations.
  31   if (f1count(1) > 3 * 4 * 5) error stop 121
  32   if (f1count(2) > 3 * 4 * 5) error stop 122
  33
  34   ! Check that the innermost loop body is executed exactly the number
  35   ! of logical iterations expected.
  36   if (f1count(3) /= 3 * 4 * 5) error stop 131
  37
  38 contains
  39
  40 subroutine f1 (depth, iter)
  41   integer :: depth, iter
  42   !$omp atomic
  43   f1count(depth) = f1count(depth) + 1
  44 end subroutine
  45
  46 subroutine f2 (depth, iter)
  47   integer :: depth, iter
  48   !$omp atomic
  49   f2count(depth) = f2count(depth) + 1
  50 end subroutine
  51
  52 subroutine s1 (a1, a2, a3)
  53   integer :: a1, a2, a3
  54   integer :: i, j, k
  55
  56   !$omp target parallel do collapse(2) map(always, tofrom:f1count, f2count) &
  57   !$omp & private(j, k)
  58   do i = 1, a1
  59     call f1 (1, i)
  60     do j = 1, a2
  61       call f1 (2, j)
  62       !$omp tile sizes(5)
  63       do k = 1, a3
  64         call f1 (3, k)
  65         call f2 (3, k)
  66       end do
  67       call f2 (2, j)
  68     end do
  69     call f2 (1, i)
  70   end do
  71
  72 end subroutine
  73
  74 end program