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

   1 ! Test OpenACC data regions with a copy-out 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, res_int
  11   integer :: a_arr(n), b_arr(n), res_arr(n)
  12   integer, allocatable :: a_alloc(:), b_alloc(:), res_alloc(:)
  13
  14   res_int = 0
  15
  16   call test_int(a_int, b_int)
  17   if (res_int .ne. 0) stop 1
  18
  19   call test_int(a_int, b_int, res_int)
  20   if (res_int .ne. a_int * b_int) stop 2
  21
  22   res_arr(:) = 0
  23   do i = 1, n
  24     a_arr(i) = i
  25     b_arr(i) = n - i + 1
  26   end do
  27
  28   call test_array(a_arr, b_arr)
  29   do i = 1, n
  30     if (res_arr(i) .ne. 0) stop 3
  31   end do
  32
  33   call test_array(a_arr, b_arr, res_arr)
  34   do i = 1, n
  35     if (res_arr(i) .ne. a_arr(i) * b_arr(i)) stop 4
  36   end do
  37
  38   allocate (a_alloc(n))
  39   allocate (b_alloc(n))
  40   allocate (res_alloc(n))
  41
  42   res_alloc(:) = 0
  43   do i = 1, n
  44     a_alloc(i) = i
  45     b_alloc(i) = n - i + 1
  46   end do
  47
  48   call test_allocatable(a_alloc, b_alloc)
  49   do i = 1, n
  50     if (res_alloc(i) .ne. 0) stop 5
  51   end do
  52
  53   call test_allocatable(a_alloc, b_alloc, res_alloc)
  54   do i = 1, n
  55     if (res_alloc(i) .ne. a_alloc(i) * b_alloc(i)) stop 6
  56   end do
  57
  58   deallocate (a_alloc)
  59   deallocate (b_alloc)
  60   deallocate (res_alloc)
  61 contains
  62   subroutine test_int(a, b, res)
  63     integer :: a, b
  64     integer, optional :: res
  65
  66     !$acc data copyin(a, b) copyout(res)
  67     !$acc parallel
  68     if (present(res)) res = a * b
  69     !$acc end parallel
  70     !$acc end data
  71   end subroutine test_int
  72
  73   subroutine test_array(a, b, res)
  74     integer :: a(n), b(n)
  75     integer, optional :: res(n)
  76
  77     !$acc data copyin(a, b) copyout(res)
  78     !$acc parallel loop
  79     do i = 1, n
  80       if (present(res)) res(i) = a(i) * b(i)
  81     end do
  82     !$acc end data
  83   end subroutine test_array
  84
  85   subroutine test_allocatable(a, b, res)
  86     integer, allocatable :: a(:), b(:)
  87     integer, allocatable, optional :: res(:)
  88
  89     !$acc data copyin(a, b) copyout(res)
  90     !$acc parallel loop
  91     do i = 1, n
  92       if (present(res)) res(i) = a(i) * b(i)
  93     end do
  94     !$acc end data
  95   end subroutine test_allocatable
  96 end program test