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

   1 ! { dg-do run }
   2 !
   3 ! Test data located inside common blocks.  This test does not exercise
   4 ! ACC DECLARE.  Most of the data clauses are implicit.
   5
   6 module consts
   7   integer, parameter :: n = 100
   8 end module consts
   9
  10 subroutine validate
  11   use consts
  12
  13   implicit none
  14   integer i, j
  15   real*4 x(n), y(n), z
  16   common /BLOCK/ x, y, z, j
  17
  18   do i = 1, n
  19      if (abs(x(i) - i - z) .ge. 0.0001) stop 1
  20   end do
  21 end subroutine validate
  22
  23 subroutine incr_parallel
  24   use consts
  25
  26   implicit none
  27   integer i, j
  28   real*4 x(n), y(n), z
  29   common /BLOCK/ x, y, z, j
  30
  31   !$acc parallel loop
  32   do i = 1, n
  33      x(i) = x(i) + z
  34   end do
  35   !$acc end parallel loop
  36 end subroutine incr_parallel
  37
  38 subroutine incr_kernels
  39   use consts
  40
  41   implicit none
  42   integer i, j
  43   real*4 x(n), y(n), z
  44   common /BLOCK/ x, y, z, j
  45
  46   !$acc kernels
  47   do i = 1, n
  48      x(i) = x(i) + z
  49   end do
  50   !$acc end kernels
  51 end subroutine incr_kernels
  52
  53 program main
  54   use consts
  55
  56   implicit none
  57   integer i, j
  58   real*4 a(n), b(n), c
  59   common /BLOCK/ a, b, c, j
  60
  61   !$acc data copyout(a, c)
  62
  63   c = 1.0
  64
  65   !$acc update device(c)
  66
  67   !$acc parallel loop
  68   do i = 1, n
  69      a(i) = i
  70   end do
  71   !$acc end parallel loop
  72
  73   call incr_parallel
  74   call incr_parallel
  75   call incr_parallel
  76   !$acc end data
  77
  78   c = 3.0
  79   call validate
  80
  81   ! Test pcopy without copyout
  82
  83   c = 2.0
  84   call incr_kernels
  85   c = 5.0
  86   call validate
  87
  88   !$acc kernels
  89   do i = 1, n
  90      b(i) = i
  91   end do
  92   !$acc end kernels
  93
  94   !$acc parallel loop
  95   do i = 1, n
  96      a(i) = b(i) + c
  97   end do
  98   !$acc end parallel loop
  99
 100   call validate
 101
 102   a(:) = b(:)
 103   c = 0.0
 104   call validate
 105
 106   ! Test copy
 107
 108   c = 1.0
 109   !$acc parallel loop
 110   do i = 1, n
 111      a(i) = b(i) + c
 112   end do
 113   !$acc end parallel loop
 114
 115   call validate
 116
 117   c = 2.0
 118   !$acc data copyin(b, c) copyout(a)
 119
 120   !$acc kernels
 121   do i = 1, n
 122      a(i) = b(i) + c
 123   end do
 124   !$acc end kernels
 125
 126   !$acc end data
 127
 128   call validate
 129
 130   j = 0
 131
 132   !$acc parallel loop reduction(+:j)
 133   do i = 1, n
 134      j = j + 1
 135   end do
 136   !$acc end parallel loop
 137
 138   if (j .ne. n) stop 2
 139 end program main