libgomp/testsuite/libgomp.oacc-fortran/optional-data-enter-exit.f90

   1 ! Test OpenACC unstructured enter data/exit data regions with optional
   2 ! arguments.
   3
   4 ! { dg-do run }
   5
   6 program test
   7   implicit none
   8
   9   integer, parameter :: n = 64
  10   integer :: a(n), b(n), c(n), res(n)
  11   integer :: x, y, z, r, i
  12
  13   do i = 1, n
  14     a(i) = i
  15     b(i) = n - i + 1
  16     c(i) = i * 3
  17   end do
  18
  19   res = test_array(a)
  20   do i = 1, n
  21     if (res(i) .ne. a(i)) stop 1
  22   end do
  23
  24   res = test_array(a, b)
  25   do i = 1, n
  26     if (res(i) .ne. a(i) * b(i)) stop 2
  27   end do
  28
  29   res = test_array(a, b, c)
  30   do i = 1, n
  31     if (res(i) .ne. a(i) * b(i) + c(i)) stop 3
  32   end do
  33
  34   x = 7
  35   y = 3
  36   z = 11
  37
  38   r = test_int(x)
  39   if (r .ne. x) stop 4
  40
  41   r = test_int(x, y)
  42   if (r .ne. x * y) stop 5
  43
  44   r = test_int(x, y, z)
  45   if (r .ne. x * y + z) stop 6
  46 contains
  47   function test_array(a, b, c)
  48     integer :: a(n)
  49     integer, optional :: b(n), c(n)
  50     integer :: test_array(n), res(n)
  51
  52     !$acc enter data copyin(a, b, c) create(res)
  53     !$acc parallel loop
  54     do i = 1, n
  55       res(i) = a(i)
  56     end do
  57
  58     !$acc parallel loop
  59     do i = 1, n
  60       if (present(b)) then
  61         res(i) = res(i) * b(i)
  62       end if
  63     end do
  64
  65     !$acc parallel loop
  66     do i = 1, n
  67       if (present(c)) then
  68         res(i) = res(i) + c(i)
  69       end if
  70     end do
  71     !$acc exit data copyout(res) delete(a, b, c)
  72
  73     test_array = res
  74   end function test_array
  75
  76   function test_int(a, b, c)
  77     integer :: a
  78     integer, optional :: b, c
  79     integer :: test_int, res
  80
  81     !$acc enter data copyin(a, b, c) create(res)
  82     !$acc parallel present(a, b, c, res)
  83     res = a
  84     if (present(b)) res = res * b
  85     if (present(c)) res = res + c
  86     !$acc end parallel
  87     !$acc exit data copyout(res) delete(a, b, c)
  88
  89     test_int = res
  90   end function test_int
  91 end program test