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

   1 ! { dg-do run }
   2 !
   3 ! Test data located inside common blocks.  This test does not exercise
   4 ! ACC DECLARE.
   5
   6 module const
   7   integer, parameter :: n = 100
   8 end module const
   9
  10 subroutine check
  11   use const
  12
  13   implicit none
  14   integer i, x(n), y
  15   common /BLOCK/ x, y
  16
  17   do i = 1, n
  18      if (x(i) .ne. y) call abort
  19   end do
  20 end subroutine check
  21
  22 module m
  23   use const
  24   integer a(n), b
  25   common /BLOCK/ a, b
  26
  27 contains
  28   subroutine mod_implicit_incr
  29     implicit none
  30     integer i
  31
  32     !$acc parallel loop
  33     do i = 1, n
  34        a(i) = b
  35     end do
  36     !$acc end parallel loop
  37
  38     call check
  39   end subroutine mod_implicit_incr
  40
  41   subroutine mod_explicit_incr
  42     implicit none
  43     integer i
  44
  45     !$acc parallel loop copy(a(1:n)) copyin(b)
  46     do i = 1, n
  47        a(i) = b
  48     end do
  49     !$acc end parallel loop
  50
  51     call check
  52   end subroutine mod_explicit_incr
  53 end module m
  54
  55 subroutine sub_implicit_incr
  56   use const
  57
  58   implicit none
  59   integer i, x(n), y
  60   common /BLOCK/ x, y
  61
  62   !$acc parallel loop
  63   do i = 1, n
  64      x(i) = y
  65   end do
  66   !$acc end parallel loop
  67
  68   call check
  69 end subroutine sub_implicit_incr
  70
  71 subroutine sub_explicit_incr
  72   use const
  73
  74   implicit none
  75   integer i, x(n), y
  76   common /BLOCK/ x, y
  77
  78   !$acc parallel loop copy(x(1:n)) copyin(y)
  79   do i = 1, n
  80      x(i) = y
  81   end do
  82   !$acc end parallel loop
  83
  84   call check
  85 end subroutine sub_explicit_incr
  86
  87 program main
  88   use m
  89
  90   implicit none
  91
  92   a(:) = -1
  93   b = 5
  94   call mod_implicit_incr
  95
  96   a(:) = -2
  97   b = 6
  98   call mod_explicit_incr
  99
 100   a(:) = -3
 101   b = 7
 102   call sub_implicit_incr
 103
 104   a(:) = -4
 105   b = 8
 106   call sub_explicit_incr
 107 end program main