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

   1 ! { dg-do run }
   2 !
   3 ! Test data located inside common blocks.  This test does not exercise
   4 ! ACC DECLARE.  All data clauses are explicit.
   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
  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 pcopy(/BLOCK/)
  32   do i = 1, n
  33      x(i) = x(i) + z
  34   end do
  35   !$acc end parallel loop
  36 end subroutine incr
  37
  38 program main
  39   use consts
  40
  41   implicit none
  42   integer i, j
  43   real*4 a(n), b(n), c
  44   common /BLOCK/ a, b, c, j
  45
  46   ! Test copyout, pcopy, device
  47
  48   !$acc data copyout(a, c)
  49
  50   c = 1.0
  51
  52   !$acc update device(c)
  53
  54   !$acc parallel loop pcopy(a)
  55   do i = 1, n
  56      a(i) = i
  57   end do
  58   !$acc end parallel loop
  59
  60   call incr
  61   call incr
  62   call incr
  63   !$acc end data
  64
  65   c = 3.0
  66   call validate
  67
  68   ! Test pcopy without copyout
  69
  70   c = 2.0
  71   call incr
  72   c = 5.0
  73   call validate
  74
  75   ! Test create, delete, host, copyout, copyin
  76
  77   !$acc enter data create(b)
  78
  79   !$acc parallel loop pcopy(b)
  80   do i = 1, n
  81      b(i) = i
  82   end do
  83   !$acc end parallel loop
  84
  85   !$acc update host (b)
  86
  87   !$acc parallel loop pcopy(b) copyout(a) copyin(c)
  88   do i = 1, n
  89      a(i) = b(i) + c
  90   end do
  91   !$acc end parallel loop
  92
  93   !$acc exit data delete(b)
  94
  95   call validate
  96
  97   a(:) = b(:)
  98   c = 0.0
  99   call validate
 100
 101   ! Test copy
 102
 103   c = 1.0
 104   !$acc parallel loop copy(/BLOCK/)
 105   do i = 1, n
 106      a(i) = b(i) + c
 107   end do
 108   !$acc end parallel loop
 109
 110   call validate
 111
 112   ! Test pcopyin, pcopyout FIXME
 113
 114   c = 2.0
 115   !$acc data copyin(b, c) copyout(a)
 116
 117   !$acc parallel loop pcopyin(b, c) pcopyout(a)
 118   do i = 1, n
 119      a(i) = b(i) + c
 120   end do
 121   !$acc end parallel loop
 122
 123   !$acc end data
 124
 125   call validate
 126
 127   ! Test reduction, private
 128
 129   j = 0
 130
 131   !$acc parallel private(i) copy(j)
 132   !$acc loop reduction(+:j)
 133   do i = 1, n
 134      j = j + 1
 135   end do
 136   !$acc end parallel
 137
 138   if (j .ne. n) stop 2
 139
 140   ! Test firstprivate, copy
 141
 142   a(:) = 0
 143   c = j
 144
 145   !$acc parallel loop firstprivate(c) copyout(a)
 146   do i = 1, n
 147      a(i) = i + c
 148   end do
 149   !$acc end parallel loop
 150
 151   call validate
 152 end program main