libgomp/testsuite/libgomp.oacc-fortran/optional-declare.f90

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