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

   1 ! { dg-do run }
   2
   3 ! Like imperfect3.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       integer :: local1
  87       local1 = 1
  88       call g1 (local1, i)
  89       do j = 1, a2
  90         call f1 (2, j)
  91         block
  92           integer :: local2
  93           local2 = 2
  94           call g1 (local2, j)
  95           do k = 1, a3
  96             call f1 (3, k)
  97             block
  98               integer :: local3
  99               local3 = 3
 100               call g1 (local3, k)
 101               call g2 (local3, k)
 102             end block
 103             call f2 (3, k)
 104           end do
 105           call g2 (local2, j)
 106         end block
 107         call f2 (2, j)
 108       end do
 109       call g2 (local1, i)
 110     end block
 111     call f2 (1, i)
 112   end do
 113
 114 end subroutine
 115
 116 end program