libgomp/testsuite/libgomp.oacc-fortran/optional-data-copyin.f90

   1 ! Test OpenACC data regions with a copy-in of optional arguments.
   2
   3 ! { dg-do run }
   4
   5 program test
   6   implicit none
   7
   8   integer, parameter :: n = 64
   9   integer :: i
  10   integer :: a_int, b_int, c_int, res_int
  11   integer :: a_arr(n), b_arr(n), c_arr(n), res_arr(n)
  12   integer, allocatable :: a_alloc(:), b_alloc(:), c_alloc(:), res_alloc(:)
  13
  14   a_int = 7
  15   b_int = 3
  16   c_int = 11
  17
  18   call test_int(res_int, a_int)
  19   if (res_int .ne. a_int) stop 1
  20
  21   call test_int(res_int, a_int, b_int)
  22   if (res_int .ne. a_int * b_int) stop 2
  23
  24   call test_int(res_int, a_int, b_int, c_int)
  25   if (res_int .ne. a_int * b_int + c_int) stop 3
  26
  27   do i = 1, n
  28     a_arr(i) = i
  29     b_arr(i) = n - i + 1
  30     c_arr(i) = i * 3
  31   end do
  32
  33   call test_array(res_arr, a_arr)
  34   do i = 1, n
  35     if (res_arr(i) .ne. a_arr(i)) stop 4
  36   end do
  37
  38   call test_array(res_arr, a_arr, b_arr)
  39   do i = 1, n
  40     if (res_arr(i) .ne. a_arr(i) * b_arr(i)) stop 5
  41   end do
  42
  43   call test_array(res_arr, a_arr, b_arr, c_arr)
  44   do i = 1, n
  45     if (res_arr(i) .ne. a_arr(i) * b_arr(i) + c_arr(i)) stop 6
  46   end do
  47
  48   allocate (a_alloc(n))
  49   allocate (b_alloc(n))
  50   allocate (c_alloc(n))
  51   allocate (res_alloc(n))
  52
  53   do i = 1, n
  54     a_alloc(i) = i
  55     b_alloc(i) = n - i + 1
  56     c_alloc(i) = i * 3
  57   end do
  58
  59   call test_allocatable(res_alloc, a_alloc)
  60   do i = 1, n
  61     if (res_alloc(i) .ne. a_alloc(i)) stop 7
  62   end do
  63
  64   call test_allocatable(res_alloc, a_alloc, b_alloc)
  65   do i = 1, n
  66     if (res_alloc(i) .ne. a_alloc(i) * b_alloc(i)) stop 8
  67   end do
  68
  69   call test_allocatable(res_alloc, a_alloc, b_alloc, c_alloc)
  70   do i = 1, n
  71     if (res_alloc(i) .ne. a_alloc(i) * b_alloc(i) + c_alloc(i)) stop 9
  72   end do
  73
  74   deallocate (a_alloc)
  75   deallocate (b_alloc)
  76   deallocate (c_alloc)
  77   deallocate (res_alloc)
  78 contains
  79   subroutine test_int(res, a, b, c)
  80     integer :: res
  81     integer :: a
  82     integer, optional :: b, c
  83
  84     !$acc data copyin(a, b, c) copyout(res)
  85     !$acc parallel
  86     res = a
  87
  88     if (present(b)) res = res * b
  89
  90     if (present(c)) res = res + c
  91     !$acc end parallel
  92     !$acc end data
  93   end subroutine test_int
  94
  95   subroutine test_array(res, a, b, c)
  96     integer :: res(n)
  97     integer :: a(n)
  98     integer, optional :: b(n), c(n)
  99
 100     !$acc data copyin(a, b, c) copyout(res)
 101     !$acc parallel loop
 102     do i = 1, n
 103       res(i) = a(i)
 104     end do
 105
 106     !$acc parallel loop
 107     do i = 1, n
 108       if (present(b)) res(i) = res(i) * b(i)
 109     end do
 110
 111     !$acc parallel loop
 112     do i = 1, n
 113       if (present(c)) res(i) = res(i) + c(i)
 114     end do
 115     !$acc end data
 116   end subroutine test_array
 117
 118   subroutine test_allocatable(res, a, b, c)
 119     integer, allocatable :: res(:)
 120     integer, allocatable  :: a(:)
 121     integer, allocatable, optional :: b(:), c(:)
 122
 123     !$acc data copyin(a, b, c) copyout(res)
 124     !$acc parallel loop
 125     do i = 1, n
 126       res(i) = a(i)
 127     end do
 128
 129     !$acc parallel loop
 130     do i = 1, n
 131       if (present(b)) res(i) = res(i) * b(i)
 132     end do
 133
 134     !$acc parallel loop
 135     do i = 1, n
 136       if (present(c)) res(i) = res(i) + c(i)
 137     end do
 138     !$acc end data
 139   end subroutine test_allocatable
 140 end program test