libgomp/testsuite/libgomp.oacc-fortran/common-block-2.f90

! { dg-do run }
!
! Test data located inside common blocks.  This test does not exercise
! ACC DECLARE.  All data clauses are explicit.

module consts
  integer, parameter :: n = 100
end module consts

subroutine validate
  use consts

  implicit none
  integer i, j
  real*4 x(n), y(n), z
  common /BLOCK/ x, y, z, j

  do i = 1, n
     if (abs(x(i) - i - z) .ge. 0.0001) stop 1
  end do
end subroutine validate

subroutine incr
  use consts

  implicit none
  integer i, j
  real*4 x(n), y(n), z
  common /BLOCK/ x, y, z, j

  !$acc parallel loop pcopy(/BLOCK/)
  do i = 1, n
     x(i) = x(i) + z
  end do
  !$acc end parallel loop
end subroutine incr

program main
  use consts

  implicit none
  integer i, j
  real*4 a(n), b(n), c
  common /BLOCK/ a, b, c, j

  ! Test copyout, pcopy, device

  !$acc data copyout(a, c)

  c = 1.0

  !$acc update device(c)

  !$acc parallel loop pcopy(a)
  do i = 1, n
     a(i) = i
  end do
  !$acc end parallel loop

  call incr
  call incr
  call incr
  !$acc end data

  c = 3.0
  call validate

  ! Test pcopy without copyout

  c = 2.0
  call incr
  c = 5.0
  call validate

  ! Test create, delete, host, copyout, copyin

  !$acc enter data create(b)

  !$acc parallel loop pcopy(b)
  do i = 1, n
     b(i) = i
  end do
  !$acc end parallel loop

  !$acc update host (b)

  !$acc parallel loop pcopy(b) copyout(a) copyin(c)
  do i = 1, n
     a(i) = b(i) + c
  end do
  !$acc end parallel loop

  !$acc exit data delete(b)

  call validate

  a(:) = b(:)
  c = 0.0
  call validate

  ! Test copy

  c = 1.0
  !$acc parallel loop copy(/BLOCK/)
  do i = 1, n
     a(i) = b(i) + c
  end do
  !$acc end parallel loop

  call validate

  ! Test pcopyin, pcopyout FIXME

  c = 2.0
  !$acc data copyin(b, c) copyout(a)

  !$acc parallel loop pcopyin(b, c) pcopyout(a)
  do i = 1, n
     a(i) = b(i) + c
  end do
  !$acc end parallel loop

  !$acc end data

  call validate

  ! Test reduction, private

  j = 0

  !$acc parallel private(i) copy(j)
  !$acc loop reduction(+:j)
  do i = 1, n
     j = j + 1
  end do
  !$acc end parallel

  if (j .ne. n) stop 2

  ! Test firstprivate, copy

  a(:) = 0
  c = j

  !$acc parallel loop firstprivate(c) copyout(a)
  do i = 1, n
     a(i) = i + c
  end do
  !$acc end parallel loop

  call validate
end program main