libgomp/testsuite/libgomp.fortran/pointer1.f90

   1 ! { dg-do run }
   2   integer, pointer :: a, c(:)
   3   integer, target :: b, d(10)
   4   b = 0
   5   a => b
   6   d = 0
   7   c => d
   8   call foo (a, c)
   9   b = 0
  10   d = 0
  11   call bar (a, c)
  12 contains
  13   subroutine foo (a, c)
  14     integer, pointer :: a, c(:), b, d(:)
  15     integer :: r, r2
  16     r = 0
  17     !$omp parallel firstprivate (a, c) reduction (+:r)
  18       !$omp atomic
  19         a = a + 1
  20       !$omp atomic
  21         c(1) = c(1) + 1
  22       r = r + 1
  23     !$omp end parallel
  24     if (a.ne.r.or.c(1).ne.r) call abort
  25     r2 = r
  26     b => a
  27     d => c
  28     r = 0
  29     !$omp parallel firstprivate (b, d) reduction (+:r)
  30       !$omp atomic
  31         b = b + 1
  32       !$omp atomic
  33         d(1) = d(1) + 1
  34       r = r + 1
  35     !$omp end parallel
  36     if (b.ne.r+r2.or.d(1).ne.r+r2) call abort
  37   end subroutine foo
  38   subroutine bar (a, c)
  39     integer, pointer :: a, c(:), b, d(:)
  40     integer, target :: q, r(5)
  41     integer :: i
  42     q = 17
  43     r = 21
  44     b => a
  45     d => c
  46     !$omp parallel do firstprivate (a, c) lastprivate (a, c)
  47       do i = 1, 100
  48         !$omp atomic
  49           a = a + 1
  50         !$omp atomic
  51           c((i+9)/10) = c((i+9)/10) + 1
  52         if (i.eq.100) then
  53           a => q
  54           c => r
  55         end if
  56       end do
  57     !$omp end parallel do
  58     if (b.ne.100.or.any(d.ne.10)) call abort
  59     if (a.ne.17.or.any(c.ne.21)) call abort
  60     a => b
  61     c => d
  62     !$omp parallel do firstprivate (b, d) lastprivate (b, d)
  63       do i = 1, 100
  64         !$omp atomic
  65           b = b + 1
  66         !$omp atomic
  67           d((i+9)/10) = d((i+9)/10) + 1
  68         if (i.eq.100) then
  69           b => q
  70           d => r
  71         end if
  72       end do
  73     !$omp end parallel do
  74     if (a.ne.200.or.any(c.ne.20)) call abort
  75     if (b.ne.17.or.any(d.ne.21)) call abort
  76   end subroutine bar
  77 end