libgomp/testsuite/libgomp.fortran/target-imperfect2.f90

   1 ! { dg-do run }
   2
   3 ! Like imperfect2.f90, but enables offloading.
   4
   5 program foo
   6   integer, save :: f1count(3), f2count(3), g1count(3), g2count(3)
   7   !$omp declare target enter (f1count, f2count)
   8   !$omp declare target enter (g1count, g2count)
   9
  10   f1count(1) = 0
  11   f1count(2) = 0
  12   f1count(3) = 0
  13   f2count(1) = 0
  14   f2count(2) = 0
  15   f2count(3) = 0
  16
  17   g1count(1) = 0
  18   g1count(2) = 0
  19   g1count(3) = 0
  20   g2count(1) = 0
  21   g2count(2) = 0
  22   g2count(3) = 0
  23
  24   call s1 (3, 4, 5)
  25
  26   ! All intervening code at the same depth must be executed the same
  27   ! number of times.
  28   if (f1count(1) /= f2count(1)) error stop 101
  29   if (f1count(2) /= f2count(2)) error stop 102
  30   if (f1count(3) /= f2count(3)) error stop 103
  31   if (g1count(1) /= f1count(1)) error stop 104
  32   if (g2count(1) /= f1count(1)) error stop 105
  33   if (g1count(2) /= f1count(2)) error stop 106
  34   if (g2count(2) /= f1count(2)) error stop 107
  35   if (g1count(3) /= f1count(3)) error stop 108
  36   if (g2count(3) /= f1count(3)) error stop 109
  37
  38   ! Intervening code must be executed at least as many times as the loop
  39   ! that encloses it.
  40   if (f1count(1) < 3) error stop 111
  41   if (f1count(2) < 3 * 4) error stop 112
  42
  43   ! Intervening code must not be executed more times than the number
  44   ! of logical iterations.
  45   if (f1count(1) > 3 * 4 * 5) error stop 121
  46   if (f1count(2) > 3 * 4 * 5) error stop 122
  47
  48   ! Check that the innermost loop body is executed exactly the number
  49   ! of logical iterations expected.
  50   if (f1count(3) /= 3 * 4 * 5) error stop 131
  51
  52 contains
  53
  54 subroutine f1 (depth, iter)
  55   integer :: depth, iter
  56   !$omp atomic
  57   f1count(depth) = f1count(depth) + 1
  58 end subroutine
  59
  60 subroutine f2 (depth, iter)
  61   integer :: depth, iter
  62   !$omp atomic
  63   f2count(depth) = f2count(depth) + 1
  64 end subroutine
  65
  66 subroutine g1 (depth, iter)
  67   integer :: depth, iter
  68   !$omp atomic
  69   g1count(depth) = g1count(depth) + 1
  70 end subroutine
  71
  72 subroutine g2 (depth, iter)
  73   integer :: depth, iter
  74   !$omp atomic
  75   g2count(depth) = g2count(depth) + 1
  76 end subroutine
  77
  78 subroutine s1 (a1, a2, a3)
  79   integer :: a1, a2, a3
  80   integer :: i, j, k
  81
  82   !$omp target parallel do collapse(3) map(always, tofrom:f1count, f2count, g1count, g2count)
  83   do i = 1, a1
  84     call f1 (1, i)
  85     block
  86       call g1 (1, i)
  87       do j = 1, a2
  88         call f1 (2, j)
  89         block
  90           call g1 (2, j)
  91           do k = 1, a3
  92             call f1 (3, k)
  93             block
  94               call g1 (3, k)
  95               call g2 (3, k)
  96             end block
  97             call f2 (3, k)
  98           end do
  99           call g2 (2, j)
 100         end block
 101         call f2 (2, j)
 102       end do
 103       call g2 (1, i)
 104     end block
 105     call f2 (1, i)
 106   end do
 107
 108 end subroutine
 109
 110 end program